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

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