Télécharger konja6.eso

Retour à la liste

Numérotation des lignes :

  1. C KONJA6 SOURCE PV 16/11/17 22:00:00 9180
  2. SUBROUTINE KONJA6(ILINC,IRN,IUN,IPN,IGAMN,INORM,ICHPVO
  3. $ ,ICHPSU,IUINF,IUPRI,MELEMC,MELEFE,MELLIM,IMAT)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : KONJA6
  10. C
  11. C DESCRIPTION : Voir KON12
  12. C Calcul du jacobien du résidu pour la méthode
  13. C AUSMplus Low Mach
  14. C
  15. C Cas deux dimensions, gaz "calorically perfect"
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18. C
  19. C AUTEUR : A.BECCANTINI, S. KUDRIAKOV, DM2S/SFME/LTMF
  20. C
  21. C************************************************************************
  22. C
  23. C
  24. C APPELES (Outils
  25. C CASTEM) : KRIPAD, LICHT, ERREUR
  26. C
  27. C APPELES (Calcul) : JAKBM, JAKWBM
  28. C
  29. C************************************************************************
  30. C
  31. C ENTREES
  32. C
  33. C ILINC : liste des inconnues (pointeur d'un objet de type LISTMOTS)
  34. C
  35. C 1) Pointeurs des CHPOINT
  36. C
  37. C IRN : CHPOINT CENTRE contenant la masse volumique ;
  38. C
  39. C IUN : CHPOINT CENTRE contenant la vitesse ;
  40. C
  41. C IPN : CHPOINT CENTRE contenant la pression ;
  42. C
  43. C IGAMN : CHPOINT CENTRE contenant le gamma ;
  44. C
  45. C INORM : CHPOINT FACE contenant les normales aux faces ;
  46. C
  47. C ICHPVO : CHPOINT VOLUME contenant le volume
  48. C
  49. C ICHPSU : CHPOINT FACE contenant la surface des faces
  50. C
  51. C 2) Pointeurs de MELEME de la table DOMAINE
  52. C
  53. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  54. C
  55. C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts
  56. C
  57. C MELLIM : MELEME SPG des conditions aux bords
  58. C N.B.: Sur le bord on ne calcule rien!
  59. C
  60. C 3) Cas Bas MACH
  61. C
  62. C IUINF : CHPOINT, one component, "cut-off velocity"
  63. C 0 if there is no Bas MACH
  64. C
  65. C IUPRI : CHPOINT, one component, second "cut-off velocity"
  66. C 0 if there is no Bas MACH
  67. C
  68. C SORTIES
  69. C
  70. C IMAT : pointeur de la MATRIK du jacobien du residu
  71. C
  72. C************************************************************************
  73. C
  74. C HISTORIQUE (Anomalies et modifications éventuelles)
  75. C
  76. C HISTORIQUE :
  77. C
  78. C************************************************************************
  79. C
  80. C
  81. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  82. C GAMMA \in (1,3)
  83. C Si non il faut le faire!!!
  84. C
  85. C************************************************************************
  86. C
  87. C
  88. C**** Variables de COOPTIO
  89. C
  90. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  91. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  92. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  93. C & ,IECHO, IIMPI, IOSPI
  94. C & ,IDIM
  95. C & ,MCOORD
  96. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  97. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  98. C & ,NORINC,NORVAL,NORIND,NORVAD
  99. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  100. C
  101. IMPLICIT INTEGER(I-N)
  102. INTEGER ILINC, IRN,IUN,IPN,IGAMN,INORM,ICHPVO,ICHPSU
  103. & , IMAT, IGEOMC, IGEOMF, IUINF, IUPRI
  104. & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  105. & , NKMT, NBME, NBEL, MP, NP
  106. & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL
  107. REAL*8 ROG, PG, UXG, UYG, GAMG, VOLG
  108. & , ROD, PD, UXD, UYD, VOLD, UPR_L, UPR_R
  109. & , SURF, FUNCEL, V_INF, UPR_M
  110. REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2)
  111. REAL*8 JTL(4,4), JTR(4,4)
  112. REAL*8 ZC1, ZC2, ZC3, ZC4
  113. CHARACTER*8 TYPE
  114. C
  115. C**** LES INCLUDES
  116. C
  117.  
  118. -INC PPARAM
  119. -INC CCOPTIO
  120. -INC SMCHPOI
  121. -INC SMELEME
  122. -INC SMLMOTS
  123. -INC SMLENTI
  124. POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL,
  125. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL,
  126. & MPOVDI.MPOVAL
  127. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  128. & MELEDU.MELEME, MELLIM.MELEME
  129. POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  130. POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  131. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  132. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  133. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  134. POINTEUR MLMINC.MLMOTS, MPUPRI.MPOVAL, MPUINF.MPOVAL
  135. C
  136. C**** KRIPAD pour la correspondance global/local des conditions limits
  137. C
  138. CALL KRIPAD(MELLIM,MLELIM)
  139. C SEGACT MELLIM
  140. C
  141. C**** KRIPAD pour la correspondance global/local des centres
  142. C
  143. CALL KRIPAD(MELEMC,MLENTC)
  144. C
  145. C SEGACT MLENTC
  146. SEGACT MELEMC
  147. C
  148. SEGACT MELEFE
  149. C
  150. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  151. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  152. CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  153. C
  154. C**** LICHT active les MPOVALs en *MOD
  155. C
  156. C i.e.
  157. C
  158. C SEGACT MPOVSU*MOD
  159. C SEGACT MPOVNO*MOD
  160. C SEGACT MPVOLU*MOD
  161. C
  162. MELEMF = IGEOMF
  163. CALL KRIPAD(MELEMF,MLENTF)
  164. C
  165. C SEGACT MLENTF
  166. SEGACT MELEMF
  167. C
  168. CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  169. CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  170. CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  171. CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
  172. C
  173. C SEGACT MPRN*MOD
  174. C SEGACT MPPN*MOD
  175. C SEGACT MPUN*MOD
  176. C SEGACT MPGAMN*MOD
  177. C
  178. NFAC = MELEFE.NUM(/2)
  179. C
  180. C**** Maillage des inconnues primales
  181. C
  182. NBSOUS = 0
  183. NBREF = 0
  184. NBELEM = NFAC
  185. NBNN = 2
  186. C
  187. SEGINI MELEDU
  188. C MELEPR = MELEDU
  189. C
  190. C**** MELEDU = 'SEG2'
  191. C
  192. MELEDU.ITYPEL = 2
  193. C
  194. NRIGE = 7
  195. NMATRI = 1
  196. NKID = 9
  197. NKMT = 7
  198. C
  199. SEGINI MATRIK
  200. IMAT = MATRIK
  201. MATRIK.IRIGEL(1,1) = MELEDU
  202. MATRIK.IRIGEL(2,1) = MELEDU
  203. C
  204. C**** Matrice non symetrique
  205. C
  206. MATRIK.IRIGEL(7,1) = 2
  207. C
  208. NBME = 16
  209. NBSOUS = 1
  210. SEGINI IMATRI
  211. MLMINC = ILINC
  212. SEGACT MLMINC
  213. MATRIK.IRIGEL(4,1) = IMATRI
  214. C
  215. IMATRI.LISPRI(1) = MLMINC.MOTS(1)
  216. IMATRI.LISPRI(2) = MLMINC.MOTS(2)
  217. IMATRI.LISPRI(3) = MLMINC.MOTS(3)
  218. IMATRI.LISPRI(4) = MLMINC.MOTS(4)
  219. IMATRI.LISPRI(5) = MLMINC.MOTS(1)
  220. IMATRI.LISPRI(6) = MLMINC.MOTS(2)
  221. IMATRI.LISPRI(7) = MLMINC.MOTS(3)
  222. IMATRI.LISPRI(8) = MLMINC.MOTS(4)
  223. IMATRI.LISPRI(9) = MLMINC.MOTS(1)
  224. IMATRI.LISPRI(10) = MLMINC.MOTS(2)
  225. IMATRI.LISPRI(11) = MLMINC.MOTS(3)
  226. IMATRI.LISPRI(12) = MLMINC.MOTS(4)
  227. IMATRI.LISPRI(13) = MLMINC.MOTS(1)
  228. IMATRI.LISPRI(14) = MLMINC.MOTS(2)
  229. IMATRI.LISPRI(15) = MLMINC.MOTS(3)
  230. IMATRI.LISPRI(16) = MLMINC.MOTS(4)
  231. C
  232. IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  233. IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  234. IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  235. IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  236. IMATRI.LISDUA(5) = MLMINC.MOTS(2)
  237. IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  238. IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  239. IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  240. IMATRI.LISDUA(9) = MLMINC.MOTS(3)
  241. IMATRI.LISDUA(10) = MLMINC.MOTS(3)
  242. IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  243. IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  244. IMATRI.LISDUA(13) = MLMINC.MOTS(4)
  245. IMATRI.LISDUA(14) = MLMINC.MOTS(4)
  246. IMATRI.LISDUA(15) = MLMINC.MOTS(4)
  247. IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  248. C
  249. NBEL = NBELEM
  250. NBSOUS = 1
  251. NP = 2
  252. MP = 2
  253. SEGINI RR , RUX , RUY , RRET ,
  254. & UXR , UXUX , UXUY , UXRET ,
  255. & UYR , UYUX , UYUY , UYRET ,
  256. & RETR , RETUX , RETUY , RETRET
  257. C
  258. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  259. C Primale = IMATRI.LISPRI(1) = 'RN'
  260. C -> IMATRI.LIZAFM(1,1) = RR
  261. C
  262. C Duale = IMATRI.LISDUA(2) = 'RN'
  263. C Primale = IMATRI.LISPRI(1) = 'RUXN'
  264. C -> IMATRI.LIZAFM(1,2) = RUX
  265. C ...
  266. C
  267. IMATRI.LIZAFM(1,1) = RR
  268. IMATRI.LIZAFM(1,2) = RUX
  269. IMATRI.LIZAFM(1,3) = RUY
  270. IMATRI.LIZAFM(1,4) = RRET
  271. IMATRI.LIZAFM(1,5) = UXR
  272. IMATRI.LIZAFM(1,6) = UXUX
  273. IMATRI.LIZAFM(1,7) = UXUY
  274. IMATRI.LIZAFM(1,8) = UXRET
  275. IMATRI.LIZAFM(1,9) = UYR
  276. IMATRI.LIZAFM(1,10) = UYUX
  277. IMATRI.LIZAFM(1,11) = UYUY
  278. IMATRI.LIZAFM(1,12) = UYRET
  279. IMATRI.LIZAFM(1,13) = RETR
  280. IMATRI.LIZAFM(1,14) = RETUX
  281. IMATRI.LIZAFM(1,15) = RETUY
  282. IMATRI.LIZAFM(1,16) = RETRET
  283. C**************************************************************
  284. C Bas Mach
  285. C**************************************************************
  286. CALL LICHT(IUPRI,MPUPRI,TYPE,IGEOMC)
  287. CALL LICHT(IUINF,MPUINF,TYPE,IGEOMC)
  288. C**************************************************************
  289. DO IFAC = 1, NFAC, 1
  290. NGCF = MELEFE.NUM(2,IFAC)
  291. NLCF = MLENTF.LECT(NGCF)
  292. IF(NLCF .NE. IFAC)THEN
  293. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  294. CALL ERREUR(5)
  295. GOTO 9999
  296. ENDIF
  297. NLFL = MLELIM.LECT(NGCF)
  298. NGCG = MELEFE.NUM(1,IFAC)
  299. NGCD = MELEFE.NUM(3,IFAC)
  300. IF(NLFL .NE. 0)THEN
  301. C
  302. C********** The point belongs on BC -> No contribution to jacobian!
  303. C
  304. MELEDU.NUM(1,IFAC) = NGCG
  305. MELEDU.NUM(2,IFAC) = NGCD
  306. ELSEIF(NGCG .NE. NGCD)THEN
  307. C
  308. C********** Les MELEMEs
  309. C
  310. MELEDU.NUM(1,IFAC) = NGCG
  311. MELEDU.NUM(2,IFAC) = NGCD
  312. C
  313. C********** Les etats G et D
  314. C
  315. NLCG = MLENTC.LECT(NGCG)
  316. NLCD = MLENTC.LECT(NGCD)
  317. C*************************************************
  318. C*************************************************
  319. ROG = MPRN.VPOCHA(NLCG,1)
  320. PG = MPPN.VPOCHA(NLCG,1)
  321. UXG = MPUN.VPOCHA(NLCG,1)
  322. UYG = MPUN.VPOCHA(NLCG,2)
  323. GAMG = MPGAMN.VPOCHA(NLCG,1)
  324. VOLG = MPVOLU.VPOCHA(NLCG,1)
  325. C-------------------------------------------------
  326. WVEC_L(1)=ROG
  327. WVEC_L(2)=UXG
  328. WVEC_L(3)=UYG
  329. WVEC_L(4)=PG
  330. C-------------------------------------------------
  331. ROD = MPRN.VPOCHA(NLCD,1)
  332. PD = MPPN.VPOCHA(NLCD,1)
  333. UXD = MPUN.VPOCHA(NLCD,1)
  334. UYD = MPUN.VPOCHA(NLCD,2)
  335. VOLD = MPVOLU.VPOCHA(NLCD,1)
  336. C------------------------------------------------
  337. WVEC_R(1)=ROD
  338. WVEC_R(2)=UXD
  339. WVEC_R(3)=UYD
  340. WVEC_R(4)=PD
  341. c------------------------------------------------
  342. UPR_L=MPUPRI.VPOCHA(NLCG,1)
  343. UPR_R=MPUPRI.VPOCHA(NLCD,1)
  344. UPR_M=MAX(UPR_L,UPR_R)
  345. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),MPUINF.VPOCHA(NLCD,1))
  346. V_INF=MAX(UPR_M,V_INF)
  347. C------------------------------------------------
  348. C
  349. C********** La normale G->D
  350. C La tangente
  351. C
  352. SURF = MPOVSU.VPOCHA(NLCF,1)
  353. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  354. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  355. TVECT(1) = -1.0D0 * NVECT(2)
  356. TVECT(2) = NVECT(1)
  357. C
  358. CALL JAKBM(JTL,JTR,WVEC_L,WVEC_R,
  359. & NVECT,TVECT,GAMG,V_INF)
  360. C
  361. C
  362. C********** AB.AM(IFAC,IPRIM,IDUAL)
  363. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  364. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  365. C IPRIM = 1, 2 -> G, D
  366. C IDUAL = 1, 2 -> G, D
  367. C i.e.
  368. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  369. C
  370. C
  371. C********** Dual RN
  372. C
  373. FUNCEL = SURF * JTL(1,1)
  374. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  375. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  376. C
  377. FUNCEL = SURF * JTL(1,2)
  378. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  379. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  380. C
  381. FUNCEL = SURF * JTL(1,3)
  382. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  383. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  384. C
  385. FUNCEL = SURF * JTL(1,4)
  386. RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  387. RRET.AM(IFAC,1,2) = FUNCEL / VOLD
  388. C
  389. C********** Dual RUXN
  390. C
  391. FUNCEL = SURF * JTL(2,1)
  392. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  393. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  394. C
  395. FUNCEL = SURF * JTL(2,2)
  396. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  397. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  398. C
  399. FUNCEL = SURF * JTL(2,3)
  400. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  401. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  402. C
  403. FUNCEL = SURF * JTL(2,4)
  404. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  405. UXRET.AM(IFAC,1,2) = FUNCEL / VOLD
  406. C
  407. C********** Dual RUYN
  408. C
  409. FUNCEL = SURF * JTL(3,1)
  410. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  411. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  412. C
  413. FUNCEL = SURF * JTL(3,2)
  414. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  415. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  416. C
  417. FUNCEL = SURF * JTL(3,3)
  418. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  419. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  420. C
  421. FUNCEL = SURF * JTL(3,4)
  422. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  423. UYRET.AM(IFAC,1,2) = FUNCEL / VOLD
  424. C
  425. C********** Dual RETN
  426. C
  427. FUNCEL = SURF * JTL(4,1)
  428. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  429. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  430. C
  431. FUNCEL = SURF * JTL(4,2)
  432. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  433. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  434. C
  435. FUNCEL = SURF * JTL(4,3)
  436. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  437. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  438. C
  439. FUNCEL = SURF * JTL(4,4)
  440. RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  441. RETRET.AM(IFAC,1,2) = FUNCEL / VOLD
  442. C
  443. C********** Dual RN
  444. C
  445. FUNCEL = SURF * JTR(1,1)
  446. RR.AM(IFAC,2,2) = FUNCEL / VOLD
  447. RR.AM(IFAC,2,1) = -FUNCEL / VOLG
  448. C
  449. FUNCEL = SURF * JTR(1,2)
  450. RUX.AM(IFAC,2,2) = FUNCEL / VOLD
  451. RUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  452. C
  453. FUNCEL = SURF * JTR(1,3)
  454. RUY.AM(IFAC,2,2) = FUNCEL / VOLD
  455. RUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  456. C
  457. FUNCEL = SURF * JTR(1,4)
  458. RRET.AM(IFAC,2,2) = FUNCEL / VOLD
  459. RRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  460. C
  461. C********** Dual RUXN
  462. C
  463. FUNCEL = SURF * JTR(2,1)
  464. UXR.AM(IFAC,2,2) = FUNCEL / VOLD
  465. UXR.AM(IFAC,2,1) = -FUNCEL / VOLG
  466. C
  467. FUNCEL = SURF * JTR(2,2)
  468. UXUX.AM(IFAC,2,2) = FUNCEL / VOLD
  469. UXUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  470. C
  471. FUNCEL = SURF * JTR(2,3)
  472. UXUY.AM(IFAC,2,2) = FUNCEL / VOLD
  473. UXUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  474. C
  475. FUNCEL = SURF * JTR(2,4)
  476. UXRET.AM(IFAC,2,2) = FUNCEL / VOLD
  477. UXRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  478. C
  479. C********** Dual RUYN
  480. C
  481. FUNCEL = SURF * JTR(3,1)
  482. UYR.AM(IFAC,2,2) = FUNCEL / VOLD
  483. UYR.AM(IFAC,2,1) = -FUNCEL / VOLG
  484. C
  485. FUNCEL = SURF * JTR(3,2)
  486. UYUX.AM(IFAC,2,2) = FUNCEL / VOLD
  487. UYUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  488. C
  489. FUNCEL = SURF * JTR(3,3)
  490. UYUY.AM(IFAC,2,2) = FUNCEL / VOLD
  491. UYUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  492. C
  493. FUNCEL = SURF * JTR(3,4)
  494. UYRET.AM(IFAC,2,2) = FUNCEL / VOLD
  495. UYRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  496. C
  497. C********** Dual RETN
  498. C
  499. FUNCEL = SURF * JTR(4,1)
  500. RETR.AM(IFAC,2,2) = FUNCEL / VOLD
  501. RETR.AM(IFAC,2,1) = -FUNCEL / VOLG
  502. C
  503. FUNCEL = SURF * JTR(4,2)
  504. RETUX.AM(IFAC,2,2) = FUNCEL / VOLD
  505. RETUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  506. C
  507. FUNCEL = SURF * JTR(4,3)
  508. RETUY.AM(IFAC,2,2) = FUNCEL / VOLD
  509. RETUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  510. C
  511. FUNCEL = SURF * JTR(4,4)
  512. RETRET.AM(IFAC,2,2) = FUNCEL / VOLD
  513. RETRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  514. C
  515. ELSE
  516. C
  517. C********** Murs (NGCG = NGCD)
  518. C
  519. C
  520. C********** Les MELEMEs
  521. C
  522. MELEDU.NUM(1,IFAC) = NGCG
  523. MELEDU.NUM(2,IFAC) = NGCD
  524. NLCG = MLENTC.LECT(NGCG)
  525. C
  526. ROG = MPRN.VPOCHA(NLCG,1)
  527. PG = MPPN.VPOCHA(NLCG,1)
  528. UXG = MPUN.VPOCHA(NLCG,1)
  529. UYG = MPUN.VPOCHA(NLCG,2)
  530. GAMG = MPGAMN.VPOCHA(NLCG,1)
  531. VOLG = MPVOLU.VPOCHA(NLCG,1)
  532. C-------------------------------------------
  533. WVEC_L(1)=ROG
  534. WVEC_L(2)=UXG
  535. WVEC_L(3)=UYG
  536. WVEC_L(4)=PG
  537. C-------------------------------------------------
  538. SURF = MPOVSU.VPOCHA(NLCF,1)
  539. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  540. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  541. TVECT(1) =-NVECT(2)
  542. TVECT(2) = NVECT(1)
  543. C------- COEFFICIENTS ----------------------------
  544. ZC1=NVECT(1)*TVECT(2)+TVECT(1)*NVECT(2)
  545. ZC2=NVECT(1)*TVECT(2)-TVECT(1)*NVECT(2)
  546. ZC3=2.0D0*NVECT(1)*TVECT(1)
  547. ZC4=2.0D0*NVECT(2)*TVECT(2)
  548. C-------------------------------------------------
  549. ROD = ROG
  550. PD = PG
  551. UXD = -ZC1*UXG/ZC2-ZC4*UYG/ZC2
  552. UYD = ZC3*UXG/ZC2+ZC1*UYG/ZC2
  553. VOLD = VOLG
  554. C------------------------------------------------
  555. UPR_L=MPUPRI.VPOCHA(NLCG,1)
  556. UPR_R=UPR_L
  557. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),UPR_L)
  558. C------------------------------------------------
  559. WVEC_R(1)=ROD
  560. WVEC_R(2)=UXD
  561. WVEC_R(3)=UYD
  562. WVEC_R(4)=PD
  563. C-------------------------------------------
  564. C********** La normale sortante
  565. C-------------------------------------------
  566. CALL JAKWBM(JTL,WVEC_L,WVEC_R,
  567. & NVECT,TVECT,GAMG,V_INF)
  568. C
  569. C********** Dual RN
  570. C
  571. RR.AM(IFAC,1,1) = 0.0D0
  572. RR.AM(IFAC,1,2) = 0.0D0
  573. C
  574. RUX.AM(IFAC,1,1) = 0.0D0
  575. RUX.AM(IFAC,1,2) = 0.0D0
  576. C
  577. RUY.AM(IFAC,1,1) = 0.0D0
  578. RUY.AM(IFAC,1,2) = 0.0D0
  579. C
  580. RRET.AM(IFAC,1,1) = 0.0D0
  581. RRET.AM(IFAC,1,2) = 0.0D0
  582. C
  583. C********** Dual RUXN
  584. C
  585. FUNCEL = SURF * JTL(2,1)
  586. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  587. UXR.AM(IFAC,1,2) = 0.0D0
  588. C
  589. FUNCEL = SURF * JTL(2,2)
  590. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  591. UXUX.AM(IFAC,1,2) = 0.0D0
  592. C
  593. FUNCEL = SURF * JTL(2,3)
  594. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  595. UXUY.AM(IFAC,1,2) = 0.0D0
  596. C
  597. FUNCEL = SURF * JTL(2,4)
  598. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  599. UXRET.AM(IFAC,1,2) = 0.0D0
  600. C
  601. C********** Dual RUYN
  602. C
  603. FUNCEL = SURF * JTL(3,1)
  604. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  605. UYR.AM(IFAC,1,2) = 0.0D0
  606. C
  607. FUNCEL = SURF * JTL(3,2)
  608. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  609. UYUX.AM(IFAC,1,2) = 0.0D0
  610. C
  611. FUNCEL = SURF * JTL(3,3)
  612. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  613. UYUY.AM(IFAC,1,2) = 0.0D0
  614. C
  615. FUNCEL = SURF * JTL(3,4)
  616. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  617. UYRET.AM(IFAC,1,2) = 0.0D0
  618. C
  619. C********** Dual RETN
  620. C
  621. RETR.AM(IFAC,1,1) = 0.0D0
  622. RETR.AM(IFAC,1,2) = 0.0D0
  623. C
  624. RETUX.AM(IFAC,1,1) = 0.0D0
  625. RETUX.AM(IFAC,1,2) = 0.0D0
  626. C
  627. RETUY.AM(IFAC,1,1) = 0.0D0
  628. RETUY.AM(IFAC,1,2) = 0.0D0
  629. C
  630. RETRET.AM(IFAC,1,1) = 0.0D0
  631. RETRET.AM(IFAC,1,2) = 0.0D0
  632. C
  633. C********** Dual RN
  634. C
  635. RR.AM(IFAC,2,2) = 0.0D0
  636. RR.AM(IFAC,2,1) = 0.0D0
  637. C
  638. RUX.AM(IFAC,2,2) = 0.0D0
  639. RUX.AM(IFAC,2,1) = 0.0D0
  640. C
  641. RUY.AM(IFAC,2,2) = 0.0D0
  642. RUY.AM(IFAC,2,1) = 0.0D0
  643. C
  644. RRET.AM(IFAC,2,2) = 0.0D0
  645. RRET.AM(IFAC,2,1) = 0.0D0
  646. C
  647. C********** Dual RUXN
  648. C
  649. UXR.AM(IFAC,2,2) = 0.0D0
  650. UXR.AM(IFAC,2,1) = 0.0D0
  651. C
  652. UXUX.AM(IFAC,2,2) = 0.0D0
  653. UXUX.AM(IFAC,2,1) = 0.0D0
  654. C
  655. UXUY.AM(IFAC,2,2) = 0.0D0
  656. UXUY.AM(IFAC,2,1) = 0.0D0
  657. C
  658. UXRET.AM(IFAC,2,2) = 0.0D0
  659. UXRET.AM(IFAC,2,1) = 0.0D0
  660. C
  661. C********** Dual RUYN
  662. C
  663. UYR.AM(IFAC,2,2) = 0.0D0
  664. UYR.AM(IFAC,2,1) = 0.0D0
  665. C
  666. UYUX.AM(IFAC,2,2) = 0.0D0
  667. UYUX.AM(IFAC,2,1) = 0.0D0
  668. C
  669. UYUY.AM(IFAC,2,2) = 0.0D0
  670. UYUY.AM(IFAC,2,1) = 0.0D0
  671. C
  672. UYRET.AM(IFAC,2,2) = 0.0D0
  673. UYRET.AM(IFAC,2,1) = 0.0D0
  674. C
  675. C********** Dual RETN
  676. C
  677. RETR.AM(IFAC,2,2) = 0.0D0
  678. RETR.AM(IFAC,2,1) = 0.0D0
  679. C
  680. RETUX.AM(IFAC,2,2) = 0.0D0
  681. RETUX.AM(IFAC,2,1) = 0.0D0
  682. C
  683. RETUY.AM(IFAC,2,2) = 0.0D0
  684. RETUY.AM(IFAC,2,1) = 0.0D0
  685. C
  686. RETRET.AM(IFAC,2,2) = 0.0D0
  687. RETRET.AM(IFAC,2,1) = 0.0D0
  688. C
  689. ENDIF
  690. ENDDO
  691. C
  692. SEGDES MELEMC
  693. SEGDES MELEFE
  694. SEGDES MELEMF
  695. C
  696. SEGDES MPOVSU
  697. SEGDES MPVOLU
  698. SEGDES MPNORM
  699. C
  700. SEGDES MPRN
  701. SEGDES MPPN
  702. SEGDES MPUN
  703. SEGDES MPGAMN
  704. C
  705. SEGDES MELEDU
  706. SEGDES MATRIK
  707. SEGDES IMATRI
  708. C
  709. SEGDES RR , RUX , RUY , RRET ,
  710. & UXR , UXUX , UXUY , UXRET ,
  711. & UYR , UYUX , UYUY , UYRET ,
  712. & RETR , RETUX , RETUY , RETRET
  713.  
  714. SEGSUP MLENTC
  715. SEGSUP MLENTF
  716. SEGDES MLMINC
  717. SEGSUP MLELIM
  718. C
  719. SEGDES MPUPRI
  720. SEGDES MPUINF
  721. IF(MELLIM .NE.0) SEGDES MELLIM
  722. C
  723. 9999 CONTINUE
  724. RETURN
  725. END
  726.  
  727.  
  728.  
  729.  
  730.  
  731.  
  732.  
  733.  
  734.  

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