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