C T4M       SOURCE    KICH      09/09/11    21:18:22     6505           
C t4m    SOURCE   G-M ROUX  CHAUFFAGE+REFROIDISSEMENT V6
      SUBROUTINE t4m(iwrk52,iwrk53,iele,igau)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC CCOPTIO
-INC CCHAMP
-INC DECHE


       wrk52 = iwrk52
       wrk53 = iwrk53
C>>>>>>Initialisations des champs
       T0 = ture0(1)
       T1 = turef(1) 
       Tm=(T0 + T1) / 2.
       TPS0=TEMP0
       TPS1=TEMPF
       PHA10 = valma0(1)
       PHA20 = valma0(2)
       PHA30 = valma0(3)
       TINC0 = valma0(4)
       PHA40 = valma0(19)
       XMATF(1)=PHA10
       XMATF(2)=PHA20
       XMATF(3)=PHA30
       XMATF(4)=TINC0
         XMATF(5)=0.
       XMATF(19)=PHA40
       XMATF(15)=valma0(15)
C>>>>>>Initialisation des constantes
       PARR_Ar=valma0(12)
       PARR_Br=valma0(13)
       PARR_Cr=valma0(14)
       AC1=valma0(5)
       PARJMA_k=valma0(6)
       PARJMA_m=valma0(7)
       PARKM_ms=valma0(10)
       PARKM_ks=valma0(11)
       PARHB_k=valma0(8)
       PARHB_e=valma0(9)
       PARHB_n=valma0(16)
       TF1=valma0(17)
       TF2=valma0(18)
C
C>>>>>germination de la phase austénitique
       IF (Tm.GT.AC1.AND.TINC0.LT.1.) THEN
         t_inc1= Tm - AC1
         t_inc2 = (PARR_Cr / t_inc1)
         t_inc3 = EXP(t_inc2)
         t_inc4 = PARR_Br - Tm
         IF (t_inc4.LE.0.) THEN
           XMATF(4)=1.
         ELSE
           t_inc=t_inc3 * t_inc4 * PARR_Ar
           TINC1 = TINC0 + ((TPS1 - TPS0) / t_inc)
           XMATF(4)=TINC1
         ENDIF
         IF (TINC1.GT.1) THEN
           XMATF(4) = 1.
         ENDIF
       ENDIF
C      ->si la germination est terminé, tinc=1
         IF (Tm.GE.AC1.AND.TINC0.EQ.1.OR.PHA20.GT.0) THEN
           XMATF(4) = 1.
         ENDIF
C      ->si T<Ms et yg=0
         IF (Tm.LT.PARKM_ms.AND.PHA20.EQ.0) THEN
           XMATF(4) = 0.
         ENDIF
C      ->si T>Assat
         IF (Tm.GT.PARR_Br) THEN
           XMATF(4) = 1.
         ENDIF
C
C>>>>>>croissance de la phase austénitique (méthode de Heun)
       IF (T1.GT.AC1.AND.XMATF(4).EQ.1.AND.PHA20.LT.1) THEN
         IF (T1.LE.1000) THEN
C      ->on passes les caractéristiques thermiques en Kelvin
         AC1=AC1 + 273.
         T1b=T1 + 273.
         T0b=T0 + 273.
C      ->calcul de Teq(t=ti)
         Teq_11 = AC1 * PARJMA_k
         Teq_12 = 1. - PHA20
         Teq_13 = LOG(Teq_12)
         Teq_14 = Teq_11 + ((-1. * Teq_13) ** (1. / PARJMA_m))
         Teq_1 = (Teq_14 / PARJMA_k)
C      ->calcul de dyA/dt(t=ti)
         dPHA2_1_1 = (-1. * PARHB_e) / (8.31 * T0b)
         dPHA2_1_2 = PARHB_k * EXP(dPHA2_1_1)
          dPHA2_1_3=ABS(T0b - Teq_1)
         dPHA2_1 = dPHA2_1_2 * (dPHA2_1_3 ** PARHB_n) * (1. - PHA20)
C      ->calcul de yA(t=ti)
         PHA2_1=PHA20 + dPHA2_1 * (TPS1 - TPS0)
         IF (PHA2_1.GT.9.999d-01) THEN
           PHA21=1.
         ELSE
C          ->calcul de Teq(t=ti+1)
           Teq_21 = AC1 * PARJMA_k
           Teq_22 = 1. - PHA2_1
           Teq_23 = LOG(Teq_22)
           Teq_24 = Teq_21 + ((-1. * Teq_23) ** (1. / PARJMA_m))
           Teq_2 = (Teq_24 / PARJMA_K)
