C CRPHA4 SOURCE PV 17/12/08 21:17:07 9660 C==================================================================== C SUBROUTINE CRPHA4(VWRK1,CARB,iwrk52,IMARQ,DTPS,VWRK2,nhist, .ilent1,ilent2,iele,igau) C C==================================================================== C C Calcul de transformations de phases C appelee par CRPHA3 C C calcule les nouvelles proportions de phases au point considere C C vwrk1 /1 temperature C /2 vitesse de chauf,refr C /3 proportion d'austenite C /4 proportion de ferrite C /5 proportion de bainite C /6 proportion de martensite C /7 temperature de debut de transf. martensitique C carb taux de carbone moyen C iptab donnees materiau C imarq indicateur pour le tri des donnees C dtps pas de temps C vwrk2 resultat : vwrk1 actualise C C routines appelees C 1)austenitisation C TRITE3 tri dans la table des temperatures C AUSTRK integration de l'equa diff de Leblond C (runge-kutta ordre 4) C 2)ferrite+bainite C VOISI2 recherche des point support de l'interpolation C INTER9 interpolation/extrapolation C C Michael Martinez 12/98 C==================================================================== C C Modifications de LB a partir du 15/03/97 C ======================================== C 1) verifie que les compositions restent positives C 3) prise en compte de la vitesse mini pour l apparition C de la martensite C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C -INC SMNUAGE -INC SMLENTI -INC SMLREEL -INC DECHE C REAL*8 VWRK1(*),VWRK2(7),ZFIN(4),VOIS2(4,3),COEF2(4) REAL*8 TZFP(4),TZBP(4),CK(10),CL(10),TE(10) INTEGER IMARQ(2) C DATA SMALL /0.000001/, PRESQU_UN /0.99999999/ C wrk52 = iwrk52 T0=VWRK1(1) TP0=VWRK1(2) ZA0=VWRK1(3) VMS1=VWRK1(7) if (iele.eq.1. and.igau.eq.1) then * write(6,*) 'trpha2 0',T0,TP0,ZA0,VMS1 endif C C ON RESTE DANS DES LIMITES RAISONNABLES C IF (T0.GT.999.) THEN VWRK2(1)=VWRK1(1) VWRK2(2)=VWRK1(2) VWRK2(3)=1.D0 VWRK2(4)=0.D0 VWRK2(5)=0.D0 VWRK2(6)=0.D0 VWRK2(7)=VWRK1(7) RETURN ENDIF C C LECTURE DES DONNEES DE LA TABLE : AR1, MS0 ... C AC1=xmat0(1) AR1=xmat0(2) VMS0=xmat0(3) BETA=xmat0(4) AC=xmat0(5) AA=xmat0(6) ZS=xmat0(7) TPLM=xmat0(8) CARB0=xmat0(9) mnuag1 = int(xmat0(17)) c NCHAUF=NHIST+3 C IF (abs(TP0).LT.abs(TPLM)) then VMS1 = 210. ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF ((T0.GT.AR1.AND.ZA0.LT.PRESQU_UN).OR.(TP0.GE.0..AND.T0.GE.AC1 . .AND.ZA0.LT.PRESQU_UN)) THEN C C AUSTENITISATION (MODELE DE LEBLOND) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C POSITIONNEMENT EN TEMPERATURE C T1=T0+TP0*DTPS mlenti = ilent2 segact mlenti ntemp = lect(/1) ITEMP0=IMARQ(1) ITEMP1=IMARQ(1) CALL TRITE3 (ilent2,NTEMP,T0,ITEMP0,ITSUP) CALL TRITE3 (ilent2,NTEMP,T1,ITEMP1,ITSUP) IMARQ(1)=ITEMP0 C C RECUPERATION DES DEUX COEF DU MODELE DE LEBLOND C segact mlenti mlree1 = lect(itemp0) mlree2 = lect(itemp1) segact mlree1,mlree2 CKA0=mlree1.prog(2) CLA0=mlree1.prog(3) CKA1=mlree2.prog(2) CLA1=mlree2.prog(3) segdes mlree1,mlree2 C AUSTENITISATION C CALL AUSTRK(VWRK1,ZFIN,CKA0,CKA1,CLA0,CLA1,DTPS) C VWRK2(1)=T0 VWRK2(2)=TP0 VWRK2(3)=ZFIN(1) VWRK2(4)=ZFIN(2) VWRK2(5)=ZFIN(3) VWRK2(6)=ZFIN(4) VWRK2(7)=VMS0-AC*(CARB-CARB0) C ELSE if (iele.eq.1. and.igau.eq.1) then * write(6,*) 'trpha2 11' endif VWRK2(1)=VWRK1(1) VWRK2(2)=VWRK1(2) VWRK2(3)=VWRK1(3) VWRK2(4)=VWRK1(4) VWRK2(5)=VWRK1(5) VWRK2(6)=VWRK1(6) VWRK2(7)=VWRK1(7) C ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF (TP0.GE.0..AND.T0.LT.AC1) THEN C C CHAUFFAGE EN DESSOUS DE AC1 --> PAS DE TRANSFORMATIONS C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C VWRK2(1)=VWRK1(1) VWRK2(2)=VWRK1(2) VWRK2(3)=VWRK1(3) VWRK2(4)=VWRK1(4) VWRK2(5)=VWRK1(5) VWRK2(6)=VWRK1(6) VWRK2(7)=VWRK1(7) C ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF (TP0.LT.0..AND.T0.LE.AR1.AND.T0.GT.VMS1) THEN C C TRANSFORMATION AUSTENITE --> FERRITE + BAINITE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC if (iele.eq.1. and.igau.eq.1) then * write(6,*) 'trpha2 3' endif C C IL N'Y A DE TRANSFORMATION C QUE POUR UN MATERIAU CONTENANT DE L'AUSTENITE C IF (VWRK1(3).LT.SMALL) THEN VWRK2(1)=VWRK1(1) VWRK2(2)=VWRK1(2) VWRK2(3)=VWRK1(3) VWRK2(4)=VWRK1(4) VWRK2(5)=VWRK1(5) VWRK2(6)=VWRK1(6) VWRK2(7)=VWRK1(7) ELSE C C (FIN MODIF MM) C C --> RECHERCHE DES VOISINS C ON COMMENCE PAR ENCADRER LA TEMPERATURE T0 C SUR LA PREMIERE COURBE C C INITIALISATION DE VOIS2 C VOIS2(1,1)=0 VOIS2(2,1)=0 VOIS2(3,1)=0 VOIS2(4,1)=0 VOIS2(1,2)=0.D0 VOIS2(2,2)=0.D0 VOIS2(3,2)=0.D0 VOIS2(4,2)=0.D0 VOIS2(1,3)=100000.D0 VOIS2(2,3)=100000.D0 VOIS2(3,3)=100000.D0 VOIS2(4,3)=100000.D0 C C DETERMINATION DES QUATRES POINTS LES PLUS PROCHES C (==> VOIS2) C CALL VOISI2(T0,TP0,ZA0,VOIS2,IMARQ,ilent1,iele,igau) if (iele.eq.1. and.igau.eq.1) then * write(6,*) t0,tp0,za0 endif C C INTERPOLATION A PARTIR DE VOIS2 C CALL INTER9(T0,TP0,ZA0,VOIS2,COEF2,ilent1) C MLENTI = ILENT1 segact mlenti C DO 1002 I=1,4 IHIST=nint(VOIS2(I,1)) mlent1 = lect(ihist) segact mlent1 ITEMP=nint(VOIS2(I,2)) mlreel = mlent1.lect(itemp) segact mlreel za = prog(3) zf = prog(4) zb = prog(5) zfp = prog(8) zbp = prog(9) tk = prog(1) tkp = prog(2) if (iele.eq.1. and.igau.eq.1) then * write(6,*) 'yo', i,ihist,itemp * write(6,*) tk,tkp,za, zf endif IF (ZA.LT.SMALL) THEN TZFP(I) = 0 TZBP(I) = 0 ELSE TZFP(I)=ZFP/ZA TZBP(I)=ZBP/ZA ENDIF segdes mlreel,mlent1 1002 CONTINUE C segdes mlenti C TZFP0=COEF2(1)*TZFP(1)+COEF2(2)*TZFP(2)+COEF2(3)*TZFP(3) & +COEF2(4)*TZFP(4) TZBP0=COEF2(1)*TZBP(1)+COEF2(2)*TZBP(2)+COEF2(3)*TZBP(3) & +COEF2(4)*TZBP(4) ZFP0=TZFP0*ZA0 ZBP0=TZBP0*ZA0 C VWRK2(1)=VWRK1(1) VWRK2(2)=VWRK1(2) VWRK2(4)=VWRK1(4)+ZFP0*DTPS VWRK2(5)=VWRK1(5)+ZBP0*DTPS C C MODIF DE LB : C C CONTROLE POUR BAINITE OU FERRITE POSITIVE C IF (VWRK2(4).LT.0.0) THEN VWRK2(4) = 0.0 ENDIF IF (VWRK2(5).LT.0.0) THEN VWRK2(5) = 0.0 ENDIF C C CONTROLE POUR GARDER AUSTENITE POSITIVE : C on verifie que BAINITE + FERRITE <= 1 C C si creation de ferrite C IF (ZFP0.GT.ZBP0) THEN IF ((VWRK2(4)+VWRK2(5)).GT.1.0) THEN VWRK2(4) = 1.0 - VWRK2(5) ENDIF C C si creation de bainite C ELSE IF ((VWRK2(4)+VWRK2(5)).GT.1.0) THEN VWRK2(5) = 1.0 - VWRK2(4) ENDIF C C FIN MODIF LB C VWRK2(3)=1.D0-(VWRK2(4)+VWRK2(5)) VWRK2(6)=VWRK1(6) C C TEMPERATURE DE DEBUT DE TRANSF. MARTENSITIQUE C ZTRSF = 1. - VWRK2(3) DZ = ZTRSF - ZS IF (DZ.LT.0.D0) THEN DZ=0.D0 ENDIF VWRK2(7)=VMS0-AC*(CARB-CARB0)-AA*DZ C ENDIF C ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF (TP0.LT.0..AND.T0.LE.VMS1) THEN C C TRANSFORMATION MARTENSITIQUE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C VWRK2(7)=VWRK1(7) VWRK2(5)=VWRK1(5) VWRK2(4)=VWRK1(4) VWRK2(2)=VWRK1(2) VWRK2(1)=VWRK1(1) C C CALCUL DU TAUX DE MARTENSITE (AVEC IRREVERSIBILITE) C ZAN=1.D0-(VWRK1(4)+VWRK1(5)) DELTT=VMS1-T0 ZM1=VWRK1(6) ZM2=ZAN*(1.D0-EXP(BETA*DELTT)) IF (ZM2.GT.ZM1) THEN VWRK2(6)=ZM2 ELSE VWRK2(6)=ZM1 ENDIF C C FIN MODIF MM C tem_00 = BETA * DELTT C C MODIF DE LB C C POUR GARDER L'AUSTENITE POSITIVE C IF ((VWRK2(4)+VWRK2(5)+VWRK2(6)).GE.1.0) THEN VWRK2(6) = 1.d0 - (VWRK2(4)+VWRK2(5)) VWRK2(3) = 0.d0 ELSE VWRK2(3)=1.0D0 - (VWRK2(4)+VWRK2(5)+VWRK2(6)) ENDIF C C FIN MODIF LB C ENDIF C RETURN END