Télécharger konjp1.eso

Retour à la liste

Numérotation des lignes :

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

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