Télécharger cli171.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI171 SOURCE CHAT 05/01/12 22:06:26 5004
  2. SUBROUTINE CLI171(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  3. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI171
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM11
  11. C
  12. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  13. C
  14. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  15. C
  16. C************************************************************************
  17. C
  18. C APPELES (Calcul) :
  19. C
  20. C************************************************************************
  21. C
  22. C HISTORIQUE (Anomalies et modifications éventuelles)
  23. C
  24. C HISTORIQUE :
  25. C
  26. C************************************************************************
  27. C
  28. IMPLICIT INTEGER(I-N)
  29. -INC CCOPTIO
  30. -INC SMLMOTS
  31. -INC SMELEME
  32. POINTEUR MELEFC.MELEME
  33. -INC SMLENTI
  34. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  35. -INC SMCHPOI
  36. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  37. & MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL,
  38. & MPRES.MPOVAL, MPRLI.MPOVAL
  39. C
  40. C**** Variables de COOPTIO
  41. C
  42. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43. C & ,IOTER, IOLEC, IOIMP, IOCAR,  IOAC
  44. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  45. C & ,IECHO, IIMPI, IOSPI
  46. C & ,IDIM, IFICLE, IPREFI
  47. C & ,MCOORD
  48. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50. C & ,NORINC,NORVAL,NORIND,NORVAD
  51. C & ,NUCROU, IPSAUV
  52. C
  53. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  54. & ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  55. & ,NGF,NGC,NLF,NLC,NLCB
  56. REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1,USGM1
  57. & ,CT2X,CT2Y,CT2Z,UTF,UT2F
  58. & ,PC,PSRF,RHOUF,ECIN,P,RHO,UN,UT,UT2,UX,UY,UZ
  59. CHARACTER*(8) TYPE
  60. C
  61. C
  62. C**** KRIPAD pour la correspondance global/local
  63. C
  64. CALL KRIPAD(MELEMC,MLEMC)
  65. C SEGINI MLEMC
  66. CALL KRIPAD(MELECB,MLEMCB)
  67. C SEGINI MLEMCB
  68. CALL KRIPAD(MELEMF,MLEMF)
  69. C SEGINI MLEMF
  70. C
  71. C**** CHPOINTs de la table DOMAINE
  72. C
  73. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  74. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  75. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  76. C
  77. C**** LICHT active les MPOVALs en *MOD
  78. C
  79. C SEGACT MPNORM*MOD
  80. C SEGACT MPOVSU*MOD
  81. C SEGACT MPOVOL*MOD
  82. C
  83. C
  84. C**** CHPOINTs des variables
  85. C
  86. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  87. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  88. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  89. CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  90. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  91. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  92. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  93. C
  94. C SEGACT *MOD
  95. C SEGACT *MOD
  96. C SEGACT *MOD
  97. C SEGACT *MOD
  98. C SEGACT *MOD
  99. C SEGACT *MOD
  100. C SEGACT *MOD
  101. C
  102. C
  103. C**** Boucle sur le face pour le calcul des invariants de
  104. C Riemann et du flux
  105. C
  106. SEGACT MELEFC
  107. NFAC=MELEFC.NUM(/2)
  108. CNZ=0.0D0
  109. CTZ=0.0D0
  110. CT2X=0.0D0
  111. CT2Y=0.0D0
  112. CT2Z=0.0D0
  113. DO IFAC=1,NFAC,1
  114. NGF=MELEFC.NUM(1,IFAC)
  115. NGC=MELEFC.NUM(2,IFAC)
  116. NLF=MLEMF.LECT(NGF)
  117. NLC=MLEMC.LECT(NGC)
  118. NLCB=MLEMCB.LECT(NGF)
  119. VOLU=MPVOL.VPOCHA(NLC,1)
  120. SURF=MPSURF.VPOCHA(NLF,1)
  121. C In CASTEM les normales sont sortantes
  122. CNX=-1*MPNORM.VPOCHA(NLF,1)
  123. CNY=-1*MPNORM.VPOCHA(NLF,2)
  124. IF(IDIM.EQ.2)THEN
  125. CTX=-1.0D0*CNY
  126. CTY=CNX
  127. ELSE
  128. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  129. CTX=-1*MPNORM.VPOCHA(NLF,4)
  130. CTY=-1*MPNORM.VPOCHA(NLF,5)
  131. CTZ=-1*MPNORM.VPOCHA(NLF,6)
  132. CT2X=-1*MPNORM.VPOCHA(NLF,7)
  133. CT2Y=-1*MPNORM.VPOCHA(NLF,8)
  134. CT2Z=-1*MPNORM.VPOCHA(NLF,9)
  135. ENDIF
  136. GAMC=MPGAMC.VPOCHA(NLC,1)
  137. GM1=GAMC-1.0D0
  138. USGM1=1.0D0/GM1
  139. C Variables au centre
  140. PC=MPPC.VPOCHA(NLC,1)
  141. C Variables à la face
  142. RHOUF=MPLIM.VPOCHA(NLCB,1)
  143. PSRF=MPLIM.VPOCHA(NLCB,2)
  144. UTF=0.0D0
  145. UT2F=0.0D0
  146. C
  147. C******* Variables à l'interface
  148. C
  149. P=PC
  150. RHO=P/PSRF
  151. UN=RHOUF/RHO
  152. UT=UTF
  153. UT2=UT2F
  154. C
  155. C******* On calcule U
  156. C
  157. UX=UN*CNX+UT*CTX+UT2*CT2X
  158. UY=UN*CNY+UT*CTY+UT2*CT2Y
  159. UZ=UN*CNZ+UT*CTZ+UT2*CT2Z
  160. C
  161. ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
  162. C
  163. C******* Densite, vitesse, pression sur le bord
  164. C
  165. MPRLI.VPOCHA(NLCB,1)=RHO
  166. MPRLI.VPOCHA(NLCB,2)=UX
  167. MPRLI.VPOCHA(NLCB,3)=UY
  168. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ
  169. MPRLI.VPOCHA(NLCB,IDIM+2)=P
  170. C
  171. C
  172. C******* Residuum (son SPG a le meme ordre que MELEFC)
  173. C
  174. MPRES.VPOCHA(IFAC,1)=RHOUF*SURF/VOLU
  175. MPRES.VPOCHA(IFAC,2)=(RHOUF*UX+P*CNX)*SURF/VOLU
  176. MPRES.VPOCHA(IFAC,3)=(RHOUF*UY+P*CNY)*SURF/VOLU
  177. IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=(RHOUF*UZ+P*CNZ)*SURF/VOLU
  178. MPRES.VPOCHA(IFAC,IDIM+2)=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))
  179. & *SURF/VOLU
  180. ENDDO
  181. C
  182. SEGDES MELEFC
  183. C
  184. SEGSUP MLEMC
  185. SEGSUP MLEMCB
  186. SEGSUP MLEMF
  187. C
  188. SEGDES MPNORM
  189. SEGDES MPVOL
  190. SEGDES MPSURF
  191. SEGDES MPRC
  192. SEGDES MPPC
  193. SEGDES MPVC
  194. SEGDES MPGAMC
  195. SEGDES MPLIM
  196. SEGDES MPRES
  197. SEGDES MPRLI
  198. C
  199. 9999 CONTINUE
  200. RETURN
  201. END
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  

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