Esope source files

   1 : C CRPHA3    SOURCE    KICH      09/09/11    21:17:50     6505           
   2 : C=======================================================================
   3 : C
   4 :       SUBROUTINE CRPHA3(iwrk52,iwrk53,ilent1,ilent2,iele,igau)
   5 : C
   6 : C=======================================================================
   7 : C
   8 : C
   9 : C       Calcul de transformations de phases
  10 : C       appelee par COMP
  11 : C
  12 : C       balaye le maillage
  13 : C       en chaque point de gauss : *calcul de Tpoint efficace 
  14 : C                                  *appel a CRPHA4 et recupere
  15 : C                                   les nouvelles proportions de phases
  16 : C
  17 : C       Michael Martinez 12/98
  18 : C
  19 : C
  20 : C insertion dans COMP et appel par COML7
  21 : C=======================================================================
  22 : C
  23 :       IMPLICIT INTEGER(I-N)
  24 :       IMPLICIT REAL*8(A-H,O-Z)
  25 : C
  26 : -INC CCOPTIO
  27 : -INC SMCHAML
  28 : -INC CCHAMP
  29 : -INC SMNUAGE
  30 : -INC SMLENTI
  31 : 
  32 : -INC DECHE
  33 : *
  34 : C
  35 :       REAL*8 VWRK1(7),VWRK2(7)
  36 : C
  37 :       INTEGER IMARQ(2)
  38 :       wrk52 = iwrk52
  39 : *      segact wrk52*mod
  40 :       wrk53 = iwrk53
  41 : *      segact wrk53*nomod
  42 : C
  43 : C     RECUPERATION DES COEF D'INFLUENCE DE
  44 : C     LA CONCENTRATION EN CARBONE ET DE LA TAILLE DE GRAINS
  45 : C
  46 :          CARB0=valma0(9)
  47 :           A1=valma0(10)
  48 :           DG0=valma0(11)
  49 :           A2=valma0(12)
  50 : C
  51 : C     RECUPERATION DU PAS D'INTEGRATION EN TEMPS
  52 : C
  53 :         mnuag1 = int(valma0(17))
  54 :         segact mnuag1*nomod
  55 :         nuavfl = mnuag1.nuapoi(1)
  56 :         segact nuavfl*nomod
  57 :         NHIST=nuaflo(/1)
  58 : c        NMAX=NHIST+4
  59 : c       NMAX=MLOTAB
  60 :         DTPS = valma0(23)
  61 :  10   continue
  62 : C
  63 : C
  64 : C
  65 : C
  66 : C
  67 : C
  68 : C       MODIF MM
  69 : C
  70 : C
  71 : C
  72 : C
  73 : CC
  74 : 
  75 :            T0 = turef(1)
  76 : C
  77 : * vitesse thermique ?
  78 :            if ((tempf-temp0).gt.0) then
  79 :              TPOINT0=(turef(1) - ture0(1))/(tempf-temp0)
  80 :            else
  81 :              TPOINT0 = 0.
  82 :            endif
  83 : C
  84 :            ZA0=valma0(18)
  85 : C
  86 :            ZF0=valma0(19)
  87 : C
  88 :            ZB0=valma0(20)
  89 : C
  90 :            ZM0=valma0(21)
  91 : C
  92 :            VMS0=valma0(22)
  93 : C
  94 : C          MODIF MM
  95 : C
  96 :            IF (CMATE.EQ.'MGRAIN') THEN
  97 :                CARB=valma0(33)
  98 :            ELSE
  99 :               CARB=CARB0
 100 :            ENDIF
 101 : C
 102 :            IF (CMATE.EQ.'MGRAIN') THEN
 103 :               DG=valma0(34)
 104 :            ELSE
 105 :               DG=DG0
 106 :            ENDIF
 107 : C
 108 : C     MODIF MM 23/07/98
 109 : C     ON PARAMETRE LA VITESSE DE REFROIDISSEMENT EN FONCTION 
 110 : C     DE LA CONCENTRATION EN CARBONE ET DE LA TAILLE DE GRAINS
 111 : C     ! LE PAS D'INTEGRATION EN TEMPS DOIT ETRE MODIFIE AUSSI
 112 : C
 113 :            IF (TPOINT0.LT.0.) THEN
 114 :               TPFICTA=TPOINT0*DEXP(A1*(CARB-CARB0))
 115 :               TPFICT0=TPFICTA*DEXP(A2*(DG-DG0))
 116 :               DTPSFIC=DTPS*(TPOINT0/TPFICT0)
 117 : C              write (*,*)'CARB' ,CARB, '  CARB0' ,CARB0
 118 : C              write (*,*)'A1' ,A1
 119 : C              FR3 = A1*(CARB-CARB0)
 120 : C              write (*,*) ' FR3' ,FR3
 121 : C              write (*,*) ' TPOINT0' ,TPOINT0 ,'   TPFICTA', TPFICTA, 
 122 : C     .        '   TPFICT0' ,TPFICT0
 123 :            ELSE
 124 :               TPFICT0=TPOINT0
 125 :               DTPSFIC=DTPS
 126 :            ENDIF
 127 : C
 128 : C     FIN MODIF MM
 129 : C
 130 :            VWRK1(1)=T0
 131 :            VWRK1(2)=TPFICT0
 132 :            VWRK1(3)=ZA0
 133 :            VWRK1(4)=ZF0
 134 :            VWRK1(5)=ZB0
 135 :            VWRK1(6)=ZM0
 136 :            VWRK1(7)=VMS0
 137 : C
 138 : C     DETERMINATION DES POINT PROCHES  DE T0, TPOINT0, Z0
 139 : C     INTERPOLATION PUIS CALCUL DU NOUVEAU CHAMP DE PHASES
 140 : C
 141 :            IF (IELE.EQ.1.AND.IGAU.EQ.1) THEN
 142 :               IMARQ(1)=0
 143 :               IMARQ(2)=0
 144 :            ENDIF
 145 : C
 145 :            CALL CRPHA4(VWRK1,CARB,iwrk52,IMARQ,DTPSFIC,VWRK2,nhist,
 146 :      &       ilent1,ilent2,iele,igau)
 147 : C
 148 : C* range valeurs calculees
 149 :            xmatf(18)=VWRK2(3)
 150 : C
 151 :            xmatf(19)=VWRK2(4)
 152 : c
 153 :            xmatf(20)=VWRK2(5)
 154 : c
 155 :            xmatf(21)=VWRK2(6)
 156 : c
 157 :            xmatf(22)=VWRK2(7)
 158 : c les autres
 159 :         do idm =1,17
 160 :           xmatf(idm) = valma0(idm)
 161 :         enddo
 162 :          xmatf(23) = valma0(23)
 163 :  
 164 :       if (iele.eq.1.and.igau.eq.1) then
 165 : c         write(6,*) ZA0, VMS0,VWRK2(3),VWRK2(7)
 166 :       endif
 167 : 
 168 : C
 169 :       RETURN
 170 :       END      
 171 :  
 172 :  
 173 :  
 174 :  
 175 :  
 176 :  
 177 :  
 178 :  
 179 :  
 180 :