1 : C CLDETA SOURCE CHAT 05/01/12 22:04:36 5004 2 : SUBROUTINE CLDETA (YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER, 3 : . CONTR,DDEFT,DCONPR) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : -INC CCOPTIO 7 : C 8 : DIMENSION RT(*),XLTR(*),XLTT(*),EPTT(*),EPTR(*),EPRS(*),OUVER(*) 9 : DIMENSION CONTR(*),DDEFT(*),DCONPR(*) 10 : DIMENSION DDR(6,6),ET(3),EPPT(3),EPSPR(3) 11 : C 12 : C*********************************************************************** 13 : C************* CALCUL DE L ETAT DE CHARGE OU DE DECHARGE *************** 14 : C*********************************************************************** 15 : C 16 : C INITIALISATION 17 : C 17 : CALL ZDANUL(DDR,36) 18 : RFE=1.D-8 19 : RFS=YUNG*RFE 20 : C 21 : DO 10 I=1,3 22 : ET(I)=YUNG 23 : IF(XLTR(I).LE.0.D0) ET(I)=0.D0 24 : EPPT(I)=EPTT(I)-XLTT(I)/YUNG 25 : EPSPR(I)=EPRS(I) 26 : IF(XLTR(I).GT.0.D0.AND.RT(I).LE.RFS) EPSPR(I)=EPTR(I) 27 : C 28 : IF(XLTR(I).GT.0.D0.AND.RT(I).GT.RFS) THEN 29 : C 30 : IF(XLTT(I).GT.0.D0) THEN 31 : IF(RT(I).GE.XLTT(I)) THEN 32 : EPSPR(I)=((XLTR(I)-RT(I))/(XLTR(I)-XLTT(I)))*EPPT(I) 33 : ELSE 34 : EPSPR(I)=EPPT(I)+((1.D0-RT(I)/XLTT(I))*(EPTR(I)-EPPT(I))) 35 : ENDIF 36 : ELSE 37 : EPSPR(I)=(1.D0-RT(I)/XLTR(I))*EPTR(I) 38 : ENDIF 39 : C 40 : EPPMAX=(1.D0-RT(I)/XLTR(I))*EPSPR(I) 41 : EPRM=(1.D0-RT(I)/XLTR(I))*EPRS(I) 42 : EPRM=MIN(EPPMAX,EPRM) 43 : ELSE 44 : EPPMAX=EPSPR(I) 45 : EPRM=EPRS(I) 46 : ENDIF 47 : C 48 : IF(XLTR(I).GT.0.D0) 49 : . ET(I)=(YUNG*XLTR(I))/(XLTR(I)+(YUNG*EPSPR(I))) 50 : 51 : C 52 : IF(ABS(CONTR(I)).LE.RFS) THEN 53 : IF(RT(I).LE.RFS) THEN 54 : IF((ABS(OUVER(I)-EPRM)).LE.RFE.OR.OUVER(I).LE.EPRM) THEN 55 : IF(DDEFT(I).LT.0.D0) THEN 56 : ET(I)=YUNG 57 : ELSE 58 : ET(I)=0.D0 59 : ENDIF 60 : ELSE 61 : ET(I)=0.D0 62 : ENDIF 63 : ELSE 64 : IF((ABS(OUVER(I)-EPPMAX)).LE.RFE.OR.OUVER(I).GE.EPPMAX) THEN 65 : IF(DDEFT(I).LT.0.D0) ET(I)=0.D0 66 : ELSE 67 : IF((ABS(OUVER(I)-EPRM)).LE.RFE.OR.OUVER(I).LE.EPRM) THEN 68 : IF(DDEFT(I).LT.0.D0) ET(I)=YUNG 69 : ELSE 70 : IF(DDEFT(I).LT.0.D0) ET(I)=0.D0 71 : ENDIF 72 : ENDIF 73 : ENDIF 74 : ENDIF 75 : C 76 : IF((ABS(XLTR(I)-RT(I))).LE.RFS.AND.XLTR(I).GT.0.D0) ET(I)=YUNG 77 : C 78 : 10 CONTINUE 79 : C 80 : ET1=ET(1) 81 : ET2=ET(2) 82 : ET3=ET(3) 83 : UPUN=1.D0+XNU 84 : UMUN=1.D0-XNU 85 : UMDN=1.D0-2.D0*XNU 86 : EMET1=YUNG-ET1 87 : EMET2=YUNG-ET2 88 : EMET3=YUNG-ET3 89 : C 90 : DENO=(EMET1*EMET2*EMET3)+ 91 : . (ET1*EMET2*EMET3)+(EMET1*ET2*EMET3)+(EMET1*EMET2*ET3)+ 92 : . (UPUN*UMUN*((EMET1*ET2*ET3)+(ET1*EMET2*ET3)+(ET1*ET2*EMET3)))+ 93 : . (UPUN*UPUN*UMDN*(ET1*ET2*ET3)) 94 : USDENO=1.D0/DENO 95 : C 96 : DDR(1,1)=((EMET2*EMET3)+(ET2*EMET3)+(EMET2*ET3)+ 97 : . (ET2*ET3*UPUN*UMUN))*YUNG*ET1*USDENO 98 : DDR(1,2)=XNU*YUNG*ET1*ET2*(EMET3+(ET3*UPUN))*USDENO 99 : DDR(1,3)=XNU*YUNG*ET1*ET3*(EMET2+(ET2*UPUN))*USDENO 100 : DDR(2,1)=DDR(1,2) 101 : DDR(2,2)=((EMET1*EMET3)+(ET1*EMET3)+(EMET1*ET3)+ 102 : . (ET1*ET3*UPUN*UMUN))*YUNG*ET2*USDENO 103 : DDR(2,3)=XNU*YUNG*ET2*ET3*(EMET1+(ET1*UPUN))*USDENO 104 : DDR(3,1)=DDR(1,3) 105 : DDR(3,2)=DDR(2,3) 106 : DDR(3,3)=((EMET1*EMET2)+(ET1*EMET2)+(EMET1*ET2)+ 107 : . (ET1*ET2*UPUN*UMUN))*YUNG*ET3*USDENO 108 : DDR(4,4)=YUNG/(2.D0*UPUN) 109 : DDR(5,5)=DDR(4,4) 110 : DDR(6,6)=DDR(4,4) 111 : C 111 : CALL MULMAT(DCONPR,DDR,DDEFT,6,1,6) 112 : C 113 : IF(IIMPI.EQ.9) THEN 114 : WRITE(IOIMP,*) 'DDR' 115 : WRITE(IOIMP,1000) ((DDR(I,J),J=1,6),I=1,6) 116 : WRITE(IOIMP,1001) (DDEFT(I),I=1,6) 117 : WRITE(IOIMP,1002) (DCONPR(I),I=1,6) 118 : 1000 FORMAT(6(1X,1PE12.5)) 119 : 1001 FORMAT(1X,'DDEFT =',6(1X,1PE12.5)) 120 : 1002 FORMAT(1X,'DCONPR=',6(1X,1PE12.5)) 121 : ENDIF 122 : C 123 : RETURN 124 : C 125 : END 126 :
© Cast3M 2003 - All rights reserved.
Disclaimer