Télécharger cl251t.eso

Retour à la liste

Numérotation des lignes :

  1. C CL251T SOURCE HP1 05/09/28 21:15:01 5185
  2. SUBROUTINE CL251T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  3. & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYC,
  4. & IKAN,IEPSN,IK0N,ICHLIM,ICHRES,ICHRLI)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : CLI251T
  10. C
  11. C DESCRIPTION : Subroutine appellée par CLIM22
  12. C Outlet B.C. (known pressure)
  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 ENTREES : NSP (type ENTIER) : full number of species
  20. C ('ESPEULE' + 1) ;
  21. C MELEMF (type MELEME) : maillage des faces des
  22. C éléments.
  23. C MELEMC (type MELEME) : maillage des centres des
  24. C éléments.
  25. C MELECB (type MELEME) : maillage des centres des éléments
  26. C de la frontière
  27. C MELEFC (type MELEME) : connectivités face-(centre
  28. C gauche, centre droit).
  29. C INORM (type MCHPOI) : normales at the faces
  30. C ICHPVO (type MCHPOI) : volumes of the cells
  31. C ICHPSU (type MCHPOI) : surfaces of the cell-interfaces
  32. C LRECP (type MLREEL) : list of CP's of the species
  33. C LRECV (type MLREEL) : list of CV's of the species
  34. C IROC (type MCHPOI) : densityes at the centres of the domain
  35. C IVITC (type MCHPOI) : velocities at the centres of the domain
  36. C IPC (type MCHPOI) : pressure at the centres of the domain
  37. C IYN (type MCHPOI) : mass fraction of the species at the
  38. C centres of the domain
  39. C IKAN (type MCHPOI) : turbulent kinetic energy, k,
  40. C at the centres of the domain
  41. C IEPSN (type MCHPOI) : rate of dissipated turb. energy
  42. C at the centres of the domain
  43. C ICHLIM (type MCHPOI) : boundary conditions at the centers
  44. C of the boundary
  45. C-----------------------------------------------------
  46. C SORTIES: ICHRES (type MCHPOI) : the contribution to the residuum
  47. C due to the boundary conditions
  48. C given at the centres of the cells
  49. C next to the boundary
  50. C ICHRLI (type MCHPOI) : the values at the boundary faces
  51. C found by the procedure.
  52. C************************************************************************
  53. C
  54. C APPELES (Calcul) :
  55. C
  56. C************************************************************************
  57. C
  58. C HISTORIQUE (Anomalies et modifications éventuelles)
  59. C
  60. C HISTORIQUE :
  61. C
  62. C************************************************************************
  63. C
  64. -INC CCOPTIO
  65. -INC SMLMOTS
  66. -INC SMELEME
  67. POINTEUR MELEFC.MELEME,MELEMF.MELEME,MELEMC.MELEME,MELECB.MELEME
  68. -INC SMLENTI
  69. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  70. -INC SMCHPOI
  71. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  72. & MPVC.MPOVAL, MPPC.MPOVAL, MPYC.MPOVAL, MPLIM.MPOVAL,
  73. & MPRES.MPOVAL, MPRLI.MPOVAL,MPKAC.MPOVAL,MPEPSC.MPOVAL,
  74. & MPK0C.MPOVAL
  75. C
  76. C**** Variables de COOPTIO
  77. C
  78. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  79. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  80. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  81. C & ,IECHO, IIMPI, IOSPI
  82. C & ,IDIM, IFICLE, IPREFI
  83. C & ,MCOORD
  84. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  85. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  86. C & ,NORINC,NORVAL,NORIND,NORVAD
  87. C & ,NUCROU, IPSAUV
  88. C
  89. INTEGER INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  90. & ,IYC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC,IKAN, IEPSN
  91. & ,IK0N,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,NESP,I
  92. REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
  93. & ,CT2X,CT2Y,CT2Z,RC,PC,UXC,UYC,UZC,PF,TOP,BOT
  94. & ,UNC,UTC,UT2C,CELLT,EPSC,KAC,K0C
  95. CHARACTER*(8) TYPE
  96. C-------------------------------------------------------
  97. -INC SMLREEL
  98. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  99. C-------------------------------------------------------
  100. C********** Les CP's and CV's ***********************
  101. C-------------------------------------------------------
  102. SEGMENT GCONST
  103. REAL*8 GC(NSP)
  104. ENDSEGMENT
  105. POINTEUR CP.GCONST, CV.GCONST
  106. C-------------------------------------------------------------
  107. C******* Les fractionines massiques **************************
  108. C-------------------------------------------------------------
  109. SEGMENT FRAMAS
  110. REAL*8 YET(NSP)
  111. ENDSEGMENT
  112. POINTEUR YC.FRAMAS
  113. C-------------------------------------------------------------
  114. C********** Segments for the flux-vector *******************
  115. C-------------------------------------------------------------
  116. SEGMENT FUNEL
  117. REAL*8 FU(IDIM+1+NSP)
  118. ENDSEGMENT
  119. POINTEUR flux2D.funel, flux3D.funel
  120. SEGINI FLUX2D
  121. SEGINI FLUX3D
  122. C------------------------------------------------------------
  123. C**** KRIPAD pour la correspondance global/local
  124. C------------------------------------------------------------
  125. CALL KRIPAD(MELEMC,MLEMC)
  126. CALL KRIPAD(MELECB,MLEMCB)
  127. CALL KRIPAD(MELEMF,MLEMF)
  128. C--------------------------------------------
  129. C**** CHPOINTs de la table DOMAINE
  130. C--------------------------------------------
  131. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  132. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  133. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  134. C----------------------------------------
  135. C**** CHPOINTs des variables
  136. C----------------------------------------
  137. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  138. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  139. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  140. CALL LICHT(IYC,MPYC,TYPE,ICEL)
  141. CALL LICHT(IKAN,MPKAC,TYPE,ICEL)
  142. CALL LICHT(IEPSN,MPEPSC,TYPE,ICEL)
  143. IF (IK0N .GT. 0) THEN
  144. CALL LICHT(IK0N,MPK0C,TYPE,ICEL)
  145. ENDIF
  146. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  147. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  148. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  149. C---------------------------------------------------------
  150. C**** Boucle sur le face pour le calcul des invariants de
  151. C Riemann et du flux
  152. C---------------------------------------------------------
  153. SEGACT MELEFC
  154. NFAC=MELEFC.NUM(/2)
  155. UZC=0.0D0
  156. CNZ=0.0D0
  157. CTZ=0.0D0
  158. CT2X=0.0D0
  159. CT2Y=0.0D0
  160. CT2Z=0.0D0
  161. DO IFAC=1,NFAC,1
  162. NGF=MELEFC.NUM(1,IFAC)
  163. NGC=MELEFC.NUM(2,IFAC)
  164. NLF=MLEMF.LECT(NGF)
  165. NLC=MLEMC.LECT(NGC)
  166. NLCB=MLEMCB.LECT(NGF)
  167. VOLU=MPVOL.VPOCHA(NLC,1)
  168. SURF=MPSURF.VPOCHA(NLF,1)
  169. C In CASTEM les normales sont sortantes
  170. CNX=MPNORM.VPOCHA(NLF,1)
  171. CNY=MPNORM.VPOCHA(NLF,2)
  172. IF(IDIM.EQ.2)THEN
  173. CTX=-1.0D0*CNY
  174. CTY=CNX
  175. ELSE
  176. CNZ=MPNORM.VPOCHA(NLF,3)
  177. CTX=MPNORM.VPOCHA(NLF,4)
  178. CTY=MPNORM.VPOCHA(NLF,5)
  179. CTZ=MPNORM.VPOCHA(NLF,6)
  180. CT2X=MPNORM.VPOCHA(NLF,7)
  181. CT2Y=MPNORM.VPOCHA(NLF,8)
  182. CT2Z=MPNORM.VPOCHA(NLF,9)
  183. ENDIF
  184. C--------------------------------------------
  185. SEGINI CP, CV
  186. MLRECP = LRECP
  187. MLRECV = LRECV
  188. SEGACT MLRECP, MLRECV
  189. DO 10 I=1,(NSP-1)
  190. CP.GC(I)=MLRECP.PROG(I)
  191. CV.GC(I)=MLRECV.PROG(I)
  192. 10 CONTINUE
  193. CP.GC(NSP)=MLRECP.PROG(NSP)
  194. CV.GC(NSP)=MLRECV.PROG(NSP)
  195. C----------------------------------------
  196. C Variables au centre
  197. C----------------------------------------
  198. RC=MPRC.VPOCHA(NLC,1)
  199. UXC=MPVC.VPOCHA(NLC,1)
  200. UYC=MPVC.VPOCHA(NLC,2)
  201. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  202. PC=MPPC.VPOCHA(NLC,1)
  203. SEGINI YC
  204. SEGACT MPYC
  205. DO 101 I=1,(NSP-1)
  206. YC.YET(I)=MPYC.VPOCHA(NLC,I)
  207. 101 CONTINUE
  208. KAC=MPKAC.VPOCHA(NLC,1)
  209. EPSC=MPEPSC.VPOCHA(NLC,1)
  210. IF (IK0N .GT. 0) THEN
  211. K0C=MPK0C.VPOCHA(NLC,1)
  212. ENDIF
  213. c-------------------------------------------------------------
  214. c Computing GAMMA at the cell-center
  215. c-------------------------------------------------------------
  216. top=0.0D0
  217. bot=0.0D0
  218. do 102 i=1,(nsp-1)
  219. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  220. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  221. 102 continue
  222. top=cp.gc(nsp)+top
  223. bot=cv.gc(nsp)+bot
  224. GAMC=top/bot
  225. C-----------------------------------------
  226. C Variables à la face
  227. C-----------------------------------------
  228. PF=MPLIM.VPOCHA(NLCB,1)
  229. C---------------------------------------
  230. C******* On calcule UN, UT, UT2
  231. C---------------------------------------
  232. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  233. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  234. UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  235. C-----------------------------------------------
  236. C******* Densite, vitesse, pression sur le bord
  237. C-----------------------------------------------
  238. MPRLI.VPOCHA(NLCB,1)=RC
  239. MPRLI.VPOCHA(NLCB,2)=UXC
  240. MPRLI.VPOCHA(NLCB,3)=UYC
  241. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
  242. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  243. do 104 i=1,(nsp-1)
  244. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
  245. 104 continue
  246. MPRLI.VPOCHA(NLCB,IDIM+NSP+2)=KAC
  247. MPRLI.VPOCHA(NLCB,IDIM+NSP+3)=EPSC
  248. IF (IK0N .GT. 0) THEN
  249. MPRLI.VPOCHA(NLCB,IDIM+NSP+4)=K0C
  250. ENDIF
  251. C---------------------------------------------------
  252. C******* Probleme de Riemann entre l'etat gauche
  253. C RC,UNC,UTC,UT2C,PC et l'etat droite
  254. C RC,UNC,UTC,UT2C,PF
  255. C On utilise AUSM+
  256. C Flux dans le repaire normale
  257. C---------------------------------------------------
  258. NESP=NSP-1
  259. IF(IDIM.EQ.2)THEN
  260. CALL FAUSMP(NESP,
  261. & GAMC,RC,PC,UNC,UTC,
  262. & GAMC,RC,PF,UNC,UTC,
  263. & YC.YET,YC.YET,
  264. & FLUX2D.FU,
  265. & CELLT)
  266. C-------------------------------------------------------
  267. C******* Residuum (son SPG a le meme ordre que MELEFC)
  268. C-------------------------------------------------------
  269. MPRES.VPOCHA(IFAC,1)=-1*FLUX2D.FU(1)*SURF/VOLU
  270. MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D.FU(2)*CNX)+
  271. & (FLUX2D.FU(3)*CTX))*SURF/VOLU
  272. MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D.FU(2)*CNY)+
  273. & (FLUX2D.FU(3)*CTY))*SURF/VOLU
  274. MPRES.VPOCHA(IFAC,4)=-1*FLUX2D.FU(4)*SURF/VOLU
  275. do 105 i=1,(nsp-1)
  276. MPRES.VPOCHA(IFAC,4+I)=-1*FLUX2D.FU(4+I)*SURF/VOLU
  277. 105 continue
  278. MPRES.VPOCHA(IFAC,4+NSP)=-1*KAC*FLUX2D.FU(1)*SURF/VOLU
  279. MPRES.VPOCHA(IFAC,5+NSP)=-1*EPSC*FLUX2D.FU(1)*SURF/VOLU
  280. IF (IK0N .GT. 0) THEN
  281. MPRES.VPOCHA(IFAC,6+NSP)=-1*K0C*FLUX2D.FU(1)*SURF/VOLU
  282. ENDIF
  283. ELSE
  284. CALL FAUSM3(NESP,
  285. & GAMC,RC,PC,UNC,UTC,UT2C,
  286. & GAMC,RC,PF,UNC,UTC,UT2C,
  287. & YC.YET,YC.YET,
  288. & FLUX3D.FU,
  289. & CELLT)
  290. C------------------------------------------------------
  291. C******* Residuum (son SPG a le meme ordre que MELEFC)
  292. C------------------------------------------------------
  293. MPRES.VPOCHA(IFAC,1)=-1*FLUX3D.FU(1)*SURF/VOLU
  294. MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D.FU(2)*CNX)+
  295. & (FLUX3D.FU(3)*CTX)+(FLUX3D.FU(4)*CT2X))*SURF/VOLU
  296. MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D.FU(2)*CNY)+
  297. & (FLUX3D.FU(3)*CTY)+(FLUX3D.FU(4)*CT2Y))*SURF/VOLU
  298. MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D.FU(2)*CNZ)+
  299. & (FLUX3D.FU(3)*CTZ)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  300. MPRES.VPOCHA(IFAC,5)=-1*FLUX3D.FU(5)*SURF/VOLU
  301. do 106 i=1,(nsp-1)
  302. MPRES.VPOCHA(IFAC,5+I)=-1*FLUX3D.FU(5+I)*SURF/VOLU
  303. 106 continue
  304. MPRES.VPOCHA(IFAC,5+NSP)=-1*KAC*FLUX3D.FU(1)*SURF/VOLU
  305. MPRES.VPOCHA(IFAC,6+NSP)=-1*EPSC*FLUX3D.FU(1)*SURF/VOLU
  306. IF (IK0N .GT. 0) THEN
  307. MPRES.VPOCHA(IFAC,7+NSP)=-1*K0C*FLUX3D.FU(1)*SURF/VOLU
  308. ENDIF
  309. ENDIF
  310. ENDDO
  311. C
  312. SEGDES MELEFC
  313. C
  314. SEGDES MLEMC
  315. SEGDES MLEMCB
  316. SEGDES MLEMF
  317. C
  318. SEGDES MPNORM
  319. SEGDES MPVOL
  320. SEGDES MPSURF
  321. SEGDES MPRC
  322. SEGDES MPPC
  323. SEGDES MPVC
  324. SEGDES MPYC
  325. SEGDES MPKAC
  326. SEGDES MPEPSC
  327. IF (IK0N .GT. 0) THEN
  328. SEGDES MPK0C
  329. ENDIF
  330. SEGDES MPLIM
  331. SEGDES MPRES
  332. SEGDES MPRLI
  333. SEGDES YC
  334. SEGDES FLUX2D
  335. SEGDES FLUX3D
  336. C
  337. 9999 CONTINUE
  338. RETURN
  339. END
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  

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