1 : C CRPHA4 SOURCE PV 11/03/07 21:16:11 6885 2 : C==================================================================== 3 : C 4 : SUBROUTINE CRPHA4(VWRK1,CARB,iwrk52,IMARQ,DTPS,VWRK2,nhist, 5 : .ilent1,ilent2,iele,igau) 6 : C 7 : C==================================================================== 8 : C 9 : C Calcul de transformations de phases 10 : C appelee par CRPHA3 11 : C 12 : C calcule les nouvelles proportions de phases au point considere 13 : C 14 : C vwrk1 /1 temperature 15 : C /2 vitesse de chauf,refr 16 : C /3 proportion d'austenite 17 : C /4 proportion de ferrite 18 : C /5 proportion de bainite 19 : C /6 proportion de martensite 20 : C /7 temperature de debut de transf. martensitique 21 : C carb taux de carbone moyen 22 : C iptab donnees materiau 23 : C imarq indicateur pour le tri des donnees 24 : C dtps pas de temps 25 : C vwrk2 resultat : vwrk1 actualise 26 : C 27 : C routines appelees 28 : C 1)austenitisation 29 : C TRITE3 tri dans la table des temperatures 30 : C AUSTRK integration de l'equa diff de Leblond 31 : C (runge-kutta ordre 4) 32 : C 2)ferrite+bainite 33 : C VOISI2 recherche des point support de l'interpolation 34 : C INTER9 interpolation/extrapolation 35 : C 36 : C Michael Martinez 12/98 37 : C==================================================================== 38 : C 39 : C Modifications de LB a partir du 15/03/97 40 : C ======================================== 41 : C 1) verifie que les compositions restent positives 42 : C 3) prise en compte de la vitesse mini pour l apparition 43 : C de la martensite 44 : C 45 : IMPLICIT INTEGER(I-N) 46 : IMPLICIT REAL*8(A-H,O-Z) 47 : C 48 : -INC SMNUAGE 49 : -INC SMLENTI 50 : -INC SMLREEL 51 : 52 : -INC DECHE 53 : C 54 : REAL*8 VWRK1(*),VWRK2(7),ZFIN(4),VOIS2(4,3),COEF2(4) 55 : REAL*8 TZFP(4),TZBP(4),CK(10),CL(10),TE(10) 56 : INTEGER IMARQ(2) 57 : C 58 : DATA SMALL /0.000001/, PRESQU_UN /0.99999999/ 59 : C 60 : wrk52 = iwrk52 61 : T0=VWRK1(1) 62 : TP0=VWRK1(2) 63 : ZA0=VWRK1(3) 64 : VMS1=VWRK1(7) 65 : if (iele.eq.1. and.igau.eq.1) then 66 : * write(6,*) 'trpha2 0',T0,TP0,ZA0,VMS1 67 : endif 68 : C 69 : C ON RESTE DANS DES LIMITES RAISONNABLES 70 : C 71 : IF (T0.GT.999.) THEN 72 : VWRK2(1)=VWRK1(1) 73 : VWRK2(2)=VWRK1(2) 74 : VWRK2(3)=1.D0 75 : VWRK2(4)=0.D0 76 : VWRK2(5)=0.D0 77 : VWRK2(6)=0.D0 78 : VWRK2(7)=VWRK1(7) 79 : RETURN 80 : ENDIF 81 : C 82 : C LECTURE DES DONNEES DE LA TABLE : AR1, MS0 ... 83 : C 84 : AC1=xmat0(1) 85 : AR1=xmat0(2) 86 : VMS0=xmat0(3) 87 : BETA=xmat0(4) 88 : AC=xmat0(5) 89 : AA=xmat0(6) 90 : ZS=xmat0(7) 91 : TPLM=xmat0(8) 92 : CARB0=xmat0(9) 93 : 94 : mnuag1 = int(xmat0(17)) 95 : 96 : c NCHAUF=NHIST+3 97 : C 98 : IF (abs(TP0).LT.abs(TPLM)) then 99 : VMS1 = 210. 100 : ENDIF 101 : C 102 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 103 : C 104 : IF ((T0.GT.AR1.AND.ZA0.LT.PRESQU_UN).OR.(TP0.GE.0..AND.T0.GE.AC1 105 : . .AND.ZA0.LT.PRESQU_UN)) THEN 106 : C 107 : C AUSTENITISATION (MODELE DE LEBLOND) 108 : C 109 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 110 : C 111 : C POSITIONNEMENT EN TEMPERATURE 112 : C 113 : T1=T0+TP0*DTPS 114 : mlenti = ilent2 115 : segact mlenti 116 : ntemp = lect(/1) 117 : ITEMP0=IMARQ(1) 118 : ITEMP1=IMARQ(1) 118 : CALL TRITE3 (ilent2,NTEMP,T0,ITEMP0,ITSUP) 118 : CALL TRITE3 (ilent2,NTEMP,T1,ITEMP1,ITSUP) 119 : IMARQ(1)=ITEMP0 120 : C 121 : C RECUPERATION DES DEUX COEF DU MODELE DE LEBLOND 122 : C 123 : segact mlenti 124 : mlree1 = lect(itemp0) 125 : mlree2 = lect(itemp1) 126 : segact mlree1,mlree2 127 : CKA0=mlree1.prog(2) 128 : CLA0=mlree1.prog(3) 129 : 130 : CKA1=mlree2.prog(2) 131 : CLA1=mlree2.prog(3) 132 : segdes mlree1,mlree2 133 : 134 : C AUSTENITISATION 135 : C 135 : CALL AUSTRK(VWRK1,ZFIN,CKA0,CKA1,CLA0,CLA1,DTPS) 136 : C 137 : VWRK2(1)=T0 138 : VWRK2(2)=TP0 139 : VWRK2(3)=ZFIN(1) 140 : VWRK2(4)=ZFIN(2) 141 : VWRK2(5)=ZFIN(3) 142 : VWRK2(6)=ZFIN(4) 143 : VWRK2(7)=VMS0-AC*(CARB-CARB0) 144 : C 145 : ELSE 146 : if (iele.eq.1. and.igau.eq.1) then 147 : * write(6,*) 'trpha2 11' 148 : endif 149 : VWRK2(1)=VWRK1(1) 150 : VWRK2(2)=VWRK1(2) 151 : VWRK2(3)=VWRK1(3) 152 : VWRK2(4)=VWRK1(4) 153 : VWRK2(5)=VWRK1(5) 154 : VWRK2(6)=VWRK1(6) 155 : VWRK2(7)=VWRK1(7) 156 : C 157 : ENDIF 158 : C 159 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 160 : C 161 : IF (TP0.GE.0..AND.T0.LT.AC1) THEN 162 : C 163 : C CHAUFFAGE EN DESSOUS DE AC1 --> PAS DE TRANSFORMATIONS 164 : C 165 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 166 : C 167 : VWRK2(1)=VWRK1(1) 168 : VWRK2(2)=VWRK1(2) 169 : VWRK2(3)=VWRK1(3) 170 : VWRK2(4)=VWRK1(4) 171 : VWRK2(5)=VWRK1(5) 172 : VWRK2(6)=VWRK1(6) 173 : VWRK2(7)=VWRK1(7) 174 : C 175 : ENDIF 176 : C 177 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 178 : C 179 : IF (TP0.LT.0..AND.T0.LE.AR1.AND.T0.GT.VMS1) THEN 180 : C 181 : C TRANSFORMATION AUSTENITE --> FERRITE + BAINITE 182 : C 183 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 184 : if (iele.eq.1. and.igau.eq.1) then 185 : * write(6,*) 'trpha2 3' 186 : endif 187 : C 188 : C IL N'Y A DE TRANSFORMATION 189 : C QUE POUR UN MATERIAU CONTENANT DE L'AUSTENITE 190 : C 191 : IF (VWRK1(3).LT.SMALL) THEN 192 : VWRK2(1)=VWRK1(1) 193 : VWRK2(2)=VWRK1(2) 194 : VWRK2(3)=VWRK1(3) 195 : VWRK2(4)=VWRK1(4) 196 : VWRK2(5)=VWRK1(5) 197 : VWRK2(6)=VWRK1(6) 198 : VWRK2(7)=VWRK1(7) 199 : ELSE 200 : C 201 : C (FIN MODIF MM) 202 : C 203 : C --> RECHERCHE DES VOISINS 204 : C ON COMMENCE PAR ENCADRER LA TEMPERATURE T0 205 : C SUR LA PREMIERE COURBE 206 : C 207 : C INITIALISATION DE VOIS2 208 : C 209 : VOIS2(1,1)=0 210 : VOIS2(2,1)=0 211 : VOIS2(3,1)=0 212 : VOIS2(4,1)=0 213 : VOIS2(1,2)=0.D0 214 : VOIS2(2,2)=0.D0 215 : VOIS2(3,2)=0.D0 216 : VOIS2(4,2)=0.D0 217 : VOIS2(1,3)=100000.D0 218 : VOIS2(2,3)=100000.D0 219 : VOIS2(3,3)=100000.D0 220 : VOIS2(4,3)=100000.D0 221 : C 222 : C DETERMINATION DES QUATRES POINTS LES PLUS PROCHES 223 : C (==> VOIS2) 224 : C 224 : CALL VOISI2(T0,TP0,ZA0,VOIS2,IMARQ,ilent1,iele,igau) 225 : if (iele.eq.1. and.igau.eq.1) then 226 : * write(6,*) t0,tp0,za0 227 : endif 228 : C 229 : C INTERPOLATION A PARTIR DE VOIS2 230 : C 230 : CALL INTER9(T0,TP0,ZA0,VOIS2,COEF2,ilent1) 231 : C 232 : MLENTI = ILENT1 233 : segact mlenti 234 : C 235 : DO 1002 I=1,4 236 : IHIST=nint(VOIS2(I,1)) 237 : mlent1 = lect(ihist) 238 : segact mlent1 239 : ITEMP=nint(VOIS2(I,2)) 240 : mlreel = mlent1.lect(itemp) 241 : segact mlreel 242 : za = prog(3) 243 : zf = prog(4) 244 : zb = prog(5) 245 : zfp = prog(8) 246 : zbp = prog(9) 247 : tk = prog(1) 248 : tkp = prog(2) 249 : if (iele.eq.1. and.igau.eq.1) then 250 : * write(6,*) 'yo', i,ihist,itemp 251 : * write(6,*) tk,tkp,za, zf 252 : endif 253 : IF (ZA.LT.SMALL) THEN 254 : TZFP(I) = 0 255 : TZBP(I) = 0 256 : ELSE 257 : TZFP(I)=ZFP/ZA 258 : TZBP(I)=ZBP/ZA 259 : ENDIF 260 : segdes mlreel,mlent1 261 : 1002 CONTINUE 262 : C 263 : segdes mlenti 264 : C 265 : TZFP0=COEF2(1)*TZFP(1)+COEF2(2)*TZFP(2)+COEF2(3)*TZFP(3) 266 : & +COEF2(4)*TZFP(4) 267 : TZBP0=COEF2(1)*TZBP(1)+COEF2(2)*TZBP(2)+COEF2(3)*TZBP(3) 268 : & +COEF2(4)*TZBP(4) 269 : ZFP0=TZFP0*ZA0 270 : ZBP0=TZBP0*ZA0 271 : C 272 : VWRK2(1)=VWRK1(1) 273 : VWRK2(2)=VWRK1(2) 274 : VWRK2(4)=VWRK1(4)+ZFP0*DTPS 275 : VWRK2(5)=VWRK1(5)+ZBP0*DTPS 276 : C 277 : C MODIF DE LB : 278 : C 279 : C CONTROLE POUR BAINITE OU FERRITE POSITIVE 280 : C 281 : IF (VWRK2(4).LT.0.0) THEN 282 : VWRK2(4) = 0.0 283 : ENDIF 284 : IF (VWRK2(5).LT.0.0) THEN 285 : VWRK2(5) = 0.0 286 : ENDIF 287 : C 288 : C CONTROLE POUR GARDER AUSTENITE POSITIVE : 289 : C on verifie que BAINITE + FERRITE <= 1 290 : C 291 : C si creation de ferrite 292 : C 293 : IF (ZFP0.GT.ZBP0) THEN 294 : IF ((VWRK2(4)+VWRK2(5)).GT.1.0) THEN 295 : VWRK2(4) = 1.0 - VWRK2(5) 296 : ENDIF 297 : C 298 : C si creation de bainite 299 : C 300 : ELSE IF ((VWRK2(4)+VWRK2(5)).GT.1.0) THEN 301 : VWRK2(5) = 1.0 - VWRK2(4) 302 : ENDIF 303 : C 304 : C FIN MODIF LB 305 : C 306 : VWRK2(3)=1.D0-(VWRK2(4)+VWRK2(5)) 307 : VWRK2(6)=VWRK1(6) 308 : C 309 : C TEMPERATURE DE DEBUT DE TRANSF. MARTENSITIQUE 310 : C 311 : ZTRSF = 1. - VWRK2(3) 312 : DZ = ZTRSF - ZS 313 : IF (DZ.LT.0.D0) THEN 314 : DZ=0.D0 315 : ENDIF 316 : VWRK2(7)=VMS0-AC*(CARB-CARB0)-AA*DZ 317 : C 318 : ENDIF 319 : C 320 : ENDIF 321 : C 322 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 323 : C 324 : IF (TP0.LT.0..AND.T0.LE.VMS1) THEN 325 : C 326 : C TRANSFORMATION MARTENSITIQUE 327 : C 328 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 329 : C 330 : VWRK2(7)=VWRK1(7) 331 : VWRK2(5)=VWRK1(5) 332 : VWRK2(4)=VWRK1(4) 333 : VWRK2(2)=VWRK1(2) 334 : VWRK2(1)=VWRK1(1) 335 : C 336 : C CALCUL DU TAUX DE MARTENSITE (AVEC IRREVERSIBILITE) 337 : C 338 : ZAN=1.D0-(VWRK1(4)+VWRK1(5)) 339 : DELTT=VMS1-T0 340 : ZM1=VWRK1(6) 341 : ZM2=ZAN*(1.D0-DEXP(BETA*DELTT)) 342 : IF (ZM2.GT.ZM1) THEN 343 : VWRK2(6)=ZM2 344 : ELSE 345 : VWRK2(6)=ZM1 346 : ENDIF 347 : C 348 : C FIN MODIF MM 349 : C 350 : tem_00 = BETA * DELTT 351 : C 352 : C MODIF DE LB 353 : C 354 : C POUR GARDER L'AUSTENITE POSITIVE 355 : C 356 : IF ((VWRK2(4)+VWRK2(5)+VWRK2(6)).GE.1.0) THEN 357 : VWRK2(6) = 1.d0 - (VWRK2(4)+VWRK2(5)) 358 : VWRK2(3) = 0.d0 359 : ELSE 360 : VWRK2(3)=1.0D0 - (VWRK2(4)+VWRK2(5)+VWRK2(6)) 361 : ENDIF 362 : C 363 : C FIN MODIF LB 364 : C 365 : ENDIF 366 : C 367 : RETURN 368 : END 369 : 370 : 371 : 372 : 373 : 374 : 375 :
© Cast3M 2003 - All rights reserved.
Disclaimer