Télécharger cli261.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI261 SOURCE CHAT 05/01/12 22:07:24 5004
  2. SUBROUTINE CLI261(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 : CLI261
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM22
  11. C calcul de RESIDU et CLIM at the board
  12. C OPTION: 'INSU' 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,NESP
  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,GAMF,ECIN,PSRF,HTF,GM1
  61. & ,CELLT,UT2C,UTC
  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********** Segments for the flux-vector *******************
  82. C-------------------------------------------------------------
  83. SEGMENT FUNEL
  84. REAL*8 FU(4+NSP)
  85. ENDSEGMENT
  86. POINTEUR flux2D.funel, flux3D.funel
  87. SEGINI FLUX2D
  88. SEGINI FLUX3D
  89. C------------------------------------------------------
  90. C**** KRIPAD pour la correspondance global/local
  91. C------------------------------------------------------
  92. CALL KRIPAD(MELEMC,MLEMC)
  93. CALL KRIPAD(MELECB,MLEMCB)
  94. CALL KRIPAD(MELEMF,MLEMF)
  95. C------------------------------------------------------
  96. C**** CHPOINTs de la table DOMAINE
  97. C------------------------------------------------------
  98. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  99. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  100. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  101. C------------------------------------------------------
  102. C**** CHPOINTs des variables
  103. C------------------------------------------------------
  104. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  105. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  106. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  107. CALL LICHT(IYN,MPYN,TYPE,ICEL)
  108. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  109. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  110. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  111. C---------------------------------------------------------
  112. C**** Boucle sur le face pour le calcul des invariants de
  113. C Riemann et du flux
  114. C---------------------------------------------------------
  115. SEGACT MELEFC
  116. NFAC=MELEFC.NUM(/2)
  117. UZC=0.0D0
  118. UZF=0.0D0
  119. UT2F=0.0D0
  120. CNZ=0.0D0
  121. CTZ=0.0D0
  122. CT2X=0.0D0
  123. CT2Y=0.0D0
  124. CT2Z=0.0D0
  125. DO 1 IFAC=1,NFAC,1
  126. NGF=MELEFC.NUM(1,IFAC)
  127. NGC=MELEFC.NUM(2,IFAC)
  128. NLF=MLEMF.LECT(NGF)
  129. NLC=MLEMC.LECT(NGC)
  130. NLCB=MLEMCB.LECT(NGF)
  131. VOLU=MPVOL.VPOCHA(NLC,1)
  132. SURF=MPSURF.VPOCHA(NLF,1)
  133. C----------------------------------------------
  134. C In CASTEM les normales sont sortantes
  135. C----------------------------------------------
  136. CNX=-1*MPNORM.VPOCHA(NLF,1)
  137. CNY=-1*MPNORM.VPOCHA(NLF,2)
  138. IF(IDIM.EQ.2)THEN
  139. CTX=-1.0D0*CNY
  140. CTY=CNX
  141. ELSE
  142. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  143. CTX=-1*MPNORM.VPOCHA(NLF,4)
  144. CTY=-1*MPNORM.VPOCHA(NLF,5)
  145. CTZ=-1*MPNORM.VPOCHA(NLF,6)
  146. CT2X=-1*MPNORM.VPOCHA(NLF,7)
  147. CT2Y=-1*MPNORM.VPOCHA(NLF,8)
  148. CT2Z=-1*MPNORM.VPOCHA(NLF,9)
  149. ENDIF
  150. C----------------------------------------
  151. SEGINI CP, CV
  152. MLRECP = LRECP
  153. MLRECV = LRECV
  154. SEGACT MLRECP, MLRECV
  155. DO 10 I=1,(NSP-1)
  156. CP.GC(I)=MLRECP.PROG(I)
  157. CV.GC(I)=MLRECV.PROG(I)
  158. 10 CONTINUE
  159. CP.GC(NSP)=MLRECP.PROG(NSP)
  160. CV.GC(NSP)=MLRECV.PROG(NSP)
  161. C----------------------------
  162. C Variables au centre
  163. C----------------------------
  164. RC=MPRC.VPOCHA(NLC,1)
  165. PC=MPPC.VPOCHA(NLC,1)
  166. UXC=MPVC.VPOCHA(NLC,1)
  167. UYC=MPVC.VPOCHA(NLC,2)
  168. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  169. SEGINI YC
  170. SEGACT MPYN
  171. DO 100 I=1,(NSP-1)
  172. YC.YET(I)=MPYN.VPOCHA(NLC,I)
  173. 100 CONTINUE
  174. C----------------------------
  175. C Variables à la face
  176. C----------------------------
  177. HTF=MPLIM.VPOCHA(NLCB,1)
  178. SF=MPLIM.VPOCHA(NLCB,2)
  179. SEGINI YF
  180. DO 101 I=1,(NSP-1)
  181. YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I)
  182. 101 CONTINUE
  183. UTF=0.0D0
  184. c-------------------------------------------------------------
  185. c Computing GAMMA at the cell-center
  186. c-------------------------------------------------------------
  187. top=0.0D0
  188. bot=0.0D0
  189. do 102 i=1,(nsp-1)
  190. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  191. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  192. 102 continue
  193. top=cp.gc(nsp)+top
  194. bot=cv.gc(nsp)+bot
  195. GAMC=top/bot
  196. c-------------------------------------------------------------
  197. c Computing GAMMA at the face-center
  198. c-------------------------------------------------------------
  199. top=0.0D0
  200. bot=0.0D0
  201. do 103 i=1,(nsp-1)
  202. top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp))
  203. bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp))
  204. 103 continue
  205. top=cp.gc(nsp)+top
  206. bot=cv.gc(nsp)+bot
  207. GAMF=top/bot
  208. GM1=GAMF-1.0D0
  209. C---------------------------------------
  210. C******* On calcule UN, UT, UT2, ASON, S
  211. C---------------------------------------
  212. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  213. UNF=UNC
  214. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  215. C----------------------------------
  216. UXF=UNF*CNX+UTF*CTX+UT2F*CT2X
  217. UYF=UNF*CNY+UTF*CTY+UT2F*CT2Y
  218. UZF=UNF*CNZ+UTF*CTZ+UT2F*CT2Z
  219. C----------------------------------
  220. ECIN=0.5D0*((UXF*UXF)+(UYF*UYF)+(UZF*UZF))
  221. PSRF=(GM1/GAMF)*(HTF-ECIN)
  222. RF=PSRF/SF
  223. RF=RF**(1.0D0/GM1)
  224. PF=SF*(RF**GAMF)
  225. C-----------------------------------------------
  226. C******* Densite, vitesse, pression sur le bord
  227. C-----------------------------------------------
  228. MPRLI.VPOCHA(NLCB,1)=RF
  229. MPRLI.VPOCHA(NLCB,2)=UXF
  230. MPRLI.VPOCHA(NLCB,3)=UYF
  231. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZF
  232. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  233. do 104 i=1,(nsp-1)
  234. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I)
  235. 104 continue
  236. C---------------------------------------------------
  237. C******* Probleme de Riemann entre l'etat gauche
  238. C RF,UNC,UTF,UT2F,PF et l'etat droite
  239. C RC,UNC,UTC,UT2C,PC
  240. C On utilise AUSM+
  241. C Flux dans le repaire normale
  242. C---------------------------------------------------
  243. NESP=NSP-1
  244. IF(IDIM.EQ.2)THEN
  245. CALL FAUSMP(NESP,
  246. & GAMF,RF,PF,UNC,UTF,
  247. & GAMC,RC,PC,UNC,UTC,
  248. & YF.YET,YC.YET,
  249. & FLUX2D.FU,
  250. & CELLT)
  251. C-------------------------------------------------------
  252. C******* Residuum (son SPG a le meme ordre que MELEFC)
  253. C-------------------------------------------------------
  254. MPRES.VPOCHA(IFAC,1)=FLUX2D.FU(1)*SURF/VOLU
  255. MPRES.VPOCHA(IFAC,2)=((FLUX2D.FU(2)*CNX)+(FLUX2D.FU(3)*CTX))
  256. & *SURF/VOLU
  257. MPRES.VPOCHA(IFAC,3)=((FLUX2D.FU(2)*CNY)+(FLUX2D.FU(3)*CTY))
  258. & *SURF/VOLU
  259. MPRES.VPOCHA(IFAC,4)=FLUX2D.FU(4)*SURF/VOLU
  260. do 105 i=1,(nsp-1)
  261. MPRES.VPOCHA(IFAC,4+I)=FLUX2D.FU(4+I)*SURF/VOLU
  262. 105 continue
  263. ELSE
  264. CALL FAUSM3(NESP,
  265. & GAMF,RF,PF,UNC,UTF,UT2F,
  266. & GAMC,RC,PC,UNC,UTC,UT2C,
  267. & YF.YET,YC.YET,
  268. & FLUX3D.FU,
  269. & CELLT)
  270. C------------------------------------------------------
  271. C******* Residuum (son SPG a le meme ordre que MELEFC)
  272. C------------------------------------------------------
  273. MPRES.VPOCHA(IFAC,1)=FLUX3D.FU(1)*SURF/VOLU
  274. MPRES.VPOCHA(IFAC,2)=((FLUX3D.FU(2)*CNX)+(FLUX3D.FU(3)*CTX)+
  275. & (FLUX3D.FU(4)*CT2X))*SURF/VOLU
  276. MPRES.VPOCHA(IFAC,3)=((FLUX3D.FU(2)*CNY)+(FLUX3D.FU(3)*CTY)+
  277. & (FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  278. MPRES.VPOCHA(IFAC,4)=((FLUX3D.FU(2)*CNZ)+(FLUX3D.FU(3)*CTZ)+
  279. & (FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  280. MPRES.VPOCHA(IFAC,5)=FLUX3D.FU(5)*SURF/VOLU
  281. do 106 i=1,(nsp-1)
  282. MPRES.VPOCHA(IFAC,5+I)=FLUX3D.FU(5+I)*SURF/VOLU
  283. 106 continue
  284. ENDIF
  285. 1 CONTINUE
  286. C
  287. SEGDES MELEFC
  288. C
  289. c SEGSUP MLEMC
  290. c SEGSUP MLEMCB
  291. c SEGSUP MLEMF
  292. c-------------------------
  293. SEGDES MLEMC
  294. SEGDES MLEMCB
  295. SEGDES MLEMF
  296. C
  297. SEGDES MPNORM
  298. SEGDES MPVOL
  299. SEGDES MPSURF
  300. SEGDES MPRC
  301. SEGDES MPPC
  302. SEGDES MPVC
  303. SEGDES MPYN
  304. SEGDES MPLIM
  305. SEGDES MPRES
  306. SEGDES MPRLI
  307. SEGDES MLRECP
  308. SEGDES MLRECV
  309. SEGDES YC
  310. SEGDES YF
  311. SEGDES FLUX2D
  312. SEGDES FLUX3D
  313. C
  314. 9999 CONTINUE
  315. RETURN
  316. END
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  

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