Télécharger cli161.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI161 SOURCE PV 15/04/10 21:15:06 8474
  2. SUBROUTINE CLI161(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 : CLI161
  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, IOACQ
  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
  57. & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF,UNF,UTF,UT2F
  58. & ,UXC,UYC,UZC,RC,PC,UNC,UTC,UT2C
  59. & ,HTF,SF,ECIN,PSRF,CELL(1),CELLT,FLUX2D(4),FLUX3D(5)
  60. CHARACTER*(8) TYPE
  61. C
  62. C
  63. C**** KRIPAD pour la correspondance global/local
  64. C
  65. CALL KRIPAD(MELEMC,MLEMC)
  66. C SEGINI MLEMC
  67. CALL KRIPAD(MELECB,MLEMCB)
  68. C SEGINI MLEMCB
  69. CALL KRIPAD(MELEMF,MLEMF)
  70. C SEGINI MLEMF
  71. C
  72. C**** CHPOINTs de la table DOMAINE
  73. C
  74. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  75. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  76. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  77. C
  78. C**** LICHT active les MPOVALs en *MOD
  79. C
  80. C SEGACT MPNORM*MOD
  81. C SEGACT MPOVSU*MOD
  82. C SEGACT MPOVOL*MOD
  83. C
  84. C
  85. C**** CHPOINTs des variables
  86. C
  87. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  88. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  89. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  90. CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  91. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  92. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  93. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  94. C
  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 SEGACT *MOD
  102. C
  103. C
  104. C**** Boucle sur le face pour le calcul des invariants de
  105. C Riemann et du flux
  106. C
  107. SEGACT MELEFC
  108. NFAC=MELEFC.NUM(/2)
  109. UZC=0.0D0
  110. UZF=0.0D0
  111. UT2F=0.0D0
  112. CNZ=0.0D0
  113. CTZ=0.0D0
  114. CT2X=0.0D0
  115. CT2Y=0.0D0
  116. CT2Z=0.0D0
  117. DO IFAC=1,NFAC,1
  118. NGF=MELEFC.NUM(1,IFAC)
  119. NGC=MELEFC.NUM(2,IFAC)
  120. NLF=MLEMF.LECT(NGF)
  121. NLC=MLEMC.LECT(NGC)
  122. NLCB=MLEMCB.LECT(NGF)
  123. VOLU=MPVOL.VPOCHA(NLC,1)
  124. SURF=MPSURF.VPOCHA(NLF,1)
  125. C In CASTEM les normales sont sortantes
  126. CNX=-1*MPNORM.VPOCHA(NLF,1)
  127. CNY=-1*MPNORM.VPOCHA(NLF,2)
  128. IF(IDIM.EQ.2)THEN
  129. CTX=-1.0D0*CNY
  130. CTY=CNX
  131. ELSE
  132. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  133. CTX=-1*MPNORM.VPOCHA(NLF,4)
  134. CTY=-1*MPNORM.VPOCHA(NLF,5)
  135. CTZ=-1*MPNORM.VPOCHA(NLF,6)
  136. CT2X=-1*MPNORM.VPOCHA(NLF,7)
  137. CT2Y=-1*MPNORM.VPOCHA(NLF,8)
  138. CT2Z=-1*MPNORM.VPOCHA(NLF,9)
  139. ENDIF
  140. GAMC=MPGAMC.VPOCHA(NLC,1)
  141. GM1=GAMC-1.0D0
  142. C Variables au centre
  143. RC=MPRC.VPOCHA(NLC,1)
  144. UXC=MPVC.VPOCHA(NLC,1)
  145. UYC=MPVC.VPOCHA(NLC,2)
  146. IF(IDIM.EQ.3) UZC=MPVC.VPOCHA(NLC,3)
  147. PC=MPPC.VPOCHA(NLC,1)
  148. C Variables à la face
  149. HTF=MPLIM.VPOCHA(NLCB,1)
  150. SF=MPLIM.VPOCHA(NLCB,2)
  151. UTF=0.0D0
  152. C
  153. C******* On calcule UNC
  154. C
  155. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  156. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  157. UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  158. UNF=UNC
  159. C
  160. C******* On calcule UN, UT, UT2
  161. C
  162. UXF=UNF*CNX+UTF*CTX+UT2F*CT2X
  163. UYF=UNF*CNY+UTF*CTY+UT2F*CT2Y
  164. UZF=UNF*CNZ+UTF*CTZ+UT2F*CT2Z
  165. C
  166. ECIN=0.5D0*((UXF*UXF)+(UYF*UYF)+(UZF*UZF))
  167. PSRF=(GM1/GAMC)*(HTF-ECIN)
  168. RF=PSRF/SF
  169. if (rf.lt.0.d0) then
  170. call erreur(213)
  171. return
  172. endif
  173. RF=RF**(1.0D0/GM1)
  174. PF=SF*(RF**GAMC)
  175. C
  176. C******* Densite, vitesse, pression sur le bord
  177. C
  178. MPRLI.VPOCHA(NLCB,1)=RF
  179. MPRLI.VPOCHA(NLCB,2)=UXF
  180. MPRLI.VPOCHA(NLCB,3)=UYF
  181. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZF
  182. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  183. C
  184. IF(IDIM.EQ.2)THEN
  185. CALL FAUSMP(0,
  186. & GAMC,RF,PF,UNC,UTF,
  187. & GAMC,RC,PC,UNC,UTC,
  188. & CELL,CELL,
  189. & FLUX2D,
  190. & CELLT)
  191. C
  192. C******* Residuum (son SPG a le meme ordre que MELEFC)
  193. C
  194. MPRES.VPOCHA(IFAC,1)=FLUX2D(1)*SURF/VOLU
  195. MPRES.VPOCHA(IFAC,2)=((FLUX2D(2)*CNX)+(FLUX2D(3)*CTX))
  196. & *SURF/VOLU
  197. MPRES.VPOCHA(IFAC,3)=((FLUX2D(2)*CNY)+(FLUX2D(3)*CTY))
  198. & *SURF/VOLU
  199. MPRES.VPOCHA(IFAC,4)=FLUX2D(4)*SURF/VOLU
  200. ELSE
  201. CALL FAUSM3(0,
  202. & GAMC,RF,PF,UNC,UTF,UT2F,
  203. & GAMC,RC,PC,UNC,UTC,UT2C,
  204. & CELL,CELL,
  205. & FLUX3D,
  206. & CELLT)
  207. C
  208. C******* Residuum (son SPG a le meme ordre que MELEFC)
  209. C
  210. MPRES.VPOCHA(IFAC,1)=FLUX3D(1)*SURF/VOLU
  211. MPRES.VPOCHA(IFAC,2)=((FLUX3D(2)*CNX)+(FLUX3D(3)*CTX)+
  212. & (FLUX3D(4)*CT2X))*SURF/VOLU
  213. MPRES.VPOCHA(IFAC,3)=((FLUX3D(2)*CNY)+(FLUX3D(3)*CTY)+
  214. & (FLUX3D(4)*CT2Y))*SURF/VOLU
  215. MPRES.VPOCHA(IFAC,4)=((FLUX3D(2)*CNZ)+(FLUX3D(3)*CTZ)+
  216. & (FLUX3D(4)*CT2Z))*SURF/VOLU
  217. MPRES.VPOCHA(IFAC,5)=FLUX3D(5)*SURF/VOLU
  218. ENDIF
  219.  
  220. ENDDO
  221. C
  222. SEGDES MELEFC
  223. C
  224. SEGSUP MLEMC
  225. SEGSUP MLEMCB
  226. SEGSUP MLEMF
  227. C
  228. SEGDES MPNORM
  229. SEGDES MPVOL
  230. SEGDES MPSURF
  231. SEGDES MPRC
  232. SEGDES MPPC
  233. SEGDES MPVC
  234. SEGDES MPGAMC
  235. SEGDES MPLIM
  236. SEGDES MPRES
  237. SEGDES MPRLI
  238. C
  239. 9999 CONTINUE
  240. RETURN
  241. END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  

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