Télécharger konjp3.eso

Retour à la liste

Numérotation des lignes :

  1. C KONJP3 SOURCE PV 16/11/17 22:00:06 9180
  2. SUBROUTINE KONJP3(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 : KONJA3
  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 3D, gaz "calorically perfect"
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, 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) : VLHJ5, VLHJ7
  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 ICHPOVO : CHPOINT VOLUME contenant le volume
  51. C
  52. C ICHPOSU : 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, UZG, RETG, GAMG, VOLG
  103. & , ROD, PD, UXD, UYD, UZD, RETD, GAMD, VOLD
  104. & , SURF, CNX, CNY, CNZ, CT1X, CT1Y, CT1Z, CT2X, CT2Y, CT2Z
  105. & , FUNCEL
  106. & , DFRO(5), DFRET(5), DFRUN(5), DFRUT1(5), DFRUT2(5)
  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, RUZ.IZAFM, RP.IZAFM,
  122. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXUZ.IZAFM, UXP.IZAFM,
  123. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYUZ.IZAFM, UYP.IZAFM,
  124. & UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZUZ.IZAFM, UZP.IZAFM,
  125. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM,
  126. & RETP.IZAFM
  127. POINTEUR MLMINC.MLMOTS
  128. C
  129. C**** KRIPAD pour la correspondance global/local des conditions limits
  130. C
  131. CALL KRIPAD(MELLIM,MLELIM)
  132. c SEGACT MELLIM
  133. C
  134. C**** KRIPAD pour la correspondance global/local des centres
  135. C
  136. CALL KRIPAD(MELEMC,MLENTC)
  137. C
  138. C SEGACT MLENTC
  139. SEGACT MELEMC
  140. C
  141. SEGACT MELEFE
  142. C
  143. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  144. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  145. CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  146. C
  147. C**** LICHT active les MPOVALs en *MOD
  148. C
  149. C i.e.
  150. C
  151. C SEGACT MPOVSU*MOD
  152. C SEGACT MPOVNO*MOD
  153. C SEGACT MPVOLU*MOD
  154. C
  155. MELEMF = IGEOMF
  156. CALL KRIPAD(MELEMF,MLENTF)
  157. C
  158. C SEGACT MLENTF
  159. SEGACT MELEMF
  160. C
  161. CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  162. CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  163. CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  164. CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
  165. C
  166. C SEGACT MPRN*MOD
  167. C SEGACT MPPN*MOD
  168. C SEGACT MPUN*MOD
  169. C SEGACT MPGAMN*MOD
  170. C
  171. NFAC = MELEFE.NUM(/2)
  172. C
  173. C**** Maillage des inconnues primales
  174. C
  175. NBSOUS = 0
  176. NBREF = 0
  177. NBELEM = NFAC
  178. NBNN = 2
  179. C
  180. SEGINI MELEDU
  181. C MELEPR = MELEDU
  182. C
  183. C**** MELEDU = 'SEG2'
  184. C
  185. MELEDU.ITYPEL = 2
  186. C
  187. NRIGE = 7
  188. NMATRI = 1
  189. NKID = 9
  190. NKMT = 7
  191. C
  192. SEGINI MATRIK
  193. IMAT = MATRIK
  194. MATRIK.IRIGEL(1,1) = MELEDU
  195. MATRIK.IRIGEL(2,1) = MELEDU
  196. C
  197. C**** Matrice non symetrique
  198. C
  199. MATRIK.IRIGEL(7,1) = 2
  200. C
  201. NBME = 25
  202. NBSOUS = 1
  203. SEGINI IMATRI
  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(5)
  215. C
  216. IMATRI.LISPRI(6) = MLMINC.MOTS(1)
  217. IMATRI.LISPRI(7) = MLMINC.MOTS(2)
  218. IMATRI.LISPRI(8) = MLMINC.MOTS(3)
  219. IMATRI.LISPRI(9) = MLMINC.MOTS(4)
  220. IMATRI.LISPRI(10) = MLMINC.MOTS(5)
  221. C
  222. IMATRI.LISPRI(11) = MLMINC.MOTS(1)
  223. IMATRI.LISPRI(12) = MLMINC.MOTS(2)
  224. IMATRI.LISPRI(13) = MLMINC.MOTS(3)
  225. IMATRI.LISPRI(14) = MLMINC.MOTS(4)
  226. IMATRI.LISPRI(15) = MLMINC.MOTS(5)
  227. C
  228. IMATRI.LISPRI(16) = MLMINC.MOTS(1)
  229. IMATRI.LISPRI(17) = MLMINC.MOTS(2)
  230. IMATRI.LISPRI(18) = MLMINC.MOTS(3)
  231. IMATRI.LISPRI(19) = MLMINC.MOTS(4)
  232. IMATRI.LISPRI(20) = MLMINC.MOTS(5)
  233. C
  234. IMATRI.LISPRI(21) = MLMINC.MOTS(1)
  235. IMATRI.LISPRI(22) = MLMINC.MOTS(2)
  236. IMATRI.LISPRI(23) = MLMINC.MOTS(3)
  237. IMATRI.LISPRI(24) = MLMINC.MOTS(4)
  238. IMATRI.LISPRI(25) = MLMINC.MOTS(5)
  239. SEGDES MLMINC
  240. C
  241. C**** Variables duales (conservatives)
  242. C
  243. MLMINC = ILINC
  244. SEGACT MLMINC
  245. IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  246. IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  247. IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  248. IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  249. IMATRI.LISDUA(5) = MLMINC.MOTS(1)
  250. C
  251. IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  252. IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  253. IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  254. IMATRI.LISDUA(9) = MLMINC.MOTS(2)
  255. IMATRI.LISDUA(10) = MLMINC.MOTS(2)
  256. C
  257. IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  258. IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  259. IMATRI.LISDUA(13) = MLMINC.MOTS(3)
  260. IMATRI.LISDUA(14) = MLMINC.MOTS(3)
  261. IMATRI.LISDUA(15) = MLMINC.MOTS(3)
  262. C
  263. IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  264. IMATRI.LISDUA(17) = MLMINC.MOTS(4)
  265. IMATRI.LISDUA(18) = MLMINC.MOTS(4)
  266. IMATRI.LISDUA(19) = MLMINC.MOTS(4)
  267. IMATRI.LISDUA(20) = MLMINC.MOTS(4)
  268. C
  269. IMATRI.LISDUA(21) = MLMINC.MOTS(5)
  270. IMATRI.LISDUA(22) = MLMINC.MOTS(5)
  271. IMATRI.LISDUA(23) = MLMINC.MOTS(5)
  272. IMATRI.LISDUA(24) = MLMINC.MOTS(5)
  273. IMATRI.LISDUA(25) = MLMINC.MOTS(5)
  274. SEGDES MLMINC
  275. C
  276. NBEL = NBELEM
  277. NBSOUS = 1
  278. NP = 2
  279. MP = 2
  280. SEGINI RR , RUX , RUY , RUZ, RP ,
  281. & UXR , UXUX , UXUY , UXUZ, UXP ,
  282. & UYR , UYUX , UYUY , UYUZ, UYP ,
  283. & UZR , UZUX , UZUY , UZUZ, UZP ,
  284. & RETR , RETUX , RETUY , RETUZ, RETP
  285. C
  286. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  287. C Primale = IMATRI.LISPRI(1) = 'RN'
  288. C -> IMATRI.LIZAFM(1,1) = RR
  289. C
  290. C Duale = IMATRI.LISDUA(2) = 'RN'
  291. C Primale = IMATRI.LISPRI(1) = 'RUXN'
  292. C -> IMATRI.LIZAFM(1,2) = RUX
  293. C ...
  294. C
  295. IMATRI.LIZAFM(1,1) = RR
  296. IMATRI.LIZAFM(1,2) = RUX
  297. IMATRI.LIZAFM(1,3) = RUY
  298. IMATRI.LIZAFM(1,4) = RUZ
  299. IMATRI.LIZAFM(1,5) = RP
  300. C
  301. IMATRI.LIZAFM(1,6) = UXR
  302. IMATRI.LIZAFM(1,7) = UXUX
  303. IMATRI.LIZAFM(1,8) = UXUY
  304. IMATRI.LIZAFM(1,9) = UXUZ
  305. IMATRI.LIZAFM(1,10) = UXP
  306. C
  307. IMATRI.LIZAFM(1,11) = UYR
  308. IMATRI.LIZAFM(1,12) = UYUX
  309. IMATRI.LIZAFM(1,13) = UYUY
  310. IMATRI.LIZAFM(1,14) = UYUZ
  311. IMATRI.LIZAFM(1,15) = UYP
  312. C
  313. IMATRI.LIZAFM(1,16) = UZR
  314. IMATRI.LIZAFM(1,17) = UZUX
  315. IMATRI.LIZAFM(1,18) = UZUY
  316. IMATRI.LIZAFM(1,19) = UZUZ
  317. IMATRI.LIZAFM(1,20) = UZP
  318. C
  319. IMATRI.LIZAFM(1,21) = RETR
  320. IMATRI.LIZAFM(1,22) = RETUX
  321. IMATRI.LIZAFM(1,23) = RETUY
  322. IMATRI.LIZAFM(1,24) = RETUZ
  323. IMATRI.LIZAFM(1,25) = RETP
  324. C
  325. DO IFAC = 1, NFAC, 1
  326. NGCF = MELEFE.NUM(2,IFAC)
  327. NLCF = MLENTF.LECT(NGCF)
  328. IF(NLCF .NE. IFAC)THEN
  329. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  330. CALL ERREUR(5)
  331. GOTO 9999
  332. ENDIF
  333. NGCG = MELEFE.NUM(1,IFAC)
  334. NGCD = MELEFE.NUM(3,IFAC)
  335. NLFL = MLELIM.LECT(NGCF)
  336. IF(NLFL .NE. 0)THEN
  337. C
  338. C********** The point belongs on BC -> No contribution to jacobian!
  339. C
  340. MELEDU.NUM(1,IFAC) = NGCG
  341. MELEDU.NUM(2,IFAC) = NGCD
  342. ELSEIF(NGCG .NE. NGCD)THEN
  343. C
  344. C********** Les MELEMEs
  345. C
  346. MELEDU.NUM(1,IFAC) = NGCG
  347. MELEDU.NUM(2,IFAC) = NGCD
  348. C
  349. C********** Les etats G et D
  350. C
  351. NLCG = MLENTC.LECT(NGCG)
  352. NLCD = MLENTC.LECT(NGCD)
  353. C
  354. ROG = MPRN.VPOCHA(NLCG,1)
  355. PG = MPPN.VPOCHA(NLCG,1)
  356. UXG = MPUN.VPOCHA(NLCG,1)
  357. UYG = MPUN.VPOCHA(NLCG,2)
  358. UZG = MPUN.VPOCHA(NLCG,3)
  359. GAMG = MPGAMN.VPOCHA(NLCG,1)
  360. RETG= PG / (GAMG - 1.0D0) + 0.5D0 * ROG *
  361. & (UXG * UXG + UYG * UYG + UZG * UZG)
  362. VOLG = MPVOLU.VPOCHA(NLCG,1)
  363. C
  364. ROD = MPRN.VPOCHA(NLCD,1)
  365. PD = MPPN.VPOCHA(NLCD,1)
  366. UXD = MPUN.VPOCHA(NLCD,1)
  367. UYD = MPUN.VPOCHA(NLCD,2)
  368. UZD = MPUN.VPOCHA(NLCD,3)
  369. GAMD = MPGAMN.VPOCHA(NLCD,1)
  370. RETD= PD / (GAMD - 1.0D0) + 0.5D0 * ROD *
  371. & (UXD * UXD + UYD * UYD + UZD * UZD)
  372. VOLD = MPVOLU.VPOCHA(NLCD,1)
  373. C
  374. C********** La normale G->D
  375. C La tangente
  376. C
  377. SURF = MPOVSU.VPOCHA(NLCF,1)
  378. CNX = MPNORM.VPOCHA(NLCF,7)
  379. CNY = MPNORM.VPOCHA(NLCF,8)
  380. CNZ = MPNORM.VPOCHA(NLCF,9)
  381. C
  382. C********** Cosinus directeurs de tangente 1
  383. C
  384. CT1X = MPNORM.VPOCHA(NLCF,1)
  385. CT1Y = MPNORM.VPOCHA(NLCF,2)
  386. CT1Z = MPNORM.VPOCHA(NLCF,3)
  387. C
  388. C********** Cosinus directeurs de tangente 2
  389. C
  390. CT2X = MPNORM.VPOCHA(NLCF,4)
  391. CT2Y = MPNORM.VPOCHA(NLCF,5)
  392. CT2Z = MPNORM.VPOCHA(NLCF,6)
  393. C
  394. C********** La contribution de Gauche
  395. C
  396. CALL VLHJ5(ROG,UXG,UYG,UZG,PG,RETG,GAMG,CNX,CNY,CNZ,
  397. & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z,
  398. & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET)
  399. C
  400. C
  401. C********** AB.AM(IFAC,IPRIM,IDUAL)
  402. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  403. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  404. C IPRIM = 1, 2 -> G, D
  405. C IDUAL = 1, 2 -> G, D
  406. C i.e.
  407. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  408. C
  409. C
  410. C********** Dual RN
  411. C
  412. FUNCEL = SURF * DFRO(1)
  413. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  414. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  415. C
  416. FUNCEL = SURF * DFRO(2)
  417. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  418. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  419. C
  420. FUNCEL = SURF * DFRO(3)
  421. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  422. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  423. C
  424. FUNCEL = SURF * DFRO(4)
  425. RUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  426. RUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  427. C
  428. FUNCEL = SURF * DFRO(5)
  429. RP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  430. RP.AM(IFAC,1,2) = FUNCEL / VOLD
  431. C
  432. C********** Dual RUXN
  433. C
  434. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT1(1) * CT1X
  435. & + DFRUT2(1) * CT2X)
  436. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  437. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  438. C
  439. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT1(2) * CT1X
  440. & + DFRUT2(2) * CT2X)
  441. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  442. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  443. C
  444. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT1(3) * CT1X
  445. & + DFRUT2(3) * CT2X)
  446. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  447. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  448. C
  449. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT1(4) * CT1X
  450. & + DFRUT2(4) * CT2X)
  451. UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  452. UXUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  453. C
  454. FUNCEL = SURF * (DFRUN(5) * CNX + DFRUT1(5) * CT1X
  455. & + DFRUT2(5) * CT2X)
  456. UXP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  457. UXP.AM(IFAC,1,2) = FUNCEL / VOLD
  458. C
  459. C********** Dual RUYN
  460. C
  461. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT1(1) * CT1Y
  462. & + DFRUT2(1) * CT2Y )
  463. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  464. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  465. C
  466. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT1(2) * CT1Y
  467. & + DFRUT2(2) * CT2Y)
  468. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  469. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  470. C
  471. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT1(3) * CT1Y
  472. & + DFRUT2(3) * CT2Y)
  473. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  474. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  475. C
  476. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT1(4) * CT1Y
  477. & + DFRUT2(4) * CT2Y)
  478. UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  479. UYUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  480. C
  481. FUNCEL = SURF * (DFRUN(5) * CNY + DFRUT1(5) * CT1Y
  482. & + DFRUT2(5) * CT2Y)
  483. UYP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  484. UYP.AM(IFAC,1,2) = FUNCEL / VOLD
  485. C
  486. C********** Dual RUZN
  487. C
  488. FUNCEL = SURF * (DFRUN(1) * CNZ + DFRUT1(1) * CT1Z
  489. & + DFRUT2(1) * CT2Z )
  490. UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  491. UZR.AM(IFAC,1,2) = FUNCEL / VOLD
  492. C
  493. FUNCEL = SURF * (DFRUN(2) * CNZ + DFRUT1(2) * CT1Z
  494. & + DFRUT2(2) * CT2Z)
  495. UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  496. UZUX.AM(IFAC,1,2) = FUNCEL / VOLD
  497. C
  498. FUNCEL = SURF * (DFRUN(3) * CNZ + DFRUT1(3) * CT1Z
  499. & + DFRUT2(3) * CT2Z)
  500. UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  501. UZUY.AM(IFAC,1,2) = FUNCEL / VOLD
  502. C
  503. FUNCEL = SURF * (DFRUN(4) * CNZ + DFRUT1(4) * CT1Z
  504. & + DFRUT2(4) * CT2Z)
  505. UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  506. UZUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  507. C
  508. FUNCEL = SURF * (DFRUN(5) * CNZ + DFRUT1(5) * CT1Z
  509. & + DFRUT2(5) * CT2Z)
  510. UZP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  511. UZP.AM(IFAC,1,2) = FUNCEL / VOLD
  512. C
  513. C********** Dual RETN
  514. C
  515. FUNCEL = SURF * DFRET(1)
  516. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  517. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  518. C
  519. FUNCEL = SURF * DFRET(2)
  520. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  521. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  522. C
  523. FUNCEL = SURF * DFRET(3)
  524. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  525. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  526. C
  527. FUNCEL = SURF * DFRET(4)
  528. RETUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  529. RETUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  530. C
  531. FUNCEL = SURF * DFRET(5)
  532. RETP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  533. RETP.AM(IFAC,1,2) = FUNCEL / VOLD
  534. C
  535. C
  536. C********** La contribution de D
  537. C
  538. CNX = -1.0D0 * CNX
  539. CNY = -1.0D0 * CNY
  540. CNZ = -1.0D0 * CNZ
  541. CT1X = -1.0D0 * CT1X
  542. CT1Y = -1.0D0 * CT1Y
  543. CT1Z = -1.0D0 * CT1Z
  544. CT2X = -1.0D0 * CT2X
  545. CT2Y = -1.0D0 * CT2Y
  546. CT2Z = -1.0D0 * CT2Z
  547. C
  548. CALL VLHJ5(ROD,UXD,UYD,UZD,PD,RETD,GAMD,CNX,CNY,CNZ,
  549. & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z,
  550. & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET)
  551. C
  552. C
  553. C********** Dual RN
  554. C
  555. FUNCEL = SURF * DFRO(1)
  556. RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  557. RR.AM(IFAC,2,1) = FUNCEL / VOLG
  558. C
  559. FUNCEL = SURF * DFRO(2)
  560. RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  561. RUX.AM(IFAC,2,1) = FUNCEL / VOLG
  562. C
  563. FUNCEL = SURF * DFRO(3)
  564. RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  565. RUY.AM(IFAC,2,1) = FUNCEL / VOLG
  566. C
  567. FUNCEL = SURF * DFRO(4)
  568. RUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  569. RUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  570. C
  571. FUNCEL = SURF * DFRO(5)
  572. RP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  573. RP.AM(IFAC,2,1) = FUNCEL / VOLG
  574. C
  575. C********** Dual RUXN
  576. C
  577. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT1(1) * CT1X
  578. & + DFRUT2(1) * CT2X)
  579. UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  580. UXR.AM(IFAC,2,1) = FUNCEL / VOLG
  581. C
  582. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT1(2) * CT1X
  583. & + DFRUT2(2) * CT2X)
  584. UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  585. UXUX.AM(IFAC,2,1) = FUNCEL / VOLG
  586. C
  587. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT1(3) * CT1X
  588. & + DFRUT2(3) * CT2X)
  589. UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  590. UXUY.AM(IFAC,2,1) = FUNCEL / VOLG
  591. C
  592. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT1(4) * CT1X
  593. & + DFRUT2(4) * CT2X)
  594. UXUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  595. UXUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  596. C
  597. FUNCEL = SURF * (DFRUN(5) * CNX + DFRUT1(5) * CT1X
  598. & + DFRUT2(5) * CT2X)
  599. UXP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  600. UXP.AM(IFAC,2,1) = FUNCEL / VOLG
  601. C
  602. C********** Dual RUYN
  603. C
  604. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT1(1) * CT1Y
  605. & + DFRUT2(1) * CT2Y )
  606. UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  607. UYR.AM(IFAC,2,1) = FUNCEL / VOLG
  608. C
  609. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT1(2) * CT1Y
  610. & + DFRUT2(2) * CT2Y)
  611. UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  612. UYUX.AM(IFAC,2,1) = FUNCEL / VOLG
  613. C
  614. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT1(3) * CT1Y
  615. & + DFRUT2(3) * CT2Y)
  616. UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  617. UYUY.AM(IFAC,2,1) = FUNCEL / VOLG
  618. C
  619. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT1(4) * CT1Y
  620. & + DFRUT2(4) * CT2Y)
  621. UYUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  622. UYUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  623. C
  624. FUNCEL = SURF * (DFRUN(5) * CNY + DFRUT1(5) * CT1Y
  625. & + DFRUT2(5) * CT2Y)
  626. UYP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  627. UYP.AM(IFAC,2,1) = FUNCEL / VOLG
  628. C
  629. C********** Dual RUZN
  630. C
  631. FUNCEL = SURF * (DFRUN(1) * CNZ + DFRUT1(1) * CT1Z
  632. & + DFRUT2(1) * CT2Z )
  633. UZR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  634. UZR.AM(IFAC,2,1) = FUNCEL / VOLG
  635. C
  636. FUNCEL = SURF * (DFRUN(2) * CNZ + DFRUT1(2) * CT1Z
  637. & + DFRUT2(2) * CT2Z)
  638. UZUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  639. UZUX.AM(IFAC,2,1) = FUNCEL / VOLG
  640. C
  641. FUNCEL = SURF * (DFRUN(3) * CNZ + DFRUT1(3) * CT1Z
  642. & + DFRUT2(3) * CT2Z)
  643. UZUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  644. UZUY.AM(IFAC,2,1) = FUNCEL / VOLG
  645. C
  646. FUNCEL = SURF * (DFRUN(4) * CNZ + DFRUT1(4) * CT1Z
  647. & + DFRUT2(4) * CT2Z)
  648. UZUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  649. UZUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  650. C
  651. FUNCEL = SURF * (DFRUN(5) * CNZ + DFRUT1(5) * CT1Z
  652. & + DFRUT2(5) * CT2Z)
  653. UZP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  654. UZP.AM(IFAC,2,1) = FUNCEL / VOLG
  655. C
  656. C********** Dual RETN
  657. C
  658. FUNCEL = SURF * DFRET(1)
  659. RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  660. RETR.AM(IFAC,2,1) = FUNCEL / VOLG
  661. C
  662. FUNCEL = SURF * DFRET(2)
  663. RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  664. RETUX.AM(IFAC,2,1) = FUNCEL / VOLG
  665. C
  666. FUNCEL = SURF * DFRET(3)
  667. RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  668. RETUY.AM(IFAC,2,1) = FUNCEL / VOLG
  669. C
  670. FUNCEL = SURF * DFRET(4)
  671. RETUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  672. RETUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  673. C
  674. FUNCEL = SURF * DFRET(5)
  675. RETP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  676. RETP.AM(IFAC,2,1) = FUNCEL / VOLG
  677. C
  678. ELSE
  679. C
  680. C********** Murs (NGCG = NGCD)
  681. C
  682. C
  683. C********** Les MELEMEs
  684. C
  685. MELEDU.NUM(1,IFAC) = NGCG
  686. MELEDU.NUM(2,IFAC) = NGCD
  687. NLCG = MLENTC.LECT(NGCG)
  688. C
  689. ROG = MPRN.VPOCHA(NLCG,1)
  690. PG = MPPN.VPOCHA(NLCG,1)
  691. UXG = MPUN.VPOCHA(NLCG,1)
  692. UYG = MPUN.VPOCHA(NLCG,2)
  693. UZG = MPUN.VPOCHA(NLCG,3)
  694. GAMG = MPGAMN.VPOCHA(NLCG,1)
  695. VOLG = MPVOLU.VPOCHA(NLCG,1)
  696. C
  697. C********** La normale sortante
  698. C
  699. SURF = MPOVSU.VPOCHA(NLCF,1)
  700. CNX = MPNORM.VPOCHA(NLCF,7)
  701. CNY = MPNORM.VPOCHA(NLCF,8)
  702. CNZ = MPNORM.VPOCHA(NLCF,9)
  703. C
  704. CALL VLHJ7(ROG,UXG,UYG,UZG,PG,GAMG,CNX,CNY,CNZ,
  705. & DFRUN)
  706. C
  707. C********** Dual RN
  708. C
  709. RR.AM(IFAC,1,1) = 0.0D0
  710. RR.AM(IFAC,1,2) = 0.0D0
  711. C
  712. RUX.AM(IFAC,1,1) = 0.0D0
  713. RUX.AM(IFAC,1,2) = 0.0D0
  714. C
  715. RUY.AM(IFAC,1,1) = 0.0D0
  716. RUY.AM(IFAC,1,2) = 0.0D0
  717. C
  718. RUZ.AM(IFAC,1,1) = 0.0D0
  719. RUZ.AM(IFAC,1,2) = 0.0D0
  720. C
  721. RP.AM(IFAC,1,1) = 0.0D0
  722. RP.AM(IFAC,1,2) = 0.0D0
  723. C
  724. C********** Dual RUXN
  725. C
  726. FUNCEL = SURF * DFRUN(1) * CNX
  727. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  728. UXR.AM(IFAC,1,2) = 0.0D0
  729. C
  730. FUNCEL = SURF * DFRUN(2) * CNX
  731. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  732. UXUX.AM(IFAC,1,2) = 0.0D0
  733. C
  734. FUNCEL = SURF * DFRUN(3) * CNX
  735. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  736. UXUY.AM(IFAC,1,2) = 0.0D0
  737. C
  738. FUNCEL = SURF * DFRUN(4) * CNX
  739. UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  740. UXUZ.AM(IFAC,1,2) = 0.0D0
  741. C
  742. FUNCEL = SURF * DFRUN(5) * CNX
  743. UXP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  744. UXP.AM(IFAC,1,2) = 0.0D0
  745. C
  746. C********** Dual RUYN
  747. C
  748. FUNCEL = SURF * DFRUN(1) * CNY
  749. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  750. UYR.AM(IFAC,1,2) = 0.0D0
  751. C
  752. FUNCEL = SURF * DFRUN(2) * CNY
  753. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  754. UYUX.AM(IFAC,1,2) = 0.0D0
  755. C
  756. FUNCEL = SURF * DFRUN(3) * CNY
  757. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  758. UYUY.AM(IFAC,1,2) = 0.0D0
  759. C
  760. FUNCEL = SURF * DFRUN(4) * CNY
  761. UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  762. UYUZ.AM(IFAC,1,2) = 0.0D0
  763. C
  764. FUNCEL = SURF * DFRUN(5) * CNY
  765. UYP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  766. UYP.AM(IFAC,1,2) = 0.0D0
  767. C
  768. C********** Dual RUZN
  769. C
  770. FUNCEL = SURF * DFRUN(1) * CNZ
  771. UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  772. UZR.AM(IFAC,1,2) = 0.0D0
  773. C
  774. FUNCEL = SURF * DFRUN(2) * CNZ
  775. UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  776. UZUX.AM(IFAC,1,2) = 0.0D0
  777. C
  778. FUNCEL = SURF * DFRUN(3) * CNZ
  779. UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  780. UZUY.AM(IFAC,1,2) = 0.0D0
  781. C
  782. FUNCEL = SURF * DFRUN(4) * CNZ
  783. UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  784. UZUZ.AM(IFAC,1,2) = 0.0D0
  785. C
  786. FUNCEL = SURF * DFRUN(5) * CNZ
  787. UZP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  788. UZP.AM(IFAC,1,2) = 0.0D0
  789. C
  790. C********** Dual RETN
  791. C
  792. RETR.AM(IFAC,1,1) = 0.0D0
  793. RETR.AM(IFAC,1,2) = 0.0D0
  794. C
  795. RETUX.AM(IFAC,1,1) = 0.0D0
  796. RETUX.AM(IFAC,1,2) = 0.0D0
  797. C
  798. RETUY.AM(IFAC,1,1) = 0.0D0
  799. RETUY.AM(IFAC,1,2) = 0.0D0
  800. C
  801. RETUZ.AM(IFAC,1,1) = 0.0D0
  802. RETUZ.AM(IFAC,1,2) = 0.0D0
  803. C
  804. RETP.AM(IFAC,1,1) = 0.0D0
  805. RETP.AM(IFAC,1,2) = 0.0D0
  806. C
  807. C********** Dual RN
  808. C
  809. RR.AM(IFAC,2,2) = 0.0D0
  810. RR.AM(IFAC,2,1) = 0.0D0
  811. C
  812. RUX.AM(IFAC,2,2) = 0.0D0
  813. RUX.AM(IFAC,2,1) = 0.0D0
  814. C
  815. RUY.AM(IFAC,2,2) = 0.0D0
  816. RUY.AM(IFAC,2,1) = 0.0D0
  817. C
  818. RUZ.AM(IFAC,2,2) = 0.0D0
  819. RUZ.AM(IFAC,2,1) = 0.0D0
  820. C
  821. RP.AM(IFAC,2,2) = 0.0D0
  822. RP.AM(IFAC,2,1) = 0.0D0
  823. C
  824. C********** Dual RUXN
  825. C
  826. UXR.AM(IFAC,2,2) = 0.0D0
  827. UXR.AM(IFAC,2,1) = 0.0D0
  828. C
  829. UXUX.AM(IFAC,2,2) = 0.0D0
  830. UXUX.AM(IFAC,2,1) = 0.0D0
  831. C
  832. UXUY.AM(IFAC,2,2) = 0.0D0
  833. UXUY.AM(IFAC,2,1) = 0.0D0
  834. C
  835. UXUZ.AM(IFAC,2,2) = 0.0D0
  836. UXUZ.AM(IFAC,2,1) = 0.0D0
  837. C
  838. UXP.AM(IFAC,2,2) = 0.0D0
  839. UXP.AM(IFAC,2,1) = 0.0D0
  840. C
  841. C********** Dual RUYN
  842. C
  843. UYR.AM(IFAC,2,2) = 0.0D0
  844. UYR.AM(IFAC,2,1) = 0.0D0
  845. C
  846. UYUX.AM(IFAC,2,2) = 0.0D0
  847. UYUX.AM(IFAC,2,1) = 0.0D0
  848. C
  849. UYUY.AM(IFAC,2,2) = 0.0D0
  850. UYUY.AM(IFAC,2,1) = 0.0D0
  851. C
  852. UYUZ.AM(IFAC,2,2) = 0.0D0
  853. UYUZ.AM(IFAC,2,1) = 0.0D0
  854. C
  855. UYP.AM(IFAC,2,2) = 0.0D0
  856. UYP.AM(IFAC,2,1) = 0.0D0
  857. C
  858. C********** Dual RUZN
  859. C
  860. UZR.AM(IFAC,2,2) = 0.0D0
  861. UZR.AM(IFAC,2,1) = 0.0D0
  862. C
  863. UZUX.AM(IFAC,2,2) = 0.0D0
  864. UZUX.AM(IFAC,2,1) = 0.0D0
  865. C
  866. UZUY.AM(IFAC,2,2) = 0.0D0
  867. UZUY.AM(IFAC,2,1) = 0.0D0
  868. C
  869. UZUZ.AM(IFAC,2,2) = 0.0D0
  870. UZUZ.AM(IFAC,2,1) = 0.0D0
  871. C
  872. UZP.AM(IFAC,2,2) = 0.0D0
  873. UZP.AM(IFAC,2,1) = 0.0D0
  874. C
  875. C********** Dual RETN
  876. C
  877. RETR.AM(IFAC,2,2) = 0.0D0
  878. RETR.AM(IFAC,2,1) = 0.0D0
  879. C
  880. RETUX.AM(IFAC,2,2) = 0.0D0
  881. RETUX.AM(IFAC,2,1) = 0.0D0
  882. C
  883. RETUY.AM(IFAC,2,2) = 0.0D0
  884. RETUY.AM(IFAC,2,1) = 0.0D0
  885. C
  886. RETUZ.AM(IFAC,2,2) = 0.0D0
  887. RETUZ.AM(IFAC,2,1) = 0.0D0
  888. C
  889. RETP.AM(IFAC,2,2) = 0.0D0
  890. RETP.AM(IFAC,2,1) = 0.0D0
  891. C
  892. ENDIF
  893. ENDDO
  894. C
  895. SEGDES MELEMC
  896. SEGDES MELEFE
  897. SEGDES MELEMF
  898. C
  899. SEGDES MPOVSU
  900. SEGDES MPVOLU
  901. SEGDES MPNORM
  902. C
  903. SEGDES MPRN
  904. SEGDES MPPN
  905. SEGDES MPUN
  906. SEGDES MPGAMN
  907. C
  908. SEGDES MELEDU
  909. SEGDES MATRIK
  910. SEGDES IMATRI
  911. C
  912. SEGDES RR , RUX , RUY , RUZ, RP ,
  913. & UXR , UXUX , UXUY , UXUZ, UXP ,
  914. & UYR , UYUX , UYUY , UYUZ, UYP ,
  915. & UZR , UZUX , UZUY , UZUZ, UYP ,
  916. & RETR , RETUX , RETUY , RETUZ, RETP
  917.  
  918. SEGSUP MLENTC
  919. SEGSUP MLENTF
  920. SEGDES MLMINC
  921. SEGSUP MLELIM
  922.  
  923. 9999 CONTINUE
  924. RETURN
  925. END
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  

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