Télécharger cli173.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI173 SOURCE PV 16/11/17 21:58:40 9180
  2. SUBROUTINE CLI173(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 : CLI173
  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. & RUZ.IZAFM, UXUZ.IZAFM, UYUZ.IZAFM, RETUZ.IZAFM,
  43. & UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZRET.IZAFM,
  44. & UZUZ.IZAFM
  45. C
  46. C**** Variables de COOPTIO
  47. C
  48. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  49. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  50. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  51. C & ,IECHO, IIMPI, IOSPI
  52. C & ,IDIM, IFICLE, IPREFI
  53. C & ,MCOORD
  54. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  55. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  56. C & ,NORINC,NORVAL,NORIND,NORVAD
  57. C & ,NUCROU, IPSAUV
  58. C
  59. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  60. & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
  61. & ,NGF,NGC,NLF,NLC,NLCB
  62. & ,ILIINC,ILIINP,IJAC
  63. & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  64. REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,GM1
  65. & ,RC,UXC,UYC,UZC
  66. & ,PC,PSRF,RHOUF,P,RHO,UN
  67. & ,DECIDP,DUNDPC,DUXDPC,DUYDPC,DUZDPC
  68. & ,DRORO,DROUX,DROUY,DROP
  69. & ,DUXRO,DUXUX,DUXUY,DUXP
  70. & ,DUYRO,DUYUX,DUYUY,DUYP
  71. & ,DPRO,DPUX,DPUY,DPP
  72. & ,COEF1,COEF2,COEF3,COEF,COEF4
  73. & ,DROUZ,DUXUZ,DUYUZ,DPUZ
  74. & ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP
  75. CHARACTER*(8) TYPE
  76. C
  77. C
  78. C**** KRIPAD pour la correspondance global/local
  79. C
  80. CALL KRIPAD(MELEMC,MLEMC)
  81. C SEGINI MLEMC
  82. CALL KRIPAD(MELECB,MLEMCB)
  83. C SEGINI MLEMCB
  84. CALL KRIPAD(MELEMF,MLEMF)
  85. C SEGINI MLEMF
  86. C
  87. C**** CHPOINTs de la table DOMAINE
  88. C
  89. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  90. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  91. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  92. C
  93. C**** LICHT active les MPOVALs en *MOD
  94. C
  95. C SEGACT MPNORM*MOD
  96. C SEGACT MPOVSU*MOD
  97. C SEGACT MPOVOL*MOD
  98. C
  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(IGAMC,MPGAMC,TYPE,ICEL)
  106. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  107. C
  108. C SEGACT *MOD
  109. C SEGACT *MOD
  110. C SEGACT *MOD
  111. C SEGACT *MOD
  112. C SEGACT *MOD
  113. C
  114. C
  115. C**** Boucle sur le face pour le calcul des invariants de
  116. C Riemann et du flux
  117. C
  118. SEGACT MELEFC
  119. NFAC=MELEFC.NUM(/2)
  120. C
  121. C**** Objet MATRIK
  122. C
  123. NRIGE = 7
  124. NMATRI = 1
  125. NKID = 9
  126. NKMT = 7
  127. C
  128. SEGINI MATRIK
  129. IJACO = MATRIK
  130. MATRIK.IRIGEL(1,1) = MELRES
  131. MATRIK.IRIGEL(2,1) = MELRES
  132. C
  133. C**** Matrice non symetrique
  134. C
  135. MATRIK.IRIGEL(7,1) = 2
  136. C
  137. NBME = 25
  138. NBSOUS = 1
  139. SEGINI IMATRI
  140. IF(IJAC.EQ.1)THEN
  141. MLMOTS=ILIINC
  142. ELSEIF(IJAC.EQ.2)THEN
  143. MLMOTS=ILIINP
  144. ENDIF
  145. SEGACT MLMOTS
  146. MATRIK.IRIGEL(4,1) = IMATRI
  147. C
  148. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  149. IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  150. IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  151. IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  152. IMATRI.LISPRI(5) = MLMOTS.MOTS(5)
  153. C
  154. IMATRI.LISPRI(6) = MLMOTS.MOTS(1)
  155. IMATRI.LISPRI(7) = MLMOTS.MOTS(2)
  156. IMATRI.LISPRI(8) = MLMOTS.MOTS(3)
  157. IMATRI.LISPRI(9) = MLMOTS.MOTS(4)
  158. IMATRI.LISPRI(10) = MLMOTS.MOTS(5)
  159. C
  160. IMATRI.LISPRI(11) = MLMOTS.MOTS(1)
  161. IMATRI.LISPRI(12) = MLMOTS.MOTS(2)
  162. IMATRI.LISPRI(13) = MLMOTS.MOTS(3)
  163. IMATRI.LISPRI(14) = MLMOTS.MOTS(4)
  164. IMATRI.LISPRI(15) = MLMOTS.MOTS(5)
  165. C
  166. IMATRI.LISPRI(16) = MLMOTS.MOTS(1)
  167. IMATRI.LISPRI(17) = MLMOTS.MOTS(2)
  168. IMATRI.LISPRI(18) = MLMOTS.MOTS(3)
  169. IMATRI.LISPRI(19) = MLMOTS.MOTS(4)
  170. IMATRI.LISPRI(20) = MLMOTS.MOTS(5)
  171. C
  172. IMATRI.LISPRI(21) = MLMOTS.MOTS(1)
  173. IMATRI.LISPRI(22) = MLMOTS.MOTS(2)
  174. IMATRI.LISPRI(23) = MLMOTS.MOTS(3)
  175. IMATRI.LISPRI(24) = MLMOTS.MOTS(4)
  176. IMATRI.LISPRI(25) = MLMOTS.MOTS(5)
  177. C
  178. SEGDES MLMOTS
  179. MLMOTS=ILIINC
  180. SEGACT MLMOTS
  181. C
  182. C
  183. IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  184. IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  185. IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  186. IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  187. IMATRI.LISDUA(5) = MLMOTS.MOTS(1)
  188. C
  189. IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  190. IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  191. IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  192. IMATRI.LISDUA(9) = MLMOTS.MOTS(2)
  193. IMATRI.LISDUA(10) = MLMOTS.MOTS(2)
  194. C
  195. IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  196. IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  197. IMATRI.LISDUA(13) = MLMOTS.MOTS(3)
  198. IMATRI.LISDUA(14) = MLMOTS.MOTS(3)
  199. IMATRI.LISDUA(15) = MLMOTS.MOTS(3)
  200. C
  201. IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  202. IMATRI.LISDUA(17) = MLMOTS.MOTS(4)
  203. IMATRI.LISDUA(18) = MLMOTS.MOTS(4)
  204. IMATRI.LISDUA(19) = MLMOTS.MOTS(4)
  205. IMATRI.LISDUA(20) = MLMOTS.MOTS(4)
  206. C
  207. IMATRI.LISDUA(21) = MLMOTS.MOTS(5)
  208. IMATRI.LISDUA(22) = MLMOTS.MOTS(5)
  209. IMATRI.LISDUA(23) = MLMOTS.MOTS(5)
  210. IMATRI.LISDUA(24) = MLMOTS.MOTS(5)
  211. IMATRI.LISDUA(25) = MLMOTS.MOTS(5)
  212. C
  213. SEGDES MLMOTS
  214. NBEL = NFAC
  215. NBSOUS = 1
  216. NP = 1
  217. MP = 1
  218. SEGINI RR , RUX , RUY , RUZ ,RRET ,
  219. & UXR , UXUX , UXUY , UXUZ ,UXRET ,
  220. & UYR , UYUX , UYUY , UYUZ , UYRET ,
  221. & UZR , UZUX , UZUY , UZUZ , UZRET ,
  222. & RETR , RETUX , RETUY, RETUZ , RETRET
  223. C
  224. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  225. C Primale = IMATRI.LISPRI(1) = 'RN'
  226. C -> IMATRI.LIZAFM(1,1) = RR
  227. C
  228. IMATRI.LIZAFM(1,1) = RR
  229. IMATRI.LIZAFM(1,2) = RUX
  230. IMATRI.LIZAFM(1,3) = RUY
  231. IMATRI.LIZAFM(1,4) = RUZ
  232. IMATRI.LIZAFM(1,5) = RRET
  233. C
  234. IMATRI.LIZAFM(1,6) = UXR
  235. IMATRI.LIZAFM(1,7) = UXUX
  236. IMATRI.LIZAFM(1,8) = UXUY
  237. IMATRI.LIZAFM(1,9) = UXUZ
  238. IMATRI.LIZAFM(1,10) = UXRET
  239. C
  240. IMATRI.LIZAFM(1,11) = UYR
  241. IMATRI.LIZAFM(1,12) = UYUX
  242. IMATRI.LIZAFM(1,13) = UYUY
  243. IMATRI.LIZAFM(1,14) = UYUZ
  244. IMATRI.LIZAFM(1,15) = UYRET
  245. C
  246. IMATRI.LIZAFM(1,16) = UZR
  247. IMATRI.LIZAFM(1,17) = UZUX
  248. IMATRI.LIZAFM(1,18) = UZUY
  249. IMATRI.LIZAFM(1,19) = UZUZ
  250. IMATRI.LIZAFM(1,20) = UZRET
  251. C
  252. IMATRI.LIZAFM(1,21) = RETR
  253. IMATRI.LIZAFM(1,22) = RETUX
  254. IMATRI.LIZAFM(1,23) = RETUY
  255. IMATRI.LIZAFM(1,24) = RETUZ
  256. IMATRI.LIZAFM(1,25) = RETRET
  257. C
  258. SEGDES MATRIK
  259. SEGDES IMATRI
  260. C
  261. C**** Fin definition MATRIK
  262. C
  263. DO IFAC=1,NFAC,1
  264. NGF=MELEFC.NUM(1,IFAC)
  265. NGC=MELEFC.NUM(2,IFAC)
  266. NLF=MLEMF.LECT(NGF)
  267. NLC=MLEMC.LECT(NGC)
  268. NLCB=MLEMCB.LECT(NGF)
  269. VOLU=MPVOL.VPOCHA(NLC,1)
  270. SURF=MPSURF.VPOCHA(NLF,1)
  271. C In CASTEM les normales sont sortantes
  272. CNX=-1*MPNORM.VPOCHA(NLF,1)
  273. CNY=-1*MPNORM.VPOCHA(NLF,2)
  274. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  275. C Variables au centre
  276. RC=MPRC.VPOCHA(NLC,1)
  277. PC=MPPC.VPOCHA(NLC,1)
  278. UXC=MPVC.VPOCHA(NLC,1)
  279. UYC=MPVC.VPOCHA(NLC,2)
  280. UZC=MPVC.VPOCHA(NLC,3)
  281. GAMC=MPGAMC.VPOCHA(NLC,1)
  282. GM1=GAMC-1.0D0
  283. RHOUF=MPLIM.VPOCHA(NLCB,1)
  284. PSRF=MPLIM.VPOCHA(NLCB,2)
  285. C
  286. C******* Variables à l'interface
  287. C
  288. P=PC
  289. RHO=P/PSRF
  290. UN=RHOUF/RHO
  291. C
  292. C******* Derivative with respect to PC
  293. C
  294. DUNDPC=-1*RHOUF/(RHO*RHO*PSRF)
  295. DUXDPC=CNX*DUNDPC
  296. DUYDPC=CNY*DUNDPC
  297. DUZDPC=CNZ*DUNDPC
  298. DECIDP=UN*DUNDPC
  299. C
  300. C******* Jacobian with respect to primitive variables
  301. C
  302. COEF=SURF/VOLU
  303. DRORO=0.0D0
  304. DROUX=0.0D0
  305. DROUY=0.0D0
  306. DROUZ=0.0D0
  307. DROP=0.0D0
  308. C
  309. DPRO=0.0D0
  310. DPUX=0.0D0
  311. DPUY=0.0D0
  312. DPUZ=0.0D0
  313. DPP=(RHOUF*DECIDP)*COEF
  314. C
  315. DUXRO=0.0D0
  316. DUXUX=0.0D0
  317. DUXUY=0.0D0
  318. DUXUZ=0.0D0
  319. DUXP =(RHOUF*DUXDPC+CNX)*COEF
  320. C
  321. DUYRO=0.0D0
  322. DUYUX=0.0D0
  323. DUYUY=0.0D0
  324. DUYUZ=0.0D0
  325. DUYP =(RHOUF*DUYDPC+CNY)*COEF
  326. C
  327. DUZRO=0.0D0
  328. DUZUX=0.0D0
  329. DUZUY=0.0D0
  330. DUZUZ=0.0D0
  331. DUZP =(RHOUF*DUZDPC+CNZ)*COEF
  332. C
  333. C******* Jacobian with respect to conservative variables
  334. C
  335. IF(IJAC.EQ.1)THEN
  336. GM1=GAMC-1.0D0
  337. C
  338. COEF1=-1.0D0*UXC/RC
  339. COEF2=-1.0D0*UYC/RC
  340. COEF3=-1.0D0*UZC/RC
  341. COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC))
  342. C
  343. RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ
  344. $ *COEF3)+(DROP*COEF4)
  345. RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  346. RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  347. RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP)
  348. RRET.AM(IFAC,1,1)=GM1*DROP
  349. C
  350. UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ
  351. $ *COEF3)+(DUXP*COEF4)
  352. UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  353. UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  354. UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP)
  355. UXRET.AM(IFAC,1,1)=GM1*DUXP
  356. C
  357. UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ
  358. $ *COEF3)+(DUYP*COEF4)
  359. UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  360. UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  361. UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP)
  362. UYRET.AM(IFAC,1,1)=GM1*DUYP
  363. C
  364. UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ
  365. $ *COEF3)+(DUZP*COEF4)
  366. UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP)
  367. UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP)
  368. UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP)
  369. UZRET.AM(IFAC,1,1)=GM1*DUZP
  370. C
  371. RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ
  372. $ *COEF3)+(DPP*COEF4)
  373. RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  374. RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  375. RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP)
  376. RETRET.AM(IFAC,1,1)=GM1*DPP
  377. C
  378. ELSEIF(IJAC.EQ.2)THEN
  379. RR.AM(IFAC,1,1)=DRORO
  380. RUX.AM(IFAC,1,1)=DROUX
  381. RUY.AM(IFAC,1,1)=DROUY
  382. RUZ.AM(IFAC,1,1)=DROUZ
  383. RRET.AM(IFAC,1,1)=DROP
  384. C
  385. UXR.AM(IFAC,1,1)=DUXRO
  386. UXUX.AM(IFAC,1,1)=DUXUX
  387. UXUY.AM(IFAC,1,1)=DUXUY
  388. UXUZ.AM(IFAC,1,1)=DUXUZ
  389. UXRET.AM(IFAC,1,1)=DUXP
  390. C
  391. UYR.AM(IFAC,1,1)=DUYRO
  392. UYUX.AM(IFAC,1,1)=DUYUX
  393. UYUY.AM(IFAC,1,1)=DUYUY
  394. UYUZ.AM(IFAC,1,1)=DUYUZ
  395. UYRET.AM(IFAC,1,1)=DUYP
  396. C
  397. UZR.AM(IFAC,1,1)=DUZRO
  398. UZUX.AM(IFAC,1,1)=DUZUX
  399. UZUY.AM(IFAC,1,1)=DUZUY
  400. UZUZ.AM(IFAC,1,1)=DUZUZ
  401. UZRET.AM(IFAC,1,1)=DUZP
  402. C
  403. RETR.AM(IFAC,1,1)=DPRO
  404. RETUX.AM(IFAC,1,1)=DPUX
  405. RETUY.AM(IFAC,1,1)=DPUY
  406. RETUZ.AM(IFAC,1,1)=DPUZ
  407. RETRET.AM(IFAC,1,1)=DPP
  408. ENDIF
  409. ENDDO
  410. C
  411. SEGDES MELEFC
  412. C
  413. SEGSUP MLEMC
  414. SEGSUP MLEMCB
  415. SEGSUP MLEMF
  416. C
  417. SEGDES MPNORM
  418. SEGDES MPVOL
  419. SEGDES MPSURF
  420. SEGDES MPRC
  421. SEGDES MPPC
  422. SEGDES MPVC
  423. SEGDES MPGAMC
  424. SEGDES MPLIM
  425. C
  426. SEGDES RR , RUX , RUY , RUZ ,RRET ,
  427. & UXR , UXUX , UXUY , UXUZ ,UXRET ,
  428. & UYR , UYUX , UYUY , UYUZ , UYRET ,
  429. & UZR , UZUX , UZUY , UZUZ , UZRET ,
  430. & RETR , RETUX , RETUY, RETUZ , RETRET
  431. C
  432. 9999 CONTINUE
  433. RETURN
  434. END
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  
  442.  
  443.  
  444.  
  445.  
  446.  

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