Télécharger konja1.eso

Retour à la liste

Numérotation des lignes :

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

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