Télécharger cl291t.eso

Retour à la liste

Numérotation des lignes :

  1. C CL291T SOURCE CHAT 05/01/12 22:04:19 5004
  2. SUBROUTINE CL291T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  3. & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYC,
  4. & IKAN,IEPSN,ICHLIM,ICHRES,ICHRLI)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : CLI291T
  10. C
  11. C DESCRIPTION : Subroutine appellée par CLIM22
  12. C Supersonic Outlet B.C.
  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 (CHPVID here)
  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. IMPLICIT INTEGER(I-N)
  65. -INC CCOPTIO
  66. -INC SMLMOTS
  67. -INC SMELEME
  68. POINTEUR MELEFC.MELEME,MELEMF.MELEME,MELEMC.MELEME,MELECB.MELEME
  69. -INC SMLENTI
  70. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  71. -INC SMCHPOI
  72. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  73. & MPVC.MPOVAL, MPPC.MPOVAL, MPYC.MPOVAL, MPLIM.MPOVAL,
  74. & MPRES.MPOVAL, MPRLI.MPOVAL,MPKAC.MPOVAL,MPEPSC.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. & ,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
  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. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  144. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  145. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  146. C---------------------------------------------------------
  147. C**** Boucle sur le face pour le calcul des invariants de
  148. C Riemann et du flux
  149. C---------------------------------------------------------
  150. SEGACT MELEFC
  151. NFAC=MELEFC.NUM(/2)
  152. UZC=0.0D0
  153. CNZ=0.0D0
  154. CTZ=0.0D0
  155. CT2X=0.0D0
  156. CT2Y=0.0D0
  157. CT2Z=0.0D0
  158. DO IFAC=1,NFAC,1
  159. NGF=MELEFC.NUM(1,IFAC)
  160. NGC=MELEFC.NUM(2,IFAC)
  161. NLF=MLEMF.LECT(NGF)
  162. NLC=MLEMC.LECT(NGC)
  163. NLCB=MLEMCB.LECT(NGF)
  164. VOLU=MPVOL.VPOCHA(NLC,1)
  165. SURF=MPSURF.VPOCHA(NLF,1)
  166. C In CASTEM les normales sont sortantes
  167. CNX=MPNORM.VPOCHA(NLF,1)
  168. CNY=MPNORM.VPOCHA(NLF,2)
  169. IF(IDIM.EQ.2)THEN
  170. CTX=-1.0D0*CNY
  171. CTY=CNX
  172. ELSE
  173. CNZ=MPNORM.VPOCHA(NLF,3)
  174. CTX=MPNORM.VPOCHA(NLF,4)
  175. CTY=MPNORM.VPOCHA(NLF,5)
  176. CTZ=MPNORM.VPOCHA(NLF,6)
  177. CT2X=MPNORM.VPOCHA(NLF,7)
  178. CT2Y=MPNORM.VPOCHA(NLF,8)
  179. CT2Z=MPNORM.VPOCHA(NLF,9)
  180. ENDIF
  181. C--------------------------------------------
  182. SEGINI CP, CV
  183. MLRECP = LRECP
  184. MLRECV = LRECV
  185. SEGACT MLRECP, MLRECV
  186. DO 10 I=1,(NSP-1)
  187. CP.GC(I)=MLRECP.PROG(I)
  188. CV.GC(I)=MLRECV.PROG(I)
  189. 10 CONTINUE
  190. CP.GC(NSP)=MLRECP.PROG(NSP)
  191. CV.GC(NSP)=MLRECV.PROG(NSP)
  192. C----------------------------------------
  193. C Variables au centre
  194. C----------------------------------------
  195. RC=MPRC.VPOCHA(NLC,1)
  196. UXC=MPVC.VPOCHA(NLC,1)
  197. UYC=MPVC.VPOCHA(NLC,2)
  198. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  199. PC=MPPC.VPOCHA(NLC,1)
  200. SEGINI YC
  201. SEGACT MPYC
  202. DO 101 I=1,(NSP-1)
  203. YC.YET(I)=MPYC.VPOCHA(NLC,I)
  204. 101 CONTINUE
  205. KAC=MPKAC.VPOCHA(NLC,1)
  206. EPSC=MPEPSC.VPOCHA(NLC,1)
  207. c-------------------------------------------------------------
  208. c Computing GAMMA at the cell-center
  209. c-------------------------------------------------------------
  210. top=0.0D0
  211. bot=0.0D0
  212. do 102 i=1,(nsp-1)
  213. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  214. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  215. 102 continue
  216. top=cp.gc(nsp)+top
  217. bot=cv.gc(nsp)+bot
  218. GAMC=top/bot
  219. C-----------------------------------------
  220. C Variables à la face
  221. C-----------------------------------------
  222. PF = PC
  223. C---------------------------------------
  224. C******* On calcule UN, UT, UT2
  225. C---------------------------------------
  226. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  227. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  228. UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  229. C-----------------------------------------------
  230. C******* Densite, vitesse, pression sur le bord
  231. C-----------------------------------------------
  232. MPRLI.VPOCHA(NLCB,1)=RC
  233. MPRLI.VPOCHA(NLCB,2)=UXC
  234. MPRLI.VPOCHA(NLCB,3)=UYC
  235. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
  236. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  237. do 104 i=1,(nsp-1)
  238. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
  239. 104 continue
  240. MPRLI.VPOCHA(NLCB,IDIM+NSP+2)=KAC
  241. MPRLI.VPOCHA(NLCB,IDIM+NSP+3)=EPSC
  242. C---------------------------------------------------
  243. C******* Probleme de Riemann entre l'etat gauche
  244. C RC,UNC,UTC,UT2C,PC et l'etat droite
  245. C RC,UNC,UTC,UT2C,PF
  246. C On utilise AUSM+
  247. C Flux dans le repaire normale
  248. C---------------------------------------------------
  249. NESP=NSP-1
  250. IF(IDIM.EQ.2)THEN
  251. CALL FAUSMP(NESP,
  252. & GAMC,RC,PC,UNC,UTC,
  253. & GAMC,RC,PF,UNC,UTC,
  254. & YC.YET,YC.YET,
  255. & FLUX2D.FU,
  256. & CELLT)
  257. C-------------------------------------------------------
  258. C******* Residuum (son SPG a le meme ordre que MELEFC)
  259. C-------------------------------------------------------
  260. MPRES.VPOCHA(IFAC,1)=-1*FLUX2D.FU(1)*SURF/VOLU
  261. MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D.FU(2)*CNX)+
  262. & (FLUX2D.FU(3)*CTX))*SURF/VOLU
  263. MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D.FU(2)*CNY)+
  264. & (FLUX2D.FU(3)*CTY))*SURF/VOLU
  265. MPRES.VPOCHA(IFAC,4)=-1*FLUX2D.FU(4)*SURF/VOLU
  266. do 105 i=1,(nsp-1)
  267. MPRES.VPOCHA(IFAC,4+I)=-1*FLUX2D.FU(4+I)*SURF/VOLU
  268. 105 continue
  269. MPRES.VPOCHA(IFAC,4+NSP)=-1*KAC*FLUX2D.FU(1)*SURF/VOLU
  270. MPRES.VPOCHA(IFAC,5+NSP)=-1*EPSC*FLUX2D.FU(1)*SURF/VOLU
  271. ELSE
  272. CALL FAUSM3(NESP,
  273. & GAMC,RC,PC,UNC,UTC,UT2C,
  274. & GAMC,RC,PF,UNC,UTC,UT2C,
  275. & YC.YET,YC.YET,
  276. & FLUX3D.FU,
  277. & CELLT)
  278. C------------------------------------------------------
  279. C******* Residuum (son SPG a le meme ordre que MELEFC)
  280. C------------------------------------------------------
  281. MPRES.VPOCHA(IFAC,1)=-1*FLUX3D.FU(1)*SURF/VOLU
  282. MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D.FU(2)*CNX)+
  283. & (FLUX3D.FU(3)*CTX)+(FLUX3D.FU(4)*CT2X))*SURF/VOLU
  284. MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D.FU(2)*CNY)+
  285. & (FLUX3D.FU(3)*CTY)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  286. MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D.FU(2)*CNZ)+
  287. & (FLUX3D.FU(3)*CTZ)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  288. MPRES.VPOCHA(IFAC,5)=-1*FLUX3D.FU(5)*SURF/VOLU
  289. do 106 i=1,(nsp-1)
  290. MPRES.VPOCHA(IFAC,5+I)=-1*FLUX3D.FU(5+I)*SURF/VOLU
  291. 106 continue
  292. MPRES.VPOCHA(IFAC,5+NSP)=-1*KAC*FLUX3D.FU(1)*SURF/VOLU
  293. MPRES.VPOCHA(IFAC,6+NSP)=-1*EPSC*FLUX3D.FU(1)*SURF/VOLU
  294. ENDIF
  295. ENDDO
  296. C
  297. SEGDES MELEFC
  298. C
  299. SEGDES MLEMC
  300. SEGDES MLEMCB
  301. SEGDES MLEMF
  302. C
  303. SEGDES MPNORM
  304. SEGDES MPVOL
  305. SEGDES MPSURF
  306. SEGDES MPRC
  307. SEGDES MPPC
  308. SEGDES MPVC
  309. SEGDES MPYC
  310. SEGDES MPKAC
  311. SEGDES MPEPSC
  312. c SEGDES MPLIM
  313. SEGDES MPRES
  314. SEGDES MPRLI
  315. SEGDES YC
  316. SEGDES FLUX2D
  317. SEGDES FLUX3D
  318. C
  319. 9999 CONTINUE
  320. RETURN
  321. END
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  

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