Télécharger cli251.eso

Retour à la liste

Numérotation des lignes :

cli251
  1. C CLI251 SOURCE CB215821 20/11/25 13:20:39 10792
  2. SUBROUTINE CLI251(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  3. & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYC,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI251
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM22
  11. C Outlet B.C. (known pressure)
  12. C
  13. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  14. C
  15. C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF
  16. C
  17. C************************************************************************
  18. C
  19. C APPELES (Calcul) :
  20. C
  21. C************************************************************************
  22. C
  23. C HISTORIQUE (Anomalies et modifications éventuelles)
  24. C
  25. C HISTORIQUE :
  26. C
  27. C************************************************************************
  28. C
  29. IMPLICIT INTEGER(I-N)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC SMLMOTS
  34. -INC SMELEME
  35. POINTEUR MELEFC.MELEME
  36. -INC SMLENTI
  37. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  38. -INC SMCHPOI
  39. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  40. & MPVC.MPOVAL, MPPC.MPOVAL, MPYC.MPOVAL, MPLIM.MPOVAL,
  41. & MPRES.MPOVAL, MPRLI.MPOVAL
  42. C
  43. C**** Variables de COOPTIO
  44. C
  45. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  46. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  47. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  48. C & ,IECHO, IIMPI, IOSPI
  49. C & ,IDIM, IFICLE, IPREFI
  50. C & ,MCOORD
  51. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  52. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  53. C & ,NORINC,NORVAL,NORIND,NORVAD
  54. C & ,NUCROU, IPSAUV
  55. C
  56. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  57. & ,IYC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  58. & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,NESP,I
  59. REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
  60. & ,CT2X,CT2Y,CT2Z,RC,PC,UXC,UYC,UZC,PF,TOP,BOT
  61. & ,UNC,UTC,UT2C,CELLT
  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
  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(IYC,MPYC,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. CNZ=0.0D0
  119. CTZ=0.0D0
  120. CT2X=0.0D0
  121. CT2Y=0.0D0
  122. CT2Z=0.0D0
  123. DO IFAC=1,NFAC,1
  124. NGF=MELEFC.NUM(1,IFAC)
  125. NGC=MELEFC.NUM(2,IFAC)
  126. NLF=MLEMF.LECT(NGF)
  127. NLC=MLEMC.LECT(NGC)
  128. NLCB=MLEMCB.LECT(NGF)
  129. VOLU=MPVOL.VPOCHA(NLC,1)
  130. SURF=MPSURF.VPOCHA(NLF,1)
  131. C In CASTEM les normales sont sortantes
  132. CNX=MPNORM.VPOCHA(NLF,1)
  133. CNY=MPNORM.VPOCHA(NLF,2)
  134. IF(IDIM.EQ.2)THEN
  135. CTX=-1.0D0*CNY
  136. CTY=CNX
  137. ELSE
  138. CNZ=MPNORM.VPOCHA(NLF,3)
  139. CTX=MPNORM.VPOCHA(NLF,4)
  140. CTY=MPNORM.VPOCHA(NLF,5)
  141. CTZ=MPNORM.VPOCHA(NLF,6)
  142. CT2X=MPNORM.VPOCHA(NLF,7)
  143. CT2Y=MPNORM.VPOCHA(NLF,8)
  144. CT2Z=MPNORM.VPOCHA(NLF,9)
  145. ENDIF
  146. C--------------------------------------------
  147. SEGINI CP, CV
  148. MLRECP = LRECP
  149. MLRECV = LRECV
  150. SEGACT MLRECP, MLRECV
  151. DO 10 I=1,(NSP-1)
  152. CP.GC(I)=MLRECP.PROG(I)
  153. CV.GC(I)=MLRECV.PROG(I)
  154. 10 CONTINUE
  155. CP.GC(NSP)=MLRECP.PROG(NSP)
  156. CV.GC(NSP)=MLRECV.PROG(NSP)
  157. C----------------------------------------
  158. C Variables au centre
  159. C----------------------------------------
  160. RC=MPRC.VPOCHA(NLC,1)
  161. UXC=MPVC.VPOCHA(NLC,1)
  162. UYC=MPVC.VPOCHA(NLC,2)
  163. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  164. PC=MPPC.VPOCHA(NLC,1)
  165. SEGINI YC
  166. SEGACT MPYC
  167. DO 101 I=1,(NSP-1)
  168. YC.YET(I)=MPYC.VPOCHA(NLC,I)
  169. 101 CONTINUE
  170. c-------------------------------------------------------------
  171. c Computing GAMMA at the cell-center
  172. c-------------------------------------------------------------
  173. top=0.0D0
  174. bot=0.0D0
  175. do 102 i=1,(nsp-1)
  176. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  177. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  178. 102 continue
  179. top=cp.gc(nsp)+top
  180. bot=cv.gc(nsp)+bot
  181. GAMC=top/bot
  182. C-----------------------------------------
  183. C Variables à la face
  184. C-----------------------------------------
  185. PF=MPLIM.VPOCHA(NLCB,1)
  186. C---------------------------------------
  187. C******* On calcule UN, UT, UT2
  188. C---------------------------------------
  189. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  190. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  191. UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  192. C-----------------------------------------------
  193. C******* Densite, vitesse, pression sur le bord
  194. C-----------------------------------------------
  195. MPRLI.VPOCHA(NLCB,1)=RC
  196. MPRLI.VPOCHA(NLCB,2)=UXC
  197. MPRLI.VPOCHA(NLCB,3)=UYC
  198. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
  199. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  200. do 104 i=1,(nsp-1)
  201. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
  202. 104 continue
  203. C---------------------------------------------------
  204. C******* Probleme de Riemann entre l'etat gauche
  205. C RC,UNC,UTC,UT2C,PC et l'etat droite
  206. C RC,UNC,UTC,UT2C,PF
  207. C On utilise AUSM+
  208. C Flux dans le repaire normale
  209. C---------------------------------------------------
  210. NESP=NSP-1
  211. IF(IDIM.EQ.2)THEN
  212. CALL FAUSMP(NESP,
  213. & GAMC,RC,PC,UNC,UTC,
  214. & GAMC,RC,PF,UNC,UTC,
  215. & YC.YET,YC.YET,
  216. & FLUX2D.FU,
  217. & CELLT)
  218. C-------------------------------------------------------
  219. C******* Residuum (son SPG a le meme ordre que MELEFC)
  220. C-------------------------------------------------------
  221. MPRES.VPOCHA(IFAC,1)=-1*FLUX2D.FU(1)*SURF/VOLU
  222. MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D.FU(2)*CNX)+
  223. & (FLUX2D.FU(3)*CTX))*SURF/VOLU
  224. MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D.FU(2)*CNY)+
  225. & (FLUX2D.FU(3)*CTY))*SURF/VOLU
  226. MPRES.VPOCHA(IFAC,4)=-1*FLUX2D.FU(4)*SURF/VOLU
  227. do 105 i=1,(nsp-1)
  228. MPRES.VPOCHA(IFAC,4+I)=-1*FLUX2D.FU(4+I)*SURF/VOLU
  229. 105 continue
  230. ELSE
  231. CALL FAUSM3(NESP,
  232. & GAMC,RC,PC,UNC,UTC,UT2C,
  233. & GAMC,RC,PF,UNC,UTC,UT2C,
  234. & YC.YET,YC.YET,
  235. & FLUX3D.FU,
  236. & CELLT)
  237. C------------------------------------------------------
  238. C******* Residuum (son SPG a le meme ordre que MELEFC)
  239. C------------------------------------------------------
  240. MPRES.VPOCHA(IFAC,1)=-1*FLUX3D.FU(1)*SURF/VOLU
  241. MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D.FU(2)*CNX)+
  242. & (FLUX3D.FU(3)*CTX)+(FLUX3D.FU(4)*CT2X))*SURF/VOLU
  243. MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D.FU(2)*CNY)+
  244. & (FLUX3D.FU(3)*CTY)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  245. MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D.FU(2)*CNZ)+
  246. & (FLUX3D.FU(3)*CTZ)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  247. MPRES.VPOCHA(IFAC,5)=-1*FLUX3D.FU(5)*SURF/VOLU
  248. do 106 i=1,(nsp-1)
  249. MPRES.VPOCHA(IFAC,5+I)=-1*FLUX3D.FU(5+I)*SURF/VOLU
  250. 106 continue
  251. ENDIF
  252. ENDDO
  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 MPYC
  267. SEGDES MPLIM
  268. SEGDES MPRES
  269. SEGDES MPRLI
  270. SEGDES YC
  271. SEGDES FLUX2D
  272. SEGDES FLUX3D
  273. C
  274. 9999 CONTINUE
  275. RETURN
  276. END
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  

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