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

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