Télécharger cli122.eso

Retour à la liste

Numérotation des lignes :

cli122
  1. C CLI122 SOURCE OF166741 24/12/13 21:15:13 12097
  2. SUBROUTINE CLI122(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 : CLI122
  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.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMLMOTS
  33. -INC SMELEME
  34. POINTEUR MELEFC.MELEME
  35. -INC SMLENTI
  36. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  37. -INC SMCHPOI
  38. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  39. & MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL
  40. POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  41. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  42. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  43. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  44.  
  45. INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  46. & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
  47. & ,NGF,NGC,NLF,NLC,NLCB
  48. & ,ILIINC,ILIINP,IJAC
  49. & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  50. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,GAMC,CNX,CNY,CTX,CTY
  51. & ,RF,PF,UXF,UYF
  52. & ,UNC,UNF,ASONC,ASONF,ASON
  53. * & ,UTF,SF
  54. & ,UTC,SC
  55. & ,GM1,USGM1,DSGM1,G1,G3,ASON2,S,UT,UN,RHO,P,UX,UY
  56. & ,DUNDG3,DASDG3,DRHDG3,DPDG3,DRHDS,DPDS
  57. * & ,CELL,EPS,CACCA
  58. & ,DUXDG3,DUYDG3,DUXDUT,DUYDUT
  59. & ,DFRDG3,DFRDS,DFMXG3,DFMXS,DFMXUT,DFMYG3,DFMYS,DFMYUT
  60. & ,DFEDG3,DFEDS,DFEDUT
  61. & ,DG3DR,DG3DP,DG3DUX,DG3DUY,DSDR,DSDP,DUTDUX,DUTDUY,COEF
  62. & ,DRORO,DROUX,DROUY,DROP
  63. & ,DUXRO,DUXUX,DUXUY,DUXP
  64. & ,DUYRO,DUYUX,DUYUY,DUYP
  65. & ,DPRO,DPUX,DPUY,DPP
  66. & ,COEF1,COEF2,COEF3
  67. CHARACTER*(8) TYPE
  68. C
  69. C
  70. C**** KRIPAD pour la correspondance global/local
  71. C
  72. CALL KRIPAD(MELEMC,MLEMC)
  73. C SEGINI MLEMC
  74. CALL KRIPAD(MELECB,MLEMCB)
  75. C SEGINI MLEMCB
  76. CALL KRIPAD(MELEMF,MLEMF)
  77. C SEGINI MLEMF
  78. C
  79. C**** CHPOINTs de la table DOMAINE
  80. C
  81. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  82. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  83. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  84. C
  85. C**** LICHT active les MPOVALs en *MOD
  86. C
  87. C SEGACT MPNORM*MOD
  88. C SEGACT MPOVSU*MOD
  89. C SEGACT MPOVOL*MOD
  90. C
  91. C
  92. C**** CHPOINTs des variables
  93. C
  94. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  95. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  96. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  97. CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  98. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  99. C
  100. C SEGACT *MOD
  101. C SEGACT *MOD
  102. C SEGACT *MOD
  103. C SEGACT *MOD
  104. C SEGACT *MOD
  105. C
  106. C
  107. C**** Boucle sur le face pour le calcul des invariants de
  108. C Riemann et du flux
  109. C
  110. SEGACT MELEFC
  111. NFAC=MELEFC.NUM(/2)
  112. C
  113. C**** Objet MATRIK
  114. C
  115. NRIGE = 7
  116. NMATRI = 1
  117. NKID = 9
  118. NKMT = 7
  119. C
  120. SEGINI MATRIK
  121. IJACO = MATRIK
  122. MATRIK.IRIGEL(1,1) = MELRES
  123. MATRIK.IRIGEL(2,1) = MELRES
  124. C
  125. C**** Matrice non symetrique
  126. C
  127. MATRIK.IRIGEL(7,1) = 2
  128. C
  129. NBME = 16
  130. NBSOUS = 1
  131. SEGINI IMATRI
  132. IF(IJAC.EQ.1)THEN
  133. MLMOTS=ILIINC
  134. ELSEIF(IJAC.EQ.2)THEN
  135. MLMOTS=ILIINP
  136. ENDIF
  137. SEGACT MLMOTS
  138. MATRIK.IRIGEL(4,1) = IMATRI
  139. C
  140. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  141. IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  142. IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  143. IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  144. IMATRI.LISPRI(5) = MLMOTS.MOTS(1)
  145. IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
  146. IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
  147. IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
  148. IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
  149. IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
  150. IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
  151. IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
  152. IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
  153. IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
  154. IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
  155. IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
  156. C
  157. SEGDES MLMOTS
  158. MLMOTS=ILIINC
  159. SEGACT MLMOTS
  160. C
  161. IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  162. IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  163. IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  164. IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  165. IMATRI.LISDUA(5) = MLMOTS.MOTS(2)
  166. IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  167. IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  168. IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  169. IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
  170. IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
  171. IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  172. IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  173. IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
  174. IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
  175. IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
  176. IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  177. C
  178. SEGDES MLMOTS
  179. NBEL = NFAC
  180. NBSOUS = 1
  181. NP = 1
  182. MP = 1
  183. SEGINI RR , RUX , RUY , RRET ,
  184. & UXR , UXUX , UXUY , UXRET ,
  185. & UYR , UYUX , UYUY , UYRET ,
  186. & RETR , RETUX , RETUY , RETRET
  187. C
  188. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  189. C Primale = IMATRI.LISPRI(1) = 'RN'
  190. C -> IMATRI.LIZAFM(1,1) = RR
  191. C
  192. IMATRI.LIZAFM(1,1) = RR
  193. IMATRI.LIZAFM(1,2) = RUX
  194. IMATRI.LIZAFM(1,3) = RUY
  195. IMATRI.LIZAFM(1,4) = RRET
  196. IMATRI.LIZAFM(1,5) = UXR
  197. IMATRI.LIZAFM(1,6) = UXUX
  198. IMATRI.LIZAFM(1,7) = UXUY
  199. IMATRI.LIZAFM(1,8) = UXRET
  200. IMATRI.LIZAFM(1,9) = UYR
  201. IMATRI.LIZAFM(1,10) = UYUX
  202. IMATRI.LIZAFM(1,11) = UYUY
  203. IMATRI.LIZAFM(1,12) = UYRET
  204. IMATRI.LIZAFM(1,13) = RETR
  205. IMATRI.LIZAFM(1,14) = RETUX
  206. IMATRI.LIZAFM(1,15) = RETUY
  207. IMATRI.LIZAFM(1,16) = RETRET
  208. C
  209. SEGDES MATRIK
  210. SEGDES IMATRI
  211. C
  212. C**** Fin definition MATRIK
  213. C
  214. DO IFAC=1,NFAC,1
  215. NGF=MELEFC.NUM(1,IFAC)
  216. NGC=MELEFC.NUM(2,IFAC)
  217. NLF=MLEMF.LECT(NGF)
  218. NLC=MLEMC.LECT(NGC)
  219. NLCB=MLEMCB.LECT(NGF)
  220. VOLU=MPVOL.VPOCHA(NLC,1)
  221. SURF=MPSURF.VPOCHA(NLF,1)
  222. C In CASTEM les normales sont sortantes
  223. CNX=MPNORM.VPOCHA(NLF,1)
  224. CNY=MPNORM.VPOCHA(NLF,2)
  225. CTX=-1.0D0*CNY
  226. CTY=CNX
  227. C Variables au centre
  228. RC=MPRC.VPOCHA(NLC,1)
  229. PC=MPPC.VPOCHA(NLC,1)
  230. UXC=MPVC.VPOCHA(NLC,1)
  231. UYC=MPVC.VPOCHA(NLC,2)
  232. GAMC=MPGAMC.VPOCHA(NLC,1)
  233. C Variables à la face
  234. RF=MPLIM.VPOCHA(NLCB,1)
  235. UXF=MPLIM.VPOCHA(NLCB,2)
  236. UYF=MPLIM.VPOCHA(NLCB,3)
  237. PF=MPLIM.VPOCHA(NLCB,IDIM+2)
  238. C
  239. C******* On calcule UN, UT ASON, S
  240. C
  241. UNC=(UXC*CNX)+(UYC*CNY)
  242. UTC=(UXC*CTX)+(UYC*CTY)
  243. UNF=(UXF*CNX)+(UYF*CNY)
  244. C UTF=(UXF*CTX)+(UYF*CTY)
  245. C
  246. ASONC=(GAMC*PC/RC)**0.5D0
  247. ASONF=(GAMC*PF/RF)**0.5D0
  248. C
  249. SC=PC/(RC**GAMC)
  250. C SF=PF/(RF**GAMC)
  251. C
  252. C******* Densite, vitesse, pression sur le bord
  253. C
  254. GM1=(GAMC-1.0D0)
  255. USGM1=1.0D0/GM1
  256. DSGM1=2.0D0*USGM1
  257. G1=UNF-(DSGM1*ASONF)
  258. G3=UNC+(DSGM1*ASONC)
  259. UN=0.5D0*(G1+G3)
  260. ASON=(0.5D0*(G3-G1))
  261. ASON=ASON/DSGM1
  262. ASON2=ASON*ASON
  263. S=SC
  264. UT=UTC
  265. RHO=ASON2/(GAMC*S)
  266. RHO=RHO**USGM1
  267. P=RHO*ASON2/GAMC
  268. UX=(UN*CNX)+(UT*CTX)
  269. UY=(UN*CNY)+(UT*CTY)
  270. C
  271. C******* Derivatives
  272. C
  273. DUNDG3=0.5D0
  274. DASDG3=0.5D0/DSGM1
  275. DRHDG3=GAMC*S
  276. DRHDG3=1.0D0/DRHDG3
  277. DRHDG3=DRHDG3**USGM1
  278. DRHDG3=DRHDG3*DSGM1
  279. DRHDG3=DRHDG3*(ASON**((3.0D0-GAMC)/(GAMC-1.0D0)))
  280. DRHDG3=DRHDG3*DASDG3
  281. DRHDS=-1.0D0*USGM1*RHO/S
  282. DPDG3=((ASON2/GAMC)*DRHDG3)+(((2*ASON*RHO)/GAMC)*DASDG3)
  283. DPDS=(ASON2/GAMC)*DRHDS
  284. CC
  285. CC******* Test
  286. CC
  287. CC ...DG3
  288. C EPS=1.0D-6
  289. C G3=G3*(1+EPS)
  290. C CELL=UN
  291. C UN=0.5D0*(G1+G3)
  292. C write(*,*) DUNDG3, ((UN - CELL)/(EPS*G3))
  293. C CELL=ASON
  294. C ASON=(0.5D0*(G3-G1))
  295. C ASON=ASON/DSGM1
  296. C write(*,*) DASDG3, ((ASON - CELL)/(EPS*G3))
  297. C ASON2=ASON*ASON
  298. C S=SC
  299. C UT=UTC
  300. C CELL=RHO
  301. C RHO=ASON2/(GAMC*S)
  302. C RHO=RHO**USGM1
  303. C write(*,*) DRHDG3, ((RHO - CELL)/(EPS*G3))
  304. C CELL=P
  305. C P=RHO*ASON2/GAMC
  306. C write(*,*) DPDG3, ((P - CELL)/(EPS*G3))
  307. CC
  308. CC******* Test
  309. CC
  310. CC ...DS
  311. C EPS=1.0D-6
  312. C S=S*(1+EPS)
  313. C CELL=RHO
  314. C RHO=ASON2/(GAMC*S)
  315. C RHO=RHO**USGM1
  316. C write(*,*) DRHDS, ((RHO - CELL)/(EPS*S))
  317. C CELL=P
  318. C P=RHO*ASON2/GAMC
  319. C write(*,*) DPDS, ((P - CELL)/(EPS*S))
  320. CC
  321. CC************************************************************
  322. CC
  323. DUXDG3=DUNDG3*CNX
  324. DUYDG3=DUNDG3*CNY
  325. DUXDUT=CTX
  326. DUYDUT=CTY
  327. C
  328. DFRDG3=(DRHDG3*UN)+(RHO*DUNDG3)
  329. DFRDS=(DRHDS*UN)
  330. DFMXG3=(DRHDG3*UN*UX)+(RHO*DUNDG3*UX)+
  331. & (RHO*UN*DUXDG3)+(DPDG3*CNX)
  332. DFMXS=(DRHDS*UN*UX)+(DPDS*CNX)
  333. DFMXUT=(RHO*UN*DUXDUT)
  334. DFMYG3=(DRHDG3*UN*UY)+(RHO*DUNDG3*UY)+
  335. & (RHO*UN*DUYDG3)+(DPDG3*CNY)
  336. DFMYS=(DRHDS*UN*UY)+(DPDS*CNY)
  337. DFMYUT=(RHO*UN*DUYDUT)
  338. DFEDG3=(DUNDG3*GAMC*USGM1*P) + (UN*GAMC*USGM1*DPDG3) +
  339. & (0.5D0*DRHDG3*UN*((UN*UN)+(UT*UT))) +
  340. & (0.5D0*RHO*DUNDG3*((UN*UN)+(UT*UT))) +
  341. & (RHO*UN*UN*DUNDG3)
  342. DFEDS=(UN*GAMC*USGM1*DPDS) +
  343. & (0.5D0*DRHDS*UN*((UN*UN)+(UT*UT)))
  344. DFEDUT=RHO*UN*UT
  345. C
  346. C******* Jacobian with respect to primitive variables
  347. C
  348. DG3DR=-1*USGM1*ASONC/RC
  349. DG3DP=USGM1*ASONC/PC
  350. DG3DUX=CNX
  351. DG3DUY=CNY
  352. DSDR=-1*GAMC*S/RC
  353. DSDP=S/PC
  354. DUTDUX=CTX
  355. DUTDUY=CTY
  356. C
  357. COEF=-1*SURF/VOLU
  358. C
  359. DRORO=((DFRDG3*DG3DR)+(DFRDS*DSDR))*COEF
  360. DROUX=(DFRDG3*DG3DUX)*COEF
  361. DROUY=(DFRDG3*DG3DUY)*COEF
  362. DROP=((DFRDG3*DG3DP)+(DFRDS*DSDP))*COEF
  363. C
  364. DUXRO=((DFMXG3*DG3DR)+(DFMXS*DSDR))*COEF
  365. DUXUX=((DFMXG3*DG3DUX)+(DFMXUT*DUTDUX))*COEF
  366. DUXUY=((DFMXG3*DG3DUY)+(DFMXUT*DUTDUY))*COEF
  367. DUXP=((DFMXG3*DG3DP)+(DFMXS*DSDP))*COEF
  368. C
  369. DUYRO=((DFMYG3*DG3DR)+(DFMYS*DSDR))*COEF
  370. DUYUX=((DFMYG3*DG3DUX)+(DFMYUT*DUTDUX))*COEF
  371. DUYUY=((DFMYG3*DG3DUY)+(DFMYUT*DUTDUY))*COEF
  372. DUYP=((DFMYG3*DG3DP)+(DFMYS*DSDP))*COEF
  373. CC
  374. DPRO=((DFEDG3*DG3DR)+(DFEDS*DSDR))*COEF
  375. DPUX=((DFEDG3*DG3DUX)+(DFEDUT*DUTDUX))*COEF
  376. DPUY=((DFEDG3*DG3DUY)+(DFEDUT*DUTDUY))*COEF
  377. DPP=((DFEDG3*DG3DP)+(DFEDS*DSDP))*COEF
  378. CC
  379. CC******* Jacobian with respect to conservative variables
  380. CC
  381. IF(IJAC.EQ.1)THEN
  382.  
  383. COEF1=-1.0D0*UXC/RC
  384. COEF2=-1.0D0*UYC/RC
  385. COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
  386. C
  387. RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
  388. $ *COEF3)
  389. RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  390. RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  391. RRET.AM(IFAC,1,1)=GM1*DROP
  392. C
  393. UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
  394. $ *COEF3)
  395. UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  396. UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  397. UXRET.AM(IFAC,1,1)=GM1*DUXP
  398. C
  399. UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
  400. $ *COEF3)
  401. UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  402. UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  403. UYRET.AM(IFAC,1,1)=GM1*DUYP
  404. C
  405. RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
  406. $ *COEF3)
  407. RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  408. RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  409. RETRET.AM(IFAC,1,1)=GM1*DPP
  410. C
  411. ELSEIF(IJAC.EQ.2)THEN
  412. RR.AM(IFAC,1,1)=DRORO
  413. RUX.AM(IFAC,1,1)=DROUX
  414. RUY.AM(IFAC,1,1)=DROUY
  415. RRET.AM(IFAC,1,1)=DROP
  416. C
  417. UXR.AM(IFAC,1,1)=DUXRO
  418. UXUX.AM(IFAC,1,1)=DUXUX
  419. UXUY.AM(IFAC,1,1)=DUXUY
  420. UXRET.AM(IFAC,1,1)=DUXP
  421. C
  422. UYR.AM(IFAC,1,1)=DUYRO
  423. UYUX.AM(IFAC,1,1)=DUYUX
  424. UYUY.AM(IFAC,1,1)=DUYUY
  425. UYRET.AM(IFAC,1,1)=DUYP
  426. C
  427. RETR.AM(IFAC,1,1)=DPRO
  428. RETUX.AM(IFAC,1,1)=DPUX
  429. RETUY.AM(IFAC,1,1)=DPUY
  430. RETRET.AM(IFAC,1,1)=DPP
  431. ENDIF
  432. ENDDO
  433. C
  434. SEGDES MELEFC
  435. C
  436. SEGSUP MLEMC
  437. SEGSUP MLEMCB
  438. SEGSUP MLEMF
  439. C
  440. SEGDES MPNORM
  441. SEGDES MPVOL
  442. SEGDES MPSURF
  443. SEGDES MPRC
  444. SEGDES MPPC
  445. SEGDES MPVC
  446. SEGDES MPGAMC
  447. SEGDES MPLIM
  448. C
  449. SEGDES RR , RUX , RUY , RRET ,
  450. & UXR , UXUX , UXUY , UXRET ,
  451. & UYR , UYUX , UYUY , UYRET ,
  452. & RETR , RETUX , RETUY , RETRET
  453. C
  454. 9999 CONTINUE
  455. RETURN
  456. END
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  
  469.  
  470.  
  471.  

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