Télécharger cli112.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI112 SOURCE PV 16/11/17 21:58:29 9180
  2. SUBROUTINE CLI112(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 : CLI112
  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
  62. & ,RF,PF,UXF,UYF
  63. & ,UNC,UNF,UTF,SF,ASONC,ASONF,ASON
  64. * & ,UTC,SC
  65. & ,GM1,USGM1,DSGM1,G1,G3,ASON2,S,UT,UN,RHO,P,UX,UY
  66. & ,DUNDG1,DASDG1,DRHDG1,DPDG1,DUXDG1,DUYDG1
  67. * & ,CELL,EPS,CACCA
  68. & ,DFRDG1,DFMXG1,DFMYG1,DFEDG1
  69. & ,DG1DR,DG1DP,DG1DUX,DG1DUY,COEF
  70. & ,DRORO,DROUX,DROUY,DROP
  71. & ,DUXRO,DUXUX,DUXUY,DUXP
  72. & ,DUYRO,DUYUX,DUYUY,DUYP
  73. & ,DPRO,DPUX,DPUY,DPP
  74. & ,COEF1,COEF2,COEF3
  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 = 16
  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(1)
  153. IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
  154. IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
  155. IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
  156. IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
  157. IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
  158. IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
  159. IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
  160. IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
  161. IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
  162. IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
  163. IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
  164. C
  165. SEGDES MLMOTS
  166. MLMOTS=ILIINC
  167. SEGACT MLMOTS
  168. C
  169. IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  170. IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  171. IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  172. IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  173. IMATRI.LISDUA(5) = MLMOTS.MOTS(2)
  174. IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  175. IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  176. IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  177. IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
  178. IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
  179. IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  180. IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  181. IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
  182. IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
  183. IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
  184. IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  185. C
  186. SEGDES MLMOTS
  187. NBEL = NFAC
  188. NBSOUS = 1
  189. NP = 1
  190. MP = 1
  191. SEGINI RR , RUX , RUY , RRET ,
  192. & UXR , UXUX , UXUY , UXRET ,
  193. & UYR , UYUX , UYUY , UYRET ,
  194. & RETR , RETUX , RETUY , RETRET
  195. C
  196. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  197. C Primale = IMATRI.LISPRI(1) = 'RN'
  198. C -> IMATRI.LIZAFM(1,1) = RR
  199. C
  200. IMATRI.LIZAFM(1,1) = RR
  201. IMATRI.LIZAFM(1,2) = RUX
  202. IMATRI.LIZAFM(1,3) = RUY
  203. IMATRI.LIZAFM(1,4) = RRET
  204. IMATRI.LIZAFM(1,5) = UXR
  205. IMATRI.LIZAFM(1,6) = UXUX
  206. IMATRI.LIZAFM(1,7) = UXUY
  207. IMATRI.LIZAFM(1,8) = UXRET
  208. IMATRI.LIZAFM(1,9) = UYR
  209. IMATRI.LIZAFM(1,10) = UYUX
  210. IMATRI.LIZAFM(1,11) = UYUY
  211. IMATRI.LIZAFM(1,12) = UYRET
  212. IMATRI.LIZAFM(1,13) = RETR
  213. IMATRI.LIZAFM(1,14) = RETUX
  214. IMATRI.LIZAFM(1,15) = RETUY
  215. IMATRI.LIZAFM(1,16) = RETRET
  216. C
  217. SEGDES MATRIK
  218. SEGDES IMATRI
  219. C
  220. C**** Fin definition MATRIK
  221. C
  222. DO IFAC=1,NFAC,1
  223. NGF=MELEFC.NUM(1,IFAC)
  224. NGC=MELEFC.NUM(2,IFAC)
  225. NLF=MLEMF.LECT(NGF)
  226. NLC=MLEMC.LECT(NGC)
  227. NLCB=MLEMCB.LECT(NGF)
  228. VOLU=MPVOL.VPOCHA(NLC,1)
  229. SURF=MPSURF.VPOCHA(NLF,1)
  230. C In CASTEM les normales sont sortantes
  231. CNX=-1*MPNORM.VPOCHA(NLF,1)
  232. CNY=-1*MPNORM.VPOCHA(NLF,2)
  233. CTX=-1.0D0*CNY
  234. CTY=CNX
  235. C Variables au centre
  236. RC=MPRC.VPOCHA(NLC,1)
  237. PC=MPPC.VPOCHA(NLC,1)
  238. UXC=MPVC.VPOCHA(NLC,1)
  239. UYC=MPVC.VPOCHA(NLC,2)
  240. GAMC=MPGAMC.VPOCHA(NLC,1)
  241. C Variables à la face
  242. RF=MPLIM.VPOCHA(NLCB,1)
  243. UXF=MPLIM.VPOCHA(NLCB,2)
  244. UYF=MPLIM.VPOCHA(NLCB,3)
  245. PF=MPLIM.VPOCHA(NLCB,IDIM+2)
  246. C
  247. C******* On calcule UN, UT ASON, S
  248. C
  249. UNC=(UXC*CNX)+(UYC*CNY)
  250. * UTC=(UXC*CTX)+(UYC*CTY)
  251. UNF=(UXF*CNX)+(UYF*CNY)
  252. UTF=(UXF*CTX)+(UYF*CTY)
  253. C
  254. ASONC=(GAMC*PC/RC)**0.5D0
  255. ASONF=(GAMC*PF/RF)**0.5D0
  256. C
  257. * SC=PC/(RC**GAMC)
  258. SF=PF/(RF**GAMC)
  259. C
  260. C******* Densite, vitesse, pression sur le bord
  261. C
  262. GM1=(GAMC-1.0D0)
  263. USGM1=1.0D0/GM1
  264. DSGM1=2.0D0*USGM1
  265. G1=UNC-(DSGM1*ASONC)
  266. G3=UNF+(DSGM1*ASONF)
  267. UN=0.5D0*(G1+G3)
  268. ASON=(0.5D0*(G3-G1))
  269. ASON=ASON/DSGM1
  270. ASON2=ASON*ASON
  271. S=SF
  272. UT=UTF
  273. RHO=ASON2/(GAMC*S)
  274. RHO=RHO**USGM1
  275. P=RHO*ASON2/GAMC
  276. UX=(UN*CNX)+(UT*CTX)
  277. UY=(UN*CNY)+(UT*CTY)
  278. C
  279. C******* Derivatives
  280. C
  281. DUNDG1=0.5D0
  282. DASDG1=-0.5D0/DSGM1
  283. DRHDG1=GAMC*S
  284. DRHDG1=1.0D0/DRHDG1
  285. DRHDG1=DRHDG1**USGM1
  286. DRHDG1=DRHDG1*DSGM1
  287. DRHDG1=DRHDG1*(ASON**((3.0D0-GAMC)/(GAMC-1.0D0)))
  288. DRHDG1=DRHDG1*DASDG1
  289. DPDG1=((ASON2/GAMC)*DRHDG1)+(((2*ASON*RHO)/GAMC)*DASDG1)
  290. CC
  291. CC******* Test
  292. CC
  293. C DFEDG1=(DUNDG1*GAMC*USGM1*P) + (UN*GAMC*USGM1*DPDG1) +
  294. C & (0.5D0*DRHDG1*UN*((UN*UN)+(UT*UT))) +
  295. C & (0.5D0*RHO*DUNDG1*((UN*UN)+(UT*UT))) +
  296. C & (RHO*UN*UN*DUNDG1)
  297. C CACCA=UN*GAMC*USGM1*P + 0.5D0*RHO*UN*(UN*UN+UT*UT)
  298. C EPS=1.0D-6
  299. C G1=G1*(1+EPS)
  300. C CELL=UN
  301. C UN=0.5D0*(G1+G3)
  302. C write(*,*) DUNDG1, ((UN - CELL)/(EPS*G1))
  303. C CELL=ASON
  304. C ASON=(0.5D0*(G3-G1))
  305. C ASON=ASON/DSGM1
  306. C write(*,*) DASDG1, ((ASON - CELL)/(EPS*G1))
  307. C ASON2=ASON*ASON
  308. C S=SF
  309. C UT=UTF
  310. C CELL=RHO
  311. C RHO=ASON2/(GAMC*S)
  312. C RHO=RHO**USGM1
  313. C write(*,*) DRHDG1, ((RHO - CELL)/(EPS*G1))
  314. C CELL=P
  315. C P=RHO*ASON2/GAMC
  316. C write(*,*) DPDG1, ((P - CELL)/(EPS*G1))
  317. C CELL=CACCA
  318. C CACCA=UN*GAMC*USGM1*P + 0.5D0*RHO*UN*(UN*UN+UT*UT)
  319. C write(*,*) DFEDG1, ((CACCA - CELL)/(EPS*G1))
  320. CC
  321. CC************************************************************
  322. CC
  323. DUXDG1=DUNDG1*CNX
  324. DUYDG1=DUNDG1*CNY
  325. C
  326. DFRDG1=(DRHDG1*UN)+(RHO*DUNDG1)
  327. DFMXG1=(DRHDG1*UN*UX)+(RHO*DUNDG1*UX)+
  328. & (RHO*UN*DUXDG1)+(DPDG1*CNX)
  329. DFMYG1=(DRHDG1*UN*UY)+(RHO*DUNDG1*UY)+
  330. & (RHO*UN*DUYDG1)+(DPDG1*CNY)
  331. DFEDG1=(DUNDG1*GAMC*USGM1*P) + (UN*GAMC*USGM1*DPDG1) +
  332. & (0.5D0*DRHDG1*UN*((UN*UN)+(UT*UT))) +
  333. & (0.5D0*RHO*DUNDG1*((UN*UN)+(UT*UT))) +
  334. & (RHO*UN*UN*DUNDG1)
  335. C
  336. C******* Jacobian with respect to primitive variables
  337. C
  338. DG1DR=USGM1*ASONC/RC
  339. DG1DP=-1.0D0*USGM1*ASONC/PC
  340. DG1DUX=CNX
  341. DG1DUY=CNY
  342. C
  343. COEF=SURF/VOLU
  344. C
  345. DRORO=DFRDG1*DG1DR*COEF
  346. DROUX=DFRDG1*DG1DUX*COEF
  347. DROUY=DFRDG1*DG1DUY*COEF
  348. DROP=DFRDG1*DG1DP*COEF
  349. C
  350. DUXRO=DFMXG1*DG1DR*COEF
  351. DUXUX=DFMXG1*DG1DUX*COEF
  352. DUXUY=DFMXG1*DG1DUY*COEF
  353. DUXP=DFMXG1*DG1DP*COEF
  354. C
  355. DUYRO=DFMYG1*DG1DR*COEF
  356. DUYUX=DFMYG1*DG1DUX*COEF
  357. DUYUY=DFMYG1*DG1DUY*COEF
  358. DUYP=DFMYG1*DG1DP*COEF
  359. C
  360. DPRO=DFEDG1*DG1DR*COEF
  361. DPUX=DFEDG1*DG1DUX*COEF
  362. DPUY=DFEDG1*DG1DUY*COEF
  363. DPP=DFEDG1*DG1DP*COEF
  364. C
  365. C******* Jacobian with respect to conservative variables
  366. C
  367. IF(IJAC.EQ.1)THEN
  368. C
  369. COEF1=-1.0D0*UXC/RC
  370. COEF2=-1.0D0*UYC/RC
  371. COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
  372. C
  373. RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
  374. $ *COEF3)
  375. RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  376. RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  377. RRET.AM(IFAC,1,1)=GM1*DROP
  378. C
  379. UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
  380. $ *COEF3)
  381. UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  382. UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  383. UXRET.AM(IFAC,1,1)=GM1*DUXP
  384. C
  385. UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
  386. $ *COEF3)
  387. UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  388. UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  389. UYRET.AM(IFAC,1,1)=GM1*DUYP
  390. C
  391. RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
  392. $ *COEF3)
  393. RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  394. RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  395. RETRET.AM(IFAC,1,1)=GM1*DPP
  396. C
  397. ELSEIF(IJAC.EQ.2)THEN
  398. RR.AM(IFAC,1,1)=DRORO
  399. RUX.AM(IFAC,1,1)=DROUX
  400. RUY.AM(IFAC,1,1)=DROUY
  401. RRET.AM(IFAC,1,1)=DROP
  402. C
  403. UXR.AM(IFAC,1,1)=DUXRO
  404. UXUX.AM(IFAC,1,1)=DUXUX
  405. UXUY.AM(IFAC,1,1)=DUXUY
  406. UXRET.AM(IFAC,1,1)=DUXP
  407. C
  408. UYR.AM(IFAC,1,1)=DUYRO
  409. UYUX.AM(IFAC,1,1)=DUYUX
  410. UYUY.AM(IFAC,1,1)=DUYUY
  411. UYRET.AM(IFAC,1,1)=DUYP
  412. C
  413. RETR.AM(IFAC,1,1)=DPRO
  414. RETUX.AM(IFAC,1,1)=DPUX
  415. RETUY.AM(IFAC,1,1)=DPUY
  416. RETRET.AM(IFAC,1,1)=DPP
  417. ENDIF
  418.  
  419. ENDDO
  420. C
  421. SEGDES MELEFC
  422. C
  423. SEGSUP MLEMC
  424. SEGSUP MLEMCB
  425. SEGSUP MLEMF
  426. C
  427. SEGDES MPNORM
  428. SEGDES MPVOL
  429. SEGDES MPSURF
  430. SEGDES MPRC
  431. SEGDES MPPC
  432. SEGDES MPVC
  433. SEGDES MPGAMC
  434. SEGDES MPLIM
  435. C
  436. SEGDES RR , RUX , RUY , RRET ,
  437. & UXR , UXUX , UXUY , UXRET ,
  438. & UYR , UYUX , UYUY , UYRET ,
  439. & RETR , RETUX , RETUY , RETRET
  440. C
  441. 9999 CONTINUE
  442. RETURN
  443. END
  444.  
  445.  
  446.  
  447.  
  448.  
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  

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