Télécharger cli271.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI271 SOURCE CHAT 05/01/12 22:07:35 5004
  2. SUBROUTINE CLI271(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
  3. & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI271
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM22
  11. C OPTION: 'INJE'
  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. & ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  56. & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,I
  57. REAL*8 VOLU,SURF,GAMF,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1,USGM1
  58. & ,CT2X,CT2Y,CT2Z,UTF,UT2F,TOP,BOT
  59. & ,PC,PSRF,RHOUF,ECIN,P,RHO,UN,UT,UT2,UX,UY,UZ
  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 YF.FRAMAS
  78. C------------------------------------------------------
  79. C**** KRIPAD pour la correspondance global/local
  80. C------------------------------------------------------
  81. CALL KRIPAD(MELEMC,MLEMC)
  82. CALL KRIPAD(MELECB,MLEMCB)
  83. CALL KRIPAD(MELEMF,MLEMF)
  84. C-----------------------------------------------------
  85. C**** CHPOINTs de la table DOMAINE
  86. C-----------------------------------------------------
  87. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  88. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  89. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  90. C-----------------------------------------------------
  91. C**** CHPOINTs des variables
  92. C-----------------------------------------------------
  93. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  94. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  95. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  96. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  97. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  98. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  99. C----------------------------------------------------------
  100. C**** Boucle sur le face pour le calcul des invariants de
  101. C Riemann et du flux
  102. C----------------------------------------------------------
  103. SEGACT MELEFC
  104. NFAC=MELEFC.NUM(/2)
  105. CNZ=0.0D0
  106. CTZ=0.0D0
  107. CT2X=0.0D0
  108. CT2Y=0.0D0
  109. CT2Z=0.0D0
  110. DO IFAC=1,NFAC,1
  111. NGF=MELEFC.NUM(1,IFAC)
  112. NGC=MELEFC.NUM(2,IFAC)
  113. NLF=MLEMF.LECT(NGF)
  114. NLC=MLEMC.LECT(NGC)
  115. NLCB=MLEMCB.LECT(NGF)
  116. VOLU=MPVOL.VPOCHA(NLC,1)
  117. SURF=MPSURF.VPOCHA(NLF,1)
  118. C In CASTEM les normales sont sortantes
  119. CNX=-1*MPNORM.VPOCHA(NLF,1)
  120. CNY=-1*MPNORM.VPOCHA(NLF,2)
  121. IF(IDIM.EQ.2)THEN
  122. CTX=-1.0D0*CNY
  123. CTY=CNX
  124. ELSE
  125. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  126. CTX=-1*MPNORM.VPOCHA(NLF,4)
  127. CTY=-1*MPNORM.VPOCHA(NLF,5)
  128. CTZ=-1*MPNORM.VPOCHA(NLF,6)
  129. CT2X=-1*MPNORM.VPOCHA(NLF,7)
  130. CT2Y=-1*MPNORM.VPOCHA(NLF,8)
  131. CT2Z=-1*MPNORM.VPOCHA(NLF,9)
  132. ENDIF
  133. C--------------------------------------------
  134. SEGINI CP, CV
  135. MLRECP = LRECP
  136. MLRECV = LRECV
  137. SEGACT MLRECP, MLRECV
  138. DO 10 I=1,(NSP-1)
  139. CP.GC(I)=MLRECP.PROG(I)
  140. CV.GC(I)=MLRECV.PROG(I)
  141. 10 CONTINUE
  142. CP.GC(NSP)=MLRECP.PROG(NSP)
  143. CV.GC(NSP)=MLRECV.PROG(NSP)
  144. C----------------------------------------
  145. C Variables au centre
  146. C----------------------------------------
  147. PC=MPPC.VPOCHA(NLC,1)
  148. C----------------------------------------
  149. C Variables à la face
  150. C----------------------------------------
  151. RHOUF=MPLIM.VPOCHA(NLCB,1)
  152. PSRF=MPLIM.VPOCHA(NLCB,2)
  153. UTF=0.0D0
  154. UT2F=0.0D0
  155. C----------------------------------------
  156. C******* Variables à l'interface
  157. C----------------------------------------
  158. P=PC
  159. RHO=P/PSRF
  160. UN=RHOUF/RHO
  161. UT=UTF
  162. UT2=UT2F
  163. SEGINI YF
  164. DO 101 I=1,(NSP-1)
  165. YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I)
  166. 101 CONTINUE
  167. c-------------------------------------------------------------
  168. c Computing GAMMA at the face-center
  169. c-------------------------------------------------------------
  170. top=0.0D0
  171. bot=0.0D0
  172. do 103 i=1,(nsp-1)
  173. top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp))
  174. bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp))
  175. 103 continue
  176. top=cp.gc(nsp)+top
  177. bot=cv.gc(nsp)+bot
  178. GAMF=top/bot
  179. C-----------------------------------------
  180. C******* On calcule U
  181. C-----------------------------------------
  182. UX=UN*CNX+UT*CTX+UT2*CT2X
  183. UY=UN*CNY+UT*CTY+UT2*CT2Y
  184. UZ=UN*CNZ+UT*CTZ+UT2*CT2Z
  185. C---------------------------------------------
  186. ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
  187. C------------------------------------------------
  188. C******* Densite, vitesse, pression sur le bord
  189. C------------------------------------------------
  190. MPRLI.VPOCHA(NLCB,1)=RHO
  191. MPRLI.VPOCHA(NLCB,2)=UX
  192. MPRLI.VPOCHA(NLCB,3)=UY
  193. IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ
  194. MPRLI.VPOCHA(NLCB,IDIM+2)=P
  195. do 104 i=1,(nsp-1)
  196. MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I)
  197. 104 continue
  198. C--------------------------------------------------------
  199. C******* Residuum (son SPG a le meme ordre que MELEFC)
  200. C--------------------------------------------------------
  201. USGM1 = 1.0D0/(GAMF-1.0D0)
  202. MPRES.VPOCHA(IFAC,1)=RHOUF*SURF/VOLU
  203. MPRES.VPOCHA(IFAC,2)=(RHOUF*UX+P*CNX)*SURF/VOLU
  204. MPRES.VPOCHA(IFAC,3)=(RHOUF*UY+P*CNY)*SURF/VOLU
  205. IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=(RHOUF*UZ+P*CNZ)*SURF/VOLU
  206. MPRES.VPOCHA(IFAC,IDIM+2)=(RHOUF*((GAMF*USGM1*PSRF)+ECIN))
  207. & *SURF/VOLU
  208. do 105 i=1,(nsp-1)
  209. MPRES.VPOCHA(IFAC,IDIM+2+I)=RHOUF*YF.YET(I)*SURF/VOLU
  210. 105 continue
  211. ENDDO
  212. C
  213. SEGDES MELEFC
  214. C
  215. SEGSUP MLEMC
  216. SEGSUP MLEMCB
  217. SEGSUP MLEMF
  218. C
  219. SEGDES MPNORM
  220. SEGDES MPVOL
  221. SEGDES MPSURF
  222. SEGDES MPRC
  223. SEGDES MPPC
  224. SEGDES MPVC
  225. SEGDES MPLIM
  226. SEGDES MPRES
  227. SEGDES MPRLI
  228. SEGDES MLRECP
  229. SEGDES MLRECV
  230. SEGDES YF
  231. C
  232. 9999 CONTINUE
  233. RETURN
  234. END
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  

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