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 CCOPTIO
  112. -INC SMCHPOI
  113. -INC SMELEME
  114. -INC SMLMOTS
  115. -INC SMLENTI
  116. POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL,
  117. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  118. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  119. & MELEDU.MELEME, MELLIM.MELEME
  120. POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  121. POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  122. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  123. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  124. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  125. POINTEUR MLMINC.MLMOTS
  126. C
  127. C**** KRIPAD pour la correspondance global/local des conditions limits
  128. C
  129. CALL KRIPAD(MELLIM,MLELIM)
  130. c SEGACT MELLIM
  131. C
  132. C**** KRIPAD pour la correspondance global/local des centres
  133. C
  134. CALL KRIPAD(MELEMC,MLENTC)
  135. C
  136. C SEGACT MLENTC
  137. SEGACT MELEMC
  138. C
  139. SEGACT MELEFE
  140. C
  141. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  142. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  143. CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  144. C
  145. C**** LICHT active les MPOVALs en *MOD
  146. C
  147. C i.e.
  148. C
  149. C SEGACT MPOVSU*MOD
  150. C SEGACT MPOVNO*MOD
  151. C SEGACT MPVOLU*MOD
  152. C
  153. MELEMF = IGEOMF
  154. CALL KRIPAD(MELEMF,MLENTF)
  155. C
  156. C SEGACT MLENTF
  157. SEGACT MELEMF
  158. C
  159. CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  160. CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  161. CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  162. CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
  163. C
  164. C SEGACT MPRN*MOD
  165. C SEGACT MPPN*MOD
  166. C SEGACT MPUN*MOD
  167. C SEGACT MPGAMN*MOD
  168. C
  169. NFAC = MELEFE.NUM(/2)
  170. C
  171. C**** Maillage des inconnues primales
  172. C
  173. NBSOUS = 0
  174. NBREF = 0
  175. NBELEM = NFAC
  176. NBNN = 2
  177. C
  178. SEGINI MELEDU
  179. C MELEPR = MELEDU
  180. C
  181. C**** MELEDU = 'SEG2'
  182. C
  183. MELEDU.ITYPEL = 2
  184. C
  185. NRIGE = 7
  186. NMATRI = 1
  187. NKID = 9
  188. NKMT = 7
  189. C
  190. SEGINI MATRIK
  191. IMAT = MATRIK
  192. MATRIK.IRIGEL(1,1) = MELEDU
  193. MATRIK.IRIGEL(2,1) = MELEDU
  194. C
  195. C**** Matrice non symetrique
  196. C
  197. MATRIK.IRIGEL(7,1) = 2
  198. C
  199. NBME = 16
  200. NBSOUS = 1
  201. SEGINI IMATRI
  202. MLMINC = ILINC
  203. MATRIK.IRIGEL(4,1) = IMATRI
  204. C
  205. C**** Variables primales (primitives)
  206. C
  207. MLMINC = ILINP
  208. SEGACT MLMINC
  209. IMATRI.LISPRI(1) = MLMINC.MOTS(1)
  210. IMATRI.LISPRI(2) = MLMINC.MOTS(2)
  211. IMATRI.LISPRI(3) = MLMINC.MOTS(3)
  212. IMATRI.LISPRI(4) = MLMINC.MOTS(4)
  213. IMATRI.LISPRI(5) = MLMINC.MOTS(1)
  214. IMATRI.LISPRI(6) = MLMINC.MOTS(2)
  215. IMATRI.LISPRI(7) = MLMINC.MOTS(3)
  216. IMATRI.LISPRI(8) = MLMINC.MOTS(4)
  217. IMATRI.LISPRI(9) = MLMINC.MOTS(1)
  218. IMATRI.LISPRI(10) = MLMINC.MOTS(2)
  219. IMATRI.LISPRI(11) = MLMINC.MOTS(3)
  220. IMATRI.LISPRI(12) = MLMINC.MOTS(4)
  221. IMATRI.LISPRI(13) = MLMINC.MOTS(1)
  222. IMATRI.LISPRI(14) = MLMINC.MOTS(2)
  223. IMATRI.LISPRI(15) = MLMINC.MOTS(3)
  224. IMATRI.LISPRI(16) = MLMINC.MOTS(4)
  225. SEGDES MLMINC
  226. C
  227. C**** Variables duales (conservatives)
  228. C
  229. MLMINC = ILINC
  230. SEGACT MLMINC
  231. IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  232. IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  233. IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  234. IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  235. IMATRI.LISDUA(5) = MLMINC.MOTS(2)
  236. IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  237. IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  238. IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  239. IMATRI.LISDUA(9) = MLMINC.MOTS(3)
  240. IMATRI.LISDUA(10) = MLMINC.MOTS(3)
  241. IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  242. IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  243. IMATRI.LISDUA(13) = MLMINC.MOTS(4)
  244. IMATRI.LISDUA(14) = MLMINC.MOTS(4)
  245. IMATRI.LISDUA(15) = MLMINC.MOTS(4)
  246. IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  247. SEGDES MLMINC
  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. DO IFAC = 1, NFAC, 1
  285. NGCF = MELEFE.NUM(2,IFAC)
  286. NLCF = MLENTF.LECT(NGCF)
  287. IF(NLCF .NE. IFAC)THEN
  288. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  289. CALL ERREUR(5)
  290. GOTO 9999
  291. ENDIF
  292. NGCG = MELEFE.NUM(1,IFAC)
  293. NGCD = MELEFE.NUM(3,IFAC)
  294. NLFL = MLELIM.LECT(NGCF)
  295. IF(NLFL .NE. 0)THEN
  296. C
  297. C********** The point belongs on BC -> No contribution to jacobian!
  298. C
  299. MELEDU.NUM(1,IFAC) = NGCG
  300. MELEDU.NUM(2,IFAC) = NGCD
  301. ELSEIF(NGCG .NE. NGCD)THEN
  302. C
  303. C********** Les MELEMEs
  304. C
  305. MELEDU.NUM(1,IFAC) = NGCG
  306. MELEDU.NUM(2,IFAC) = NGCD
  307. C
  308. C********** Les etats G et D
  309. C
  310. NLCG = MLENTC.LECT(NGCG)
  311. NLCD = MLENTC.LECT(NGCD)
  312. C
  313. ROG = MPRN.VPOCHA(NLCG,1)
  314. PG = MPPN.VPOCHA(NLCG,1)
  315. UXG = MPUN.VPOCHA(NLCG,1)
  316. UYG = MPUN.VPOCHA(NLCG,2)
  317. GAMG = MPGAMN.VPOCHA(NLCG,1)
  318. VOLG = MPVOLU.VPOCHA(NLCG,1)
  319. C-------------------------------------------------
  320. WVEC_L(1)=ROG
  321. WVEC_L(2)=UXG
  322. WVEC_L(3)=UYG
  323. WVEC_L(4)=PG
  324. C-------------------------------------------------
  325. ROD = MPRN.VPOCHA(NLCD,1)
  326. PD = MPPN.VPOCHA(NLCD,1)
  327. UXD = MPUN.VPOCHA(NLCD,1)
  328. UYD = MPUN.VPOCHA(NLCD,2)
  329. VOLD = MPVOLU.VPOCHA(NLCD,1)
  330. C------------------------------------------------
  331. WVEC_R(1)=ROD
  332. WVEC_R(2)=UXD
  333. WVEC_R(3)=UYD
  334. WVEC_R(4)=PD
  335. C------------------------------------------------
  336. C
  337. C********** La normale G->D
  338. C La tangente
  339. C
  340. SURF = MPOVSU.VPOCHA(NLCF,1)
  341. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  342. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  343. TVECT(1) = -1.0D0 * NVECT(2)
  344. TVECT(2) = NVECT(1)
  345. C
  346. CALL CONJP2(JTL,JTR,WVEC_L,WVEC_R,
  347. & NVECT,TVECT,GAMG)
  348. C
  349. C
  350. C********** AB.AM(IFAC,IPRIM,IDUAL)
  351. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  352. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  353. C IPRIM = 1, 2 -> G, D
  354. C IDUAL = 1, 2 -> G, D
  355. C i.e.
  356. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  357. C
  358. C
  359. C********** Dual RN
  360. C
  361. FUNCEL = SURF * JTL(1,1)
  362. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  363. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  364. C
  365. FUNCEL = SURF * JTL(1,2)
  366. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  367. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  368. C
  369. FUNCEL = SURF * JTL(1,3)
  370. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  371. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  372. C
  373. FUNCEL = SURF * JTL(1,4)
  374. RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  375. RRET.AM(IFAC,1,2) = FUNCEL / VOLD
  376. C
  377. C********** Dual RUXN
  378. C
  379. FUNCEL = SURF * JTL(2,1)
  380. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  381. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  382. C
  383. FUNCEL = SURF * JTL(2,2)
  384. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  385. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  386. C
  387. FUNCEL = SURF * JTL(2,3)
  388. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  389. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  390. C
  391. FUNCEL = SURF * JTL(2,4)
  392. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  393. UXRET.AM(IFAC,1,2) = FUNCEL / VOLD
  394. C
  395. C********** Dual RUYN
  396. C
  397. FUNCEL = SURF * JTL(3,1)
  398. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  399. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  400. C
  401. FUNCEL = SURF * JTL(3,2)
  402. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  403. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  404. C
  405. FUNCEL = SURF * JTL(3,3)
  406. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  407. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  408. C
  409. FUNCEL = SURF * JTL(3,4)
  410. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  411. UYRET.AM(IFAC,1,2) = FUNCEL / VOLD
  412. C
  413. C********** Dual RETN
  414. C
  415. FUNCEL = SURF * JTL(4,1)
  416. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  417. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  418. C
  419. FUNCEL = SURF * JTL(4,2)
  420. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  421. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  422. C
  423. FUNCEL = SURF * JTL(4,3)
  424. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  425. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  426. C
  427. FUNCEL = SURF * JTL(4,4)
  428. RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  429. RETRET.AM(IFAC,1,2) = FUNCEL / VOLD
  430. C
  431. C********** Dual RN
  432. C
  433. FUNCEL = SURF * JTR(1,1)
  434. RR.AM(IFAC,2,2) = FUNCEL / VOLD
  435. RR.AM(IFAC,2,1) = -FUNCEL / VOLG
  436. C
  437. FUNCEL = SURF * JTR(1,2)
  438. RUX.AM(IFAC,2,2) = FUNCEL / VOLD
  439. RUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  440. C
  441. FUNCEL = SURF * JTR(1,3)
  442. RUY.AM(IFAC,2,2) = FUNCEL / VOLD
  443. RUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  444. C
  445. FUNCEL = SURF * JTR(1,4)
  446. RRET.AM(IFAC,2,2) = FUNCEL / VOLD
  447. RRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  448. C
  449. C********** Dual RUXN
  450. C
  451. FUNCEL = SURF * JTR(2,1)
  452. UXR.AM(IFAC,2,2) = FUNCEL / VOLD
  453. UXR.AM(IFAC,2,1) = -FUNCEL / VOLG
  454. C
  455. FUNCEL = SURF * JTR(2,2)
  456. UXUX.AM(IFAC,2,2) = FUNCEL / VOLD
  457. UXUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  458. C
  459. FUNCEL = SURF * JTR(2,3)
  460. UXUY.AM(IFAC,2,2) = FUNCEL / VOLD
  461. UXUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  462. C
  463. FUNCEL = SURF * JTR(2,4)
  464. UXRET.AM(IFAC,2,2) = FUNCEL / VOLD
  465. UXRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  466. C
  467. C********** Dual RUYN
  468. C
  469. FUNCEL = SURF * JTR(3,1)
  470. UYR.AM(IFAC,2,2) = FUNCEL / VOLD
  471. UYR.AM(IFAC,2,1) = -FUNCEL / VOLG
  472. C
  473. FUNCEL = SURF * JTR(3,2)
  474. UYUX.AM(IFAC,2,2) = FUNCEL / VOLD
  475. UYUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  476. C
  477. FUNCEL = SURF * JTR(3,3)
  478. UYUY.AM(IFAC,2,2) = FUNCEL / VOLD
  479. UYUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  480. C
  481. FUNCEL = SURF * JTR(3,4)
  482. UYRET.AM(IFAC,2,2) = FUNCEL / VOLD
  483. UYRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  484. C
  485. C********** Dual RETN
  486. C
  487. FUNCEL = SURF * JTR(4,1)
  488. RETR.AM(IFAC,2,2) = FUNCEL / VOLD
  489. RETR.AM(IFAC,2,1) = -FUNCEL / VOLG
  490. C
  491. FUNCEL = SURF * JTR(4,2)
  492. RETUX.AM(IFAC,2,2) = FUNCEL / VOLD
  493. RETUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  494. C
  495. FUNCEL = SURF * JTR(4,3)
  496. RETUY.AM(IFAC,2,2) = FUNCEL / VOLD
  497. RETUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  498. C
  499. FUNCEL = SURF * JTR(4,4)
  500. RETRET.AM(IFAC,2,2) = FUNCEL / VOLD
  501. RETRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  502. C
  503. ELSE
  504. C
  505. C********** Murs (NGCG = NGCD)
  506. C
  507. C
  508. C********** Les MELEMEs
  509. C
  510. MELEDU.NUM(1,IFAC) = NGCG
  511. MELEDU.NUM(2,IFAC) = NGCD
  512. NLCG = MLENTC.LECT(NGCG)
  513. C
  514. ROG = MPRN.VPOCHA(NLCG,1)
  515. PG = MPPN.VPOCHA(NLCG,1)
  516. UXG = MPUN.VPOCHA(NLCG,1)
  517. UYG = MPUN.VPOCHA(NLCG,2)
  518. GAMG = MPGAMN.VPOCHA(NLCG,1)
  519. VOLG = MPVOLU.VPOCHA(NLCG,1)
  520. C-------------------------------------------
  521. WVEC_L(1)=ROG
  522. WVEC_L(2)=UXG
  523. WVEC_L(3)=UYG
  524. WVEC_L(4)=PG
  525. C-------------------------------------------------
  526. SURF = MPOVSU.VPOCHA(NLCF,1)
  527. NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  528. NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  529. TVECT(1) =-NVECT(2)
  530. TVECT(2) = NVECT(1)
  531. C------- COEFFICIENTS ----------------------------
  532. ZC1=NVECT(1)*TVECT(2)+TVECT(1)*NVECT(2)
  533. ZC2=NVECT(1)*TVECT(2)-TVECT(1)*NVECT(2)
  534. ZC3=2.0D0*NVECT(1)*TVECT(1)
  535. ZC4=2.0D0*NVECT(2)*TVECT(2)
  536. C-------------------------------------------------
  537. ROD = ROG
  538. PD = PG
  539. UXD = -ZC1*UXG/ZC2-ZC4*UYG/ZC2
  540. UYD = ZC3*UXG/ZC2+ZC1*UYG/ZC2
  541. VOLD = VOLG
  542. C------------------------------------------------
  543. WVEC_R(1)=ROD
  544. WVEC_R(2)=UXD
  545. WVEC_R(3)=UYD
  546. WVEC_R(4)=PD
  547. C-------------------------------------------
  548. C********** La normale sortante
  549. C-------------------------------------------
  550. CALL CONJP3(JTL,JTR,WVEC_L,WVEC_R,
  551. & NVECT,TVECT,GAMG)
  552. C
  553. C********** Dual RN
  554. C
  555. RR.AM(IFAC,1,1) = 0.0D0
  556. RR.AM(IFAC,1,2) = 0.0D0
  557. C
  558. RUX.AM(IFAC,1,1) = 0.0D0
  559. RUX.AM(IFAC,1,2) = 0.0D0
  560. C
  561. RUY.AM(IFAC,1,1) = 0.0D0
  562. RUY.AM(IFAC,1,2) = 0.0D0
  563. C
  564. RRET.AM(IFAC,1,1) = 0.0D0
  565. RRET.AM(IFAC,1,2) = 0.0D0
  566. C
  567. C********** Dual RUXN
  568. C
  569. FUNCEL = SURF * JTL(2,1)
  570. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  571. UXR.AM(IFAC,1,2) = 0.0D0
  572. C
  573. FUNCEL = SURF * JTL(2,2)
  574. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  575. UXUX.AM(IFAC,1,2) = 0.0D0
  576. C
  577. FUNCEL = SURF * JTL(2,3)
  578. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  579. UXUY.AM(IFAC,1,2) = 0.0D0
  580. C
  581. FUNCEL = SURF * JTL(2,4)
  582. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  583. UXRET.AM(IFAC,1,2) = 0.0D0
  584. C
  585. C********** Dual RUYN
  586. C
  587. FUNCEL = SURF * JTL(3,1)
  588. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  589. UYR.AM(IFAC,1,2) = 0.0D0
  590. C
  591. FUNCEL = SURF * JTL(3,2)
  592. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  593. UYUX.AM(IFAC,1,2) = 0.0D0
  594. C
  595. FUNCEL = SURF * JTL(3,3)
  596. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  597. UYUY.AM(IFAC,1,2) = 0.0D0
  598. C
  599. FUNCEL = SURF * JTL(3,4)
  600. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  601. UYRET.AM(IFAC,1,2) = 0.0D0
  602. C
  603. C********** Dual RETN
  604. C
  605. RETR.AM(IFAC,1,1) = 0.0D0
  606. RETR.AM(IFAC,1,2) = 0.0D0
  607. C
  608. RETUX.AM(IFAC,1,1) = 0.0D0
  609. RETUX.AM(IFAC,1,2) = 0.0D0
  610. C
  611. RETUY.AM(IFAC,1,1) = 0.0D0
  612. RETUY.AM(IFAC,1,2) = 0.0D0
  613. C
  614. RETRET.AM(IFAC,1,1) = 0.0D0
  615. RETRET.AM(IFAC,1,2) = 0.0D0
  616. C
  617. C********** Dual RN
  618. C
  619. RR.AM(IFAC,2,2) = 0.0D0
  620. RR.AM(IFAC,2,1) = 0.0D0
  621. C
  622. RUX.AM(IFAC,2,2) = 0.0D0
  623. RUX.AM(IFAC,2,1) = 0.0D0
  624. C
  625. RUY.AM(IFAC,2,2) = 0.0D0
  626. RUY.AM(IFAC,2,1) = 0.0D0
  627. C
  628. RRET.AM(IFAC,2,2) = 0.0D0
  629. RRET.AM(IFAC,2,1) = 0.0D0
  630. C
  631. C********** Dual RUXN
  632. C
  633. UXR.AM(IFAC,2,2) = 0.0D0
  634. UXR.AM(IFAC,2,1) = 0.0D0
  635. C
  636. UXUX.AM(IFAC,2,2) = 0.0D0
  637. UXUX.AM(IFAC,2,1) = 0.0D0
  638. C
  639. UXUY.AM(IFAC,2,2) = 0.0D0
  640. UXUY.AM(IFAC,2,1) = 0.0D0
  641. C
  642. UXRET.AM(IFAC,2,2) = 0.0D0
  643. UXRET.AM(IFAC,2,1) = 0.0D0
  644. C
  645. C********** Dual RUYN
  646. C
  647. UYR.AM(IFAC,2,2) = 0.0D0
  648. UYR.AM(IFAC,2,1) = 0.0D0
  649. C
  650. UYUX.AM(IFAC,2,2) = 0.0D0
  651. UYUX.AM(IFAC,2,1) = 0.0D0
  652. C
  653. UYUY.AM(IFAC,2,2) = 0.0D0
  654. UYUY.AM(IFAC,2,1) = 0.0D0
  655. C
  656. UYRET.AM(IFAC,2,2) = 0.0D0
  657. UYRET.AM(IFAC,2,1) = 0.0D0
  658. C
  659. C********** Dual RETN
  660. C
  661. RETR.AM(IFAC,2,2) = 0.0D0
  662. RETR.AM(IFAC,2,1) = 0.0D0
  663. C
  664. RETUX.AM(IFAC,2,2) = 0.0D0
  665. RETUX.AM(IFAC,2,1) = 0.0D0
  666. C
  667. RETUY.AM(IFAC,2,2) = 0.0D0
  668. RETUY.AM(IFAC,2,1) = 0.0D0
  669. C
  670. RETRET.AM(IFAC,2,2) = 0.0D0
  671. RETRET.AM(IFAC,2,1) = 0.0D0
  672. C
  673. ENDIF
  674. ENDDO
  675. C
  676. SEGDES MELEMC
  677. SEGDES MELEFE
  678. SEGDES MELEMF
  679. C
  680. SEGDES MPOVSU
  681. SEGDES MPVOLU
  682. SEGDES MPNORM
  683. C
  684. SEGDES MPRN
  685. SEGDES MPPN
  686. SEGDES MPUN
  687. SEGDES MPGAMN
  688. C
  689. SEGDES MELEDU
  690. SEGDES MATRIK
  691. SEGDES IMATRI
  692. C
  693. SEGDES RR , RUX , RUY , RRET ,
  694. & UXR , UXUX , UXUY , UXRET ,
  695. & UYR , UYUX , UYUY , UYRET ,
  696. & RETR , RETUX , RETUY , RETRET
  697.  
  698. SEGSUP MLENTC
  699. SEGSUP MLENTF
  700. SEGSUP MLELIM
  701. C
  702. 9999 CONTINUE
  703. RETURN
  704. END
  705.  
  706.  
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  

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