Télécharger konjp1.eso

Retour à la liste

Numérotation des lignes :

  1. C KONJP1 SOURCE PV 16/11/17 22:00:04 9180
  2. SUBROUTINE KONJP1(ILINC,ILINP,IRN,IUN,IPN,IGAMN,INORM,ICHPVO
  3. $ ,ICHPSU,MELEMC,MELEFE,MELLIM,IMAT)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : KONJP1
  10. C
  11. C DESCRIPTION : Voir KON14
  12. C Calcul du jacobien du résidu pour la méthode de
  13. C VLH (variable primales = variables primitives,
  14. C variable duales = variables conservatives)
  15. C
  16. C Cas deux dimensions, gaz "calorically perfect"
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, DRN/DMT/SFME/LTMF
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C APPELES (Outils
  26. C CASTEM) : KRIPAD, LICHT, ERREUR
  27. C
  28. C APPELES (Calcul) : VLHJ1, VLHJ3
  29. C
  30. C************************************************************************
  31. C
  32. C ENTREES
  33. C
  34. C ILINC : liste des inconnues duales (pointeur d'un LISTMOTS)
  35. C
  36. C ILINP : liste des inconnues primales (pointeur d'un LISTMOTS)
  37. C
  38. C 1) Pointeurs des CHPOINT
  39. C
  40. C IRN : CHPOINT CENTRE contenant la masse volumique ;
  41. C
  42. C IUN : CHPOINT CENTRE contenant la vitesse ;
  43. C
  44. C IPN : CHPOINT CENTRE contenant la pression ;
  45. C
  46. C IGAMN : CHPOINT CENTRE contenant le gamma ;
  47. C
  48. C INORM : CHPOINT FACE contenant les normales aux faces ;
  49. C
  50. C ICHPVO : CHPOINT VOLUME contenant le volume
  51. C
  52. C ICHPSU : CHPOINT FACE contenant la surface des faces
  53. C
  54. C
  55. C 2) Pointeurs de MELEME de la table DOMAINE
  56. C
  57. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  58. C
  59. C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts
  60. C
  61. C MELLIM : MELEME SPG des conditions aux bords
  62. C
  63. C SORTIES
  64. C
  65. C IMAT : pointeur de la MATRIK du jacobien du residu
  66. C
  67. C************************************************************************
  68. C
  69. C HISTORIQUE (Anomalies et modifications éventuelles)
  70. C
  71. C HISTORIQUE :
  72. C
  73. C************************************************************************
  74. C
  75. C
  76. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  77. C GAMMA \in (1,3)
  78. C Si non il faut le faire!!!
  79. C
  80. C************************************************************************
  81. C
  82. C
  83. C**** Variables de COOPTIO
  84. C
  85. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  86. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  87. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  88. C & ,IECHO, IIMPI, IOSPI
  89. C & ,IDIM, IFICLE, IPREFI
  90. C & ,MCOORD
  91. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  92. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  93. C & ,NORINC,NORVAL,NORIND,NORVAD
  94. C & ,NUCROU, IPSAUV
  95. C
  96. IMPLICIT INTEGER(I-N)
  97. INTEGER ILINC, ILINP, IRN,IUN,IPN,IGAMN,INORM,ICHPVO,ICHPSU
  98. & , IMAT, IGEOMC, IGEOMF
  99. & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  100. & , NKMT, NBME, NBEL, MP, NP
  101. & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL
  102. REAL*8 ROG, PG, UXG, UYG, RETG, GAMG, VOLG
  103. & , ROD, PD, UXD, UYD, RETD, GAMD, VOLD
  104. & , SURF, CNX, CNY, CTX, CTY, FUNCEL
  105. & , DFRO(4), DFRET(4), DFRUN(4), DFRUT(4)
  106. CHARACTER*8 TYPE
  107. C
  108. C**** LES INCLUDES
  109. C
  110.  
  111. -INC PPARAM
  112. -INC CCOPTIO
  113. -INC SMCHPOI
  114. -INC SMELEME
  115. -INC SMLMOTS
  116. -INC SMLENTI
  117. POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL,
  118. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  119. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  120. & MELEDU.MELEME,MELLIM.MELEME
  121. POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  122. POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RP.IZAFM,
  123. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXP.IZAFM,
  124. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYP.IZAFM,
  125. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETP.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 = 16
  201. NBSOUS = 1
  202. SEGINI IMATRI
  203. MATRIK.IRIGEL(4,1) = IMATRI
  204. C
  205. C**** Variables primales (primitives)
  206. C
  207. MLMINC = ILINP
  208. SEGACT MLMINC
  209. IMATRI.LISPRI(1) = MLMINC.MOTS(1)
  210. IMATRI.LISPRI(2) = MLMINC.MOTS(2)
  211. IMATRI.LISPRI(3) = MLMINC.MOTS(3)
  212. IMATRI.LISPRI(4) = MLMINC.MOTS(4)
  213. IMATRI.LISPRI(5) = MLMINC.MOTS(1)
  214. IMATRI.LISPRI(6) = MLMINC.MOTS(2)
  215. IMATRI.LISPRI(7) = MLMINC.MOTS(3)
  216. IMATRI.LISPRI(8) = MLMINC.MOTS(4)
  217. IMATRI.LISPRI(9) = MLMINC.MOTS(1)
  218. IMATRI.LISPRI(10) = MLMINC.MOTS(2)
  219. IMATRI.LISPRI(11) = MLMINC.MOTS(3)
  220. IMATRI.LISPRI(12) = MLMINC.MOTS(4)
  221. IMATRI.LISPRI(13) = MLMINC.MOTS(1)
  222. IMATRI.LISPRI(14) = MLMINC.MOTS(2)
  223. IMATRI.LISPRI(15) = MLMINC.MOTS(3)
  224. IMATRI.LISPRI(16) = MLMINC.MOTS(4)
  225. SEGDES MLMINC
  226. C
  227. C**** Variables duales (conservatives)
  228. C
  229. MLMINC = ILINC
  230. SEGACT MLMINC
  231. IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  232. IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  233. IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  234. IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  235. IMATRI.LISDUA(5) = MLMINC.MOTS(2)
  236. IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  237. IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  238. IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  239. IMATRI.LISDUA(9) = MLMINC.MOTS(3)
  240. IMATRI.LISDUA(10) = MLMINC.MOTS(3)
  241. IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  242. IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  243. IMATRI.LISDUA(13) = MLMINC.MOTS(4)
  244. IMATRI.LISDUA(14) = MLMINC.MOTS(4)
  245. IMATRI.LISDUA(15) = MLMINC.MOTS(4)
  246. IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  247. SEGDES MLMINC
  248. C
  249. NBEL = NBELEM
  250. NBSOUS = 1
  251. NP = 2
  252. MP = 2
  253. SEGINI RR , RUX , RUY , RP ,
  254. & UXR , UXUX , UXUY , UXP ,
  255. & UYR , UYUX , UYUY , UYP ,
  256. & RETR , RETUX , RETUY , RETP
  257. C
  258. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  259. C Primale = IMATRI.LISPRI(1) = 'RN'
  260. C -> IMATRI.LIZAFM(1,1) = RR
  261. C
  262. C Duale = IMATRI.LISDUA(2) = 'RN'
  263. C Primale = IMATRI.LISPRI(1) = 'RUXN'
  264. C -> IMATRI.LIZAFM(1,2) = RUX
  265. C ...
  266. C
  267. IMATRI.LIZAFM(1,1) = RR
  268. IMATRI.LIZAFM(1,2) = RUX
  269. IMATRI.LIZAFM(1,3) = RUY
  270. IMATRI.LIZAFM(1,4) = RP
  271. IMATRI.LIZAFM(1,5) = UXR
  272. IMATRI.LIZAFM(1,6) = UXUX
  273. IMATRI.LIZAFM(1,7) = UXUY
  274. IMATRI.LIZAFM(1,8) = UXP
  275. IMATRI.LIZAFM(1,9) = UYR
  276. IMATRI.LIZAFM(1,10) = UYUX
  277. IMATRI.LIZAFM(1,11) = UYUY
  278. IMATRI.LIZAFM(1,12) = UYP
  279. IMATRI.LIZAFM(1,13) = RETR
  280. IMATRI.LIZAFM(1,14) = RETUX
  281. IMATRI.LIZAFM(1,15) = RETUY
  282. IMATRI.LIZAFM(1,16) = RETP
  283. C
  284. DO IFAC = 1, NFAC, 1
  285. NGCF = MELEFE.NUM(2,IFAC)
  286. NLCF = MLENTF.LECT(NGCF)
  287. IF(NLCF .NE. IFAC)THEN
  288. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  289. CALL ERREUR(5)
  290. GOTO 9999
  291. ENDIF
  292. NLFL = MLELIM.LECT(NGCF)
  293. NGCG = MELEFE.NUM(1,IFAC)
  294. NGCD = MELEFE.NUM(3,IFAC)
  295. IF(NLFL .NE. 0)THEN
  296. C
  297. C********** The point belongs on BC -> No contribution to jacobian!
  298. C
  299. MELEDU.NUM(1,IFAC) = NGCG
  300. MELEDU.NUM(2,IFAC) = NGCD
  301. ELSEIF(NGCG .NE. NGCD)THEN
  302. C
  303. C********** Les MELEMEs
  304. C
  305. MELEDU.NUM(1,IFAC) = NGCG
  306. MELEDU.NUM(2,IFAC) = NGCD
  307. C
  308. C********** Les etats G et D
  309. C
  310. NLCG = MLENTC.LECT(NGCG)
  311. NLCD = MLENTC.LECT(NGCD)
  312. C
  313. ROG = MPRN.VPOCHA(NLCG,1)
  314. PG = MPPN.VPOCHA(NLCG,1)
  315. UXG = MPUN.VPOCHA(NLCG,1)
  316. UYG = MPUN.VPOCHA(NLCG,2)
  317. GAMG = MPGAMN.VPOCHA(NLCG,1)
  318. RETG= (PG / (GAMG - 1.0D0)) + 0.5D0 * ROG * (UXG * UXG +
  319. & UYG * UYG)
  320. VOLG = MPVOLU.VPOCHA(NLCG,1)
  321. C
  322. ROD = MPRN.VPOCHA(NLCD,1)
  323. PD = MPPN.VPOCHA(NLCD,1)
  324. UXD = MPUN.VPOCHA(NLCD,1)
  325. UYD = MPUN.VPOCHA(NLCD,2)
  326. GAMD = MPGAMN.VPOCHA(NLCD,1)
  327. RETD= (PD / (GAMD - 1.0D0)) + 0.5D0 * ROD * (UXD * UXD +
  328. & UYD * UYD)
  329. VOLD = MPVOLU.VPOCHA(NLCD,1)
  330. C
  331. C********** La normale G->D
  332. C La tangente
  333. C
  334. SURF = MPOVSU.VPOCHA(NLCF,1)
  335. CNX = MPNORM.VPOCHA(NLCF,1)
  336. CNY = MPNORM.VPOCHA(NLCF,2)
  337. CTX = -1.0D0 * CNY
  338. CTY = CNX
  339. C
  340. C********** La contribution de Gauche
  341. C
  342. CALL VLHJ1(ROG,UXG,UYG,PG,RETG,GAMG,CNX,CNY,CTX,CTY,
  343. & DFRO,DFRUN,DFRUT,DFRET)
  344. C
  345. C
  346. C********** AB.AM(IFAC,IPRIM,IDUAL)
  347. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  348. C B = nom de l'inconnu primale (Ro,UX,UY,P)
  349. C IPRIM = 1, 2 -> G, D
  350. C IDUAL = 1, 2 -> G, D
  351. C i.e.
  352. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  353. C
  354. C
  355. C********** Dual RN
  356. C
  357. FUNCEL = SURF * DFRO(1)
  358. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  359. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  360. C
  361. FUNCEL = SURF * DFRO(2)
  362. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  363. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  364. C
  365. FUNCEL = SURF * DFRO(3)
  366. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  367. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  368. C
  369. FUNCEL = SURF * DFRO(4)
  370. RP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  371. RP.AM(IFAC,1,2) = FUNCEL / VOLD
  372. C
  373. C********** Dual RUXN
  374. C
  375. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX)
  376. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  377. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  378. C
  379. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX)
  380. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  381. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  382. C
  383. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX)
  384. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  385. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  386. C
  387. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX)
  388. UXP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  389. UXP.AM(IFAC,1,2) = FUNCEL / VOLD
  390. C
  391. C********** Dual RUYN
  392. C
  393. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY)
  394. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  395. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  396. C
  397. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY)
  398. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  399. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  400. C
  401. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY)
  402. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  403. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  404. C
  405. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY)
  406. UYP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  407. UYP.AM(IFAC,1,2) = FUNCEL / VOLD
  408. C
  409. C********** Dual RETN
  410. C
  411. FUNCEL = SURF * DFRET(1)
  412. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  413. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  414. C
  415. FUNCEL = SURF * DFRET(2)
  416. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  417. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  418. C
  419. FUNCEL = SURF * DFRET(3)
  420. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  421. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  422. C
  423. FUNCEL = SURF * DFRET(4)
  424. RETP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  425. RETP.AM(IFAC,1,2) = FUNCEL / VOLD
  426. C
  427. C
  428. C********** La contribution de D
  429. C
  430. CNX = -1.0D0 * CNX
  431. CNY = -1.0D0 * CNY
  432. CTX = -1.0D0 * CTX
  433. CTY = -1.0D0 * CTY
  434.  
  435. CALL VLHJ1(ROD,UXD,UYD,PD,RETD,GAMD,CNX,CNY,CTX,CTY,
  436. & DFRO,DFRUN,DFRUT,DFRET)
  437. C
  438. C
  439. C********** Dual RN
  440. C
  441. FUNCEL = SURF * DFRO(1)
  442. RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  443. RR.AM(IFAC,2,1) = FUNCEL / VOLG
  444. C
  445. FUNCEL = SURF * DFRO(2)
  446. RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  447. RUX.AM(IFAC,2,1) = FUNCEL / VOLG
  448. C
  449. FUNCEL = SURF * DFRO(3)
  450. RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  451. RUY.AM(IFAC,2,1) = FUNCEL / VOLG
  452. C
  453. FUNCEL = SURF * DFRO(4)
  454. RP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  455. RP.AM(IFAC,2,1) = FUNCEL / VOLG
  456. C
  457. C********** Dual RUXN
  458. C
  459. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX)
  460. UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  461. UXR.AM(IFAC,2,1) = FUNCEL / VOLG
  462. C
  463. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX)
  464. UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  465. UXUX.AM(IFAC,2,1) = FUNCEL / VOLG
  466. C
  467. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX)
  468. UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  469. UXUY.AM(IFAC,2,1) = FUNCEL / VOLG
  470. C
  471. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX)
  472. UXP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  473. UXP.AM(IFAC,2,1) = FUNCEL / VOLG
  474. C
  475. C********** Dual RUYN
  476. C
  477. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY)
  478. UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  479. UYR.AM(IFAC,2,1) = FUNCEL / VOLG
  480. C
  481. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY)
  482. UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  483. UYUX.AM(IFAC,2,1) = FUNCEL / VOLG
  484. C
  485. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY)
  486. UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  487. UYUY.AM(IFAC,2,1) = FUNCEL / VOLG
  488. C
  489. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY)
  490. UYP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  491. UYP.AM(IFAC,2,1) = FUNCEL / VOLG
  492. C
  493. C********** Dual RETN
  494. C
  495. FUNCEL = SURF * DFRET(1)
  496. RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  497. RETR.AM(IFAC,2,1) = FUNCEL / VOLG
  498. C
  499. FUNCEL = SURF * DFRET(2)
  500. RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  501. RETUX.AM(IFAC,2,1) = FUNCEL / VOLG
  502. C
  503. FUNCEL = SURF * DFRET(3)
  504. RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  505. RETUY.AM(IFAC,2,1) = FUNCEL / VOLG
  506. C
  507. FUNCEL = SURF * DFRET(4)
  508. RETP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  509. RETP.AM(IFAC,2,1) = FUNCEL / VOLG
  510. C
  511. ELSE
  512. C
  513. C********** Murs (NGCG = NGCD)
  514. C
  515. C
  516. C********** Les MELEMEs
  517. C
  518. MELEDU.NUM(1,IFAC) = NGCG
  519. MELEDU.NUM(2,IFAC) = NGCD
  520. NLCG = MLENTC.LECT(NGCG)
  521. C
  522. ROG = MPRN.VPOCHA(NLCG,1)
  523. PG = MPPN.VPOCHA(NLCG,1)
  524. UXG = MPUN.VPOCHA(NLCG,1)
  525. UYG = MPUN.VPOCHA(NLCG,2)
  526. GAMG = MPGAMN.VPOCHA(NLCG,1)
  527. VOLG = MPVOLU.VPOCHA(NLCG,1)
  528. C
  529. C********** La normale sortante
  530. C
  531. SURF = MPOVSU.VPOCHA(NLCF,1)
  532. CNX = MPNORM.VPOCHA(NLCF,1)
  533. CNY = MPNORM.VPOCHA(NLCF,2)
  534. C
  535. CALL VLHJ3(ROG,UXG,UYG,PG,GAMG,CNX,CNY,
  536. & DFRUN)
  537. C
  538. C********** Dual RN
  539. C
  540. RR.AM(IFAC,1,1) = 0.0D0
  541. RR.AM(IFAC,1,2) = 0.0D0
  542. C
  543. RUX.AM(IFAC,1,1) = 0.0D0
  544. RUX.AM(IFAC,1,2) = 0.0D0
  545. C
  546. RUY.AM(IFAC,1,1) = 0.0D0
  547. RUY.AM(IFAC,1,2) = 0.0D0
  548. C
  549. RP.AM(IFAC,1,1) = 0.0D0
  550. RP.AM(IFAC,1,2) = 0.0D0
  551. C
  552. C********** Dual RUXN
  553. C
  554. FUNCEL = SURF * DFRUN(1) * CNX
  555. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  556. UXR.AM(IFAC,1,2) = 0.0D0
  557. C
  558. FUNCEL = SURF * DFRUN(2) * CNX
  559. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  560. UXUX.AM(IFAC,1,2) = 0.0D0
  561. C
  562. FUNCEL = SURF * DFRUN(3) * CNX
  563. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  564. UXUY.AM(IFAC,1,2) = 0.0D0
  565. C
  566. FUNCEL = SURF * DFRUN(4) * CNX
  567. UXP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  568. UXP.AM(IFAC,1,2) = 0.0D0
  569. C
  570. C********** Dual RUYN
  571. C
  572. FUNCEL = SURF * DFRUN(1) * CNY
  573. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  574. UYR.AM(IFAC,1,2) = 0.0D0
  575. C
  576. FUNCEL = SURF * DFRUN(2) * CNY
  577. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  578. UYUX.AM(IFAC,1,2) = 0.0D0
  579. C
  580. FUNCEL = SURF * DFRUN(3) * CNY
  581. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  582. UYUY.AM(IFAC,1,2) = 0.0D0
  583. C
  584. FUNCEL = SURF * DFRUN(4) * CNY
  585. UYP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  586. UYP.AM(IFAC,1,2) = 0.0D0
  587. C
  588. C********** Dual RETN
  589. C
  590. RETR.AM(IFAC,1,1) = 0.0D0
  591. RETR.AM(IFAC,1,2) = 0.0D0
  592. C
  593. RETUX.AM(IFAC,1,1) = 0.0D0
  594. RETUX.AM(IFAC,1,2) = 0.0D0
  595. C
  596. RETUY.AM(IFAC,1,1) = 0.0D0
  597. RETUY.AM(IFAC,1,2) = 0.0D0
  598. C
  599. RETP.AM(IFAC,1,1) = 0.0D0
  600. RETP.AM(IFAC,1,2) = 0.0D0
  601. C
  602. C********** Dual RN
  603. C
  604. RR.AM(IFAC,2,2) = 0.0D0
  605. RR.AM(IFAC,2,1) = 0.0D0
  606. C
  607. RUX.AM(IFAC,2,2) = 0.0D0
  608. RUX.AM(IFAC,2,1) = 0.0D0
  609. C
  610. RUY.AM(IFAC,2,2) = 0.0D0
  611. RUY.AM(IFAC,2,1) = 0.0D0
  612. C
  613. RP.AM(IFAC,2,2) = 0.0D0
  614. RP.AM(IFAC,2,1) = 0.0D0
  615. C
  616. C********** Dual RUXN
  617. C
  618. UXR.AM(IFAC,2,2) = 0.0D0
  619. UXR.AM(IFAC,2,1) = 0.0D0
  620. C
  621. UXUX.AM(IFAC,2,2) = 0.0D0
  622. UXUX.AM(IFAC,2,1) = 0.0D0
  623. C
  624. UXUY.AM(IFAC,2,2) = 0.0D0
  625. UXUY.AM(IFAC,2,1) = 0.0D0
  626. C
  627. UXP.AM(IFAC,2,2) = 0.0D0
  628. UXP.AM(IFAC,2,1) = 0.0D0
  629. C
  630. C********** Dual RUYN
  631. C
  632. UYR.AM(IFAC,2,2) = 0.0D0
  633. UYR.AM(IFAC,2,1) = 0.0D0
  634. C
  635. UYUX.AM(IFAC,2,2) = 0.0D0
  636. UYUX.AM(IFAC,2,1) = 0.0D0
  637. C
  638. UYUY.AM(IFAC,2,2) = 0.0D0
  639. UYUY.AM(IFAC,2,1) = 0.0D0
  640. C
  641. UYP.AM(IFAC,2,2) = 0.0D0
  642. UYP.AM(IFAC,2,1) = 0.0D0
  643. C
  644. C********** Dual RETN
  645. C
  646. RETR.AM(IFAC,2,2) = 0.0D0
  647. RETR.AM(IFAC,2,1) = 0.0D0
  648. C
  649. RETUX.AM(IFAC,2,2) = 0.0D0
  650. RETUX.AM(IFAC,2,1) = 0.0D0
  651. C
  652. RETUY.AM(IFAC,2,2) = 0.0D0
  653. RETUY.AM(IFAC,2,1) = 0.0D0
  654. C
  655. RETP.AM(IFAC,2,2) = 0.0D0
  656. RETP.AM(IFAC,2,1) = 0.0D0
  657. C
  658. ENDIF
  659. ENDDO
  660. C
  661. SEGDES MELEMC
  662. SEGDES MELEFE
  663. SEGDES MELEMF
  664. C
  665. SEGDES MPOVSU
  666. SEGDES MPVOLU
  667. SEGDES MPNORM
  668. C
  669. SEGDES MPRN
  670. SEGDES MPPN
  671. SEGDES MPUN
  672. SEGDES MPGAMN
  673. C
  674. SEGDES MELEDU
  675. SEGDES MATRIK
  676. SEGDES IMATRI
  677. C
  678. SEGDES RR , RUX , RUY , RP ,
  679. & UXR , UXUX , UXUY , UXP ,
  680. & UYR , UYUX , UYUY , UYP ,
  681. & RETR , RETUX , RETUY , RETP
  682.  
  683. SEGSUP MLENTC
  684. SEGSUP MLENTF
  685. SEGSUP MLELIM
  686. C
  687. 9999 CONTINUE
  688. RETURN
  689. END
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  
  696.  
  697.  
  698.  

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