Télécharger cli143.eso

Retour à la liste

Numérotation des lignes :

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

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