1 : C CHMTMB SOURCE CHAT 05/01/12 22:00:27 5004 2 : SUBROUTINE CHMTMB(IDSCHI,LGKMOD,ICOTY3,TMP,TMPNEW) 3 : C===================================================================== 4 : C 5 : C ISSU DE TRIO-EF (TRTMPB) 6 : C 7 : C 8 : C prise en compte de la température 9 : C deuxieme approximation d'Ulich 10 : C 11 : C====================================================================== 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : -INC SMLENTI 15 : POINTEUR ICOTY3.MLENTI 16 : SEGMENT IDSCHI 17 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 18 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 19 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 20 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 21 : ENDSEGMENT 22 : SEGMENT LGKMOD 23 : REAL*8 DELH0(NYDIM),DELCP0(NYDIM) 24 : ENDSEGMENT 25 : * 26 : C 27 : IF (ICOTY3.NE.0) NO3=ICOTY3.LECT(/1) 28 : IF (TMPNEW.EQ.TMP) RETURN 29 : NX=NN(1)+1 30 : NC=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6) 31 : T1=273.16D0+TMP 32 : T2=273.16D0+TMPNEW 33 : VJ=(T2-T1)/T1/T2 34 : VI=219.30D0*VJ 35 : VJ=0.2193D0*(-298.16D0*VJ+DLOG(T2/T1)) 36 : CBRUNO 37 : NF2=NN(1)+NN(2) 38 : NI3=NN(1)+NN(2)+1 39 : NF3=NN(1)+NN(2)+NN(3) 40 : DO 200 I=NX,NF2 41 : GK(I)=GK(I)+VI*DELH0(I)+VJ*DELCP0(I) 42 : 200 CONTINUE 43 : DO 210 I=NF3+1,NC 44 : GK(I)=GK(I)+VI*DELH0(I)+VJ*DELCP0(I) 45 : 210 CONTINUE 46 : DO 220 I=NI3,NF3 47 : IF (ICOTY3.NE.0) THEN 48 : DO J=1,NO3 49 : IF (IDY(I).EQ.ICOTY3.LECT(J)) GOTO 240 50 : ENDDO 51 : ENDIF 52 : GK(I)=GK(I)+VI*DELH0(I)+VJ*DELCP0(I) 53 : 220 CONTINUE 54 : 240 CONTINUE 55 : * 56 : TMP=TMPNEW 57 : 58 : RETURN 59 : END 60 : 61 : 62 : 63 : 64 :
© Cast3M 2003 - All rights reserved.
Disclaimer