Télécharger cli251.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI251 SOURCE CHAT 05/01/12 22:07:15 5004
  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. -INC CCOPTIO
  31. -INC SMLMOTS
  32. -INC SMELEME
  33. POINTEUR MELEFC.MELEME
  34. -INC SMLENTI
  35. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  36. -INC SMCHPOI
  37. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  38. & MPVC.MPOVAL, MPPC.MPOVAL, MPYC.MPOVAL, MPLIM.MPOVAL,
  39. & MPRES.MPOVAL, MPRLI.MPOVAL
  40. C
  41. C**** Variables de COOPTIO
  42. C
  43. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  44. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  45. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  46. C & ,IECHO, IIMPI, IOSPI
  47. C & ,IDIM, IFICLE, IPREFI
  48. C & ,MCOORD
  49. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  50. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  51. C & ,NORINC,NORVAL,NORIND,NORVAD
  52. C & ,NUCROU, IPSAUV
  53. C
  54. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  55. & ,IYC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  56. & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,NESP,I
  57. REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
  58. & ,CT2X,CT2Y,CT2Z,RC,PC,UXC,UYC,UZC,PF,TOP,BOT
  59. & ,UNC,UTC,UT2C,CELLT
  60. CHARACTER*(8) TYPE
  61. C-------------------------------------------------------
  62. -INC SMLREEL
  63. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  64. C-------------------------------------------------------
  65. C********** Les CP's and CV's ***********************
  66. C-------------------------------------------------------
  67. SEGMENT GCONST
  68. REAL*8 GC(NSP)
  69. ENDSEGMENT
  70. POINTEUR CP.GCONST, CV.GCONST
  71. C-------------------------------------------------------------
  72. C******* Les fractionines massiques **************************
  73. C-------------------------------------------------------------
  74. SEGMENT FRAMAS
  75. REAL*8 YET(NSP)
  76. ENDSEGMENT
  77. POINTEUR YC.FRAMAS
  78. C-------------------------------------------------------------
  79. C********** Segments for the flux-vector *******************
  80. C-------------------------------------------------------------
  81. SEGMENT FUNEL
  82. REAL*8 FU(4+NSP)
  83. ENDSEGMENT
  84. POINTEUR flux2D.funel, flux3D.funel
  85. SEGINI FLUX2D
  86. SEGINI FLUX3D
  87. C------------------------------------------------------------
  88. C**** KRIPAD pour la correspondance global/local
  89. C------------------------------------------------------------
  90. CALL KRIPAD(MELEMC,MLEMC)
  91. CALL KRIPAD(MELECB,MLEMCB)
  92. CALL KRIPAD(MELEMF,MLEMF)
  93. C--------------------------------------------
  94. C**** CHPOINTs de la table DOMAINE
  95. C--------------------------------------------
  96. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  97. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  98. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  99. C----------------------------------------
  100. C**** CHPOINTs des variables
  101. C----------------------------------------
  102. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  103. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  104. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  105. CALL LICHT(IYC,MPYC,TYPE,ICEL)
  106. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  107. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  108. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  109. C---------------------------------------------------------
  110. C**** Boucle sur le face pour le calcul des invariants de
  111. C Riemann et du flux
  112. C---------------------------------------------------------
  113. SEGACT MELEFC
  114. NFAC=MELEFC.NUM(/2)
  115. UZC=0.0D0
  116. CNZ=0.0D0
  117. CTZ=0.0D0
  118. CT2X=0.0D0
  119. CT2Y=0.0D0
  120. CT2Z=0.0D0
  121. DO IFAC=1,NFAC,1
  122. NGF=MELEFC.NUM(1,IFAC)
  123. NGC=MELEFC.NUM(2,IFAC)
  124. NLF=MLEMF.LECT(NGF)
  125. NLC=MLEMC.LECT(NGC)
  126. NLCB=MLEMCB.LECT(NGF)
  127. VOLU=MPVOL.VPOCHA(NLC,1)
  128. SURF=MPSURF.VPOCHA(NLF,1)
  129. C In CASTEM les normales sont sortantes
  130. CNX=MPNORM.VPOCHA(NLF,1)
  131. CNY=MPNORM.VPOCHA(NLF,2)
  132. IF(IDIM.EQ.2)THEN
  133. CTX=-1.0D0*CNY
  134. CTY=CNX
  135. ELSE
  136. CNZ=MPNORM.VPOCHA(NLF,3)
  137. CTX=MPNORM.VPOCHA(NLF,4)
  138. CTY=MPNORM.VPOCHA(NLF,5)
  139. CTZ=MPNORM.VPOCHA(NLF,6)
  140. CT2X=MPNORM.VPOCHA(NLF,7)
  141. CT2Y=MPNORM.VPOCHA(NLF,8)
  142. CT2Z=MPNORM.VPOCHA(NLF,9)
  143. ENDIF
  144. C--------------------------------------------
  145. SEGINI CP, CV
  146. MLRECP = LRECP
  147. MLRECV = LRECV
  148. SEGACT MLRECP, MLRECV
  149. DO 10 I=1,(NSP-1)
  150. CP.GC(I)=MLRECP.PROG(I)
  151. CV.GC(I)=MLRECV.PROG(I)
  152. 10 CONTINUE
  153. CP.GC(NSP)=MLRECP.PROG(NSP)
  154. CV.GC(NSP)=MLRECV.PROG(NSP)
  155. C----------------------------------------
  156. C Variables au centre
  157. C----------------------------------------
  158. RC=MPRC.VPOCHA(NLC,1)
  159. UXC=MPVC.VPOCHA(NLC,1)
  160. UYC=MPVC.VPOCHA(NLC,2)
  161. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  162. PC=MPPC.VPOCHA(NLC,1)
  163. SEGINI YC
  164. SEGACT MPYC
  165. DO 101 I=1,(NSP-1)
  166. YC.YET(I)=MPYC.VPOCHA(NLC,I)
  167. 101 CONTINUE
  168. c-------------------------------------------------------------
  169. c Computing GAMMA at the cell-center
  170. c-------------------------------------------------------------
  171. top=0.0D0
  172. bot=0.0D0
  173. do 102 i=1,(nsp-1)
  174. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  175. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  176. 102 continue
  177. top=cp.gc(nsp)+top
  178. bot=cv.gc(nsp)+bot
  179. GAMC=top/bot
  180. C-----------------------------------------
  181. C Variables à la face
  182. C-----------------------------------------
  183. PF=MPLIM.VPOCHA(NLCB,1)
  184. C---------------------------------------
  185. C******* On calcule UN, UT, UT2
  186. C---------------------------------------
  187. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  188. UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  189. UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  190. C-----------------------------------------------
  191. C******* Densite, vitesse, pression sur le bord
  192. C-----------------------------------------------
  193. MPRLI.VPOCHA(NLCB,1)=RC
  194. MPRLI.VPOCHA(NLCB,2)=UXC
  195. MPRLI.VPOCHA(NLCB,3)=UYC
  196. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
  197. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  198. do 104 i=1,(nsp-1)
  199. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
  200. 104 continue
  201. C---------------------------------------------------
  202. C******* Probleme de Riemann entre l'etat gauche
  203. C RC,UNC,UTC,UT2C,PC et l'etat droite
  204. C RC,UNC,UTC,UT2C,PF
  205. C On utilise AUSM+
  206. C Flux dans le repaire normale
  207. C---------------------------------------------------
  208. NESP=NSP-1
  209. IF(IDIM.EQ.2)THEN
  210. CALL FAUSMP(NESP,
  211. & GAMC,RC,PC,UNC,UTC,
  212. & GAMC,RC,PF,UNC,UTC,
  213. & YC.YET,YC.YET,
  214. & FLUX2D.FU,
  215. & CELLT)
  216. C-------------------------------------------------------
  217. C******* Residuum (son SPG a le meme ordre que MELEFC)
  218. C-------------------------------------------------------
  219. MPRES.VPOCHA(IFAC,1)=-1*FLUX2D.FU(1)*SURF/VOLU
  220. MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D.FU(2)*CNX)+
  221. & (FLUX2D.FU(3)*CTX))*SURF/VOLU
  222. MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D.FU(2)*CNY)+
  223. & (FLUX2D.FU(3)*CTY))*SURF/VOLU
  224. MPRES.VPOCHA(IFAC,4)=-1*FLUX2D.FU(4)*SURF/VOLU
  225. do 105 i=1,(nsp-1)
  226. MPRES.VPOCHA(IFAC,4+I)=-1*FLUX2D.FU(4+I)*SURF/VOLU
  227. 105 continue
  228. ELSE
  229. CALL FAUSM3(NESP,
  230. & GAMC,RC,PC,UNC,UTC,UT2C,
  231. & GAMC,RC,PF,UNC,UTC,UT2C,
  232. & YC.YET,YC.YET,
  233. & FLUX3D.FU,
  234. & CELLT)
  235. C------------------------------------------------------
  236. C******* Residuum (son SPG a le meme ordre que MELEFC)
  237. C------------------------------------------------------
  238. MPRES.VPOCHA(IFAC,1)=-1*FLUX3D.FU(1)*SURF/VOLU
  239. MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D.FU(2)*CNX)+
  240. & (FLUX3D.FU(3)*CTX)+(FLUX3D.FU(4)*CT2X))*SURF/VOLU
  241. MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D.FU(2)*CNY)+
  242. & (FLUX3D.FU(3)*CTY)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  243. MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D.FU(2)*CNZ)+
  244. & (FLUX3D.FU(3)*CTZ)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
  245. MPRES.VPOCHA(IFAC,5)=-1*FLUX3D.FU(5)*SURF/VOLU
  246. do 106 i=1,(nsp-1)
  247. MPRES.VPOCHA(IFAC,5+I)=-1*FLUX3D.FU(5+I)*SURF/VOLU
  248. 106 continue
  249. ENDIF
  250. ENDDO
  251. C
  252. SEGDES MELEFC
  253. C
  254. SEGSUP MLEMC
  255. SEGSUP MLEMCB
  256. SEGSUP MLEMF
  257. C
  258. SEGDES MPNORM
  259. SEGDES MPVOL
  260. SEGDES MPSURF
  261. SEGDES MPRC
  262. SEGDES MPPC
  263. SEGDES MPVC
  264. SEGDES MPYC
  265. SEGDES MPLIM
  266. SEGDES MPRES
  267. SEGDES MPRLI
  268. SEGDES YC
  269. SEGDES FLUX2D
  270. SEGDES FLUX3D
  271. C
  272. 9999 CONTINUE
  273. RETURN
  274. END
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  

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