Télécharger cli221.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI221 SOURCE CHAT 05/01/12 22:07:00 5004
  2. SUBROUTINE CLI221(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 : CLI221
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM22
  11. C calcul de RESIDU et CLIM at the board
  12. C OPTION: 'INRI' 2D
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15. C
  16. C AUTEUR : S.Kudriakov, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C APPELES (Calcul) :
  21. C
  22. C************************************************************************
  23. C
  24. C HISTORIQUE (Anomalies et modifications éventuelles)
  25. C
  26. C HISTORIQUE :
  27. C
  28. C************************************************************************
  29. C
  30. IMPLICIT INTEGER(I-N)
  31. -INC CCOPTIO
  32. -INC SMLMOTS
  33. -INC SMELEME
  34. POINTEUR MELEFC.MELEME
  35. -INC SMLENTI
  36. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  37. -INC SMCHPOI
  38. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  39. & MPVC.MPOVAL, MPPC.MPOVAL, MPYN.MPOVAL, MPLIM.MPOVAL,
  40. & MPRES.MPOVAL, MPRLI.MPOVAL
  41. C----------------------------------------
  42. C**** Variables de COOPTIO
  43. C----------------------------------------
  44. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  45. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  46. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  47. C & ,IECHO, IIMPI, IOSPI
  48. C & ,IDIM, IFICLE, IPREFI
  49. C & ,MCOORD
  50. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  51. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  52. C & ,NORINC,NORVAL,NORIND,NORVAD
  53. C & ,NUCROU, IPSAUV
  54. C
  55. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  56. & ,IYN,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  57. & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,I,NSP
  58. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,UZC,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
  59. & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF,TOP,BOT
  60. & ,UNC,UNF,UTF,UT2F,SF,ASONC,ASONF,GAMF
  61. & ,G1,G3,ASON2,S,UT,UT2,UN,RHO,P,UX,UY,UZ
  62. CHARACTER*(8) TYPE
  63. C------------------------------------------------------------
  64. -INC SMLREEL
  65. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  66. C-------------------------------------------------------
  67. C********** Les CP's and CV's ***********************
  68. C-------------------------------------------------------
  69. SEGMENT GCONST
  70. REAL*8 GC(NSP)
  71. ENDSEGMENT
  72. POINTEUR CP.GCONST, CV.GCONST
  73. C-------------------------------------------------------------
  74. C******* Les fractionines massiques **************************
  75. C-------------------------------------------------------------
  76. SEGMENT FRAMAS
  77. REAL*8 YET(NSP)
  78. ENDSEGMENT
  79. POINTEUR YC.FRAMAS, YF.FRAMAS
  80. C------------------------------------------------------
  81. C**** KRIPAD pour la correspondance global/local
  82. C------------------------------------------------------
  83. CALL KRIPAD(MELEMC,MLEMC)
  84. CALL KRIPAD(MELECB,MLEMCB)
  85. CALL KRIPAD(MELEMF,MLEMF)
  86. C------------------------------------------------------
  87. C**** CHPOINTs de la table DOMAINE
  88. C------------------------------------------------------
  89. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  90. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  91. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  92. C------------------------------------------------------
  93. C**** CHPOINTs des variables
  94. C------------------------------------------------------
  95. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  96. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  97. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  98. CALL LICHT(IYN,MPYN,TYPE,ICEL)
  99. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  100. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  101. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  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. UZC=0.0D0
  109. UZF=0.0D0
  110. CNZ=0.0D0
  111. CTZ=0.0D0
  112. CT2X=0.0D0
  113. CT2Y=0.0D0
  114. CT2Z=0.0D0
  115. DO 1 IFAC=1,NFAC,1
  116. NGF=MELEFC.NUM(1,IFAC)
  117. NGC=MELEFC.NUM(2,IFAC)
  118. NLF=MLEMF.LECT(NGF)
  119. NLC=MLEMC.LECT(NGC)
  120. NLCB=MLEMCB.LECT(NGF)
  121. VOLU=MPVOL.VPOCHA(NLC,1)
  122. SURF=MPSURF.VPOCHA(NLF,1)
  123. C----------------------------------------------
  124. C In CASTEM les normales sont sortantes
  125. C----------------------------------------------
  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. C----------------------------------------
  141. SEGINI CP, CV
  142. MLRECP = LRECP
  143. MLRECV = LRECV
  144. SEGACT MLRECP, MLRECV
  145. DO 10 I=1,(NSP-1)
  146. CP.GC(I)=MLRECP.PROG(I)
  147. CV.GC(I)=MLRECV.PROG(I)
  148. 10 CONTINUE
  149. CP.GC(NSP)=MLRECP.PROG(NSP)
  150. CV.GC(NSP)=MLRECV.PROG(NSP)
  151. C----------------------------
  152. C Variables au centre
  153. C----------------------------
  154. RC=MPRC.VPOCHA(NLC,1)
  155. PC=MPPC.VPOCHA(NLC,1)
  156. UXC=MPVC.VPOCHA(NLC,1)
  157. UYC=MPVC.VPOCHA(NLC,2)
  158. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  159. SEGINI YC
  160. SEGACT MPYN
  161. DO 100 I=1,(NSP-1)
  162. YC.YET(I)=MPYN.VPOCHA(NLC,I)
  163. 100 CONTINUE
  164. C----------------------------
  165. C Variables à la face
  166. C----------------------------
  167. RF=MPLIM.VPOCHA(NLCB,1)
  168. UXF=MPLIM.VPOCHA(NLCB,2)
  169. UYF=MPLIM.VPOCHA(NLCB,3)
  170. IF(IDIM.EQ.3)UZF=MPLIM.VPOCHA(NLCB,4)
  171. PF=MPLIM.VPOCHA(NLCB,IDIM+2)
  172. SEGINI YF
  173. DO 101 I=1,(NSP-1)
  174. YF.YET(I)=MPLIM.VPOCHA(NLCB,IDIM+2+I)
  175. 101 CONTINUE
  176. c-------------------------------------------------------------
  177. c Computing GAMMA at the cell-center
  178. c-------------------------------------------------------------
  179. top=0.0D0
  180. bot=0.0D0
  181. do 102 i=1,(nsp-1)
  182. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  183. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  184. 102 continue
  185. top=cp.gc(nsp)+top
  186. bot=cv.gc(nsp)+bot
  187. GAMC=top/bot
  188. c-------------------------------------------------------------
  189. c Computing GAMMA at the face-center
  190. c-------------------------------------------------------------
  191. top=0.0D0
  192. bot=0.0D0
  193. do 103 i=1,(nsp-1)
  194. top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp))
  195. bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp))
  196. 103 continue
  197. top=cp.gc(nsp)+top
  198. bot=cv.gc(nsp)+bot
  199. GAMF=top/bot
  200. C---------------------------------------
  201. C******* On calcule UN, UT, UT2, ASON, S
  202. C---------------------------------------
  203. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  204. UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ)
  205. UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ)
  206. 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. SF=PF/(RF**GAMF)
  212. C-----------------------------------------------
  213. C******* Densite, vitesse, pression sur le bord
  214. C-----------------------------------------------
  215. G1=UNC-(2.0D0*ASONC)/(GAMC-1.0D0)
  216. G3=UNF+(2.0D0*ASONF)/(GAMF-1.0D0)
  217. UN=0.5D0*(G1+G3)
  218. ASON2=(0.5D0*(G3-G1))
  219. ASON2=ASON2*(GAMF-1.0D0)/2.0D0
  220. ASON2=ASON2*ASON2
  221. S=SF
  222. UT=UTF
  223. UT2=UT2F
  224. RHO=ASON2/(GAMF*S)
  225. RHO=RHO**(1.0D0/(GAMF-1.0D0))
  226. P=RHO*ASON2/GAMF
  227. UX=(UN*CNX)+(UT*CTX)+(UT2*CT2X)
  228. UY=(UN*CNY)+(UT*CTY)+(UT2*CT2Y)
  229. UZ=(UN*CNZ)+(UT*CTZ)+(UT2*CT2Z)
  230. C----------------------------------------
  231. MPRLI.VPOCHA(NLCB,1)=RHO
  232. MPRLI.VPOCHA(NLCB,2)=UX
  233. MPRLI.VPOCHA(NLCB,3)=UY
  234. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ
  235. MPRLI.VPOCHA(NLCB,IDIM+2)=P
  236. do 104 i=1,(nsp-1)
  237. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I)
  238. 104 continue
  239. C-------------------------------------------------------
  240. C******* Residuum (son SPG a le meme ordre que MELEFC)
  241. C-------------------------------------------------------
  242. MPRES.VPOCHA(IFAC,1)=RHO*UN*SURF/VOLU
  243. MPRES.VPOCHA(IFAC,2)=(RHO*UN*UX+(P*CNX))*SURF/VOLU
  244. MPRES.VPOCHA(IFAC,3)=(RHO*UN*UY+(P*CNY))*SURF/VOLU
  245. IF(IDIM.EQ.3)
  246. & MPRES.VPOCHA(IFAC,4)=(RHO*UN*UZ+(P*CNZ))*SURF/VOLU
  247. MPRES.VPOCHA(IFAC,IDIM+2)=((UN*GAMF*P/(GAMF-1.0D0)) +
  248. & (0.5D0*RHO*UN*(UN*UN+UT*UT+UT2*UT2)))*SURF/VOLU
  249. do 105 i=1,(nsp-1)
  250. MPRES.VPOCHA(IFAC,IDIM+2+I)=RHO*YF.YET(I)*UN*SURF/VOLU
  251. 105 continue
  252. 1 CONTINUE
  253. C
  254. SEGDES MELEFC
  255. C
  256. SEGSUP MLEMC
  257. SEGSUP MLEMCB
  258. SEGSUP MLEMF
  259. C
  260. SEGDES MPNORM
  261. SEGDES MPVOL
  262. SEGDES MPSURF
  263. SEGDES MPRC
  264. SEGDES MPPC
  265. SEGDES MPVC
  266. SEGDES MPYN
  267. SEGDES MPLIM
  268. SEGDES MPRES
  269. SEGDES MPRLI
  270. SEGDES MLRECP
  271. SEGDES MLRECV
  272. SEGDES YC
  273. SEGDES YF
  274. C
  275. 9999 CONTINUE
  276. RETURN
  277. END
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  

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