Télécharger konja3.eso

Retour à la liste

Numérotation des lignes :

  1. C KONJA3 SOURCE PV 16/11/17 21:59:54 9180
  2. SUBROUTINE KONJA3(ILINC,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 KONV11
  12. C Calcul du jacobien du résidu pour la méthode de
  13. C VLH
  14. C
  15. C Cas 3D, gaz "calorically perfect"
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18. C
  19. C AUTEUR : A. BECCANTINI, 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) : VLHJ4, VLHJ6
  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 ICHPOVO : CHPOINT VOLUME contenant le volume
  48. C
  49. C ICHPOSU : CHPOINT FACE contenant la surface des faces
  50. C
  51. C
  52. C 2) Pointeurs de MELEME de la table DOMAINE
  53. C
  54. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  55. C
  56. C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts
  57. C
  58. C MELLIM : MELEME SPG des conditions aux bords
  59. C
  60. C SORTIES
  61. C
  62. C IMAT : pointeur de la MATRIK du jacobien du residu
  63. C
  64. C************************************************************************
  65. C
  66. C HISTORIQUE (Anomalies et modifications éventuelles)
  67. C
  68. C HISTORIQUE :
  69. C
  70. C************************************************************************
  71. C
  72. C
  73. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  74. C GAMMA \in (1,3)
  75. C Si non il faut le faire!!!
  76. C
  77. C************************************************************************
  78. C
  79. C
  80. C**** Variables de COOPTIO
  81. C
  82. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  83. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  84. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  85. C & ,IECHO, IIMPI, IOSPI
  86. C & ,IDIM, IFICLE, IPREFI
  87. C & ,MCOORD
  88. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  89. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  90. C & ,NORINC,NORVAL,NORIND,NORVAD
  91. C & ,NUCROU, IPSAUV
  92. C
  93. IMPLICIT INTEGER(I-N)
  94. INTEGER ILINC, IRN,IUN,IPN,IGAMN,INORM,ICHPVO,ICHPSU
  95. & , IMAT, IGEOMC, IGEOMF
  96. & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  97. & , NKMT, NBME, NBEL, MP, NP
  98. & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL
  99. REAL*8 ROG, PG, UXG, UYG, UZG, RETG, GAMG, VOLG
  100. & , ROD, PD, UXD, UYD, UZD, RETD, GAMD, VOLD
  101. & , SURF, CNX, CNY, CNZ, CT1X, CT1Y, CT1Z, CT2X, CT2Y, CT2Z
  102. & , FUNCEL
  103. & , DFRO(5), DFRET(5), DFRUN(5), DFRUT1(5), DFRUT2(5)
  104. CHARACTER*8 TYPE
  105. C
  106. C**** LES INCLUDES
  107. C
  108.  
  109. -INC PPARAM
  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, RUZ.IZAFM, RRET.IZAFM,
  121. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXUZ.IZAFM, UXRET.IZAFM,
  122. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYUZ.IZAFM, UYRET.IZAFM,
  123. & UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZUZ.IZAFM, UZRET.IZAFM,
  124. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM,
  125. & 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 = 25
  201. NBSOUS = 1
  202. SEGINI IMATRI
  203. MLMINC = ILINC
  204. SEGACT MLMINC
  205. MATRIK.IRIGEL(4,1) = IMATRI
  206. C
  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(5)
  212. C
  213. IMATRI.LISPRI(6) = MLMINC.MOTS(1)
  214. IMATRI.LISPRI(7) = MLMINC.MOTS(2)
  215. IMATRI.LISPRI(8) = MLMINC.MOTS(3)
  216. IMATRI.LISPRI(9) = MLMINC.MOTS(4)
  217. IMATRI.LISPRI(10) = MLMINC.MOTS(5)
  218. C
  219. IMATRI.LISPRI(11) = MLMINC.MOTS(1)
  220. IMATRI.LISPRI(12) = MLMINC.MOTS(2)
  221. IMATRI.LISPRI(13) = MLMINC.MOTS(3)
  222. IMATRI.LISPRI(14) = MLMINC.MOTS(4)
  223. IMATRI.LISPRI(15) = MLMINC.MOTS(5)
  224. C
  225. IMATRI.LISPRI(16) = MLMINC.MOTS(1)
  226. IMATRI.LISPRI(17) = MLMINC.MOTS(2)
  227. IMATRI.LISPRI(18) = MLMINC.MOTS(3)
  228. IMATRI.LISPRI(19) = MLMINC.MOTS(4)
  229. IMATRI.LISPRI(20) = MLMINC.MOTS(5)
  230. C
  231. IMATRI.LISPRI(21) = MLMINC.MOTS(1)
  232. IMATRI.LISPRI(22) = MLMINC.MOTS(2)
  233. IMATRI.LISPRI(23) = MLMINC.MOTS(3)
  234. IMATRI.LISPRI(24) = MLMINC.MOTS(4)
  235. IMATRI.LISPRI(25) = MLMINC.MOTS(5)
  236. C
  237. IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  238. IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  239. IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  240. IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  241. IMATRI.LISDUA(5) = MLMINC.MOTS(1)
  242. C
  243. IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  244. IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  245. IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  246. IMATRI.LISDUA(9) = MLMINC.MOTS(2)
  247. IMATRI.LISDUA(10) = MLMINC.MOTS(2)
  248. C
  249. IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  250. IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  251. IMATRI.LISDUA(13) = MLMINC.MOTS(3)
  252. IMATRI.LISDUA(14) = MLMINC.MOTS(3)
  253. IMATRI.LISDUA(15) = MLMINC.MOTS(3)
  254. C
  255. IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  256. IMATRI.LISDUA(17) = MLMINC.MOTS(4)
  257. IMATRI.LISDUA(18) = MLMINC.MOTS(4)
  258. IMATRI.LISDUA(19) = MLMINC.MOTS(4)
  259. IMATRI.LISDUA(20) = MLMINC.MOTS(4)
  260. C
  261. IMATRI.LISDUA(21) = MLMINC.MOTS(5)
  262. IMATRI.LISDUA(22) = MLMINC.MOTS(5)
  263. IMATRI.LISDUA(23) = MLMINC.MOTS(5)
  264. IMATRI.LISDUA(24) = MLMINC.MOTS(5)
  265. IMATRI.LISDUA(25) = MLMINC.MOTS(5)
  266. C
  267. NBEL = NBELEM
  268. NBSOUS = 1
  269. NP = 2
  270. MP = 2
  271. SEGINI RR , RUX , RUY , RUZ, RRET ,
  272. & UXR , UXUX , UXUY , UXUZ, UXRET ,
  273. & UYR , UYUX , UYUY , UYUZ, UYRET ,
  274. & UZR , UZUX , UZUY , UZUZ, UZRET ,
  275. & RETR , RETUX , RETUY , RETUZ, RETRET
  276. C
  277. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  278. C Primale = IMATRI.LISPRI(1) = 'RN'
  279. C -> IMATRI.LIZAFM(1,1) = RR
  280. C
  281. C Duale = IMATRI.LISDUA(2) = 'RN'
  282. C Primale = IMATRI.LISPRI(1) = 'RUXN'
  283. C -> IMATRI.LIZAFM(1,2) = RUX
  284. C ...
  285. C
  286. IMATRI.LIZAFM(1,1) = RR
  287. IMATRI.LIZAFM(1,2) = RUX
  288. IMATRI.LIZAFM(1,3) = RUY
  289. IMATRI.LIZAFM(1,4) = RUZ
  290. IMATRI.LIZAFM(1,5) = RRET
  291. C
  292. IMATRI.LIZAFM(1,6) = UXR
  293. IMATRI.LIZAFM(1,7) = UXUX
  294. IMATRI.LIZAFM(1,8) = UXUY
  295. IMATRI.LIZAFM(1,9) = UXUZ
  296. IMATRI.LIZAFM(1,10) = UXRET
  297. C
  298. IMATRI.LIZAFM(1,11) = UYR
  299. IMATRI.LIZAFM(1,12) = UYUX
  300. IMATRI.LIZAFM(1,13) = UYUY
  301. IMATRI.LIZAFM(1,14) = UYUZ
  302. IMATRI.LIZAFM(1,15) = UYRET
  303. C
  304. IMATRI.LIZAFM(1,16) = UZR
  305. IMATRI.LIZAFM(1,17) = UZUX
  306. IMATRI.LIZAFM(1,18) = UZUY
  307. IMATRI.LIZAFM(1,19) = UZUZ
  308. IMATRI.LIZAFM(1,20) = UZRET
  309. C
  310. IMATRI.LIZAFM(1,21) = RETR
  311. IMATRI.LIZAFM(1,22) = RETUX
  312. IMATRI.LIZAFM(1,23) = RETUY
  313. IMATRI.LIZAFM(1,24) = RETUZ
  314. IMATRI.LIZAFM(1,25) = RETRET
  315. C
  316. DO IFAC = 1, NFAC, 1
  317. NGCF = MELEFE.NUM(2,IFAC)
  318. NLCF = MLENTF.LECT(NGCF)
  319. IF(NLCF .NE. IFAC)THEN
  320. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  321. CALL ERREUR(5)
  322. GOTO 9999
  323. ENDIF
  324. NGCG = MELEFE.NUM(1,IFAC)
  325. NGCD = MELEFE.NUM(3,IFAC)
  326. NLFL = MLELIM.LECT(NGCF)
  327. IF(NLFL .NE. 0)THEN
  328. C
  329. C********** The point belongs on BC -> No contribution to jacobian!
  330. C
  331. MELEDU.NUM(1,IFAC) = NGCG
  332. MELEDU.NUM(2,IFAC) = NGCD
  333. ELSEIF(NGCG .NE. NGCD)THEN
  334. C
  335. C********** Les MELEMEs
  336. C
  337. MELEDU.NUM(1,IFAC) = NGCG
  338. MELEDU.NUM(2,IFAC) = NGCD
  339. C
  340. C********** Les etats G et D
  341. C
  342. NLCG = MLENTC.LECT(NGCG)
  343. NLCD = MLENTC.LECT(NGCD)
  344. C
  345. ROG = MPRN.VPOCHA(NLCG,1)
  346. PG = MPPN.VPOCHA(NLCG,1)
  347. UXG = MPUN.VPOCHA(NLCG,1)
  348. UYG = MPUN.VPOCHA(NLCG,2)
  349. UZG = MPUN.VPOCHA(NLCG,3)
  350. GAMG = MPGAMN.VPOCHA(NLCG,1)
  351. RETG= PG / (GAMG - 1.0D0) + 0.5D0 * ROG *
  352. & (UXG * UXG + UYG * UYG + UZG * UZG)
  353. VOLG = MPVOLU.VPOCHA(NLCG,1)
  354. C
  355. ROD = MPRN.VPOCHA(NLCD,1)
  356. PD = MPPN.VPOCHA(NLCD,1)
  357. UXD = MPUN.VPOCHA(NLCD,1)
  358. UYD = MPUN.VPOCHA(NLCD,2)
  359. UZD = MPUN.VPOCHA(NLCD,3)
  360. GAMD = MPGAMN.VPOCHA(NLCD,1)
  361. RETD= PD / (GAMD - 1.0D0) + 0.5D0 * ROD *
  362. & (UXD * UXD + UYD * UYD + UZD * UZD)
  363. VOLD = MPVOLU.VPOCHA(NLCD,1)
  364. C
  365. C********** La normale G->D
  366. C La tangente
  367. C
  368. SURF = MPOVSU.VPOCHA(NLCF,1)
  369. CNX = MPNORM.VPOCHA(NLCF,7)
  370. CNY = MPNORM.VPOCHA(NLCF,8)
  371. CNZ = MPNORM.VPOCHA(NLCF,9)
  372. C
  373. C********** Cosinus directeurs de tangente 1
  374. C
  375. CT1X = MPNORM.VPOCHA(NLCF,1)
  376. CT1Y = MPNORM.VPOCHA(NLCF,2)
  377. CT1Z = MPNORM.VPOCHA(NLCF,3)
  378. C
  379. C********** Cosinus directeurs de tangente 2
  380. C
  381. CT2X = MPNORM.VPOCHA(NLCF,4)
  382. CT2Y = MPNORM.VPOCHA(NLCF,5)
  383. CT2Z = MPNORM.VPOCHA(NLCF,6)
  384. C
  385. C********** La contribution de Gauche
  386. C
  387. CALL VLHJ4(ROG,UXG,UYG,UZG,PG,RETG,GAMG,CNX,CNY,CNZ,
  388. & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z,
  389. & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET)
  390. C
  391. C
  392. C********** AB.AM(IFAC,IPRIM,IDUAL)
  393. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  394. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  395. C IPRIM = 1, 2 -> G, D
  396. C IDUAL = 1, 2 -> G, D
  397. C i.e.
  398. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  399. C
  400. C
  401. C********** Dual RN
  402. C
  403. FUNCEL = SURF * DFRO(1)
  404. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  405. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  406. C
  407. FUNCEL = SURF * DFRO(2)
  408. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  409. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  410. C
  411. FUNCEL = SURF * DFRO(3)
  412. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  413. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  414. C
  415. FUNCEL = SURF * DFRO(4)
  416. RUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  417. RUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  418. C
  419. FUNCEL = SURF * DFRO(5)
  420. RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  421. RRET.AM(IFAC,1,2) = FUNCEL / VOLD
  422. C
  423. C********** Dual RUXN
  424. C
  425. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT1(1) * CT1X
  426. & + DFRUT2(1) * CT2X)
  427. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  428. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  429. C
  430. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT1(2) * CT1X
  431. & + DFRUT2(2) * CT2X)
  432. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  433. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  434. C
  435. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT1(3) * CT1X
  436. & + DFRUT2(3) * CT2X)
  437. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  438. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  439. C
  440. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT1(4) * CT1X
  441. & + DFRUT2(4) * CT2X)
  442. UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  443. UXUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  444. C
  445. FUNCEL = SURF * (DFRUN(5) * CNX + DFRUT1(5) * CT1X
  446. & + DFRUT2(5) * CT2X)
  447. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  448. UXRET.AM(IFAC,1,2) = FUNCEL / VOLD
  449. C
  450. C********** Dual RUYN
  451. C
  452. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT1(1) * CT1Y
  453. & + DFRUT2(1) * CT2Y )
  454. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  455. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  456. C
  457. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT1(2) * CT1Y
  458. & + DFRUT2(2) * CT2Y)
  459. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  460. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  461. C
  462. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT1(3) * CT1Y
  463. & + DFRUT2(3) * CT2Y)
  464. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  465. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  466. C
  467. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT1(4) * CT1Y
  468. & + DFRUT2(4) * CT2Y)
  469. UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  470. UYUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  471. C
  472. FUNCEL = SURF * (DFRUN(5) * CNY + DFRUT1(5) * CT1Y
  473. & + DFRUT2(5) * CT2Y)
  474. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  475. UYRET.AM(IFAC,1,2) = FUNCEL / VOLD
  476. C
  477. C********** Dual RUZN
  478. C
  479. FUNCEL = SURF * (DFRUN(1) * CNZ + DFRUT1(1) * CT1Z
  480. & + DFRUT2(1) * CT2Z )
  481. UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  482. UZR.AM(IFAC,1,2) = FUNCEL / VOLD
  483. C
  484. FUNCEL = SURF * (DFRUN(2) * CNZ + DFRUT1(2) * CT1Z
  485. & + DFRUT2(2) * CT2Z)
  486. UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  487. UZUX.AM(IFAC,1,2) = FUNCEL / VOLD
  488. C
  489. FUNCEL = SURF * (DFRUN(3) * CNZ + DFRUT1(3) * CT1Z
  490. & + DFRUT2(3) * CT2Z)
  491. UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  492. UZUY.AM(IFAC,1,2) = FUNCEL / VOLD
  493. C
  494. FUNCEL = SURF * (DFRUN(4) * CNZ + DFRUT1(4) * CT1Z
  495. & + DFRUT2(4) * CT2Z)
  496. UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  497. UZUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  498. C
  499. FUNCEL = SURF * (DFRUN(5) * CNZ + DFRUT1(5) * CT1Z
  500. & + DFRUT2(5) * CT2Z)
  501. UZRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  502. UZRET.AM(IFAC,1,2) = FUNCEL / VOLD
  503. C
  504. C********** Dual RETN
  505. C
  506. FUNCEL = SURF * DFRET(1)
  507. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  508. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  509. C
  510. FUNCEL = SURF * DFRET(2)
  511. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  512. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  513. C
  514. FUNCEL = SURF * DFRET(3)
  515. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  516. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  517. C
  518. FUNCEL = SURF * DFRET(4)
  519. RETUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  520. RETUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  521. C
  522. FUNCEL = SURF * DFRET(5)
  523. RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  524. RETRET.AM(IFAC,1,2) = FUNCEL / VOLD
  525. C
  526. C
  527. C********** La contribution de D
  528. C
  529. CNX = -1.0D0 * CNX
  530. CNY = -1.0D0 * CNY
  531. CNZ = -1.0D0 * CNZ
  532. CT1X = -1.0D0 * CT1X
  533. CT1Y = -1.0D0 * CT1Y
  534. CT1Z = -1.0D0 * CT1Z
  535. CT2X = -1.0D0 * CT2X
  536. CT2Y = -1.0D0 * CT2Y
  537. CT2Z = -1.0D0 * CT2Z
  538. C
  539. CALL VLHJ4(ROD,UXD,UYD,UZD,PD,RETD,GAMD,CNX,CNY,CNZ,
  540. & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z,
  541. & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET)
  542. C
  543. C
  544. C********** Dual RN
  545. C
  546. FUNCEL = SURF * DFRO(1)
  547. RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  548. RR.AM(IFAC,2,1) = FUNCEL / VOLG
  549. C
  550. FUNCEL = SURF * DFRO(2)
  551. RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  552. RUX.AM(IFAC,2,1) = FUNCEL / VOLG
  553. C
  554. FUNCEL = SURF * DFRO(3)
  555. RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  556. RUY.AM(IFAC,2,1) = FUNCEL / VOLG
  557. C
  558. FUNCEL = SURF * DFRO(4)
  559. RUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  560. RUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  561. C
  562. FUNCEL = SURF * DFRO(5)
  563. RRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  564. RRET.AM(IFAC,2,1) = FUNCEL / VOLG
  565. C
  566. C********** Dual RUXN
  567. C
  568. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT1(1) * CT1X
  569. & + DFRUT2(1) * CT2X)
  570. UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  571. UXR.AM(IFAC,2,1) = FUNCEL / VOLG
  572. C
  573. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT1(2) * CT1X
  574. & + DFRUT2(2) * CT2X)
  575. UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  576. UXUX.AM(IFAC,2,1) = FUNCEL / VOLG
  577. C
  578. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT1(3) * CT1X
  579. & + DFRUT2(3) * CT2X)
  580. UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  581. UXUY.AM(IFAC,2,1) = FUNCEL / VOLG
  582. C
  583. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT1(4) * CT1X
  584. & + DFRUT2(4) * CT2X)
  585. UXUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  586. UXUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  587. C
  588. FUNCEL = SURF * (DFRUN(5) * CNX + DFRUT1(5) * CT1X
  589. & + DFRUT2(5) * CT2X)
  590. UXRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  591. UXRET.AM(IFAC,2,1) = FUNCEL / VOLG
  592. C
  593. C********** Dual RUYN
  594. C
  595. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT1(1) * CT1Y
  596. & + DFRUT2(1) * CT2Y )
  597. UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  598. UYR.AM(IFAC,2,1) = FUNCEL / VOLG
  599. C
  600. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT1(2) * CT1Y
  601. & + DFRUT2(2) * CT2Y)
  602. UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  603. UYUX.AM(IFAC,2,1) = FUNCEL / VOLG
  604. C
  605. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT1(3) * CT1Y
  606. & + DFRUT2(3) * CT2Y)
  607. UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  608. UYUY.AM(IFAC,2,1) = FUNCEL / VOLG
  609. C
  610. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT1(4) * CT1Y
  611. & + DFRUT2(4) * CT2Y)
  612. UYUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  613. UYUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  614. C
  615. FUNCEL = SURF * (DFRUN(5) * CNY + DFRUT1(5) * CT1Y
  616. & + DFRUT2(5) * CT2Y)
  617. UYRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  618. UYRET.AM(IFAC,2,1) = FUNCEL / VOLG
  619. C
  620. C********** Dual RUZN
  621. C
  622. FUNCEL = SURF * (DFRUN(1) * CNZ + DFRUT1(1) * CT1Z
  623. & + DFRUT2(1) * CT2Z )
  624. UZR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  625. UZR.AM(IFAC,2,1) = FUNCEL / VOLG
  626. C
  627. FUNCEL = SURF * (DFRUN(2) * CNZ + DFRUT1(2) * CT1Z
  628. & + DFRUT2(2) * CT2Z)
  629. UZUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  630. UZUX.AM(IFAC,2,1) = FUNCEL / VOLG
  631. C
  632. FUNCEL = SURF * (DFRUN(3) * CNZ + DFRUT1(3) * CT1Z
  633. & + DFRUT2(3) * CT2Z)
  634. UZUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  635. UZUY.AM(IFAC,2,1) = FUNCEL / VOLG
  636. C
  637. FUNCEL = SURF * (DFRUN(4) * CNZ + DFRUT1(4) * CT1Z
  638. & + DFRUT2(4) * CT2Z)
  639. UZUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  640. UZUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  641. C
  642. FUNCEL = SURF * (DFRUN(5) * CNZ + DFRUT1(5) * CT1Z
  643. & + DFRUT2(5) * CT2Z)
  644. UZRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  645. UZRET.AM(IFAC,2,1) = FUNCEL / VOLG
  646. C
  647. C********** Dual RETN
  648. C
  649. FUNCEL = SURF * DFRET(1)
  650. RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  651. RETR.AM(IFAC,2,1) = FUNCEL / VOLG
  652. C
  653. FUNCEL = SURF * DFRET(2)
  654. RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  655. RETUX.AM(IFAC,2,1) = FUNCEL / VOLG
  656. C
  657. FUNCEL = SURF * DFRET(3)
  658. RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  659. RETUY.AM(IFAC,2,1) = FUNCEL / VOLG
  660. C
  661. FUNCEL = SURF * DFRET(4)
  662. RETUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  663. RETUZ.AM(IFAC,2,1) = FUNCEL / VOLG
  664. C
  665. FUNCEL = SURF * DFRET(5)
  666. RETRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  667. RETRET.AM(IFAC,2,1) = FUNCEL / VOLG
  668. C
  669. ELSE
  670. C
  671. C********** Murs (NGCG = NGCD)
  672. C
  673. C
  674. C********** Les MELEMEs
  675. C
  676. MELEDU.NUM(1,IFAC) = NGCG
  677. MELEDU.NUM(2,IFAC) = NGCD
  678. NLCG = MLENTC.LECT(NGCG)
  679. C
  680. ROG = MPRN.VPOCHA(NLCG,1)
  681. PG = MPPN.VPOCHA(NLCG,1)
  682. UXG = MPUN.VPOCHA(NLCG,1)
  683. UYG = MPUN.VPOCHA(NLCG,2)
  684. UZG = MPUN.VPOCHA(NLCG,3)
  685. GAMG = MPGAMN.VPOCHA(NLCG,1)
  686. VOLG = MPVOLU.VPOCHA(NLCG,1)
  687. C
  688. C********** La normale sortante
  689. C
  690. SURF = MPOVSU.VPOCHA(NLCF,1)
  691. CNX = MPNORM.VPOCHA(NLCF,7)
  692. CNY = MPNORM.VPOCHA(NLCF,8)
  693. CNZ = MPNORM.VPOCHA(NLCF,9)
  694. C
  695. CALL VLHJ6(ROG,UXG,UYG,UZG,PG,GAMG,CNX,CNY,CNZ,
  696. & DFRUN)
  697. C
  698. C********** Dual RN
  699. C
  700. RR.AM(IFAC,1,1) = 0.0D0
  701. RR.AM(IFAC,1,2) = 0.0D0
  702. C
  703. RUX.AM(IFAC,1,1) = 0.0D0
  704. RUX.AM(IFAC,1,2) = 0.0D0
  705. C
  706. RUY.AM(IFAC,1,1) = 0.0D0
  707. RUY.AM(IFAC,1,2) = 0.0D0
  708. C
  709. RUZ.AM(IFAC,1,1) = 0.0D0
  710. RUZ.AM(IFAC,1,2) = 0.0D0
  711. C
  712. RRET.AM(IFAC,1,1) = 0.0D0
  713. RRET.AM(IFAC,1,2) = 0.0D0
  714. C
  715. C********** Dual RUXN
  716. C
  717. FUNCEL = SURF * DFRUN(1) * CNX
  718. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  719. UXR.AM(IFAC,1,2) = 0.0D0
  720. C
  721. FUNCEL = SURF * DFRUN(2) * CNX
  722. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  723. UXUX.AM(IFAC,1,2) = 0.0D0
  724. C
  725. FUNCEL = SURF * DFRUN(3) * CNX
  726. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  727. UXUY.AM(IFAC,1,2) = 0.0D0
  728. C
  729. FUNCEL = SURF * DFRUN(4) * CNX
  730. UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  731. UXUZ.AM(IFAC,1,2) = 0.0D0
  732. C
  733. FUNCEL = SURF * DFRUN(5) * CNX
  734. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  735. UXRET.AM(IFAC,1,2) = 0.0D0
  736. C
  737. C********** Dual RUYN
  738. C
  739. FUNCEL = SURF * DFRUN(1) * CNY
  740. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  741. UYR.AM(IFAC,1,2) = 0.0D0
  742. C
  743. FUNCEL = SURF * DFRUN(2) * CNY
  744. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  745. UYUX.AM(IFAC,1,2) = 0.0D0
  746. C
  747. FUNCEL = SURF * DFRUN(3) * CNY
  748. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  749. UYUY.AM(IFAC,1,2) = 0.0D0
  750. C
  751. FUNCEL = SURF * DFRUN(4) * CNY
  752. UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  753. UYUZ.AM(IFAC,1,2) = 0.0D0
  754. C
  755. FUNCEL = SURF * DFRUN(5) * CNY
  756. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  757. UYRET.AM(IFAC,1,2) = 0.0D0
  758. C
  759. C********** Dual RUZN
  760. C
  761. FUNCEL = SURF * DFRUN(1) * CNZ
  762. UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  763. UZR.AM(IFAC,1,2) = 0.0D0
  764. C
  765. FUNCEL = SURF * DFRUN(2) * CNZ
  766. UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  767. UZUX.AM(IFAC,1,2) = 0.0D0
  768. C
  769. FUNCEL = SURF * DFRUN(3) * CNZ
  770. UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  771. UZUY.AM(IFAC,1,2) = 0.0D0
  772. C
  773. FUNCEL = SURF * DFRUN(4) * CNZ
  774. UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  775. UZUZ.AM(IFAC,1,2) = 0.0D0
  776. C
  777. FUNCEL = SURF * DFRUN(5) * CNZ
  778. UZRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  779. UZRET.AM(IFAC,1,2) = 0.0D0
  780. C
  781. C********** Dual RETN
  782. C
  783. RETR.AM(IFAC,1,1) = 0.0D0
  784. RETR.AM(IFAC,1,2) = 0.0D0
  785. C
  786. RETUX.AM(IFAC,1,1) = 0.0D0
  787. RETUX.AM(IFAC,1,2) = 0.0D0
  788. C
  789. RETUY.AM(IFAC,1,1) = 0.0D0
  790. RETUY.AM(IFAC,1,2) = 0.0D0
  791. C
  792. RETUZ.AM(IFAC,1,1) = 0.0D0
  793. RETUZ.AM(IFAC,1,2) = 0.0D0
  794. C
  795. RETRET.AM(IFAC,1,1) = 0.0D0
  796. RETRET.AM(IFAC,1,2) = 0.0D0
  797. C
  798. C********** Dual RN
  799. C
  800. RR.AM(IFAC,2,2) = 0.0D0
  801. RR.AM(IFAC,2,1) = 0.0D0
  802. C
  803. RUX.AM(IFAC,2,2) = 0.0D0
  804. RUX.AM(IFAC,2,1) = 0.0D0
  805. C
  806. RUY.AM(IFAC,2,2) = 0.0D0
  807. RUY.AM(IFAC,2,1) = 0.0D0
  808. C
  809. RUZ.AM(IFAC,2,2) = 0.0D0
  810. RUZ.AM(IFAC,2,1) = 0.0D0
  811. C
  812. RRET.AM(IFAC,2,2) = 0.0D0
  813. RRET.AM(IFAC,2,1) = 0.0D0
  814. C
  815. C********** Dual RUXN
  816. C
  817. UXR.AM(IFAC,2,2) = 0.0D0
  818. UXR.AM(IFAC,2,1) = 0.0D0
  819. C
  820. UXUX.AM(IFAC,2,2) = 0.0D0
  821. UXUX.AM(IFAC,2,1) = 0.0D0
  822. C
  823. UXUY.AM(IFAC,2,2) = 0.0D0
  824. UXUY.AM(IFAC,2,1) = 0.0D0
  825. C
  826. UXUZ.AM(IFAC,2,2) = 0.0D0
  827. UXUZ.AM(IFAC,2,1) = 0.0D0
  828. C
  829. UXRET.AM(IFAC,2,2) = 0.0D0
  830. UXRET.AM(IFAC,2,1) = 0.0D0
  831. C
  832. C********** Dual RUYN
  833. C
  834. UYR.AM(IFAC,2,2) = 0.0D0
  835. UYR.AM(IFAC,2,1) = 0.0D0
  836. C
  837. UYUX.AM(IFAC,2,2) = 0.0D0
  838. UYUX.AM(IFAC,2,1) = 0.0D0
  839. C
  840. UYUY.AM(IFAC,2,2) = 0.0D0
  841. UYUY.AM(IFAC,2,1) = 0.0D0
  842. C
  843. UYUZ.AM(IFAC,2,2) = 0.0D0
  844. UYUZ.AM(IFAC,2,1) = 0.0D0
  845. C
  846. UYRET.AM(IFAC,2,2) = 0.0D0
  847. UYRET.AM(IFAC,2,1) = 0.0D0
  848. C
  849. C********** Dual RUZN
  850. C
  851. UZR.AM(IFAC,2,2) = 0.0D0
  852. UZR.AM(IFAC,2,1) = 0.0D0
  853. C
  854. UZUX.AM(IFAC,2,2) = 0.0D0
  855. UZUX.AM(IFAC,2,1) = 0.0D0
  856. C
  857. UZUY.AM(IFAC,2,2) = 0.0D0
  858. UZUY.AM(IFAC,2,1) = 0.0D0
  859. C
  860. UZUZ.AM(IFAC,2,2) = 0.0D0
  861. UZUZ.AM(IFAC,2,1) = 0.0D0
  862. C
  863. UZRET.AM(IFAC,2,2) = 0.0D0
  864. UZRET.AM(IFAC,2,1) = 0.0D0
  865. C
  866. C********** Dual RETN
  867. C
  868. RETR.AM(IFAC,2,2) = 0.0D0
  869. RETR.AM(IFAC,2,1) = 0.0D0
  870. C
  871. RETUX.AM(IFAC,2,2) = 0.0D0
  872. RETUX.AM(IFAC,2,1) = 0.0D0
  873. C
  874. RETUY.AM(IFAC,2,2) = 0.0D0
  875. RETUY.AM(IFAC,2,1) = 0.0D0
  876. C
  877. RETUZ.AM(IFAC,2,2) = 0.0D0
  878. RETUZ.AM(IFAC,2,1) = 0.0D0
  879. C
  880. RETRET.AM(IFAC,2,2) = 0.0D0
  881. RETRET.AM(IFAC,2,1) = 0.0D0
  882. C
  883. ENDIF
  884. ENDDO
  885. C
  886. SEGDES MELEMC
  887. SEGDES MELEFE
  888. SEGDES MELEMF
  889. C
  890. SEGDES MPOVSU
  891. SEGDES MPVOLU
  892. SEGDES MPNORM
  893. C
  894. SEGDES MPRN
  895. SEGDES MPPN
  896. SEGDES MPUN
  897. SEGDES MPGAMN
  898. C
  899. SEGDES MELEDU
  900. SEGDES MATRIK
  901. SEGDES IMATRI
  902. C
  903. SEGDES RR , RUX , RUY , RUZ, RRET ,
  904. & UXR , UXUX , UXUY , UXUZ, UXRET ,
  905. & UYR , UYUX , UYUY , UYUZ, UYRET ,
  906. & UZR , UZUX , UZUY , UZUZ, UYRET ,
  907. & RETR , RETUX , RETUY , RETUZ, RETRET
  908.  
  909. SEGSUP MLENTC
  910. SEGSUP MLENTF
  911. SEGDES MLMINC
  912. SEGSUP MLELIM
  913.  
  914. 9999 CONTINUE
  915. RETURN
  916. END
  917.  
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  

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