Télécharger konjc1.eso

Retour à la liste

Numérotation des lignes :

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

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