Télécharger cli222.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI222 SOURCE CHAT 05/01/12 22:07:04 5004
  2. SUBROUTINE CLI222(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  3. & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI222
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM22
  11. C
  12. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  13. C
  14. C AUTEUR : S.Kudriakov, 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, MPYN.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. & ,IYN,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  55. & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,I,NSP
  56. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,UZC,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
  57. & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF,TOP,BOT
  58. & ,UNC,UNF,UTC,UT2C,SC,ASONC,ASONF,GAMF,GAMM
  59. & ,G1,G3,ASON2,S,UT,UT2,UN,RHO,P,UX,UY,UZ
  60. CHARACTER*(8) TYPE
  61. C------------------------------------------------------------
  62. -INC SMLREEL
  63. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  64. C-------------------------------------------------------
  65. C********** Les CP's and CV's ***********************
  66. C-------------------------------------------------------
  67. SEGMENT GCONST
  68. REAL*8 GC(NSP)
  69. ENDSEGMENT
  70. POINTEUR CP.GCONST, CV.GCONST
  71. C-------------------------------------------------------------
  72. C******* Les fractionines massiques **************************
  73. C-------------------------------------------------------------
  74. SEGMENT FRAMAS
  75. REAL*8 YET(NSP)
  76. ENDSEGMENT
  77. POINTEUR YC.FRAMAS, YF.FRAMAS
  78. C------------------------------------------------------
  79. C**** KRIPAD pour la correspondance global/local
  80. C------------------------------------------------------
  81. CALL KRIPAD(MELEMC,MLEMC)
  82. CALL KRIPAD(MELECB,MLEMCB)
  83. CALL KRIPAD(MELEMF,MLEMF)
  84. C------------------------------------------------------
  85. C**** CHPOINTs de la table DOMAINE
  86. C------------------------------------------------------
  87. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  88. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  89. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  90. C------------------------------------------------------
  91. C**** CHPOINTs des variables
  92. C------------------------------------------------------
  93. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  94. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  95. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  96. CALL LICHT(IYN,MPYN,TYPE,ICEL)
  97. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  98. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  99. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  100. C---------------------------------------------------------
  101. C**** Boucle sur le face pour le calcul des invariants de
  102. C Riemann et du flux
  103. C---------------------------------------------------------
  104. SEGACT MELEFC
  105. NFAC=MELEFC.NUM(/2)
  106. UZC=0.0D0
  107. UZF=0.0D0
  108. CNZ=0.0D0
  109. CTZ=0.0D0
  110. CT2X=0.0D0
  111. CT2Y=0.0D0
  112. CT2Z=0.0D0
  113. DO 1 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----------------------------------------------
  122. C In CASTEM les normales sont sortantes
  123. C----------------------------------------------
  124. CNX=MPNORM.VPOCHA(NLF,1)
  125. CNY=MPNORM.VPOCHA(NLF,2)
  126. IF(IDIM.EQ.2)THEN
  127. CTX=-1.0D0*CNY
  128. CTY=CNX
  129. ELSE
  130. CNZ=MPNORM.VPOCHA(NLF,3)
  131. CTX=MPNORM.VPOCHA(NLF,4)
  132. CTY=MPNORM.VPOCHA(NLF,5)
  133. CTZ=MPNORM.VPOCHA(NLF,6)
  134. CT2X=MPNORM.VPOCHA(NLF,7)
  135. CT2Y=MPNORM.VPOCHA(NLF,8)
  136. CT2Z=MPNORM.VPOCHA(NLF,9)
  137. ENDIF
  138. C----------------------------------------
  139. SEGINI CP, CV
  140. MLRECP = LRECP
  141. MLRECV = LRECV
  142. SEGACT MLRECP, MLRECV
  143. DO 10 I=1,(NSP-1)
  144. CP.GC(I)=MLRECP.PROG(I)
  145. CV.GC(I)=MLRECV.PROG(I)
  146. 10 CONTINUE
  147. CP.GC(NSP)=MLRECP.PROG(NSP)
  148. CV.GC(NSP)=MLRECV.PROG(NSP)
  149. C----------------------------
  150. C Variables au centre
  151. C----------------------------
  152. RC=MPRC.VPOCHA(NLC,1)
  153. PC=MPPC.VPOCHA(NLC,1)
  154. UXC=MPVC.VPOCHA(NLC,1)
  155. UYC=MPVC.VPOCHA(NLC,2)
  156. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  157. SEGINI YC
  158. SEGACT MPYN
  159. DO 100 I=1,(NSP-1)
  160. YC.YET(I)=MPYN.VPOCHA(NLC,I)
  161. 100 CONTINUE
  162. C----------------------------
  163. C Variables à la face
  164. C----------------------------
  165. RF=MPLIM.VPOCHA(NLCB,1)
  166. UXF=MPLIM.VPOCHA(NLCB,2)
  167. UYF=MPLIM.VPOCHA(NLCB,3)
  168. IF(IDIM.EQ.3)UZF=MPLIM.VPOCHA(NLCB,4)
  169. PF=MPLIM.VPOCHA(NLCB,IDIM+2)
  170. SEGINI YF
  171. DO 101 I=1,(NSP-1)
  172. YF.YET(I)=MPLIM.VPOCHA(NLCB,IDIM+2+I)
  173. 101 CONTINUE
  174. c-------------------------------------------------------------
  175. c Computing GAMMA at the cell-center
  176. c-------------------------------------------------------------
  177. top=0.0D0
  178. bot=0.0D0
  179. do 102 i=1,(nsp-1)
  180. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  181. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  182. 102 continue
  183. top=cp.gc(nsp)+top
  184. bot=cv.gc(nsp)+bot
  185. GAMC=top/bot
  186. c-------------------------------------------------------------
  187. c Computing GAMMA at the face-center
  188. c-------------------------------------------------------------
  189. top=0.0D0
  190. bot=0.0D0
  191. do 103 i=1,(nsp-1)
  192. top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp))
  193. bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp))
  194. 103 continue
  195. top=cp.gc(nsp)+top
  196. bot=cv.gc(nsp)+bot
  197. GAMF=top/bot
  198. C---------------------------------------
  199. C******* On calcule UN, UT, UT2, ASON, S
  200. C---------------------------------------
  201. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  202. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  203. UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  204. UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ)
  205. c UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ)
  206. c UT2F=(UXF*CT2X)+(UYF*CT2Y)+(UZF*CT2Z)
  207. C----------------------------------
  208. ASONC=(GAMC*PC/RC)**0.5D0
  209. ASONF=(GAMF*PF/RF)**0.5D0
  210. C
  211. SC=PC/(RC**GAMC)
  212. c SF=PF/(RF**GAMF)
  213. C-----------------------------------------------
  214. C******* Densite, vitesse, pression sur le bord
  215. C-----------------------------------------------
  216. GAMM = 0.5D0*(GAMC+GAMF)
  217. G1=UNF-(2.0D0*ASONF)/(GAMF-1.0D0)
  218. G3=UNC+(2.0D0*ASONC)/(GAMC-1.0D0)
  219. UN=0.5D0*(G1+G3)
  220. ASON2=(0.5D0*(G3-G1))
  221. ASON2=ASON2*(GAMM-1.0D0)/2.0D0
  222. ASON2=ASON2*ASON2
  223. S=SC
  224. UT=UTC
  225. UT2=UT2C
  226. RHO=ASON2/(GAMM*S)
  227. RHO=RHO**(1.0D0/(GAMC-1.0D0))
  228. P=RHO*ASON2/GAMM
  229. UX=(UN*CNX)+(UT*CTX)+(UT2*CT2X)
  230. UY=(UN*CNY)+(UT*CTY)+(UT2*CT2Y)
  231. UZ=(UN*CNZ)+(UT*CTZ)+(UT2*CT2Z)
  232. C----------------------------------------
  233. MPRLI.VPOCHA(NLCB,1)=RHO
  234. MPRLI.VPOCHA(NLCB,2)=UX
  235. MPRLI.VPOCHA(NLCB,3)=UY
  236. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ
  237. MPRLI.VPOCHA(NLCB,IDIM+2)=P
  238. do 104 i=1,(nsp-1)
  239. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
  240. 104 continue
  241. C-------------------------------------------------------
  242. C******* Residuum (son SPG a le meme ordre que MELEFC)
  243. C-------------------------------------------------------
  244. MPRES.VPOCHA(IFAC,1)=-1*RHO*UN*SURF/VOLU
  245. MPRES.VPOCHA(IFAC,2)=-1*(RHO*UN*UX+(P*CNX))*SURF/VOLU
  246. MPRES.VPOCHA(IFAC,3)=-1*(RHO*UN*UY+(P*CNY))*SURF/VOLU
  247. IF(IDIM.EQ.3)
  248. & MPRES.VPOCHA(IFAC,4)=-1*(RHO*UN*UZ+(P*CNZ))*SURF/VOLU
  249. MPRES.VPOCHA(IFAC,IDIM+2)=-1*((UN*GAMM*P/(GAMM-1.0D0)) +
  250. & (0.5D0*RHO*UN*(UN*UN+UT*UT+UT2*UT2)))*SURF/VOLU
  251. do 105 i=1,(nsp-1)
  252. MPRES.VPOCHA(IFAC,IDIM+2+I)=-1.0D0*RHO*YC.YET(I)*UN*SURF/VOLU
  253. 105 continue
  254. 1 CONTINUE
  255. C
  256. SEGDES MELEFC
  257. C
  258. SEGSUP MLEMC
  259. SEGSUP MLEMCB
  260. SEGSUP MLEMF
  261. C
  262. SEGDES MPNORM
  263. SEGDES MPVOL
  264. SEGDES MPSURF
  265. SEGDES MPRC
  266. SEGDES MPPC
  267. SEGDES MPVC
  268. SEGDES MPYN
  269. SEGDES MPLIM
  270. SEGDES MPRES
  271. SEGDES MPRLI
  272. SEGDES MLRECP
  273. SEGDES MLRECV
  274. SEGDES YC
  275. SEGDES YF
  276. C
  277. 9999 CONTINUE
  278. RETURN
  279. END
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  

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