Télécharger cldeta.eso

Retour à la liste

Numérotation des lignes :

  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
  18. CALL ZDANUL(DDR,36)
  19. RFE=1.D-8
  20. RFS=YUNG*RFE
  21. C
  22. DO 10 I=1,3
  23. ET(I)=YUNG
  24. IF(XLTR(I).LE.0.D0) ET(I)=0.D0
  25. EPPT(I)=EPTT(I)-XLTT(I)/YUNG
  26. EPSPR(I)=EPRS(I)
  27. IF(XLTR(I).GT.0.D0.AND.RT(I).LE.RFS) EPSPR(I)=EPTR(I)
  28. C
  29. IF(XLTR(I).GT.0.D0.AND.RT(I).GT.RFS) THEN
  30. C
  31. IF(XLTT(I).GT.0.D0) THEN
  32. IF(RT(I).GE.XLTT(I)) THEN
  33. EPSPR(I)=((XLTR(I)-RT(I))/(XLTR(I)-XLTT(I)))*EPPT(I)
  34. ELSE
  35. EPSPR(I)=EPPT(I)+((1.D0-RT(I)/XLTT(I))*(EPTR(I)-EPPT(I)))
  36. ENDIF
  37. ELSE
  38. EPSPR(I)=(1.D0-RT(I)/XLTR(I))*EPTR(I)
  39. ENDIF
  40. C
  41. EPPMAX=(1.D0-RT(I)/XLTR(I))*EPSPR(I)
  42. EPRM=(1.D0-RT(I)/XLTR(I))*EPRS(I)
  43. EPRM=MIN(EPPMAX,EPRM)
  44. ELSE
  45. EPPMAX=EPSPR(I)
  46. EPRM=EPRS(I)
  47. ENDIF
  48. C
  49. IF(XLTR(I).GT.0.D0)
  50. . ET(I)=(YUNG*XLTR(I))/(XLTR(I)+(YUNG*EPSPR(I)))
  51.  
  52. C
  53. IF(ABS(CONTR(I)).LE.RFS) THEN
  54. IF(RT(I).LE.RFS) THEN
  55. IF((ABS(OUVER(I)-EPRM)).LE.RFE.OR.OUVER(I).LE.EPRM) THEN
  56. IF(DDEFT(I).LT.0.D0) THEN
  57. ET(I)=YUNG
  58. ELSE
  59. ET(I)=0.D0
  60. ENDIF
  61. ELSE
  62. ET(I)=0.D0
  63. ENDIF
  64. ELSE
  65. IF((ABS(OUVER(I)-EPPMAX)).LE.RFE.OR.OUVER(I).GE.EPPMAX) THEN
  66. IF(DDEFT(I).LT.0.D0) ET(I)=0.D0
  67. ELSE
  68. IF((ABS(OUVER(I)-EPRM)).LE.RFE.OR.OUVER(I).LE.EPRM) THEN
  69. IF(DDEFT(I).LT.0.D0) ET(I)=YUNG
  70. ELSE
  71. IF(DDEFT(I).LT.0.D0) ET(I)=0.D0
  72. ENDIF
  73. ENDIF
  74. ENDIF
  75. ENDIF
  76. C
  77. IF((ABS(XLTR(I)-RT(I))).LE.RFS.AND.XLTR(I).GT.0.D0) ET(I)=YUNG
  78. C
  79. 10 CONTINUE
  80. C
  81. ET1=ET(1)
  82. ET2=ET(2)
  83. ET3=ET(3)
  84. UPUN=1.D0+XNU
  85. UMUN=1.D0-XNU
  86. UMDN=1.D0-2.D0*XNU
  87. EMET1=YUNG-ET1
  88. EMET2=YUNG-ET2
  89. EMET3=YUNG-ET3
  90. C
  91. DENO=(EMET1*EMET2*EMET3)+
  92. . (ET1*EMET2*EMET3)+(EMET1*ET2*EMET3)+(EMET1*EMET2*ET3)+
  93. . (UPUN*UMUN*((EMET1*ET2*ET3)+(ET1*EMET2*ET3)+(ET1*ET2*EMET3)))+
  94. . (UPUN*UPUN*UMDN*(ET1*ET2*ET3))
  95. USDENO=1.D0/DENO
  96. C
  97. DDR(1,1)=((EMET2*EMET3)+(ET2*EMET3)+(EMET2*ET3)+
  98. . (ET2*ET3*UPUN*UMUN))*YUNG*ET1*USDENO
  99. DDR(1,2)=XNU*YUNG*ET1*ET2*(EMET3+(ET3*UPUN))*USDENO
  100. DDR(1,3)=XNU*YUNG*ET1*ET3*(EMET2+(ET2*UPUN))*USDENO
  101. DDR(2,1)=DDR(1,2)
  102. DDR(2,2)=((EMET1*EMET3)+(ET1*EMET3)+(EMET1*ET3)+
  103. . (ET1*ET3*UPUN*UMUN))*YUNG*ET2*USDENO
  104. DDR(2,3)=XNU*YUNG*ET2*ET3*(EMET1+(ET1*UPUN))*USDENO
  105. DDR(3,1)=DDR(1,3)
  106. DDR(3,2)=DDR(2,3)
  107. DDR(3,3)=((EMET1*EMET2)+(ET1*EMET2)+(EMET1*ET2)+
  108. . (ET1*ET2*UPUN*UMUN))*YUNG*ET3*USDENO
  109. DDR(4,4)=YUNG/(2.D0*UPUN)
  110. DDR(5,5)=DDR(4,4)
  111. DDR(6,6)=DDR(4,4)
  112. C
  113. CALL MULMAT(DCONPR,DDR,DDEFT,6,1,6)
  114. C
  115. IF(IIMPI.EQ.9) THEN
  116. WRITE(IOIMP,*) 'DDR'
  117. WRITE(IOIMP,1000) ((DDR(I,J),J=1,6),I=1,6)
  118. WRITE(IOIMP,1001) (DDEFT(I),I=1,6)
  119. WRITE(IOIMP,1002) (DCONPR(I),I=1,6)
  120. 1000 FORMAT(6(1X,1PE12.5))
  121. 1001 FORMAT(1X,'DDEFT =',6(1X,1PE12.5))
  122. 1002 FORMAT(1X,'DCONPR=',6(1X,1PE12.5))
  123. ENDIF
  124. C
  125. RETURN
  126. C
  127. END
  128.  
  129.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales