Télécharger konjp2.eso

Retour à la liste

Numérotation des lignes :

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

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