Sources Esope | Cast3M

crpha3
C CRPHA3    SOURCE    JK148537  23/03/20    21:15:04     11638          
C=======================================================================
C
      SUBROUTINE CRPHA3(iwrk52,iwrk53,ilent1,ilent2,iele,igau)
C
C=======================================================================
C
C
C       Calcul de transformations de phases
C       appelee par COMP
C
C       balaye le maillage
C       en chaque point de gauss : *calcul de Tpoint efficace
C                                  *appel a CRPHA4 et recupere
C                                   les nouvelles proportions de phases
C
C       Michael Martinez 12/98
C
C
C insertion dans COMP et appel par COML7
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC CCHAMP
-INC SMNUAGE
-INC SMLENTI
 
-INC DECHE
*
C
      REAL*8 VWRK1(7),VWRK2(7)
C
      INTEGER IMARQ(2)
      wrk52 = iwrk52
*      segact wrk52*mod
      wrk53 = iwrk53
*      segact wrk53*nomod
C
C     RECUPERATION DES COEF D'INFLUENCE DE
C     LA CONCENTRATION EN CARBONE ET DE LA TAILLE DE GRAINS
C
         CARB0=valma0(9)
          A1=valma0(10)
          DG0=valma0(11)
          A2=valma0(12)
C
C     RECUPERATION DU PAS D'INTEGRATION EN TEMPS
C
        mnuag1 = int(valma0(17))
        segact mnuag1*nomod
        nuavfl = mnuag1.nuapoi(1)
        segact nuavfl*nomod
        NHIST=nuaflo(/1)
c        NMAX=NHIST+4
c       NMAX=MLOTAB
*        DTPS = valma0(23)
        DTPS = valma0(19)
 10   continue
C
C
C
C
C
C
C       MODIF MM
C
C
C
C
CC
 
           T0 = turef(1)
C
* vitesse thermique ?
           if ((tempf-temp0).gt.0) then
             TPOINT0=(turef(1) - ture0(1))/(tempf-temp0)
           else
             TPOINT0 = 0.
           endif
C
*           ZA0=valma0(18)
           ZA0=rhas0(1)
C
*           ZF0=valma0(19)
           ZF0=rhas0(2)
C
*           ZB0=valma0(20)
           ZB0=rhas0(3)
C
*           ZM0=valma0(21)
           ZM0=rhas0(4)
C
*           VMS0=valma0(22)
           VMS0=valma0(18)
C
C          MODIF MM
C
           IF (CMATE.EQ.'MGRAIN') THEN
               CARB=valma0(33)
           ELSE
              CARB=CARB0
           ENDIF
C
           IF (CMATE.EQ.'MGRAIN') THEN
              DG=valma0(34)
           ELSE
              DG=DG0
           ENDIF
C
C     MODIF MM 23/07/98
C     ON PARAMETRE LA VITESSE DE REFROIDISSEMENT EN FONCTION
C     DE LA CONCENTRATION EN CARBONE ET DE LA TAILLE DE GRAINS
C     ! LE PAS D'INTEGRATION EN TEMPS DOIT ETRE MODIFIE AUSSI
C
           IF (TPOINT0.LT.0.) THEN
              TPFICTA=TPOINT0*EXP(A1*(CARB-CARB0))
              TPFICT0=TPFICTA*EXP(A2*(DG-DG0))
              DTPSFIC=DTPS*(TPOINT0/TPFICT0)
C              write (*,*)'CARB' ,CARB, '  CARB0' ,CARB0
C              write (*,*)'A1' ,A1
C              FR3 = A1*(CARB-CARB0)
C              write (*,*) ' FR3' ,FR3
C              write (*,*) ' TPOINT0' ,TPOINT0 ,'   TPFICTA', TPFICTA,
C     .        '   TPFICT0' ,TPFICT0
           ELSE
              TPFICT0=TPOINT0
              DTPSFIC=DTPS
           ENDIF
C
C     FIN MODIF MM
C
           VWRK1(1)=T0
           VWRK1(2)=TPFICT0
           VWRK1(3)=ZA0
           VWRK1(4)=ZF0
           VWRK1(5)=ZB0
           VWRK1(6)=ZM0
           VWRK1(7)=VMS0
C
C     DETERMINATION DES POINT PROCHES  DE T0, TPOINT0, Z0
C     INTERPOLATION PUIS CALCUL DU NOUVEAU CHAMP DE PHASES
C
           IF (IELE.EQ.1.AND.IGAU.EQ.1) THEN
              IMARQ(1)=0
              IMARQ(2)=0
           ENDIF
C
           CALL CRPHA4(VWRK1,CARB,iwrk52,IMARQ,DTPSFIC,VWRK2,nhist,
     &       ilent1,ilent2,iele,igau)
C
C* range valeurs calculees
           rhasf(1)=VWRK2(3)
C
           rhasf(2)=VWRK2(4)
c
           rhasf(3)=VWRK2(5)
c
           rhasf(4)=VWRK2(6)
c
           xmatf(18)=VWRK2(7)
c les autres
        do idm =1,17
          xmatf(idm) = valma0(idm)
        enddo
         xmatf(19) = valma0(19)
 
      if (iele.eq.1.and.igau.eq.1) then
c         write(6,*) ZA0, VMS0,VWRK2(3),VWRK2(7)
      endif
 
C
      RETURN
      END