Télécharger cli272.eso

Retour à la liste

Numérotation des lignes :

  1. C CLI272 SOURCE PV 16/11/17 21:58:47 9180
  2. SUBROUTINE CLI272(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  3. & ICHPVO,ICHPSU,LRECP,LRECV,
  4. & IROC,IVITC,IPC,IYC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : CLI112
  10. C
  11. C DESCRIPTION : Subroutine appellée par CLIM22
  12. C OPTION: 'INJE' -- Jacobian
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15. C
  16. C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C APPELES (Calcul) :
  21. C
  22. C************************************************************************
  23. C
  24. C HISTORIQUE (Anomalies et modifications éventuelles)
  25. C
  26. C HISTORIQUE :
  27. C
  28. C************************************************************************
  29. C
  30. C----------------------------------------------------
  31. C**** Variables de COOPTIO
  32. C----------------------------------------------------
  33. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  34. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  35. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  36. C & ,IECHO, IIMPI, IOSPI
  37. C & ,IDIM, IFICLE, IPREFI
  38. C & ,MCOORD
  39. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  40. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  41. C & ,NORINC,NORVAL,NORIND,NORVAD
  42. C & ,NUCROU, IPSAUV
  43. C
  44. IMPLICIT INTEGER(I-N)
  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,II,JJ,K
  49. & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  50. & ,NSP,I, IYC,J, LRECP,LRECV,KV
  51. REAL*8 VOLU,SURF,RC,PC,UXC,UYC,GAMC,CNX,CNY
  52. & ,PSRF,RHOUF,DECIDP,DUNDPC,DUXDPC,DUYDPC
  53. & ,UN,RHO,P,COEF
  54. & ,BR1,BOT,TOP
  55.  
  56. CHARACTER*(8) TYPE
  57. -INC CCOPTIO
  58. -INC SMLMOTS
  59. -INC SMELEME
  60. POINTEUR MELEFC.MELEME
  61. -INC SMLENTI
  62. POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  63. -INC SMCHPOI
  64. POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  65. & MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL
  66. POINTEUR CELL.IZAFM
  67. C-------------------------------------------------------
  68. -INC SMLREEL
  69. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  70. C-------------------------------------------------------
  71. C********* Les Jacobians ******************************
  72. C-------------------------------------------------------
  73. SEGMENT JACEL
  74. REAL*8 JAC(3+NSP,3+NSP)
  75. ENDSEGMENT
  76. POINTEUR JTL.JACEL, WL.JACEL, JTT.JACEL
  77. C-------------------------------------------------------------
  78. C******* Les fractionines massiques **************************
  79. C-------------------------------------------------------------
  80. SEGMENT FRAMAS
  81. REAL*8 YET(NSP)
  82. ENDSEGMENT
  83. POINTEUR YC.FRAMAS, YF.FRAMAS
  84. C-------------------------------------------------------
  85. C********** Les CP's and CV's ***********************
  86. C-------------------------------------------------------
  87. SEGMENT GCONST
  88. REAL*8 GC(NSP)
  89. ENDSEGMENT
  90. POINTEUR CP.GCONST, CV.GCONST
  91. C-------------------------------------------------------------
  92. C********** Segments for the vectors ***********************
  93. C-------------------------------------------------------------
  94. SEGMENT VECEL
  95. REAL*8 VV(NSP)
  96. ENDSEGMENT
  97. POINTEUR DGDYC.VECEL
  98. C--------------------------------------------------
  99. SEGINI JTL
  100. SEGINI JTT
  101. SEGINI WL
  102. C----------------------------------------------------
  103. C**** KRIPAD pour la correspondance global/local
  104. C----------------------------------------------------
  105. CALL KRIPAD(MELEMC,MLEMC)
  106. CALL KRIPAD(MELECB,MLEMCB)
  107. CALL KRIPAD(MELEMF,MLEMF)
  108. C----------------------------------------------------
  109. C**** CHPOINTs de la table DOMAINE
  110. C----------------------------------------------------
  111. CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  112. CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  113. CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  114. C----------------------------------------------------
  115. C**** CHPOINTs des variables
  116. C----------------------------------------------------
  117. CALL LICHT(IROC,MPRC,TYPE,ICEL)
  118. CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  119. CALL LICHT(IPC,MPPC,TYPE,ICEL)
  120. CALL LICHT(IYC,MPYC,TYPE,ICEL)
  121. CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  122. C--------------------------------------------------------
  123. C**** Boucle sur le face pour le calcul des invariants de
  124. C Riemann et du flux
  125. C--------------------------------------------------------
  126. SEGACT MELEFC
  127. NFAC=MELEFC.NUM(/2)
  128. C---------------------------------
  129. C**** Objet MATRIK
  130. C---------------------------------
  131. NRIGE = 7
  132. NMATRI = 1
  133. NKID = 9
  134. NKMT = 7
  135. C---------------------------------
  136. SEGINI MATRIK
  137. IJACO = MATRIK
  138. MATRIK.IRIGEL(1,1) = MELRES
  139. MATRIK.IRIGEL(2,1) = MELRES
  140. C---------------------------------
  141. C**** Matrice non symetrique
  142. C---------------------------------
  143. MATRIK.IRIGEL(7,1) = 2
  144. C---------------------------------
  145. NBME = (3+NSP)*(3+NSP)
  146. NBSOUS = 1
  147. SEGINI IMATRI
  148. IF(IJAC.EQ.1)THEN
  149. MLMOTS=ILIINC
  150. ELSEIF(IJAC.EQ.2)THEN
  151. MLMOTS=ILIINP
  152. ENDIF
  153. SEGACT MLMOTS
  154. MATRIK.IRIGEL(4,1) = IMATRI
  155. C-------------------------------------------
  156. DO 1 J=1,(NSP+3)
  157. KV=(J-1)*(3+NSP)
  158. IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1)
  159. IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2)
  160. IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3)
  161. IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4)
  162. DO 2 I=1,(NSP-1)
  163. IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I)
  164. 2 CONTINUE
  165. 1 CONTINUE
  166. C-----------------------------------------------
  167. SEGDES MLMOTS
  168. MLMOTS=ILIINC
  169. SEGACT MLMOTS
  170. C-----------------------------------------------
  171. DO 3 J=1,(NSP+3)
  172. KV=(J-1)*(3+NSP)
  173. IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j)
  174. IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j)
  175. IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j)
  176. IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j)
  177. DO 4 I=1,(NSP-1)
  178. IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j)
  179. 4 CONTINUE
  180. 3 CONTINUE
  181. C-----------------------------------------------
  182. C-----------------------------------------------
  183. SEGDES MLMOTS
  184. NBEL = NFAC
  185. NBSOUS = 1
  186. NP = 1
  187. MP = 1
  188. C-----------------------------------------------------------
  189. C-----------------------------------------------------------
  190. DO 5 I=1,NBME
  191. SEGINI CELL
  192. IMATRI.LIZAFM(1,I) = CELL
  193. 5 CONTINUE
  194. C---------------------------------
  195. C---------------------------------
  196. C**** Fin definition MATRIK
  197. C---------------------------------
  198. DO IFAC=1,NFAC,1
  199. NGF=MELEFC.NUM(1,IFAC)
  200. NGC=MELEFC.NUM(2,IFAC)
  201. NLF=MLEMF.LECT(NGF)
  202. NLC=MLEMC.LECT(NGC)
  203. NLCB=MLEMCB.LECT(NGF)
  204. VOLU=MPVOL.VPOCHA(NLC,1)
  205. SURF=MPSURF.VPOCHA(NLF,1)
  206. C In CASTEM les normales sont sortantes
  207. CNX=-1*MPNORM.VPOCHA(NLF,1)
  208. CNY=-1*MPNORM.VPOCHA(NLF,2)
  209. C----------------------------------------------
  210. SEGINI CP, CV
  211. MLRECP = LRECP
  212. MLRECV = LRECV
  213. SEGACT MLRECP, MLRECV
  214. DO 10 I=1,(NSP-1)
  215. CP.GC(I)=MLRECP.PROG(I)
  216. CV.GC(I)=MLRECV.PROG(I)
  217. 10 CONTINUE
  218. CP.GC(NSP)=MLRECP.PROG(NSP)
  219. CV.GC(NSP)=MLRECV.PROG(NSP)
  220. C---------------------------------
  221. C Variables au centre
  222. C---------------------------------
  223. RC=MPRC.VPOCHA(NLC,1)
  224. PC=MPPC.VPOCHA(NLC,1)
  225. UXC=MPVC.VPOCHA(NLC,1)
  226. UYC=MPVC.VPOCHA(NLC,2)
  227. SEGINI YC
  228. SEGACT MPYC
  229. DO 100 I=1,(NSP-1)
  230. YC.YET(I)=MPYC.VPOCHA(NLC,I)
  231. 100 CONTINUE
  232. C---------------------------------
  233. C Variables à la face
  234. C---------------------------------
  235. RHOUF=MPLIM.VPOCHA(NLCB,1)
  236. PSRF=MPLIM.VPOCHA(NLCB,2)
  237. SEGINI YF
  238. SEGACT MPLIM
  239. DO 101 I=1,(NSP-1)
  240. YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I)
  241. 101 CONTINUE
  242. c-------------------------------------------------------------
  243. c Computing GAMMA at the cell-center
  244. c-------------------------------------------------------------
  245. top=0.0D0
  246. bot=0.0D0
  247. do 102 i=1,(nsp-1)
  248. top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  249. bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  250. 102 continue
  251. top=cp.gc(nsp)+top
  252. bot=cv.gc(nsp)+bot
  253. GAMC=top/bot
  254. C-------------------------------------------------------------
  255. SEGINI DGDYC
  256. do 41 i=1,(nsp-1)
  257. dgdyc.vv(i)=(cp.gc(i)-cp.gc(nsp)-
  258. & GAMC*(cv.gc(i)-cv.gc(nsp)))/bot
  259. 41 continue
  260. c-------------------------------------------------------------
  261. C------------------------------------------------
  262. C******* Densite, vitesse, pression sur le bord
  263. C------------------------------------------------
  264. P=PC
  265. RHO=P/PSRF
  266. UN=RHOUF/RHO
  267. C------------------------------
  268. C******* Derivatives w.r.t. PC
  269. C------------------------------
  270. DUNDPC=-1*RHOUF/(RHO*RHO*PSRF)
  271. DUXDPC=CNX*DUNDPC
  272. DUYDPC=CNY*DUNDPC
  273. DECIDP=UN*DUNDPC
  274. C--------------------------------------------------------------
  275. COEF=SURF/VOLU
  276. C-------------------------------------------------------------
  277. JTL.JAC(1,1) = 0.0D0
  278. JTL.JAC(1,2) = 0.0D0
  279. JTL.JAC(1,3) = 0.0D0
  280. JTL.JAC(1,4) = 0.0D0
  281. DO 107 I=1,(NSP-1)
  282. JTL.JAC(1,4+I) = 0.0D0
  283. 107 CONTINUE
  284. C----------------------------------------
  285. JTL.JAC(2,1) = 0.0D0
  286. JTL.JAC(2,2) = 0.0D0
  287. JTL.JAC(2,3) = 0.0D0
  288. JTL.JAC(2,4) = (RHOUF*DUXDPC+CNX)*COEF
  289. DO 108 I=1,(NSP-1)
  290. JTL.JAC(2,4+I) = 0.0D0
  291. 108 CONTINUE
  292. C----------------------------------------
  293. JTL.JAC(3,1) = 0.0D0
  294. JTL.JAC(3,2) = 0.0D0
  295. JTL.JAC(3,3) = 0.0D0
  296. JTL.JAC(3,4) = (RHOUF*DUYDPC+CNY)*COEF
  297. DO 109 I=1,(NSP-1)
  298. JTL.JAC(3,4+I) = 0.0D0
  299. 109 CONTINUE
  300. C----------------------------------------
  301. JTL.JAC(4,1) = 0.0D0
  302. JTL.JAC(4,2) = 0.0D0
  303. JTL.JAC(4,3) = 0.0D0
  304. JTL.JAC(4,4) = (RHOUF*DECIDP)*COEF
  305. DO 110 I=1,(NSP-1)
  306. JTL.JAC(4,4+I) = 0.0D0
  307. 110 CONTINUE
  308. C----------------------------------------
  309. DO 111 I=1,(NSP-1)
  310. JTL.JAC(4+I,1) = 0.0D0
  311. JTL.JAC(4+I,2) = 0.0D0
  312. JTL.JAC(4+I,3) = 0.0D0
  313. JTL.JAC(4+I,4) = 0.0D0
  314. DO 112 J=1,(NSP-1)
  315. JTL.JAC(4+I,4+J) = 0.0D0
  316. 112 CONTINUE
  317. 111 CONTINUE
  318. C---------------------------------------------------------
  319. c matrix wl(i,j) represents the derivative of the i-component
  320. c of the vector of primitive variables of the left state with
  321. c respect to the j-component of the vector of the conservative
  322. c variables of the left state.
  323. c
  324. c Here: (rho, ux, uy, p, Y_1,...,Y_(nsp-1)) -
  325. c vector of primitive variables;
  326. c (rho, rho ux, rho uy, rho e, rho Y_1,..., rho Y_(nsp-1)) -
  327. c vector of conservative variables.
  328. c-------------------------------------------------------------
  329. wl.jac(1,1)=1.0d0
  330. wl.jac(1,2)=0.0d0
  331. wl.jac(1,3)=0.0d0
  332. wl.jac(1,4)=0.0d0
  333. do 83 i=1,(nsp-1)
  334. wl.jac(1,4+i)=0.0d0
  335. 83 continue
  336. c------------------------------
  337. wl.jac(2,1)=-UXC/RC
  338. wl.jac(2,2)=1.0d0/RC
  339. wl.jac(2,3)=0.0d0
  340. wl.jac(2,4)=0.0d0
  341. do 84 i=1,(nsp-1)
  342. wl.jac(2,4+i)=0.0d0
  343. 84 continue
  344. c------------------------------
  345. wl.jac(3,1)=-UYC/RC
  346. wl.jac(3,2)=0.0d0
  347. wl.jac(3,3)=1.0d0/RC
  348. wl.jac(3,4)=0.0d0
  349. do 85 i=1,(nsp-1)
  350. wl.jac(3,4+i)=0.0d0
  351. 85 continue
  352. c------------------------------
  353. br1=0.0d0
  354. do 86 i=1,(nsp-1)
  355. br1=br1+dgdyc.vv(i)*yc.yet(i)
  356. 86 continue
  357. br1=br1*PC/(RC*(GAMC-1.0D0))
  358. wl.jac(4,1)=(GAMC-1.0D0)*(UXC*UXC+UYC*UYC)/2.0d0-br1
  359. wl.jac(4,2)=-UXC*(GAMC-1.0D0)
  360. wl.jac(4,3)=-UYC*(GAMC-1.0D0)
  361. wl.jac(4,4)=(GAMC-1.0D0)
  362. do 87 i=1,(nsp-1)
  363. wl.jac(4,4+i)=dgdyc.vv(i)*PC/(RC*(GAMC-1.0D0))
  364. 87 continue
  365. c------------------------------
  366. do 88 i=1,(nsp-1)
  367. do 89 j=1,4
  368. wl.jac(4+i,j)=0.0d0
  369. if(j.eq.1) wl.jac(4+i,j)=-yc.yet(i)/RC
  370. 89 continue
  371. c------------
  372. do 890 j=5,(4+nsp-1)
  373. wl.jac(4+i,j)=0.0d0
  374. if(4+i.eq.j) then
  375. wl.jac(4+i,j)=1.0d0/RC
  376. endif
  377. 890 continue
  378. 88 continue
  379. c------------------------------------------------
  380. C------------------------------------------------
  381. do 114 i=1,(3+nsp)
  382. do 115 j=1,(3+nsp)
  383. jtt.jac(i,j)=0.0d0
  384. do 116 k=1,(3+nsp)
  385. jtt.jac(i,j)=jtt.jac(i,j)+jtl.jac(i,k)*wl.jac(k,j)
  386. 116 continue
  387. 115 continue
  388. 114 continue
  389. C----------------------------------------------------------------
  390. C******* Jacobian with respect to conservative variables
  391. C----------------------------------------------------------------
  392. IF(IJAC.EQ.1)THEN
  393. DO 9 II = 1,(3+NSP)
  394. DO 15 JJ = 1,(3+NSP)
  395. KV = (II-1)*(3+NSP)
  396. C----------------------------------
  397. CELL = IMATRI.LIZAFM(1,KV+JJ)
  398. CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)
  399. 15 CONTINUE
  400. 9 CONTINUE
  401. ELSEIF(IJAC.EQ.2)THEN
  402. DO 20 II = 1,(3+NSP)
  403. DO 25 JJ = 1,(3+NSP)
  404. KV = (II-1)*(3+NSP)
  405. C----------------------------------
  406. CELL = IMATRI.LIZAFM(1,KV+JJ)
  407. CELL.AM(IFAC,1,1) = JTL.JAC(II,JJ)
  408. 25 CONTINUE
  409. 20 CONTINUE
  410. ENDIF
  411. c--------------------------------------------------
  412. ENDDO
  413. C
  414. SEGDES MELEFC
  415. C
  416. SEGSUP MLEMC
  417. SEGSUP MLEMCB
  418. SEGSUP MLEMF
  419. C
  420. SEGDES MPNORM
  421. SEGDES MPVOL
  422. SEGDES MPSURF
  423. SEGDES MPRC
  424. SEGDES MPPC
  425. SEGDES MPVC
  426. SEGDES MPYC
  427. SEGDES MPLIM
  428. SEGDES YC
  429. SEGDES YF
  430. SEGDES CP
  431. SEGDES CV
  432. SEGDES JTL
  433. SEGDES JTT
  434. SEGDES WL
  435. SEGDES DGDYC
  436. SEGDES MATRIK
  437. DO 80 II=1,NBME
  438. CELL = IMATRI.LIZAFM(1,II)
  439. SEGDES CELL
  440. 80 CONTINUE
  441. SEGDES IMATRI
  442. C---------------------------------------------
  443. 9999 CONTINUE
  444. RETURN
  445. END
  446.  
  447.  
  448.  
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  

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