1 : C CFLUN2 SOURCE KICH 09/09/11 21:15:55 6505 2 : SUBROUTINE CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3, 3 : & IB,IGAU,NBPGAU,NBGMAT,NELMAT,IFOURB) 4 : * 5 : * modele fluage type Norton dep/dt = C sig^n t^m 6 : * traite sigf = sig0 + k (deps - dep) 7 : * on pourrait separer deviateur et terme spherique 8 : * 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8 (A-H,O-Z) 11 : -INC CCOPTIO 12 : -INC DECHE 13 : -INC SMLREEL 14 : -INC SMEVOLL 15 : * 16 : * 17 : * 18 : SEGMENT WRK2 19 : REAL*8 TRAC(LTRAC) 20 : ENDSEGMENT 21 : * 22 : SEGMENT WRK3 23 : REAL*8 WORK(LW),WORK2(LW2) 24 : ENDSEGMENT 25 : * 26 : dimension spri0(8),delep0(8),spri1(8),delep1(8), 27 : &DIV(8) 28 : 29 : 30 : 31 : * cas isotrope 32 : ip1 = 4 33 : * 34 : youn0 = xmat0(1) 35 : sigy0 = xmat0(ip1+1) 36 : xc0 = xmat0(ip1+2) 37 : xn0 = xmat0(ip1+3) 38 : xm0 = xmat0(ip1+4) 39 : ips0 = int(xmat0(ip1+5)) 40 : ipe0 = int(xmat0(ip1+6)) 41 : x2mu0= xmat0(1)/(1.+xmat0(2)) 42 : 43 : 44 : if(ib.eq.1.and.igau.eq.1) then 45 : * write(6,*) 't0' , youn0, sigy0, xn0 ,xm0 ,gk0,pk0 46 : endif 47 : 48 : youn1 = xmat(1) 49 : sigy1 = xmat(ip1+1) 50 : xc1 = xmat(ip1+2) 51 : xn1 = xmat(ip1+3) 52 : xm1 = xmat(ip1+4) 53 : ips1 = int(xmat(ip1+5)) 54 : ipe1 = int(xmat(ip1+6)) 55 : x2mu1= xmat(1)/(1.+xmat(2)) 56 : 57 : if(ib.eq.1.and.igau.eq.1) then 58 : * write(6,*) 't1' ,ips1,ipe1 59 : endif 60 : * 61 : delt = tempf - temp0 62 : if (delt.lt.0..or.tempf.lt.0.) then 63 : moterr(1:16) = conm 64 : moterr(17:24) = 'CFLUN2-5' 64 : call erreur(943) 65 : return 66 : endif 67 : 68 : C---------CARACTERISTIQUES GEOMETRIQUES--------------------------------- 69 : C 70 : C COQUES 71 : C 72 : ALFAH=1.D0 73 : IF(MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 74 : EP1=work(1) 75 : IF(MFR.NE.5) ALFAH=work(2)**2 76 : ENDIF 77 : C---------COQUES AVEC CT------------------------------------------------ 78 : C ON NE TRAVAILLE QUE SUR LES 6 PREMIERES COMPOSANTES 79 : 80 : IF(MFR.EQ.9) THEN 81 : NCONT=6 82 : ELSE 83 : NCONT=NSTRS 84 : ENDIF 85 : 86 : * calcul increments de contrainte 87 : * remarque on utilise les caracteristiques elastiques a la date finale 88 : 88 : CALL CALSIG(depst,DDAUX,NSTAUX,CMATE,VALMAT,VALCAR, 89 : & N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST, 90 : & NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR, 91 : & XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,dsigt,IRTD) 92 : 93 : IF(IRTD.NE.1) THEN 94 : KERRE=69 95 : GOTO 1010 96 : ENDIF 97 : 98 : * determine direction et sens de sigf et eflu 99 : 100 : DO I=1,NSTRS 101 : DSIGT(I)=SIG0(I) + dsigt(i) 102 : ENDDO 103 : 104 : C---------CAS DES POUTRES----------------------------------------------- 105 : 106 : IF(MFR.EQ.7) THEN 107 : DIV(1)=1.D0/work(4) 108 : DIV(2)=1.D0 109 : DIV(3)=1.D0 110 : DIV(4)=work(10)/work(1) 111 : DIV(5)=work(11)/work(2) 112 : DIV(6)=work(12)/work(3) 113 : IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(work(1)*work(4)) 114 : IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(work(2)*work(4)) 115 : IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(work(3)*work(4)) 116 : DO I=1,NCONT 117 : DSIGT(I)= DSIGT(I)*DIV(I) 118 : ENDDO 119 : ENDIF 120 : * 121 : * raisonne en deviateur 122 : trsig0 = (dsigt(1) + dsigt(2) + dsigt(3)) * 0.33333333333d0 123 : spri0(1) = dsigt(1) - trsig0 124 : spri0(2) = dsigt(2) - trsig0 125 : spri0(3) = dsigt(3) - trsig0 126 : do is = 4,nstrs 127 : spri0(is) = dsigt(is) 128 : enddo 129 : 130 : C----------------------------------------------------------------------- 131 : C CALCUL DE LA CONTRAINTE EQUIVALENTE SEQ 132 : C----------------------------------------------------------------------- 133 : seqtot=VONMIS0(spri0,NSTRS,MFR,IFOURB,EP1,ALFAH) 134 : 135 : if (seqtot - sigy1.gt.0.) then 136 : seq0 = seqtot 137 : else 138 : * pas de termes inelastiques 139 : do ic = 1,nstrs 140 : sigf(ic) = dsigt(ic) 141 : enddo 142 : varf(1) = var0(1) 143 : varf(2) = var0(2) 144 : goto 1002 145 : return 146 : endif 147 : 148 : if (xn1.ge.0..and.xc1.ge.0..and.xm1.ge.0..AND.x2mu1.ge.0.) then 149 : else 150 : moterr(1:16) = conm 151 : moterr(17:24) = 'CFLUEN-1' 152 : c write(6,*) xn1,xc1,xm1,x2mu1 152 : call erreur(943) 153 : return 154 : endif 155 : 156 : * point fixe pour determiner le multiplicateur de sigtot/seqtot 157 : icaz = 1 158 : do ipfx = 1,50 159 : if(ib.eq.1.and.igau.eq.1) then 160 : c write(6,*) 'pt fixe' , ipfx, seq0,seqtot,icaz 161 : endif 162 : goto (70,80) icaz 163 : 70 continue 164 : * fonction 165 : delr0 = (seq0 ** xn1) * (tempf ** xm1) 166 : xmult = delr0 * xc1 * delt * x2mu1 167 : seq01 = seqtot - xmult 168 : goto 90 169 : 170 : * fonction associee 171 : 80 continue 172 : xmult = seqtot - seq0 173 : delr0 = xmult / delt/xc1 / (tempf ** xm1) / x2mu1 174 : seq01 = delr0 ** (1/xn1) 175 : goto 90 176 : 177 : 90 continue 178 : if(ib.eq.1.and.igau.eq.1) then 179 : * write(6,*) 'delr0' , delr0,xmult,seq01, icaz 180 : endif 181 : if (ipfx.eq.1) then 182 : if (seq01.lt.0) then 183 : icaz = 2 184 : seq01 = seqtot/2. 185 : else if (seq01.eq.0.) then 186 : icaz =1 187 : seq01 = seqtot/2. 188 : endif 189 : endif 190 : varseq = abs((seq01 - seq0) / seq0) 191 : if (ib.eq.1.and.igau.eq.1) then 192 : c write(6,*) 'variation relative', varseq 193 : endif 194 : seq0 = seq01 195 : if (seq0 .lt.0.) then 196 : c write(6,*) 'erreur point fixe', seqtot, seq0 197 : moterr(1:16) = conm 198 : moterr(17:24) = 'CFLUN2-6' 198 : call erreur(943) 199 : return 200 : endif 201 : if (varseq.lt.1.e-6) goto 100 202 : 203 : enddo 204 : 205 : 100 if (seqtot - seq0 .lt.0.) then 206 : c write(6,*) 'erreur point fixe', seqtot, seq0 207 : moterr(1:16) = conm 208 : moterr(17:24) = 'CFLUN2-7' 208 : call erreur(943) 209 : return 210 : endif 211 : 212 : c au final 213 : 1000 continue 214 : do ic = 1,nstrs 215 : sigf(ic) = dsigt(ic) * seq0 / seqtot 216 : enddo 217 : 218 : 219 : varf(1) = var0(1) + xc1*(seq0**xn1)*(tempf**xm1)*delt 220 : varf(2) = var0(2) 221 : 222 : * position vis a vis des abaques 223 : if (ips1.gt.0) then 224 : temcri =0.d0 225 : 226 : mevoll = ips1 227 : segact mevoll 228 : kevoll = ievoll(1) 229 : segact kevoll 230 : mlree1 = iprogx 231 : mlree2 = iprogy 232 : segact mlree1,mlree2 233 : nds = mlree2.prog(/1) 234 : * suppose valeurs de contraintes decroissantes et temps croissants 235 : do jds=1,nds-1 236 : if (mlree2.prog(jds).le.mlree2.prog(jds+1).or. 237 : &mlree1.prog(jds).ge.mlree1.prog(jds+1)) then 238 : moterr(1:16) = conm 239 : moterr(17:24) = 'CFLUN2-8' 239 : call erreur(943) 240 : return 241 : endif 242 : if(mlree2.prog(jds).ge.seq0.and.seq0.gt.mlree2.prog(jds+1))then 243 : tosig = (mlree2.prog(jds) - seq0)/ 244 : & (mlree2.prog(jds) - mlree2.prog(jds+1)) 245 : * interpole logarithmiquement 246 : utemp = tosig * (log(mlree1.prog(jds+1)) 247 : & - log(mlree1.prog(jds))) + log(mlree1.prog(jds)) 248 : temcri = exp(utemp) 249 : * 250 : goto 1001 251 : endif 252 : enddo 253 : 254 : 1001 if (temcri.gt.0) then 255 : varf(2) = var0(2) + delt/temcri 256 : if (varf(2).gt.1) then 257 : write(6,*) 'detruire prochaine etape', ipmail, conm,ib,igau 258 : endif 259 : endif 260 : endif 261 : 262 : 1002 continue 263 : if(ib.eq.1.and.igau.eq.1) then 264 : c write(6,*) 't0' ,sigf(3),varf(1),varf(2),depst(3),dsigt(3) 265 : endif 266 : 267 : 1010 continue 268 : RETURN 269 : END 270 : 271 : 272 : 273 : 274 : 275 :
© Cast3M 2003 - All rights reserved.
Disclaimer