Télécharger cli111.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI111 SOURCE CHAT 05/01/12 22:04:55 5004
  2. SUBROUTINE CLI111(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  3. & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI111
  9. C
  10. C DESCRIPTION : Subroutine appellée par CLIM11
  11. C
  12. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  13. C
  14. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  15. C
  16. C************************************************************************
  17. C
  18. C APPELES (Calcul) :
  19. C
  20. C************************************************************************
  21. C
  22. C HISTORIQUE (Anomalies et modifications éventuelles)
  23. C
  24. C HISTORIQUE :
  25. C
  26. C************************************************************************
  27. C
  28. IMPLICIT INTEGER(I-N)
  29. -INC CCOPTIO
  30. -INC SMLMOTS
  31. -INC SMELEME
  32. POINTEUR MELEFC.MELEME
  33. -INC SMLENTI
  34. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  35. -INC SMCHPOI
  36. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  37. & MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL,
  38. & MPRES.MPOVAL, MPRLI.MPOVAL
  39. C
  40. C**** Variables de COOPTIO
  41. C
  42. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  44. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  45. C & ,IECHO, IIMPI, IOSPI
  46. C & ,IDIM, IFICLE, IPREFI
  47. C & ,MCOORD
  48. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50. C & ,NORINC,NORVAL,NORIND,NORVAD
  51. C & ,NUCROU, IPSAUV
  52. C
  53. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  54. & ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  55. & ,NGF,NGC,NLF,NLC,NLCB
  56. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,UZC,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
  57. & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF
  58. & ,UNC,UNF,UTF,UT2F,SF,ASONC,ASONF
  59. * & ,UTC,UT2C,SC
  60. & ,USGM1,DSGM1,G1,G3,ASON2,S,UT,UT2,UN,RHO,P,UX,UY,UZ
  61. * & ,CACCA,EPS
  62. CHARACTER*(8) TYPE
  63. C
  64. C
  65. C**** KRIPAD pour la correspondance global/local
  66. C
  67. CALL KRIPAD(MELEMC,MLEMC)
  68. C SEGINI MLEMC
  69. CALL KRIPAD(MELECB,MLEMCB)
  70. C SEGINI MLEMCB
  71. CALL KRIPAD(MELEMF,MLEMF)
  72. C SEGINI MLEMF
  73. C
  74. C**** CHPOINTs de la table DOMAINE
  75. C
  76. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  77. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  78. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  79. C
  80. C**** LICHT active les MPOVALs en *MOD
  81. C
  82. C SEGACT MPNORM*MOD
  83. C SEGACT MPOVSU*MOD
  84. C SEGACT MPOVOL*MOD
  85. C
  86. C
  87. C**** CHPOINTs des variables
  88. C
  89. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  90. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  91. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  92. CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  93. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  94. CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  95. CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  96. C
  97. C SEGACT *MOD
  98. C SEGACT *MOD
  99. C SEGACT *MOD
  100. C SEGACT *MOD
  101. C SEGACT *MOD
  102. C SEGACT *MOD
  103. C SEGACT *MOD
  104. C
  105. C
  106. C**** Boucle sur le face pour le calcul des invariants de
  107. C Riemann et du flux
  108. C
  109. SEGACT MELEFC
  110. NFAC=MELEFC.NUM(/2)
  111. UZC=0.0D0
  112. UZF=0.0D0
  113. CNZ=0.0D0
  114. CTZ=0.0D0
  115. CT2X=0.0D0
  116. CT2Y=0.0D0
  117. CT2Z=0.0D0
  118. DO IFAC=1,NFAC,1
  119. NGF=MELEFC.NUM(1,IFAC)
  120. NGC=MELEFC.NUM(2,IFAC)
  121. NLF=MLEMF.LECT(NGF)
  122. NLC=MLEMC.LECT(NGC)
  123. NLCB=MLEMCB.LECT(NGF)
  124. VOLU=MPVOL.VPOCHA(NLC,1)
  125. SURF=MPSURF.VPOCHA(NLF,1)
  126. C In CASTEM les normales sont sortantes
  127. CNX=-1*MPNORM.VPOCHA(NLF,1)
  128. CNY=-1*MPNORM.VPOCHA(NLF,2)
  129. IF(IDIM.EQ.2)THEN
  130. CTX=-1.0D0*CNY
  131. CTY=CNX
  132. ELSE
  133. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  134. CTX=-1*MPNORM.VPOCHA(NLF,4)
  135. CTY=-1*MPNORM.VPOCHA(NLF,5)
  136. CTZ=-1*MPNORM.VPOCHA(NLF,6)
  137. CT2X=-1*MPNORM.VPOCHA(NLF,7)
  138. CT2Y=-1*MPNORM.VPOCHA(NLF,8)
  139. CT2Z=-1*MPNORM.VPOCHA(NLF,9)
  140. ENDIF
  141. C Variables au centre
  142. RC=MPRC.VPOCHA(NLC,1)
  143. PC=MPPC.VPOCHA(NLC,1)
  144. UXC=MPVC.VPOCHA(NLC,1)
  145. UYC=MPVC.VPOCHA(NLC,2)
  146. GAMC=MPGAMC.VPOCHA(NLC,1)
  147. IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  148. C Variables à la face
  149. RF=MPLIM.VPOCHA(NLCB,1)
  150. UXF=MPLIM.VPOCHA(NLCB,2)
  151. UYF=MPLIM.VPOCHA(NLCB,3)
  152. IF(IDIM.EQ.3)UZF=MPLIM.VPOCHA(NLCB,4)
  153. PF=MPLIM.VPOCHA(NLCB,IDIM+2)
  154. C
  155. C******* On calcule UN, UT, UT2, ASON, S
  156. C
  157. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  158. * UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  159. * UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  160. UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ)
  161. UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ)
  162. UT2F=(UXF*CT2X)+(UYF*CT2Y)+(UZF*CT2Z)
  163. C
  164. ASONC=(GAMC*PC/RC)**0.5D0
  165. ASONF=(GAMC*PF/RF)**0.5D0
  166. C
  167. * SC=PC/(RC**GAMC)
  168. SF=PF/(RF**GAMC)
  169. C
  170. C******* Densite, vitesse, pression sur le bord
  171. C
  172. USGM1=1.0D0/(GAMC-1.0D0)
  173. DSGM1=2.0D0*USGM1
  174. G1=UNC-(DSGM1*ASONC)
  175. G3=UNF+(DSGM1*ASONF)
  176. UN=0.5D0*(G1+G3)
  177. ASON2=(0.5D0*(G3-G1))
  178. ASON2=ASON2/DSGM1
  179. ASON2=ASON2*ASON2
  180. S=SF
  181. UT=UTF
  182. UT2=UT2F
  183. RHO=ASON2/(GAMC*S)
  184. RHO=RHO**USGM1
  185. P=RHO*ASON2/GAMC
  186. UX=(UN*CNX)+(UT*CTX)+(UT2*CT2X)
  187. UY=(UN*CNY)+(UT*CTY)+(UT2*CT2Y)
  188. UZ=(UN*CNZ)+(UT*CTZ)+(UT2*CT2Z)
  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. C
  196. C*******************************************************
  197. C******* Test : we compute RHO*UN*SURF/VOLU
  198. C and its derivative with respect to RHO
  199. CC*******************************************************
  200. CC
  201. C CACCA=RHO*UN*SURF/VOLU
  202. C EPS=1.0D-6
  203. C RC=RC*(1+EPS)
  204. CC
  205. CC******* On calcule UN, UT, UT2, ASON, S
  206. CC
  207. C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  208. C* UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  209. C* UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  210. C UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ)
  211. C UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ)
  212. C UT2F=(UXF*CT2X)+(UYF*CT2Y)+(UZF*CT2Z)
  213. CC
  214. C ASONC=(GAMC*PC/RC)**0.5D0
  215. C ASONF=(GAMC*PF/RF)**0.5D0
  216. CC
  217. C* SC=PC/(RC**GAMC)
  218. C SF=PF/(RF**GAMC)
  219. CC
  220. CC******* Densite, vitesse, pression sur le bord
  221. CC
  222. C USGM1=1.0D0/(GAMC-1.0D0)
  223. C DSGM1=2.0D0*USGM1
  224. C G1=UNC-(DSGM1*ASONC)
  225. C G3=UNF+(DSGM1*ASONF)
  226. C UN=0.5D0*(G1+G3)
  227. C ASON2=(0.5D0*(G3-G1))
  228. C ASON2=ASON2/DSGM1
  229. C ASON2=ASON2*ASON2
  230. C S=SF
  231. C UT=UTF
  232. C UT2=UT2F
  233. C RHO=ASON2/(GAMC*S)
  234. C RHO=RHO**USGM1
  235. C write(*,*) (((RHO*UN*SURF/VOLU) - CACCA)/(RC*EPS))
  236. CC*******************************************************
  237. C*************** FIN TEST ******************************
  238. C*******************************************************
  239. C
  240. C******* Residuum (son SPG a le meme ordre que MELEFC)
  241. C
  242. MPRES.VPOCHA(IFAC,1)=RHO*UN*SURF/VOLU
  243. MPRES.VPOCHA(IFAC,2)=(RHO*UN*UX+(P*CNX))*SURF/VOLU
  244. MPRES.VPOCHA(IFAC,3)=(RHO*UN*UY+(P*CNY))*SURF/VOLU
  245. IF(IDIM.EQ.3)
  246. & MPRES.VPOCHA(IFAC,4)=(RHO*UN*UZ+(P*CNZ))*SURF/VOLU
  247. MPRES.VPOCHA(IFAC,IDIM+2)=((UN*GAMC*USGM1*P) +
  248. & (0.5D0*RHO*UN*(UN*UN+UT*UT+UT2*UT2)))*SURF/VOLU
  249. ENDDO
  250. C
  251. SEGDES MELEFC
  252. C
  253. SEGSUP MLEMC
  254. SEGSUP MLEMCB
  255. SEGSUP MLEMF
  256. C
  257. SEGDES MPNORM
  258. SEGDES MPVOL
  259. SEGDES MPSURF
  260. SEGDES MPRC
  261. SEGDES MPPC
  262. SEGDES MPVC
  263. SEGDES MPGAMC
  264. SEGDES MPLIM
  265. SEGDES MPRES
  266. SEGDES MPRLI
  267. C
  268. 9999 CONTINUE
  269. RETURN
  270. END
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  

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