Télécharger cli183.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI183 SOURCE PV 16/11/17 21:58:42 9180
  2. SUBROUTINE CLI183(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 : CLI183
  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,CC,UNC
  66. & ,PC,PSRF,RHOUF,P,RHO,UN,ACEL,BCEL,CCEL,PSTAR,UX,UY,UZ,ECIN
  67. & ,DADR,DADP,DBDR,DBDP,DBDUX,DBDUY,DBDUZ,DCDP
  68. & ,DPSDA,DPSDB,DPSDC,DPDR,DPDP,DPDUX,DPDUY,DPDUZ
  69. & ,DUXDP,DUYDP,DUZDP,DECINP,DF2DP,DF3DP,DF4DP,DF5DP
  70. & ,DRORO,DROUX,DROUY,DROP
  71. & ,DUXRO,DUXUX,DUXUY,DUXP
  72. & ,DUYRO,DUYUX,DUYUY,DUYP
  73. & ,DPRO,DPUX,DPUY,DPP
  74. & ,COEF1,COEF2,COEF3,COEF,COEF4
  75. & ,DROUZ,DUXUZ,DUYUZ,DPUZ
  76. & ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP
  77. C & ,YCAC,YCAC2,YCAC3,YCAC4,XCAC,F1,F2,F3,F4,F5,USGM1
  78. CHARACTER*(8) TYPE
  79. C
  80. C
  81. C**** KRIPAD pour la correspondance global/local
  82. C
  83. CALL KRIPAD(MELEMC,MLEMC)
  84. C SEGINI MLEMC
  85. CALL KRIPAD(MELECB,MLEMCB)
  86. C SEGINI MLEMCB
  87. CALL KRIPAD(MELEMF,MLEMF)
  88. C SEGINI MLEMF
  89. C
  90. C**** CHPOINTs de la table DOMAINE
  91. C
  92. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  93. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  94. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  95. C
  96. C**** LICHT active les MPOVALs en *MOD
  97. C
  98. C SEGACT MPNORM*MOD
  99. C SEGACT MPOVSU*MOD
  100. C SEGACT MPOVOL*MOD
  101. C
  102. C
  103. C**** CHPOINTs des variables
  104. C
  105. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  106. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  107. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  108. CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  109. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  110. C
  111. C SEGACT *MOD
  112. C SEGACT *MOD
  113. C SEGACT *MOD
  114. C SEGACT *MOD
  115. C SEGACT *MOD
  116. C
  117. C
  118. C**** Boucle sur le face pour le calcul des invariants de
  119. C Riemann et du flux
  120. C
  121. SEGACT MELEFC
  122. NFAC=MELEFC.NUM(/2)
  123. C
  124. C**** Objet MATRIK
  125. C
  126. NRIGE = 7
  127. NMATRI = 1
  128. NKID = 9
  129. NKMT = 7
  130. C
  131. SEGINI MATRIK
  132. IJACO = MATRIK
  133. MATRIK.IRIGEL(1,1) = MELRES
  134. MATRIK.IRIGEL(2,1) = MELRES
  135. C
  136. C**** Matrice non symetrique
  137. C
  138. MATRIK.IRIGEL(7,1) = 2
  139. C
  140. NBME = 25
  141. NBSOUS = 1
  142. SEGINI IMATRI
  143. IF(IJAC.EQ.1)THEN
  144. MLMOTS=ILIINC
  145. ELSEIF(IJAC.EQ.2)THEN
  146. MLMOTS=ILIINP
  147. ENDIF
  148. SEGACT MLMOTS
  149. MATRIK.IRIGEL(4,1) = IMATRI
  150. C
  151. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  152. IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  153. IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  154. IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  155. IMATRI.LISPRI(5) = MLMOTS.MOTS(5)
  156. C
  157. IMATRI.LISPRI(6) = MLMOTS.MOTS(1)
  158. IMATRI.LISPRI(7) = MLMOTS.MOTS(2)
  159. IMATRI.LISPRI(8) = MLMOTS.MOTS(3)
  160. IMATRI.LISPRI(9) = MLMOTS.MOTS(4)
  161. IMATRI.LISPRI(10) = MLMOTS.MOTS(5)
  162. C
  163. IMATRI.LISPRI(11) = MLMOTS.MOTS(1)
  164. IMATRI.LISPRI(12) = MLMOTS.MOTS(2)
  165. IMATRI.LISPRI(13) = MLMOTS.MOTS(3)
  166. IMATRI.LISPRI(14) = MLMOTS.MOTS(4)
  167. IMATRI.LISPRI(15) = MLMOTS.MOTS(5)
  168. C
  169. IMATRI.LISPRI(16) = MLMOTS.MOTS(1)
  170. IMATRI.LISPRI(17) = MLMOTS.MOTS(2)
  171. IMATRI.LISPRI(18) = MLMOTS.MOTS(3)
  172. IMATRI.LISPRI(19) = MLMOTS.MOTS(4)
  173. IMATRI.LISPRI(20) = MLMOTS.MOTS(5)
  174. C
  175. IMATRI.LISPRI(21) = MLMOTS.MOTS(1)
  176. IMATRI.LISPRI(22) = MLMOTS.MOTS(2)
  177. IMATRI.LISPRI(23) = MLMOTS.MOTS(3)
  178. IMATRI.LISPRI(24) = MLMOTS.MOTS(4)
  179. IMATRI.LISPRI(25) = MLMOTS.MOTS(5)
  180. C
  181. SEGDES MLMOTS
  182. MLMOTS=ILIINC
  183. SEGACT MLMOTS
  184. C
  185. C
  186. IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  187. IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  188. IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  189. IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  190. IMATRI.LISDUA(5) = MLMOTS.MOTS(1)
  191. C
  192. IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  193. IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  194. IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  195. IMATRI.LISDUA(9) = MLMOTS.MOTS(2)
  196. IMATRI.LISDUA(10) = MLMOTS.MOTS(2)
  197. C
  198. IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  199. IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  200. IMATRI.LISDUA(13) = MLMOTS.MOTS(3)
  201. IMATRI.LISDUA(14) = MLMOTS.MOTS(3)
  202. IMATRI.LISDUA(15) = MLMOTS.MOTS(3)
  203. C
  204. IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  205. IMATRI.LISDUA(17) = MLMOTS.MOTS(4)
  206. IMATRI.LISDUA(18) = MLMOTS.MOTS(4)
  207. IMATRI.LISDUA(19) = MLMOTS.MOTS(4)
  208. IMATRI.LISDUA(20) = MLMOTS.MOTS(4)
  209. C
  210. IMATRI.LISDUA(21) = MLMOTS.MOTS(5)
  211. IMATRI.LISDUA(22) = MLMOTS.MOTS(5)
  212. IMATRI.LISDUA(23) = MLMOTS.MOTS(5)
  213. IMATRI.LISDUA(24) = MLMOTS.MOTS(5)
  214. IMATRI.LISDUA(25) = MLMOTS.MOTS(5)
  215. C
  216. SEGDES MLMOTS
  217. NBEL = NFAC
  218. NBSOUS = 1
  219. NP = 1
  220. MP = 1
  221. SEGINI RR , RUX , RUY , RUZ ,RRET ,
  222. & UXR , UXUX , UXUY , UXUZ ,UXRET ,
  223. & UYR , UYUX , UYUY , UYUZ , UYRET ,
  224. & UZR , UZUX , UZUY , UZUZ , UZRET ,
  225. & RETR , RETUX , RETUY, RETUZ , RETRET
  226. C
  227. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  228. C Primale = IMATRI.LISPRI(1) = 'RN'
  229. C -> IMATRI.LIZAFM(1,1) = RR
  230. C
  231. IMATRI.LIZAFM(1,1) = RR
  232. IMATRI.LIZAFM(1,2) = RUX
  233. IMATRI.LIZAFM(1,3) = RUY
  234. IMATRI.LIZAFM(1,4) = RUZ
  235. IMATRI.LIZAFM(1,5) = RRET
  236. C
  237. IMATRI.LIZAFM(1,6) = UXR
  238. IMATRI.LIZAFM(1,7) = UXUX
  239. IMATRI.LIZAFM(1,8) = UXUY
  240. IMATRI.LIZAFM(1,9) = UXUZ
  241. IMATRI.LIZAFM(1,10) = UXRET
  242. C
  243. IMATRI.LIZAFM(1,11) = UYR
  244. IMATRI.LIZAFM(1,12) = UYUX
  245. IMATRI.LIZAFM(1,13) = UYUY
  246. IMATRI.LIZAFM(1,14) = UYUZ
  247. IMATRI.LIZAFM(1,15) = UYRET
  248. C
  249. IMATRI.LIZAFM(1,16) = UZR
  250. IMATRI.LIZAFM(1,17) = UZUX
  251. IMATRI.LIZAFM(1,18) = UZUY
  252. IMATRI.LIZAFM(1,19) = UZUZ
  253. IMATRI.LIZAFM(1,20) = UZRET
  254. C
  255. IMATRI.LIZAFM(1,21) = RETR
  256. IMATRI.LIZAFM(1,22) = RETUX
  257. IMATRI.LIZAFM(1,23) = RETUY
  258. IMATRI.LIZAFM(1,24) = RETUZ
  259. IMATRI.LIZAFM(1,25) = RETRET
  260. C
  261. SEGDES MATRIK
  262. SEGDES IMATRI
  263. C
  264. C**** Fin definition MATRIK
  265. C
  266. DO IFAC=1,NFAC,1
  267. NGF=MELEFC.NUM(1,IFAC)
  268. NGC=MELEFC.NUM(2,IFAC)
  269. NLF=MLEMF.LECT(NGF)
  270. NLC=MLEMC.LECT(NGC)
  271. NLCB=MLEMCB.LECT(NGF)
  272. VOLU=MPVOL.VPOCHA(NLC,1)
  273. SURF=MPSURF.VPOCHA(NLF,1)
  274. C In CASTEM les normales sont sortantes
  275. CNX=-1*MPNORM.VPOCHA(NLF,1)
  276. CNY=-1*MPNORM.VPOCHA(NLF,2)
  277. CNZ=-1*MPNORM.VPOCHA(NLF,3)
  278. C Variables au centre
  279. RC=MPRC.VPOCHA(NLC,1)
  280. PC=MPPC.VPOCHA(NLC,1)
  281. UXC=MPVC.VPOCHA(NLC,1)
  282. UYC=MPVC.VPOCHA(NLC,2)
  283. UZC=MPVC.VPOCHA(NLC,3)
  284. GAMC=MPGAMC.VPOCHA(NLC,1)
  285. UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  286. CC=GAMC*PC/RC
  287. CC=CC**0.5D0
  288. GM1=GAMC-1.0D0
  289. C Variables à la face
  290. RHOUF=MPLIM.VPOCHA(NLCB,1)
  291. PSRF=MPLIM.VPOCHA(NLCB,2)
  292. C
  293. C******* Variables à l'interface
  294. C
  295. ACEL=CC/GAMC
  296. BCEL=ACEL - UNC
  297. CCEL=(RHOUF / PC) * PSRF
  298. PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  299. PSTAR=PSTAR/(2*ACEL)
  300. P=PSTAR*PC
  301. RHO=P/PSRF
  302. UN=RHOUF/RHO
  303. UX=UN*CNX
  304. UY=UN*CNY
  305. UZ=UN*CNZ
  306. ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
  307. C
  308. C******* Derivatives of ACEL, BCEL, CCEL with respect to the
  309. C variables at centers
  310. C
  311. DADR = -0.5D0*CC/(RC*GAMC)
  312. DADP = 0.5D0*CC/(PC*GAMC)
  313. DBDR = DADR
  314. DBDP = DADP
  315. DBDUX = -1*CNX
  316. DBDUY = -1*CNY
  317. DBDUZ = -1*CNZ
  318. DCDP = -1*CCEL/PC
  319. C
  320. C******* Derivatives of PSTAR with respect to ACEL,BCEL,CCEL
  321. C
  322. DPSDA = -1*(PSTAR*PSTAR)/((2*ACEL*PSTAR)-BCEL)
  323. DPSDB = PSTAR/((2*ACEL*PSTAR)-BCEL)
  324. DPSDC = 1/((2*ACEL*PSTAR)-BCEL)
  325. C
  326. C******* Derivatives of PC*PSTAR with respect to RC,PC,UXC,UYC
  327. C
  328. DPDR=(DPSDA*DADR)+(DPSDB*DBDR)
  329. DPDR=DPDR*PC
  330. DPDP=(DPSDA*DADP)+(DPSDB*DBDP)+(DPSDC*DCDP)
  331. DPDP=(DPDP*PC)+PSTAR
  332. DPDUX=(DPSDB*DBDUX)*PC
  333. DPDUY=(DPSDB*DBDUY)*PC
  334. DPDUZ=(DPSDB*DBDUZ)*PC
  335. CC
  336. CC******* Test 1
  337. CC
  338. CC We check dpdp
  339. CC
  340. C YCAC=P
  341. C XCAC=PC
  342. C PC=PC*(1+1.0D-4)
  343. C CC=GAMC*PC/RC
  344. C CC=CC**0.5D0
  345. CC
  346. C ACEL=CC/GAMC
  347. C BCEL=ACEL - UNC
  348. C CCEL=(RHOUF / PC) * PSRF
  349. C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  350. C PSTAR=PSTAR/(2*ACEL)
  351. C P=PSTAR*PC
  352. C write(*,*) ((P - YCAC)/(PC - XCAC)), DPDP
  353. CC
  354. CC We check dpdr
  355. CC
  356. C YCAC=P
  357. C XCAC=RC
  358. C RC=RC*(1+1.0D-4)
  359. C CC=GAMC*PC/RC
  360. C CC=CC**0.5D0
  361. CC
  362. C ACEL=CC/GAMC
  363. C BCEL=ACEL - UNC
  364. C CCEL=(RHOUF / PC) * PSRF
  365. C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  366. C PSTAR=PSTAR/(2*ACEL)
  367. C P=PSTAR*PC
  368. C write(*,*) ((P - YCAC)/(RC - XCAC)), DPDR
  369. CC
  370. CC We check dpdux
  371. CC
  372. C YCAC=P
  373. C XCAC=UXC
  374. C UXC=UXC*(1+1.0D-4)
  375. C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  376. C CC=GAMC*PC/RC
  377. C CC=CC**0.5D0
  378. CC
  379. C ACEL=CC/GAMC
  380. C BCEL=ACEL - UNC
  381. C CCEL=(RHOUF / PC) * PSRF
  382. C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  383. C PSTAR=PSTAR/(2*ACEL)
  384. C P=PSTAR*PC
  385. C write(*,*) ((P - YCAC)/(UXC - XCAC)), DPDUX
  386. CC
  387. CC We check dpduy
  388. CC
  389. C YCAC=P
  390. C XCAC=UYC
  391. C UYC=UYC*(1+1.0D-4)
  392. C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  393. C CC=GAMC*PC/RC
  394. C CC=CC**0.5D0
  395. CC
  396. C ACEL=CC/GAMC
  397. C BCEL=ACEL - UNC
  398. C CCEL=(RHOUF / PC) * PSRF
  399. C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  400. C PSTAR=PSTAR/(2*ACEL)
  401. C P=PSTAR*PC
  402. C write(*,*) ((P - YCAC)/(UYC - XCAC)), DPDUY
  403. CC
  404. CC We check dpduz
  405. CC
  406. C YCAC=P
  407. C XCAC=UZC
  408. C UZC=UZC*(1+1.0D-4)
  409. C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  410. C CC=GAMC*PC/RC
  411. C CC=CC**0.5D0
  412. CC
  413. C ACEL=CC/GAMC
  414. C BCEL=ACEL - UNC
  415. C CCEL=(RHOUF / PC) * PSRF
  416. C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  417. C PSTAR=PSTAR/(2*ACEL)
  418. C P=PSTAR*PC
  419. C write(*,*) ((P - YCAC)/(UZC - XCAC)), DPDUZ
  420. CC
  421. CC
  422. CC******* Fin test 1
  423. C
  424. C
  425. C******* The interfacial state is thus given by
  426. C RHOUF,PSRF,P and UT (UT=0), UT2 (UT2=0)
  427. C Let us now compute the derivative of the residuum with
  428. C respect to P.
  429. C The residuum is given by
  430. C
  431. C F1=RHOUF*SURF/VOLU
  432. C F2=(RHOUF*UX+P*CNX)*SURF/VOLU
  433. C F3=(RHOUF*UY+P*CNY)*SURF/VOLU
  434. C F4=(RHOUF*UZ+P*CNZ)*SURF/VOLU
  435. C F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*SURF/VOLU
  436. C
  437. C In these expression: UX, UY, P and ECIN depends on P
  438. C
  439. COEF=SURF/VOLU
  440. DUXDP=-1*UX/P
  441. DUYDP=-1*UY/P
  442. DUZDP=-1*UZ/P
  443. DECINP=-2*ECIN/P
  444. DF2DP=((RHOUF*DUXDP)+CNX)*COEF
  445. DF3DP=((RHOUF*DUYDP)+CNY)*COEF
  446. DF4DP=((RHOUF*DUZDP)+CNZ)*COEF
  447. DF5DP=(RHOUF*DECINP)*COEF
  448. CC
  449. CC******* Test 2
  450. CC
  451. CC We check DF2P
  452. CC
  453. C USGM1=1/GM1
  454. C F2=(RHOUF*UX+P*CNX)*COEF
  455. C F3=(RHOUF*UY+P*CNY)*COEF
  456. C F4=(RHOUF*UZ+P*CNZ)*COEF
  457. C F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF
  458. CC
  459. C YCAC=F2
  460. C YCAC2=F3
  461. C YCAC3=F4
  462. C YCAC4=F5
  463. C XCAC=P
  464. C P=P*(1+1.0D-4)
  465. C RHO=P/PSRF
  466. C UN=RHOUF/RHO
  467. C UX=UN*CNX
  468. C UY=UN*CNY
  469. C UZ=UN*CNZ
  470. C ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
  471. C
  472. C F2=(RHOUF*UX+P*CNX)*COEF
  473. C F3=(RHOUF*UY+P*CNY)*COEF
  474. C F4=(RHOUF*UZ+P*CNZ)*COEF
  475. C F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF
  476. C write(*,*) ((F2 -YCAC)/(P-XCAC)),DF2DP
  477. C write(*,*) ((F3 -YCAC2)/(P-XCAC)),DF3DP
  478. C write(*,*) ((F4 -YCAC3)/(P-XCAC)),DF4DP
  479. C write(*,*) ((F5 -YCAC4)/(P-XCAC)),DF5DP
  480. C
  481. C******* Fin test 2
  482. C
  483. C
  484. C******* Jacobian with respect to primitive variables
  485. C
  486. C
  487. C DF1D...
  488. C
  489. DRORO=0.0D0
  490. DROUX=0.0D0
  491. DROUY=0.0D0
  492. DROUZ=0.0D0
  493. DROP=0.0D0
  494. C
  495. C DF5D...
  496. C
  497. DPRO=DF5DP*DPDR
  498. DPUX=DF5DP*DPDUX
  499. DPUY=DF5DP*DPDUY
  500. DPUZ=DF5DP*DPDUZ
  501. DPP=DF5DP*DPDP
  502. C
  503. C DF2D...
  504. C
  505. DUXRO=DF2DP*DPDR
  506. DUXUX=DF2DP*DPDUX
  507. DUXUY=DF2DP*DPDUY
  508. DUXUZ=DF2DP*DPDUZ
  509. DUXP =DF2DP*DPDP
  510. C
  511. C DF3D
  512. C
  513. DUYRO=DF3DP*DPDR
  514. DUYUX=DF3DP*DPDUX
  515. DUYUY=DF3DP*DPDUY
  516. DUYUZ=DF3DP*DPDUZ
  517. DUYP =DF3DP*DPDP
  518. C
  519. C DF4D
  520. C
  521. DUZRO=DF4DP*DPDR
  522. DUZUX=DF4DP*DPDUX
  523. DUZUY=DF4DP*DPDUY
  524. DUZUZ=DF4DP*DPDUZ
  525. DUZP =DF4DP*DPDP
  526. C
  527. C******* Jacobian with respect to conservative variables
  528. C
  529. IF(IJAC.EQ.1)THEN
  530. GM1=GAMC-1.0D0
  531. C
  532. COEF1=-1.0D0*UXC/RC
  533. COEF2=-1.0D0*UYC/RC
  534. COEF3=-1.0D0*UZC/RC
  535. COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC))
  536. C
  537. RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ
  538. $ *COEF3)+(DROP*COEF4)
  539. RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  540. RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  541. RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP)
  542. RRET.AM(IFAC,1,1)=GM1*DROP
  543. C
  544. UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ
  545. $ *COEF3)+(DUXP*COEF4)
  546. UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  547. UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  548. UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP)
  549. UXRET.AM(IFAC,1,1)=GM1*DUXP
  550. C
  551. UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ
  552. $ *COEF3)+(DUYP*COEF4)
  553. UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  554. UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  555. UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP)
  556. UYRET.AM(IFAC,1,1)=GM1*DUYP
  557. C
  558. UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ
  559. $ *COEF3)+(DUZP*COEF4)
  560. UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP)
  561. UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP)
  562. UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP)
  563. UZRET.AM(IFAC,1,1)=GM1*DUZP
  564. C
  565. RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ
  566. $ *COEF3)+(DPP*COEF4)
  567. RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  568. RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  569. RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP)
  570. RETRET.AM(IFAC,1,1)=GM1*DPP
  571. C
  572. ELSEIF(IJAC.EQ.2)THEN
  573. RR.AM(IFAC,1,1)=DRORO
  574. RUX.AM(IFAC,1,1)=DROUX
  575. RUY.AM(IFAC,1,1)=DROUY
  576. RUZ.AM(IFAC,1,1)=DROUZ
  577. RRET.AM(IFAC,1,1)=DROP
  578. C
  579. UXR.AM(IFAC,1,1)=DUXRO
  580. UXUX.AM(IFAC,1,1)=DUXUX
  581. UXUY.AM(IFAC,1,1)=DUXUY
  582. UXUZ.AM(IFAC,1,1)=DUXUZ
  583. UXRET.AM(IFAC,1,1)=DUXP
  584. C
  585. UYR.AM(IFAC,1,1)=DUYRO
  586. UYUX.AM(IFAC,1,1)=DUYUX
  587. UYUY.AM(IFAC,1,1)=DUYUY
  588. UYUZ.AM(IFAC,1,1)=DUYUZ
  589. UYRET.AM(IFAC,1,1)=DUYP
  590. C
  591. UZR.AM(IFAC,1,1)=DUZRO
  592. UZUX.AM(IFAC,1,1)=DUZUX
  593. UZUY.AM(IFAC,1,1)=DUZUY
  594. UZUZ.AM(IFAC,1,1)=DUZUZ
  595. UZRET.AM(IFAC,1,1)=DUZP
  596. C
  597. RETR.AM(IFAC,1,1)=DPRO
  598. RETUX.AM(IFAC,1,1)=DPUX
  599. RETUY.AM(IFAC,1,1)=DPUY
  600. RETUZ.AM(IFAC,1,1)=DPUZ
  601. RETRET.AM(IFAC,1,1)=DPP
  602. ENDIF
  603. ENDDO
  604. C
  605. SEGDES MELEFC
  606. C
  607. SEGSUP MLEMC
  608. SEGSUP MLEMCB
  609. SEGSUP MLEMF
  610. C
  611. SEGDES MPNORM
  612. SEGDES MPVOL
  613. SEGDES MPSURF
  614. SEGDES MPRC
  615. SEGDES MPPC
  616. SEGDES MPVC
  617. SEGDES MPGAMC
  618. SEGDES MPLIM
  619. C
  620. SEGDES RR , RUX , RUY , RUZ ,RRET ,
  621. & UXR , UXUX , UXUY , UXUZ ,UXRET ,
  622. & UYR , UYUX , UYUY , UYUZ , UYRET ,
  623. & UZR , UZUX , UZUY , UZUZ , UZRET ,
  624. & RETR , RETUX , RETUY, RETUZ , RETRET
  625. C
  626. 9999 CONTINUE
  627. RETURN
  628. END
  629.  
  630.  
  631.  
  632.  
  633.  
  634.  
  635.  
  636.  
  637.  
  638.  
  639.  
  640.  
  641.  

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