Télécharger cli22r.eso

Retour à la liste

Numérotation des lignes :

cli22r
  1. C CLI22R SOURCE CB215821 20/11/25 13:20:37 10792
  2. SUBROUTINE CLI22R(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  3. & ICHPSU,LRECP,LRECV,IPC,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI22R
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM22
  11. C calcul de RESIDU et CLIM at the board
  12. C OPTION: 'RESE' 2D, 3D
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15. C
  16. C AUTEUR : A. Beccantini, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C APPELES (Calcul) :
  21. C
  22. C************************************************************************
  23. C
  24. C HISTORIQUE (Anomalies et modifications éventuelles)
  25. C
  26. C HISTORIQUE :
  27. C
  28. C************************************************************************
  29. C
  30. C We know everything outside
  31. C
  32. C 1) PC < PF
  33. C Condition de type reservoir
  34. C
  35. C 2) PC > PF
  36. C We stop the mass flux
  37. C We put zero velocity on the wall
  38. C We put P = PF at the wall
  39. C
  40. IMPLICIT INTEGER(I-N)
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC SMLMOTS
  45. -INC SMELEME
  46. POINTEUR MELEFC.MELEME
  47. -INC SMLENTI
  48. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  49. -INC SMCHPOI
  50. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL,
  51. & MPPC.MPOVAL, MPLIM.MPOVAL,
  52. & MPRES.MPOVAL, MPRLI.MPOVAL
  53. C----------------------------------------
  54. C**** Variables de COOPTIO
  55. C----------------------------------------
  56. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  57. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  58. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  59. C & ,IECHO, IIMPI, IOSPI
  60. C & ,IDIM, IFICLE, IPREFI
  61. C & ,MCOORD
  62. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  63. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  64. C & ,NORINC,NORVAL,NORIND,NORVAD
  65. C & ,NUCROU, IPSAUV
  66. C
  67. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU,IPC
  68. & ,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  69. & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,I,NSP
  70. REAL*8 VOLU,SURF,PC,CNX,CNY,CNZ
  71. & ,RF,PF,PCR,TOP,BOT
  72. & ,GAMF
  73. & ,UN,RHO,P,UX,UY,UZ
  74. CHARACTER*(8) TYPE
  75. C------------------------------------------------------------
  76. -INC SMLREEL
  77. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  78. C
  79. C-------------------------------------------------------------
  80. C******* Les fractionines massiques **************************
  81. C-------------------------------------------------------------
  82. SEGMENT FRAMAS
  83. REAL*8 YET(NSP)
  84. ENDSEGMENT
  85. POINTEUR YF.FRAMAS
  86. C------------------------------------------------------
  87. C**** KRIPAD pour la correspondance global/local
  88. C------------------------------------------------------
  89. CALL KRIPAD(MELEMC,MLEMC)
  90. CALL KRIPAD(MELECB,MLEMCB)
  91. CALL KRIPAD(MELEMF,MLEMF)
  92. C------------------------------------------------------
  93. C**** CHPOINTs de la table DOMAINE
  94. C------------------------------------------------------
  95. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  96. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  97. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  98. C------------------------------------------------------
  99. C**** CHPOINTs des variables
  100. C------------------------------------------------------
  101. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  102. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  103. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  104. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  105.  
  106. C---------------------------------------------------------
  107. C**** Boucle sur le face pour le calcul du flux
  108. C---------------------------------------------------------
  109.  
  110. MLRECV = LRECV
  111. MLRECP = LRECP
  112.  
  113. SEGACT MLRECV
  114. SEGACT MLRECP
  115. SEGACT MELEFC
  116. SEGINI YF
  117.  
  118. NFAC=MELEFC.NUM(/2)
  119. CNZ=0.0D0
  120. DO 1 IFAC=1,NFAC,1
  121. NGF=MELEFC.NUM(1,IFAC)
  122. NGC=MELEFC.NUM(2,IFAC)
  123. NLF=MLEMF.LECT(NGF)
  124. NLC=MLEMC.LECT(NGC)
  125. NLCB=MLEMCB.LECT(NGF)
  126. VOLU=MPVOL.VPOCHA(NLC,1)
  127. SURF=MPSURF.VPOCHA(NLF,1)
  128. C----------------------------------------------
  129. C In CASTEM les normales sont sortantes
  130. C----------------------------------------------
  131. CNX=-1*MPNORM.VPOCHA(NLF,1)
  132. CNY=-1*MPNORM.VPOCHA(NLF,2)
  133. IF(IDIM.EQ.3)THEN
  134. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  135. ENDIF
  136. C----------------------------
  137. C Variables au centre
  138. C----------------------------
  139. PC=MPPC.VPOCHA(NLC,1)
  140. C----------------------------
  141. C Variables à la face
  142. C----------------------------
  143. RF=MPLIM.VPOCHA(NLCB,1)
  144. PF=MPLIM.VPOCHA(NLCB,2)
  145. DO 101 I=1,(NSP-1)
  146. YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I)
  147. 101 CONTINUE
  148. c-------------------------------------------------------------
  149. c Computing GAMMA at the face-center
  150. c-------------------------------------------------------------
  151. top=0.0D0
  152. bot=0.0D0
  153. do 103 i=1,(nsp-1)
  154. top=top+yf.yet(i)*(MLRECP.PROG(i)-MLRECP.PROG(nsp))
  155. bot=bot+yf.yet(i)*(MLRECV.PROG(i)-MLRECV.PROG(nsp))
  156. 103 continue
  157. top=MLRECP.PROG(nsp)+top
  158. bot=MLRECV.PROG(nsp)+bot
  159. GAMF=top/bot
  160. C----------------------------------------
  161. C******* PCR, P, RHO and UN on the border
  162. C----------------------------------------
  163. IF(PF .LT. PC)THEN
  164. C
  165. C P_{interface}=PF
  166. C \rho_{interface}=RF
  167. C U_{interface}=0.0D0
  168. C Y_{interface}=YF
  169. C
  170. MPRLI.VPOCHA(NLCB,1)=RF
  171. MPRLI.VPOCHA(NLCB,2)=0.0D0
  172. MPRLI.VPOCHA(NLCB,3)=0.0D0
  173. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=0.0D0
  174. MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  175. do 104 i=1,(nsp-1),1
  176. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I)
  177. 104 continue
  178. MPRES.VPOCHA(IFAC,1)=0.0D0
  179. MPRES.VPOCHA(IFAC,2)=(PC*CNX)*SURF/VOLU
  180. MPRES.VPOCHA(IFAC,3)=(PC*CNY)*SURF/VOLU
  181. IF(IDIM.EQ.3)
  182. & MPRES.VPOCHA(IFAC,4)=(PC*CNZ)*SURF/VOLU
  183. MPRES.VPOCHA(IFAC,IDIM+2)=0.0D0
  184. do 105 i=1,(nsp-1),1
  185. MPRES.VPOCHA(IFAC,IDIM+2+I)=0.0D0
  186. 105 continue
  187. ELSE
  188. PCR=PF*((2.0D0/(GAMF+1.0D0))**((GAMF/(GAMF-1.0D0))))
  189. P=MAX(PCR,PC)
  190. RHO=(P/PF)**(1.0D0/GAMF)
  191. RHO=RHO*RF
  192. C
  193. UN=(2*GAMF)/(GAMF-1.0D0)
  194. UN=UN*((PF/RF)-(P/RHO))
  195. UN=MAX(UN,1.0D-16*((P/RHO)*0.5D0))
  196. UN=UN**0.5D0
  197. C
  198. UX=UN*CNX
  199. UY=UN*CNY
  200. UZ=UN*CNZ
  201. C
  202. MPRLI.VPOCHA(NLCB,1)=RHO
  203. MPRLI.VPOCHA(NLCB,2)=UX
  204. MPRLI.VPOCHA(NLCB,3)=UY
  205. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ
  206. MPRLI.VPOCHA(NLCB,IDIM+2)=P
  207. do 106 i=1,(nsp-1),1
  208. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I)
  209. 106 continue
  210. C-------------------------------------------------------
  211. C******* Residuum (son SPG a le meme ordre que MELEFC)
  212. C-------------------------------------------------------
  213. MPRES.VPOCHA(IFAC,1)=RHO*UN*SURF/VOLU
  214. MPRES.VPOCHA(IFAC,2)=(RHO*UN*UX+(P*CNX))*SURF/VOLU
  215. MPRES.VPOCHA(IFAC,3)=(RHO*UN*UY+(P*CNY))*SURF/VOLU
  216. IF(IDIM.EQ.3)
  217. & MPRES.VPOCHA(IFAC,4)=(RHO*UN*UZ+(P*CNZ))*SURF/VOLU
  218. MPRES.VPOCHA(IFAC,IDIM+2)=((UN*GAMF*P/(GAMF-1.0D0)) +
  219. & (0.5D0*RHO*UN*UN*UN))*SURF/VOLU
  220. do 107 i=1,(nsp-1)
  221. MPRES.VPOCHA(IFAC,IDIM+2+I)=RHO*YF.YET(I)*UN*SURF/VOLU
  222. 107 continue
  223. ENDIF
  224. 1 CONTINUE
  225. C
  226. SEGDES MELEFC
  227. C
  228. SEGSUP MLEMC
  229. SEGSUP MLEMCB
  230. SEGSUP MLEMF
  231. SEGSUP YF
  232. C
  233. C
  234. SEGDES MPNORM
  235. SEGDES MPVOL
  236. SEGDES MPSURF
  237. SEGDES MPPC
  238. SEGDES MPLIM
  239. SEGDES MPRES
  240. SEGDES MPRLI
  241. SEGDES MLRECP
  242. SEGDES MLRECV
  243. C
  244. 9999 CONTINUE
  245. RETURN
  246. END
  247.  
  248.  
  249.  
  250.  
  251.  

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