Télécharger cli162.eso

Retour à la liste

Numérotation des lignes :

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

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