Télécharger cl251t.eso

Retour à la liste

Numérotation des lignes :

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

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