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. -INC CCOPTIO
  111. -INC SMCHPOI
  112. -INC SMELEME
  113. -INC SMLMOTS
  114. -INC SMLENTI
  115. POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPYN.MPOVAL,
  116. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  117. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  118. & MELEDU.MELEME, MELLIM.MELEME
  119. POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  120. POINTEUR CELL.IZAFM
  121. POINTEUR MLMINC.MLMOTS, MPUPRI.MPOVAL, MPUINF.MPOVAL
  122. C----------------------------------------------------
  123. -INC SMLREEL
  124. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  125. C-------------------------------------------------------
  126. C********* Les Jacobians ******************************
  127. C-------------------------------------------------------
  128. SEGMENT JACEL
  129. REAL*8 JAC(3+NSP,3+NSP)
  130. ENDSEGMENT
  131. POINTEUR JTL.JACEL, JTR.JACEL, JTT.JACEL
  132. C--------------------------------------------------------
  133. C KRIPAD pour la correspondance global/local des centres
  134. C--------------------------------------------------------
  135. CALL KRIPAD(MELLIM,MLELIM)
  136. CALL KRIPAD(MELEMC,MLENTC)
  137. C------------------
  138. SEGACT MELEMC
  139. C------------------
  140. SEGACT MELEFE
  141. C------------------
  142. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  143. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  144. CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  145. C----------------------------------------------
  146. MELEMF = IGEOMF
  147. CALL KRIPAD(MELEMF,MLENTF)
  148. SEGACT MELEMF
  149. C-----------------------------------------------
  150. CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  151. CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  152. CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  153. CALL LICHT(IYN,MPYN,TYPE,IGEOMC)
  154. C-----------------------------------------------
  155. NFAC = MELEFE.NUM(/2)
  156. C-----------------------------------------------
  157. C**** Maillage des inconnues primales
  158. C-----------------------------------------------
  159. NBSOUS = 0
  160. NBREF = 0
  161. NBELEM = NFAC
  162. NBNN = 2
  163. C-----------------------------------------------
  164. SEGINI MELEDU
  165. C----------------------
  166. C** MELEDU = 'SEG2' **
  167. C----------------------
  168. MELEDU.ITYPEL = 2
  169. C--------------
  170. NRIGE = 7
  171. NMATRI = 1
  172. NKID = 9
  173. NKMT = 7
  174. C--------------
  175. SEGINI MATRIK
  176. IMAT = MATRIK
  177. MATRIK.IRIGEL(1,1) = MELEDU
  178. MATRIK.IRIGEL(2,1) = MELEDU
  179. C-------------------------
  180. C Matrice non symetrique
  181. C-------------------------
  182. MATRIK.IRIGEL(7,1) = 2
  183. C-------------------------
  184. NBME = (3+NSP)*(3+NSP)
  185. NBSOUS = 1
  186. SEGINI IMATRI
  187. MLMINC = ILIINC
  188. SEGACT MLMINC
  189. MATRIK.IRIGEL(4,1) = IMATRI
  190. C-----------------------------------------------
  191. DO 1 J=1,(NSP+3)
  192. KV=(J-1)*(3+NSP)
  193. IMATRI.LISPRI(KV+1) = MLMINC.MOTS(1)
  194. IMATRI.LISPRI(KV+2) = MLMINC.MOTS(2)
  195. IMATRI.LISPRI(KV+3) = MLMINC.MOTS(3)
  196. IMATRI.LISPRI(KV+4) = MLMINC.MOTS(4)
  197. DO 2 I=1,(NSP-1)
  198. IMATRI.LISPRI(KV+4+I) = MLMINC.MOTS(4+I)
  199. 2 CONTINUE
  200. 1 CONTINUE
  201. C-----------------------------------------------
  202. DO 3 J=1,(NSP+3)
  203. KV=(J-1)*(3+NSP)
  204. IMATRI.LISDUA(KV+1) = MLMINC.MOTS(j)
  205. IMATRI.LISDUA(KV+2) = MLMINC.MOTS(j)
  206. IMATRI.LISDUA(KV+3) = MLMINC.MOTS(j)
  207. IMATRI.LISDUA(KV+4) = MLMINC.MOTS(j)
  208. DO 4 I=1,(NSP-1)
  209. IMATRI.LISDUA(KV+4+I) = MLMINC.MOTS(j)
  210. 4 CONTINUE
  211. 3 CONTINUE
  212. C-----------------------------------------------
  213. C-----------------------------------------------
  214. NBEL = NBELEM
  215. NBSOUS = 1
  216. NP = 2
  217. MP = 2
  218. C-----------------------------------------------------------
  219. C-----------------------------------------------------------
  220. DO 5 I=1,NBME
  221. SEGINI CELL
  222. IMATRI.LIZAFM(1,I) = CELL
  223. 5 CONTINUE
  224. C**************************************************************
  225. C Bas Mach
  226. C**************************************************************
  227. CALL LICHT(IUPRI,MPUPRI,TYPE,IGEOMC)
  228. CALL LICHT(IUINF,MPUINF,TYPE,IGEOMC)
  229. C---------------------------------
  230. DO IFAC = 1, NFAC, 1
  231. NGCF = MELEFE.NUM(2,IFAC)
  232. NLCF = MLENTF.LECT(NGCF)
  233. IF(NLCF .NE. IFAC)THEN
  234. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  235. CALL ERREUR(5)
  236. GOTO 9999
  237. ENDIF
  238. NLFL = MLELIM.LECT(NGCF)
  239. NGCG = MELEFE.NUM(1,IFAC)
  240. NGCD = MELEFE.NUM(3,IFAC)
  241. IF(NLFL .NE. 0)THEN
  242. C---------------------------------------------------------
  243. C The point belongs to BC -> No contribution to jacobian!
  244. C---------------------------------------------------------
  245. MELEDU.NUM(1,IFAC) = NGCG
  246. MELEDU.NUM(2,IFAC) = NGCD
  247. ELSEIF(NGCG .NE. NGCD)THEN
  248. C-----------------------------------
  249. C********** Les MELEMEs
  250. C-----------------------------------
  251. MELEDU.NUM(1,IFAC) = NGCG
  252. MELEDU.NUM(2,IFAC) = NGCD
  253. C-----------------------------------
  254. C********** Les etats G et D
  255. C-----------------------------------
  256. NLCG = MLENTC.LECT(NGCG)
  257. NLCD = MLENTC.LECT(NGCD)
  258. C-----------------
  259. ROG = MPRN.VPOCHA(NLCG,1)
  260. PG = MPPN.VPOCHA(NLCG,1)
  261. UXG = MPUN.VPOCHA(NLCG,1)
  262. UYG = MPUN.VPOCHA(NLCG,2)
  263. VOLG = MPVOLU.VPOCHA(NLCG,1)
  264. C-------------------------------------------------
  265. WVEC_L(1)=ROG
  266. WVEC_L(2)=UXG
  267. WVEC_L(3)=UYG
  268. WVEC_L(4)=PG
  269. C-------------------------------------------------
  270. ROD = MPRN.VPOCHA(NLCD,1)
  271. PD = MPPN.VPOCHA(NLCD,1)
  272. UXD = MPUN.VPOCHA(NLCD,1)
  273. UYD = MPUN.VPOCHA(NLCD,2)
  274. VOLD = MPVOLU.VPOCHA(NLCD,1)
  275. C------------------------------------------------
  276. UPR_L=MPUPRI.VPOCHA(NLCG,1)
  277. UPR_R=MPUPRI.VPOCHA(NLCD,1)
  278. UPR_M=MAX(UPR_L,UPR_R)
  279. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),MPUINF.VPOCHA(NLCD,1))
  280. V_INF=MAX(UPR_M,V_INF)
  281. C------------------------------------------------
  282. WVEC_R(1)=ROD
  283. WVEC_R(2)=UXD
  284. WVEC_R(3)=UYD
  285. WVEC_R(4)=PD
  286. C------------------------------------------------
  287. C La normale G->D
  288. C La tangente
  289. C------------------------------------------------
  290. SURF = MPOVSU.VPOCHA(NLCF,1)
  291. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  292. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  293. TVECT(1) = -1.0D0 * NVECT(2)
  294. TVECT(2) = NVECT(1)
  295. C-------------------------------------------------
  296. CALL jbmms2(NSP,JLL,JRR,WVEC_L,WVEC_R,NVECT,TVECT,
  297. & MPYN,MLRECP,MLRECV,NLCG,NLCD,V_INF)
  298. C-----------------------------------------------------
  299. C********** AB.AM(IFAC,IPRIM,IDUAL)
  300. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  301. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  302. C IPRIM = 1, 2 -> G, D
  303. C IDUAL = 1, 2 -> G, D
  304. C i.e.
  305. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  306. C
  307. C
  308. C********** Dual RN
  309. C----------------------------------------------------
  310. JTL=JLL
  311. JTR=JRR
  312. SEGACT JTL
  313. SEGACT JTR
  314. DO 10 II = 1,(3+NSP)
  315. DO 15 JJ = 1,(3+NSP)
  316. KV = (II-1)*(3+NSP)
  317. C----------------------------------
  318. CELL = IMATRI.LIZAFM(1,KV+JJ)
  319. FUNCEL = SURF * JTL.JAC(II,JJ)
  320. CELL.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  321. CELL.AM(IFAC,1,2) = FUNCEL / VOLD
  322. 15 CONTINUE
  323. 10 CONTINUE
  324. C-----------------------------------------------------
  325. DO 20 II = 1,(3+NSP)
  326. DO 25 JJ = 1,(3+NSP)
  327. KV = (II-1)*(3+NSP)
  328. CELL = IMATRI.LIZAFM(1,KV+JJ)
  329. FUNCEL = SURF * JTR.JAC(II,JJ)
  330. CELL.AM(IFAC,2,2) = FUNCEL / VOLD
  331. CELL.AM(IFAC,2,1) = -FUNCEL / VOLG
  332. 25 CONTINUE
  333. 20 CONTINUE
  334. SEGDES JTR
  335. SEGDES JTL
  336. C-----------------------------------------------------
  337. ELSE
  338. C-----------------------------------------------------
  339. C************* Murs (NGCG = NGCD) ******************
  340. C-----------------------------------------------------
  341. MELEDU.NUM(1,IFAC) = NGCG
  342. MELEDU.NUM(2,IFAC) = NGCD
  343. NLCG = MLENTC.LECT(NGCG)
  344. C--------------------------------------
  345. ROG = MPRN.VPOCHA(NLCG,1)
  346. PG = MPPN.VPOCHA(NLCG,1)
  347. UXG = MPUN.VPOCHA(NLCG,1)
  348. UYG = MPUN.VPOCHA(NLCG,2)
  349. VOLG = MPVOLU.VPOCHA(NLCG,1)
  350. C-------------------------------------------
  351. WVEC_L(1)=ROG
  352. WVEC_L(2)=UXG
  353. WVEC_L(3)=UYG
  354. WVEC_L(4)=PG
  355. C-------------------------------------------------
  356. SURF = MPOVSU.VPOCHA(NLCF,1)
  357. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  358. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  359. TVECT(1) =-NVECT(2)
  360. TVECT(2) = NVECT(1)
  361. C------- COEFFICIENTS ----------------------------
  362. ZC1=NVECT(1)*TVECT(2)+TVECT(1)*NVECT(2)
  363. ZC2=NVECT(1)*TVECT(2)-TVECT(1)*NVECT(2)
  364. ZC3=2.0D0*NVECT(1)*TVECT(1)
  365. ZC4=2.0D0*NVECT(2)*TVECT(2)
  366. C-------------------------------------------------
  367. ROD = ROG
  368. PD = PG
  369. UXD = -ZC1*UXG/ZC2-ZC4*UYG/ZC2
  370. UYD = ZC3*UXG/ZC2+ZC1*UYG/ZC2
  371. VOLD = VOLG
  372. C------------------------------------------------
  373. UPR_L=MPUPRI.VPOCHA(NLCG,1)
  374. UPR_R=UPR_L
  375. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),UPR_L)
  376. C------------------------------------------------
  377. WVEC_R(1)=ROD
  378. WVEC_R(2)=UXD
  379. WVEC_R(3)=UYD
  380. WVEC_R(4)=PD
  381. C-------------------------------------------
  382. C********** La normale sortante
  383. C-------------------------------------------
  384. CALL jbmmw2(NSP,JLL,WVEC_L,WVEC_R,NVECT,
  385. & TVECT,MPYN,MLRECP,MLRECV,NLCG,V_INF)
  386. C----------------------------------------------------
  387. JTL=JLL
  388. SEGACT JTL
  389. DO 70 II = 1,(3+NSP)
  390. DO 75 JJ = 1,(3+NSP)
  391. KV = (II-1)*(3+NSP)
  392. C---------------------------------
  393. CELL = IMATRI.LIZAFM(1,KV+JJ)
  394. FUNCEL = SURF * JTL.JAC(II,JJ)
  395. CELL.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  396. CELL.AM(IFAC,1,2) = 0.0D0
  397. 75 CONTINUE
  398. 70 CONTINUE
  399. SEGDES JTL
  400. C--------------------------------------------
  401. DO 40 II = 1,(3+NSP)
  402. DO 45 JJ = 1,(3+NSP)
  403. KV = (II-1)*(3+NSP)
  404. CELL = IMATRI.LIZAFM(1,KV+JJ)
  405. CELL.AM(IFAC,2,2) = 0.0D0
  406. CELL.AM(IFAC,2,1) = 0.0D0
  407. 45 CONTINUE
  408. 40 CONTINUE
  409. C--------------------------------------------
  410. ENDIF
  411. ENDDO
  412. C
  413. SEGDES MELEMC
  414. SEGDES MELEFE
  415. SEGDES MELEMF
  416. C
  417. SEGDES MPOVSU
  418. SEGDES MPVOLU
  419. SEGDES MPNORM
  420. C
  421. SEGDES MPRN
  422. SEGDES MPPN
  423. SEGDES MPUN
  424. SEGDES MPYN
  425. C
  426. SEGDES MELEDU
  427. SEGDES MATRIK
  428. DO 80 II=1,NBME
  429. CELL = IMATRI.LIZAFM(1,II)
  430. SEGDES CELL
  431. 80 CONTINUE
  432. SEGDES IMATRI
  433. C
  434. SEGSUP MLENTC
  435. SEGSUP MLENTF
  436. SEGSUP MLELIM
  437. SEGDES MLMINC
  438. C
  439. SEGDES MPUPRI
  440. SEGDES MPUINF
  441. IF(MELLIM .NE.0) SEGDES MELLIM
  442.  
  443. 9999 CONTINUE
  444. RETURN
  445. END
  446.  
  447.  
  448.  
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  

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