Télécharger ccgtau.eso

Retour à la liste

Numérotation des lignes :

  1. C CCGTAU SOURCE GOUNAND 05/12/21 21:16:56 5281
  2. SUBROUTINE CCGTAU(LCOF,
  3. $ FC,IKAS,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CCGTAU
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
  10. C T(H) (enthalpie(temperature)+ chaleur latente
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES :
  18. C APPELE PAR :
  19. C***********************************************************************
  20. C ENTREES :
  21. C ENTREES/SORTIES :
  22. C SORTIES : -
  23. C TRAVAIL :
  24. C***********************************************************************
  25. C VERSION : v1, 02/12/04, version initiale
  26. C HISTORIQUE : v1, 02/12/04, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC CCOPTIO
  35. CBEGININCLUDE SMCHAEL
  36. SEGMENT MCHAEL
  37. POINTEUR IMACHE(N1).MELEME
  38. POINTEUR ICHEVA(N1).MCHEVA
  39. ENDSEGMENT
  40. SEGMENT MCHEVA
  41. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  42. ENDSEGMENT
  43. SEGMENT LCHEVA
  44. POINTEUR LISCHE(NBCHE).MCHEVA
  45. ENDSEGMENT
  46. CENDINCLUDE SMCHAEL
  47. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  48. POINTEUR FC.MCHEVA
  49. POINTEUR LCOF.LCHEVA
  50. POINTEUR T1.MCHEVA
  51. POINTEUR T2.MCHEVA
  52. POINTEUR T3.MCHEVA
  53. POINTEUR T4.MCHEVA
  54. POINTEUR T5.MCHEVA
  55. *
  56. INTEGER IMPR,IRET
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgtau'
  61. NLFC=FC.VELCHE(/6)
  62. NPFC=FC.VELCHE(/5)
  63. T1=LCOF.LISCHE(1)
  64. T2=LCOF.LISCHE(2)
  65. T3=LCOF.LISCHE(3)
  66. T4=LCOF.LISCHE(4)
  67. T5=LCOF.LISCHE(5)
  68. NLC1=T1.VELCHE(/6)
  69. NPC1=T1.VELCHE(/5)
  70. NLC2=T2.VELCHE(/6)
  71. NPC2=T2.VELCHE(/5)
  72. NLC3=T3.VELCHE(/6)
  73. NPC3=T3.VELCHE(/5)
  74. NLC4=T4.VELCHE(/6)
  75. NPC4=T4.VELCHE(/5)
  76. NLC5=T5.VELCHE(/6)
  77. NPC5=T5.VELCHE(/5)
  78. DO ILFC=1,NLFC
  79. IF (NLC1.EQ.1) THEN
  80. ILC1=1
  81. ELSE
  82. ILC1=ILFC
  83. ENDIF
  84. IF (NLC2.EQ.1) THEN
  85. ILC2=1
  86. ELSE
  87. ILC2=ILFC
  88. ENDIF
  89. IF (NLC3.EQ.1) THEN
  90. ILC3=1
  91. ELSE
  92. ILC3=ILFC
  93. ENDIF
  94. IF (NLC4.EQ.1) THEN
  95. ILC4=1
  96. ELSE
  97. ILC4=ILFC
  98. ENDIF
  99. IF (NLC5.EQ.1) THEN
  100. ILC5=1
  101. ELSE
  102. ILC5=ILFC
  103. ENDIF
  104. DO IPFC=1,NPFC
  105. IF (NPC1.EQ.1) THEN
  106. IPC1=1
  107. ELSE
  108. IPC1=IPFC
  109. ENDIF
  110. IF (NPC2.EQ.1) THEN
  111. IPC2=1
  112. ELSE
  113. IPC2=IPFC
  114. ENDIF
  115. IF (NPC3.EQ.1) THEN
  116. IPC3=1
  117. ELSE
  118. IPC3=IPFC
  119. ENDIF
  120. IF (NPC4.EQ.1) THEN
  121. IPC4=1
  122. ELSE
  123. IPC4=IPFC
  124. ENDIF
  125. IF (NPC5.EQ.1) THEN
  126. IPC5=1
  127. ELSE
  128. IPC5=IPFC
  129. ENDIF
  130. XT1=T1.VELCHE(1,1,1,1,IPC1,ILC1)
  131. XT2=T2.VELCHE(1,1,1,1,IPC2,ILC2)
  132. XT3=T3.VELCHE(1,1,1,1,IPC3,ILC3)
  133. XT4=T4.VELCHE(1,1,1,1,IPC4,ILC4)
  134. XT5=T5.VELCHE(1,1,1,1,IPC5,ILC5)
  135. IF (IKAS.EQ.1) THEN
  136. H=XT1
  137. CS=XT2
  138. CL=XT3
  139. TM=XT4
  140. XL=XT5
  141. HS=CS*TM
  142. HL=HS+XL
  143. IF (H.LT.HS) THEN
  144. XVAL=H/CS
  145. ELSEIF (H.GT.HL) THEN
  146. XVAL=TM+((H-HS-XL)/CL)
  147. ELSE
  148. XVAL=TM
  149. ENDIF
  150. ELSEIF (IKAS.EQ.2) THEN
  151. T=XT1
  152. CS=XT2
  153. CL=XT3
  154. TM=XT4
  155. XL=XT5
  156. IF (T.LT.TM) THEN
  157. XVAL=T*CS
  158. ELSE
  159. XVAL=(TM*CS)+XL+((T-TM)*CL)
  160. ENDIF
  161. ELSE
  162. WRITE(IOIMP,*) 'Erreur : IKAS=',IKAS
  163. GOTO 9999
  164. ENDIF
  165. FC.VELCHE(1,1,1,1,IPFC,ILFC)=XVAL
  166. ENDDO
  167. ENDDO
  168. *
  169. * Normal termination
  170. *
  171. IRET=0
  172. RETURN
  173. *
  174. * Format handling
  175. *
  176. *
  177. * Error handling
  178. *
  179. 9999 CONTINUE
  180. IRET=1
  181. WRITE(IOIMP,*) 'An error was detected in subroutine ccgtau'
  182. RETURN
  183. *
  184. * End of subroutine CCGTAU
  185. *
  186. END
  187.  
  188.  
  189.  

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