Télécharger cli152.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI152 SOURCE PV 16/11/17 21:58:35 9180
  2. SUBROUTINE CLI152(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO,
  3. & ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : CLI152
  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. POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  39. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  40. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  41. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  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. & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
  58. & ,NGF,NGC,NLF,NLC,NLCB
  59. & ,ILIINC,ILIINP,IJAC
  60. & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  61. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,GAMC,CNX,CNY,CTX,CTY,PF
  62. & ,VECG(4),VECD(4),DFDUG(4,4),DFDUD(4,4)
  63. & ,NVEC(2),TVEC(2)
  64. & ,DRORO,DROUX,DROUY,DROP
  65. & ,DUXRO,DUXUX,DUXUY,DUXP
  66. & ,DUYRO,DUYUX,DUYUY,DUYP
  67. & ,DPRO,DPUX,DPUY,DPP
  68. & ,COEF1,COEF2,COEF3,GM1,COEF
  69. CHARACTER*(8) TYPE
  70. C
  71. C
  72. C**** KRIPAD pour la correspondance global/local
  73. C
  74. CALL KRIPAD(MELEMC,MLEMC)
  75. C SEGINI MLEMC
  76. CALL KRIPAD(MELECB,MLEMCB)
  77. C SEGINI MLEMCB
  78. CALL KRIPAD(MELEMF,MLEMF)
  79. C SEGINI MLEMF
  80. C
  81. C**** CHPOINTs de la table DOMAINE
  82. C
  83. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  84. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  85. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  86. C
  87. C**** LICHT active les MPOVALs en *MOD
  88. C
  89. C SEGACT MPNORM*MOD
  90. C SEGACT MPOVSU*MOD
  91. C SEGACT MPOVOL*MOD
  92. C
  93. C
  94. C**** CHPOINTs des variables
  95. C
  96. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  97. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  98. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  99. CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  100. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  101. C
  102. C SEGACT *MOD
  103. C SEGACT *MOD
  104. C SEGACT *MOD
  105. C SEGACT *MOD
  106. C SEGACT *MOD
  107. C
  108. C
  109. C**** Boucle sur le face pour le calcul des invariants de
  110. C Riemann et du flux
  111. C
  112. SEGACT MELEFC
  113. NFAC=MELEFC.NUM(/2)
  114. C
  115. C**** Objet MATRIK
  116. C
  117. NRIGE = 7
  118. NMATRI = 1
  119. NKID = 9
  120. NKMT = 7
  121. C
  122. SEGINI MATRIK
  123. IJACO = MATRIK
  124. MATRIK.IRIGEL(1,1) = MELRES
  125. MATRIK.IRIGEL(2,1) = MELRES
  126. C
  127. C**** Matrice non symetrique
  128. C
  129. MATRIK.IRIGEL(7,1) = 2
  130. C
  131. NBME = 16
  132. NBSOUS = 1
  133. SEGINI IMATRI
  134. IF(IJAC.EQ.1)THEN
  135. MLMOTS=ILIINC
  136. ELSEIF(IJAC.EQ.2)THEN
  137. MLMOTS=ILIINP
  138. ENDIF
  139. SEGACT MLMOTS
  140. MATRIK.IRIGEL(4,1) = IMATRI
  141. C
  142. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  143. IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  144. IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  145. IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  146. IMATRI.LISPRI(5) = MLMOTS.MOTS(1)
  147. IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
  148. IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
  149. IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
  150. IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
  151. IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
  152. IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
  153. IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
  154. IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
  155. IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
  156. IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
  157. IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
  158. C
  159. SEGDES MLMOTS
  160. MLMOTS=ILIINC
  161. SEGACT MLMOTS
  162. C
  163. IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  164. IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  165. IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  166. IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  167. IMATRI.LISDUA(5) = MLMOTS.MOTS(2)
  168. IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  169. IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  170. IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  171. IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
  172. IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
  173. IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  174. IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  175. IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
  176. IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
  177. IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
  178. IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  179. C
  180. SEGDES MLMOTS
  181. NBEL = NFAC
  182. NBSOUS = 1
  183. NP = 1
  184. MP = 1
  185. SEGINI RR , RUX , RUY , RRET ,
  186. & UXR , UXUX , UXUY , UXRET ,
  187. & UYR , UYUX , UYUY , UYRET ,
  188. & RETR , RETUX , RETUY , RETRET
  189. C
  190. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  191. C Primale = IMATRI.LISPRI(1) = 'RN'
  192. C -> IMATRI.LIZAFM(1,1) = RR
  193. C
  194. IMATRI.LIZAFM(1,1) = RR
  195. IMATRI.LIZAFM(1,2) = RUX
  196. IMATRI.LIZAFM(1,3) = RUY
  197. IMATRI.LIZAFM(1,4) = RRET
  198. IMATRI.LIZAFM(1,5) = UXR
  199. IMATRI.LIZAFM(1,6) = UXUX
  200. IMATRI.LIZAFM(1,7) = UXUY
  201. IMATRI.LIZAFM(1,8) = UXRET
  202. IMATRI.LIZAFM(1,9) = UYR
  203. IMATRI.LIZAFM(1,10) = UYUX
  204. IMATRI.LIZAFM(1,11) = UYUY
  205. IMATRI.LIZAFM(1,12) = UYRET
  206. IMATRI.LIZAFM(1,13) = RETR
  207. IMATRI.LIZAFM(1,14) = RETUX
  208. IMATRI.LIZAFM(1,15) = RETUY
  209. IMATRI.LIZAFM(1,16) = RETRET
  210. C
  211. SEGDES MATRIK
  212. SEGDES IMATRI
  213. C
  214. C**** Fin definition MATRIK
  215. C
  216. DO IFAC=1,NFAC,1
  217. NGF=MELEFC.NUM(1,IFAC)
  218. NGC=MELEFC.NUM(2,IFAC)
  219. NLF=MLEMF.LECT(NGF)
  220. NLC=MLEMC.LECT(NGC)
  221. NLCB=MLEMCB.LECT(NGF)
  222. VOLU=MPVOL.VPOCHA(NLC,1)
  223. SURF=MPSURF.VPOCHA(NLF,1)
  224. C In CASTEM les normales sont sortantes
  225. CNX=MPNORM.VPOCHA(NLF,1)
  226. CNY=MPNORM.VPOCHA(NLF,2)
  227. CTX=-1.0D0*CNY
  228. CTY=CNX
  229. C Variables au centre
  230. RC=MPRC.VPOCHA(NLC,1)
  231. PC=MPPC.VPOCHA(NLC,1)
  232. UXC=MPVC.VPOCHA(NLC,1)
  233. UYC=MPVC.VPOCHA(NLC,2)
  234. GAMC=MPGAMC.VPOCHA(NLC,1)
  235. C Variables à la face
  236. PF=MPLIM.VPOCHA(NLCB,1)
  237. C
  238. C******* Jacobian with respect to primitive variables
  239. C
  240. VECG(1)=RC
  241. VECG(2)=UXC
  242. VECG(3)=UYC
  243. VECG(4)=PC
  244. VECD(1)=RC
  245. VECD(2)=UXC
  246. VECD(3)=UYC
  247. VECD(4)=PF
  248. NVEC(1)=CNX
  249. NVEC(2)=CNY
  250. TVEC(1)=CTX
  251. TVEC(2)=CTY
  252. CALL CONJP2(DFDUG,DFDUD,VECG,VECD,NVEC,TVEC,GAMC)
  253. C
  254. COEF=-1*SURF/VOLU
  255. DRORO=(DFDUG(1,1)+DFDUD(1,1))*COEF
  256. DROUX=(DFDUG(1,2)+DFDUD(1,2))*COEF
  257. DROUY=(DFDUG(1,3)+DFDUD(1,3))*COEF
  258. DROP=DFDUG(1,4)*COEF
  259. C
  260. DPRO=(DFDUG(4,1)+DFDUD(4,1))*COEF
  261. DPUX=(DFDUG(4,2)+DFDUD(4,2))*COEF
  262. DPUY=(DFDUG(4,3)+DFDUD(4,3))*COEF
  263. DPP=DFDUG(4,4)*COEF
  264. C
  265. DUXRO=(DFDUG(2,1)+DFDUD(2,1))*COEF
  266. DUXUX=(DFDUG(2,2)+DFDUD(2,2))*COEF
  267. DUXUY=(DFDUG(2,3)+DFDUD(2,3))*COEF
  268. DUXP =DFDUG(2,4)*COEF
  269. C
  270. DUYRO=(DFDUG(3,1)+DFDUD(3,1))*COEF
  271. DUYUX=(DFDUG(3,2)+DFDUD(3,2))*COEF
  272. DUYUY=(DFDUG(3,3)+DFDUD(3,3))*COEF
  273. DUYP =DFDUG(3,4)*COEF
  274. C
  275. C******* Jacobian with respect to conservative variables
  276. C
  277. IF(IJAC.EQ.1)THEN
  278. GM1=GAMC-1.0D0
  279. COEF1=-1.0D0*UXC/RC
  280. COEF2=-1.0D0*UYC/RC
  281. COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
  282. C
  283. RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
  284. $ *COEF3)
  285. RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  286. RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  287. RRET.AM(IFAC,1,1)=GM1*DROP
  288. C
  289. UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
  290. $ *COEF3)
  291. UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  292. UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  293. UXRET.AM(IFAC,1,1)=GM1*DUXP
  294. C
  295. UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
  296. $ *COEF3)
  297. UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  298. UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  299. UYRET.AM(IFAC,1,1)=GM1*DUYP
  300. C
  301. RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
  302. $ *COEF3)
  303. RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  304. RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  305. RETRET.AM(IFAC,1,1)=GM1*DPP
  306. C
  307. ELSEIF(IJAC.EQ.2)THEN
  308. RR.AM(IFAC,1,1)=DRORO
  309. RUX.AM(IFAC,1,1)=DROUX
  310. RUY.AM(IFAC,1,1)=DROUY
  311. RRET.AM(IFAC,1,1)=DROP
  312. C
  313. UXR.AM(IFAC,1,1)=DUXRO
  314. UXUX.AM(IFAC,1,1)=DUXUX
  315. UXUY.AM(IFAC,1,1)=DUXUY
  316. UXRET.AM(IFAC,1,1)=DUXP
  317. C
  318. UYR.AM(IFAC,1,1)=DUYRO
  319. UYUX.AM(IFAC,1,1)=DUYUX
  320. UYUY.AM(IFAC,1,1)=DUYUY
  321. UYRET.AM(IFAC,1,1)=DUYP
  322. C
  323. RETR.AM(IFAC,1,1)=DPRO
  324. RETUX.AM(IFAC,1,1)=DPUX
  325. RETUY.AM(IFAC,1,1)=DPUY
  326. RETRET.AM(IFAC,1,1)=DPP
  327. ENDIF
  328. ENDDO
  329. C
  330. SEGDES MELEFC
  331. C
  332. SEGSUP MLEMC
  333. SEGSUP MLEMCB
  334. SEGSUP MLEMF
  335. C
  336. SEGDES MPNORM
  337. SEGDES MPVOL
  338. SEGDES MPSURF
  339. SEGDES MPRC
  340. SEGDES MPPC
  341. SEGDES MPVC
  342. SEGDES MPGAMC
  343. SEGDES MPLIM
  344. C
  345. SEGDES RR , RUX , RUY , RRET ,
  346. & UXR , UXUX , UXUY , UXRET ,
  347. & UYR , UYUX , UYUY , UYRET ,
  348. & RETR , RETUX , RETUY , RETRET
  349. C
  350. 9999 CONTINUE
  351. RETURN
  352. END
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  

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