Télécharger kbmms2.eso

Retour à la liste

Numérotation des lignes :

  1. C KBMMS2 SOURCE PV 16/11/17 21:59:44 9180
  2. SUBROUTINE KBMMS2(NSP,ILIINC,IRN,IUN,IPN,IYN,MLRECP,
  3. & MLRECV,INORM,ICHPVO,ICHPSU,IUINF,IUPRI,
  4. & MELEMC,MELEFE,MELLIM,IMAT)
  5. C
  6. C************************************************************************
  7. C
  8. C PROJET : CASTEM 2000
  9. C
  10. C NOM : KONMSP ("convection for multispecies")
  11. C
  12. C DESCRIPTION : Voir KON19 (appele par KON19)
  13. C Calcul du jacobien du résidu pour la méthode
  14. C AUSMplus
  15. C
  16. C Cas deux dimensions, gaz "calorically perfect"
  17. C MULTISPECIES!!!!!!!!
  18. C
  19. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  20. C
  21. C AUTEUR : S. KUDRIAKOV, DM2S/SFME/LTMF
  22. C
  23. C************************************************************************
  24. C
  25. C
  26. C APPELES (Outils
  27. C CASTEM) : KRIPAD, LICHT, ERREUR
  28. C
  29. C APPELES (Calcul) : CONMSP, CWMSP
  30. C
  31. C************************************************************************
  32. C
  33. C ENTREES
  34. C
  35. C NSP : number of species (total) ;
  36. C
  37. C ILINC : liste des inconnues (pointeur d'un objet de type LISTMOTS)
  38. C
  39. C 1) Pointeurs des CHPOINT
  40. C
  41. C IRN : CHPOINT CENTRE contenant la masse volumique ;
  42. C
  43. C IUN : CHPOINT CENTRE contenant la vitesse ;
  44. C
  45. C IPN : CHPOINT CENTRE contenant la pression ;
  46. C
  47. C IYN : CHPOINT CENTRE contenant les fractions massiques ;
  48. C
  49. C INORM : CHPOINT FACE contenant les normales aux faces ;
  50. C
  51. C ICHPOVO : CHPOINT VOLUME contenant le volume
  52. C
  53. C ICHPOSU : CHPOINT FACE contenant la surface des faces
  54. C
  55. C
  56. C 2) Pointeurs des LIST REELS
  57. C
  58. C MLRECP : LIST REELS contenant les CP's des gases differents ;
  59. C
  60. C MLRECV : LIST REELS contenant les CV's des gases differents ;
  61. C
  62. C 3) Pointeurs de MELEME de la table DOMAINE
  63. C
  64. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  65. C
  66. C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts
  67. C
  68. C MELLIM : MELEME SPG des conditions aux bords
  69. C N.B.: Sur le bord on ne calcule rien!
  70. C
  71. C SORTIES
  72. C
  73. C IMAT : pointeur de la MATRIK du jacobien du residu
  74. C
  75. C************************************************************************
  76. C
  77. C HISTORIQUE (Anomalies et modifications éventuelles)
  78. C
  79. C HISTORIQUE :
  80. C
  81. C************************************************************************
  82. C
  83. C
  84. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  85. C GAMMA \in (1,3)
  86. C Si non il faut le faire!!!
  87. C
  88. C************************************************************************
  89. C
  90. C
  91. IMPLICIT INTEGER(I-N)
  92. IMPLICIT REAL*8(A-H,O-Z)
  93.  
  94. C---------------------------------------------------
  95. INTEGER NSP,II,JJ,KV,I,J,JLL,JRR
  96. INTEGER ILIINC, IRN,IUN,IPN,IYN,INORM,ICHPVO,ICHPSU
  97. & , IMAT, IGEOMC, IGEOMF, IUPRI, IUINF
  98. & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  99. & , NKMT, NBME, NBEL, MP, NP
  100. & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL
  101. REAL*8 ROG, PG, UXG, UYG, VOLG
  102. & , ROD, PD, UXD, UYD, VOLD
  103. & , SURF, FUNCEL, UPR_L, UPR_R, UPR_M, V_INF
  104. REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2)
  105. REAL*8 ZC1, ZC2, ZC3, ZC4
  106. CHARACTER*8 TYPE
  107. C
  108. C**** LES INCLUDES
  109. C
  110.  
  111. -INC PPARAM
  112. -INC CCOPTIO
  113. -INC SMCHPOI
  114. -INC SMELEME
  115. -INC SMLMOTS
  116. -INC SMLENTI
  117. POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPYN.MPOVAL,
  118. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  119. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  120. & MELEDU.MELEME, MELLIM.MELEME
  121. POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  122. POINTEUR CELL.IZAFM
  123. POINTEUR MLMINC.MLMOTS, MPUPRI.MPOVAL, MPUINF.MPOVAL
  124. C----------------------------------------------------
  125. -INC SMLREEL
  126. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  127. C-------------------------------------------------------
  128. C********* Les Jacobians ******************************
  129. C-------------------------------------------------------
  130. SEGMENT JACEL
  131. REAL*8 JAC(3+NSP,3+NSP)
  132. ENDSEGMENT
  133. POINTEUR JTL.JACEL, JTR.JACEL, JTT.JACEL
  134. C--------------------------------------------------------
  135. C KRIPAD pour la correspondance global/local des centres
  136. C--------------------------------------------------------
  137. CALL KRIPAD(MELLIM,MLELIM)
  138. CALL KRIPAD(MELEMC,MLENTC)
  139. C------------------
  140. SEGACT MELEMC
  141. C------------------
  142. SEGACT MELEFE
  143. C------------------
  144. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  145. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  146. CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  147. C----------------------------------------------
  148. MELEMF = IGEOMF
  149. CALL KRIPAD(MELEMF,MLENTF)
  150. SEGACT MELEMF
  151. C-----------------------------------------------
  152. CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  153. CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  154. CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  155. CALL LICHT(IYN,MPYN,TYPE,IGEOMC)
  156. C-----------------------------------------------
  157. NFAC = MELEFE.NUM(/2)
  158. C-----------------------------------------------
  159. C**** Maillage des inconnues primales
  160. C-----------------------------------------------
  161. NBSOUS = 0
  162. NBREF = 0
  163. NBELEM = NFAC
  164. NBNN = 2
  165. C-----------------------------------------------
  166. SEGINI MELEDU
  167. C----------------------
  168. C** MELEDU = 'SEG2' **
  169. C----------------------
  170. MELEDU.ITYPEL = 2
  171. C--------------
  172. NRIGE = 7
  173. NMATRI = 1
  174. NKID = 9
  175. NKMT = 7
  176. C--------------
  177. SEGINI MATRIK
  178. IMAT = MATRIK
  179. MATRIK.IRIGEL(1,1) = MELEDU
  180. MATRIK.IRIGEL(2,1) = MELEDU
  181. C-------------------------
  182. C Matrice non symetrique
  183. C-------------------------
  184. MATRIK.IRIGEL(7,1) = 2
  185. C-------------------------
  186. NBME = (3+NSP)*(3+NSP)
  187. NBSOUS = 1
  188. SEGINI IMATRI
  189. MLMINC = ILIINC
  190. SEGACT MLMINC
  191. MATRIK.IRIGEL(4,1) = IMATRI
  192. C-----------------------------------------------
  193. DO 1 J=1,(NSP+3)
  194. KV=(J-1)*(3+NSP)
  195. IMATRI.LISPRI(KV+1) = MLMINC.MOTS(1)
  196. IMATRI.LISPRI(KV+2) = MLMINC.MOTS(2)
  197. IMATRI.LISPRI(KV+3) = MLMINC.MOTS(3)
  198. IMATRI.LISPRI(KV+4) = MLMINC.MOTS(4)
  199. DO 2 I=1,(NSP-1)
  200. IMATRI.LISPRI(KV+4+I) = MLMINC.MOTS(4+I)
  201. 2 CONTINUE
  202. 1 CONTINUE
  203. C-----------------------------------------------
  204. DO 3 J=1,(NSP+3)
  205. KV=(J-1)*(3+NSP)
  206. IMATRI.LISDUA(KV+1) = MLMINC.MOTS(j)
  207. IMATRI.LISDUA(KV+2) = MLMINC.MOTS(j)
  208. IMATRI.LISDUA(KV+3) = MLMINC.MOTS(j)
  209. IMATRI.LISDUA(KV+4) = MLMINC.MOTS(j)
  210. DO 4 I=1,(NSP-1)
  211. IMATRI.LISDUA(KV+4+I) = MLMINC.MOTS(j)
  212. 4 CONTINUE
  213. 3 CONTINUE
  214. C-----------------------------------------------
  215. C-----------------------------------------------
  216. NBEL = NBELEM
  217. NBSOUS = 1
  218. NP = 2
  219. MP = 2
  220. C-----------------------------------------------------------
  221. C-----------------------------------------------------------
  222. DO 5 I=1,NBME
  223. SEGINI CELL
  224. IMATRI.LIZAFM(1,I) = CELL
  225. 5 CONTINUE
  226. C**************************************************************
  227. C Bas Mach
  228. C**************************************************************
  229. CALL LICHT(IUPRI,MPUPRI,TYPE,IGEOMC)
  230. CALL LICHT(IUINF,MPUINF,TYPE,IGEOMC)
  231. C---------------------------------
  232. DO IFAC = 1, NFAC, 1
  233. NGCF = MELEFE.NUM(2,IFAC)
  234. NLCF = MLENTF.LECT(NGCF)
  235. IF(NLCF .NE. IFAC)THEN
  236. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  237. CALL ERREUR(5)
  238. GOTO 9999
  239. ENDIF
  240. NLFL = MLELIM.LECT(NGCF)
  241. NGCG = MELEFE.NUM(1,IFAC)
  242. NGCD = MELEFE.NUM(3,IFAC)
  243. IF(NLFL .NE. 0)THEN
  244. C---------------------------------------------------------
  245. C The point belongs to BC -> No contribution to jacobian!
  246. C---------------------------------------------------------
  247. MELEDU.NUM(1,IFAC) = NGCG
  248. MELEDU.NUM(2,IFAC) = NGCD
  249. ELSEIF(NGCG .NE. NGCD)THEN
  250. C-----------------------------------
  251. C********** Les MELEMEs
  252. C-----------------------------------
  253. MELEDU.NUM(1,IFAC) = NGCG
  254. MELEDU.NUM(2,IFAC) = NGCD
  255. C-----------------------------------
  256. C********** Les etats G et D
  257. C-----------------------------------
  258. NLCG = MLENTC.LECT(NGCG)
  259. NLCD = MLENTC.LECT(NGCD)
  260. C-----------------
  261. ROG = MPRN.VPOCHA(NLCG,1)
  262. PG = MPPN.VPOCHA(NLCG,1)
  263. UXG = MPUN.VPOCHA(NLCG,1)
  264. UYG = MPUN.VPOCHA(NLCG,2)
  265. VOLG = MPVOLU.VPOCHA(NLCG,1)
  266. C-------------------------------------------------
  267. WVEC_L(1)=ROG
  268. WVEC_L(2)=UXG
  269. WVEC_L(3)=UYG
  270. WVEC_L(4)=PG
  271. C-------------------------------------------------
  272. ROD = MPRN.VPOCHA(NLCD,1)
  273. PD = MPPN.VPOCHA(NLCD,1)
  274. UXD = MPUN.VPOCHA(NLCD,1)
  275. UYD = MPUN.VPOCHA(NLCD,2)
  276. VOLD = MPVOLU.VPOCHA(NLCD,1)
  277. C------------------------------------------------
  278. UPR_L=MPUPRI.VPOCHA(NLCG,1)
  279. UPR_R=MPUPRI.VPOCHA(NLCD,1)
  280. UPR_M=MAX(UPR_L,UPR_R)
  281. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),MPUINF.VPOCHA(NLCD,1))
  282. V_INF=MAX(UPR_M,V_INF)
  283. C------------------------------------------------
  284. WVEC_R(1)=ROD
  285. WVEC_R(2)=UXD
  286. WVEC_R(3)=UYD
  287. WVEC_R(4)=PD
  288. C------------------------------------------------
  289. C La normale G->D
  290. C La tangente
  291. C------------------------------------------------
  292. SURF = MPOVSU.VPOCHA(NLCF,1)
  293. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  294. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  295. TVECT(1) = -1.0D0 * NVECT(2)
  296. TVECT(2) = NVECT(1)
  297. C-------------------------------------------------
  298. CALL jbmms2(NSP,JLL,JRR,WVEC_L,WVEC_R,NVECT,TVECT,
  299. & MPYN,MLRECP,MLRECV,NLCG,NLCD,V_INF)
  300. C-----------------------------------------------------
  301. C********** AB.AM(IFAC,IPRIM,IDUAL)
  302. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  303. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  304. C IPRIM = 1, 2 -> G, D
  305. C IDUAL = 1, 2 -> G, D
  306. C i.e.
  307. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  308. C
  309. C
  310. C********** Dual RN
  311. C----------------------------------------------------
  312. JTL=JLL
  313. JTR=JRR
  314. SEGACT JTL
  315. SEGACT JTR
  316. DO 10 II = 1,(3+NSP)
  317. DO 15 JJ = 1,(3+NSP)
  318. KV = (II-1)*(3+NSP)
  319. C----------------------------------
  320. CELL = IMATRI.LIZAFM(1,KV+JJ)
  321. FUNCEL = SURF * JTL.JAC(II,JJ)
  322. CELL.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  323. CELL.AM(IFAC,1,2) = FUNCEL / VOLD
  324. 15 CONTINUE
  325. 10 CONTINUE
  326. C-----------------------------------------------------
  327. DO 20 II = 1,(3+NSP)
  328. DO 25 JJ = 1,(3+NSP)
  329. KV = (II-1)*(3+NSP)
  330. CELL = IMATRI.LIZAFM(1,KV+JJ)
  331. FUNCEL = SURF * JTR.JAC(II,JJ)
  332. CELL.AM(IFAC,2,2) = FUNCEL / VOLD
  333. CELL.AM(IFAC,2,1) = -FUNCEL / VOLG
  334. 25 CONTINUE
  335. 20 CONTINUE
  336. SEGDES JTR
  337. SEGDES JTL
  338. C-----------------------------------------------------
  339. ELSE
  340. C-----------------------------------------------------
  341. C************* Murs (NGCG = NGCD) ******************
  342. C-----------------------------------------------------
  343. MELEDU.NUM(1,IFAC) = NGCG
  344. MELEDU.NUM(2,IFAC) = NGCD
  345. NLCG = MLENTC.LECT(NGCG)
  346. C--------------------------------------
  347. ROG = MPRN.VPOCHA(NLCG,1)
  348. PG = MPPN.VPOCHA(NLCG,1)
  349. UXG = MPUN.VPOCHA(NLCG,1)
  350. UYG = MPUN.VPOCHA(NLCG,2)
  351. VOLG = MPVOLU.VPOCHA(NLCG,1)
  352. C-------------------------------------------
  353. WVEC_L(1)=ROG
  354. WVEC_L(2)=UXG
  355. WVEC_L(3)=UYG
  356. WVEC_L(4)=PG
  357. C-------------------------------------------------
  358. SURF = MPOVSU.VPOCHA(NLCF,1)
  359. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  360. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  361. TVECT(1) =-NVECT(2)
  362. TVECT(2) = NVECT(1)
  363. C------- COEFFICIENTS ----------------------------
  364. ZC1=NVECT(1)*TVECT(2)+TVECT(1)*NVECT(2)
  365. ZC2=NVECT(1)*TVECT(2)-TVECT(1)*NVECT(2)
  366. ZC3=2.0D0*NVECT(1)*TVECT(1)
  367. ZC4=2.0D0*NVECT(2)*TVECT(2)
  368. C-------------------------------------------------
  369. ROD = ROG
  370. PD = PG
  371. UXD = -ZC1*UXG/ZC2-ZC4*UYG/ZC2
  372. UYD = ZC3*UXG/ZC2+ZC1*UYG/ZC2
  373. VOLD = VOLG
  374. C------------------------------------------------
  375. UPR_L=MPUPRI.VPOCHA(NLCG,1)
  376. UPR_R=UPR_L
  377. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),UPR_L)
  378. C------------------------------------------------
  379. WVEC_R(1)=ROD
  380. WVEC_R(2)=UXD
  381. WVEC_R(3)=UYD
  382. WVEC_R(4)=PD
  383. C-------------------------------------------
  384. C********** La normale sortante
  385. C-------------------------------------------
  386. CALL jbmmw2(NSP,JLL,WVEC_L,WVEC_R,NVECT,
  387. & TVECT,MPYN,MLRECP,MLRECV,NLCG,V_INF)
  388. C----------------------------------------------------
  389. JTL=JLL
  390. SEGACT JTL
  391. DO 70 II = 1,(3+NSP)
  392. DO 75 JJ = 1,(3+NSP)
  393. KV = (II-1)*(3+NSP)
  394. C---------------------------------
  395. CELL = IMATRI.LIZAFM(1,KV+JJ)
  396. FUNCEL = SURF * JTL.JAC(II,JJ)
  397. CELL.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  398. CELL.AM(IFAC,1,2) = 0.0D0
  399. 75 CONTINUE
  400. 70 CONTINUE
  401. SEGDES JTL
  402. C--------------------------------------------
  403. DO 40 II = 1,(3+NSP)
  404. DO 45 JJ = 1,(3+NSP)
  405. KV = (II-1)*(3+NSP)
  406. CELL = IMATRI.LIZAFM(1,KV+JJ)
  407. CELL.AM(IFAC,2,2) = 0.0D0
  408. CELL.AM(IFAC,2,1) = 0.0D0
  409. 45 CONTINUE
  410. 40 CONTINUE
  411. C--------------------------------------------
  412. ENDIF
  413. ENDDO
  414. C
  415. SEGDES MELEMC
  416. SEGDES MELEFE
  417. SEGDES MELEMF
  418. C
  419. SEGDES MPOVSU
  420. SEGDES MPVOLU
  421. SEGDES MPNORM
  422. C
  423. SEGDES MPRN
  424. SEGDES MPPN
  425. SEGDES MPUN
  426. SEGDES MPYN
  427. C
  428. SEGDES MELEDU
  429. SEGDES MATRIK
  430. DO 80 II=1,NBME
  431. CELL = IMATRI.LIZAFM(1,II)
  432. SEGDES CELL
  433. 80 CONTINUE
  434. SEGDES IMATRI
  435. C
  436. SEGSUP MLENTC
  437. SEGSUP MLENTF
  438. SEGSUP MLELIM
  439. SEGDES MLMINC
  440. C
  441. SEGDES MPUPRI
  442. SEGDES MPUINF
  443. IF(MELLIM .NE.0) SEGDES MELLIM
  444.  
  445. 9999 CONTINUE
  446. RETURN
  447. END
  448.  
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  

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