C          ->calcul de dyA/dt(t=ti+1)
           dPHA2_2_1 = (-1. * PARHB_e) / (8.31 * T1b)
           dPHA2_2_2 = PARHB_k * EXP(dPHA2_2_1)
             dPHA2_2_3=ABS(T1b - Teq_2)
           dPHA2_2 = dPHA2_2_2 * (dPHA2_2_3 ** PARHB_n) * (1. - PHA2_1)
C          ->calcul de yA(t)(ti+1)
           PHA21=PHA20 + ( (dPHA2_1 + dPHA2_2) / 2.)*(TPS1 - TPS0)
           IF (PHA21.GT.9.9d-01) THEN
             PHA21=1.
           ENDIF
         ENDIF
         IF (PHA30.GT.0.AND.PHA10.GT.0.) THEN
C          ->calcul des nouvelles phases si martensite+martensite revenue
           PHA11=PHA10-(PHA21-PHA20)/2.
           PHA31=PHA30-(PHA21-PHA20)/2.
           IF (PHA11.GT.0.) THEN
             PHA11=0.
             PHA31=1 - PHA21
           ENDIF
           IF (PHA31.GT.0.) THEN
             PHA31=0.
             PHA11=1 - PHA21
           ENDIF
           XMATF(2)=PHA21
           XMATF(1)=PHA11
           XMATF(3)=PHA31
           XMATF(15)=PHA21
         ELSE
           IF (PHA10.GT.0.) THEN
C            ->calcul des nouvelles phases si martensite revenue
             XMATF(2)=PHA21
             XMATF(1)=1. - PHA21
             XMATF(3)=0.
             XMATF(15)=PHA21
           ELSE
C          ->calcul des nouvelles phases si martensite
             XMATF(2)=PHA21
             XMATF(3)=1. - PHA21
             XMATF(1)=0.
             XMATF(15)=PHA21
           ENDIF
         ENDIF
       ENDIF
       ENDIF
       IF (T1.GT.1000.AND.T1.LT.TF1) THEN
         XMATF(2)=1.
         XMATF(3)=0.
         XMATF(1)=0.
         XMATF(15)=1.    
         ENDIF
C>>>>>transformation liquide-solide(loi linéaire)
        IF (T1.GE.TF1.AND.T1.LE.TF2) THEN
          XMATF(19)=(T1 - TF1) * (1.d0 / (TF2 - TF1))
          XMATF(2)=1.d0 - XMATF(19)
            XMATF(1)=0.
            XMATF(3)=0.
            XMATF(15)=1.
        ENDIF
        IF (T1.GE.TF2) THEN
          XMATF(19)=1.
          XMATF(2)=0.
            XMATF(1)=0.
            XMATF(15)=1.
            XMATF(4)=1.
            XMATF(3)=0.
        ENDIF
        IF (T1.LT.TF1.AND.PHA40.GT.0.) THEN
          XMATF(19)=0.
          XMATF(2)=1.
            XMATF(1)=0.
            XMATF(15)=1.
            XMATF(3)=0.
        ENDIF
C
C>>>>>transformation martensitique
       IF (T1.LT.T0.AND.PHA20.GT.0.AND.T1.LE.PARKM_ms) THEN
         PHA31_1 = -1. * PARKM_ks *(PARKM_ms - T1)
         PHA31_2 = EXP(PHA31_1)
         PHA31_3=XMATF(15) * (1-PHA31_2)
         PHA11=PHA10
         PHA21=XMATF(15) - PHA31_3
         PHA31=1 - (PHA11 + PHA21)
         IF (PHA21.LT.1.d-03) THEN
           PHA21=0.
           PHA11=PHA10
           PHA31=1 - PHA11
             XMATF(19)=0.
         ENDIF
C        ->sorties
         XMATF(1)=PHA11        
         XMATF(2)=PHA21
         XMATF(3)=PHA31
       ENDIF
C
C>>>>>transformation martensite revenue
         XMATF(20)=0.;
C
       XMATF(5)=valma0(5)
       XMATF(6)=valma0(6)
       XMATF(7)=valma0(7)
       XMATF(8)=valma0(8)
       XMATF(9)=valma0(9)
       XMATF(10)=valma0(10)
       XMATF(11)=valma0(11)
       XMATF(12)=valma0(12)
       XMATF(13)=valma0(13)
       XMATF(14)=valma0(14)
       XMATF(16)=valma0(16)
       XMATF(17)=valma0(17)
       XMATF(18)=valma0(18)
C
       RETURN
       END