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. -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. NGCG = MELEFE.NUM(1,IFAC)
  282. NGCD = MELEFE.NUM(3,IFAC)
  283. NLFL = MLELIM.LECT(NGCF)
  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.  
  291. ELSEIF(NGCG .NE. NGCD)THEN
  292. C
  293. C********** Les MELEMEs
  294. C
  295. MELEDU.NUM(1,IFAC) = NGCG
  296. MELEDU.NUM(2,IFAC) = NGCD
  297. C
  298. C********** Les etats G et D
  299. C
  300. NLCG = MLENTC.LECT(NGCG)
  301. NLCD = MLENTC.LECT(NGCD)
  302. C
  303. ROG = MPRN.VPOCHA(NLCG,1)
  304. PG = MPPN.VPOCHA(NLCG,1)
  305. UXG = MPUN.VPOCHA(NLCG,1)
  306. UYG = MPUN.VPOCHA(NLCG,2)
  307. GAMG = MPGAMN.VPOCHA(NLCG,1)
  308. VOLG = MPVOLU.VPOCHA(NLCG,1)
  309. C
  310. ROD = MPRN.VPOCHA(NLCD,1)
  311. PD = MPPN.VPOCHA(NLCD,1)
  312. UXD = MPUN.VPOCHA(NLCD,1)
  313. UYD = MPUN.VPOCHA(NLCD,2)
  314. GAMD = MPGAMN.VPOCHA(NLCD,1)
  315. VOLD = MPVOLU.VPOCHA(NLCD,1)
  316. C
  317. C********** La normale G->D
  318. C La tangente
  319. C
  320. SURF = MPOVSU.VPOCHA(NLCF,1)
  321. CNX = MPNORM.VPOCHA(NLCF,1)
  322. CNY = MPNORM.VPOCHA(NLCF,2)
  323. CTX = -1.0D0 * CNY
  324. CTY = CNX
  325. C
  326. C********** La contribution de Gauche
  327. C
  328. CALL CENTJ0(ROG,UXG,UYG,PG,GAMG,CNX,CNY,CTX,CTY,
  329. & DFRO,DFRUN,DFRUT,DFRET)
  330. C
  331. C
  332. C********** AB.AM(IFAC,IPRIM,IDUAL)
  333. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  334. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  335. C IPRIM = 1, 2 -> G, D
  336. C IDUAL = 1, 2 -> G, D
  337. C i.e.
  338. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  339. C
  340. C
  341. C********** Dual RN
  342. C
  343. FUNCEL = SURF * DFRO(1)
  344. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  345. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  346. C
  347. FUNCEL = SURF * DFRO(2)
  348. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  349. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  350. C
  351. FUNCEL = SURF * DFRO(3)
  352. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  353. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  354. C
  355. FUNCEL = SURF * DFRO(4)
  356. RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  357. RRET.AM(IFAC,1,2) = FUNCEL / VOLD
  358. C
  359. C********** Dual RUXN
  360. C
  361. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX)
  362. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  363. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  364. C
  365. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX)
  366. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  367. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  368. C
  369. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX)
  370. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  371. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  372. C
  373. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX)
  374. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  375. UXRET.AM(IFAC,1,2) = FUNCEL / VOLD
  376. C
  377. C********** Dual RUYN
  378. C
  379. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY)
  380. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  381. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  382. C
  383. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY)
  384. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  385. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  386. C
  387. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY)
  388. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  389. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  390. C
  391. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY)
  392. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  393. UYRET.AM(IFAC,1,2) = FUNCEL / VOLD
  394. C
  395. C********** Dual RETN
  396. C
  397. FUNCEL = SURF * DFRET(1)
  398. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  399. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  400. C
  401. FUNCEL = SURF * DFRET(2)
  402. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  403. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  404. C
  405. FUNCEL = SURF * DFRET(3)
  406. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  407. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  408. C
  409. FUNCEL = SURF * DFRET(4)
  410. RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  411. RETRET.AM(IFAC,1,2) = FUNCEL / VOLD
  412. C
  413. C
  414. C********** La contribution de D
  415. C
  416. CNX = -1.0D0 * CNX
  417. CNY = -1.0D0 * CNY
  418. CTX = -1.0D0 * CTX
  419. CTY = -1.0D0 * CTY
  420. C
  421. CALL CENTJ0(ROD,UXD,UYD,PD,GAMD,CNX,CNY,CTX,CTY,
  422. & DFRO,DFRUN,DFRUT,DFRET)
  423. C
  424. C
  425. C********** Dual RN
  426. C
  427. FUNCEL = SURF * DFRO(1)
  428. RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  429. RR.AM(IFAC,2,1) = FUNCEL / VOLG
  430. C
  431. FUNCEL = SURF * DFRO(2)
  432. RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  433. RUX.AM(IFAC,2,1) = FUNCEL / VOLG
  434. C
  435. FUNCEL = SURF * DFRO(3)
  436. RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  437. RUY.AM(IFAC,2,1) = FUNCEL / VOLG
  438. C
  439. FUNCEL = SURF * DFRO(4)
  440. RRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  441. RRET.AM(IFAC,2,1) = FUNCEL / VOLG
  442. C
  443. C********** Dual RUXN
  444. C
  445. FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX)
  446. UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  447. UXR.AM(IFAC,2,1) = FUNCEL / VOLG
  448. C
  449. FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX)
  450. UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  451. UXUX.AM(IFAC,2,1) = FUNCEL / VOLG
  452. C
  453. FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX)
  454. UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  455. UXUY.AM(IFAC,2,1) = FUNCEL / VOLG
  456. C
  457. FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX)
  458. UXRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  459. UXRET.AM(IFAC,2,1) = FUNCEL / VOLG
  460. C
  461. C********** Dual RUYN
  462. C
  463. FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY)
  464. UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  465. UYR.AM(IFAC,2,1) = FUNCEL / VOLG
  466. C
  467. FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY)
  468. UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  469. UYUX.AM(IFAC,2,1) = FUNCEL / VOLG
  470. C
  471. FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY)
  472. UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  473. UYUY.AM(IFAC,2,1) = FUNCEL / VOLG
  474. C
  475. FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY)
  476. UYRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  477. UYRET.AM(IFAC,2,1) = FUNCEL / VOLG
  478. C
  479. C********** Dual RETN
  480. C
  481. FUNCEL = SURF * DFRET(1)
  482. RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  483. RETR.AM(IFAC,2,1) = FUNCEL / VOLG
  484. C
  485. FUNCEL = SURF * DFRET(2)
  486. RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  487. RETUX.AM(IFAC,2,1) = FUNCEL / VOLG
  488. C
  489. FUNCEL = SURF * DFRET(3)
  490. RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  491. RETUY.AM(IFAC,2,1) = FUNCEL / VOLG
  492. C
  493. FUNCEL = SURF * DFRET(4)
  494. RETRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  495. RETRET.AM(IFAC,2,1) = FUNCEL / VOLG
  496. C
  497. ELSE
  498. C
  499. C********** Murs (NGCG = NGCD)
  500. C
  501. C
  502. C********** Les MELEMEs
  503. C
  504. MELEDU.NUM(1,IFAC) = NGCG
  505. MELEDU.NUM(2,IFAC) = NGCD
  506. NLCG = MLENTC.LECT(NGCG)
  507. C
  508. ROG = MPRN.VPOCHA(NLCG,1)
  509. PG = MPPN.VPOCHA(NLCG,1)
  510. UXG = MPUN.VPOCHA(NLCG,1)
  511. UYG = MPUN.VPOCHA(NLCG,2)
  512. GAMG = MPGAMN.VPOCHA(NLCG,1)
  513. VOLG = MPVOLU.VPOCHA(NLCG,1)
  514. C
  515. C********** La normale sortante
  516. C
  517. SURF = MPOVSU.VPOCHA(NLCF,1)
  518. CNX = MPNORM.VPOCHA(NLCF,1)
  519. CNY = MPNORM.VPOCHA(NLCF,2)
  520. C
  521. CALL CENTJ2(ROG,UXG,UYG,GAMG,CNX,CNY,
  522. & DFRUN)
  523. C
  524. C********** Dual RN
  525. C
  526. RR.AM(IFAC,1,1) = 0.0D0
  527. RR.AM(IFAC,1,2) = 0.0D0
  528. C
  529. RUX.AM(IFAC,1,1) = 0.0D0
  530. RUX.AM(IFAC,1,2) = 0.0D0
  531. C
  532. RUY.AM(IFAC,1,1) = 0.0D0
  533. RUY.AM(IFAC,1,2) = 0.0D0
  534. C
  535. RRET.AM(IFAC,1,1) = 0.0D0
  536. RRET.AM(IFAC,1,2) = 0.0D0
  537. C
  538. C********** Dual RUXN
  539. C
  540. FUNCEL = SURF * DFRUN(1) * CNX
  541. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  542. UXR.AM(IFAC,1,2) = 0.0D0
  543. C
  544. FUNCEL = SURF * DFRUN(2) * CNX
  545. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  546. UXUX.AM(IFAC,1,2) = 0.0D0
  547. C
  548. FUNCEL = SURF * DFRUN(3) * CNX
  549. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  550. UXUY.AM(IFAC,1,2) = 0.0D0
  551. C
  552. FUNCEL = SURF * DFRUN(4) * CNX
  553. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  554. UXRET.AM(IFAC,1,2) = 0.0D0
  555. C
  556. C********** Dual RUYN
  557. C
  558. FUNCEL = SURF * DFRUN(1) * CNY
  559. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  560. UYR.AM(IFAC,1,2) = 0.0D0
  561. C
  562. FUNCEL = SURF * DFRUN(2) * CNY
  563. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  564. UYUX.AM(IFAC,1,2) = 0.0D0
  565. C
  566. FUNCEL = SURF * DFRUN(3) * CNY
  567. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  568. UYUY.AM(IFAC,1,2) = 0.0D0
  569. C
  570. FUNCEL = SURF * DFRUN(4) * CNY
  571. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  572. UYRET.AM(IFAC,1,2) = 0.0D0
  573. C
  574. C********** Dual RETN
  575. C
  576. RETR.AM(IFAC,1,1) = 0.0D0
  577. RETR.AM(IFAC,1,2) = 0.0D0
  578. C
  579. RETUX.AM(IFAC,1,1) = 0.0D0
  580. RETUX.AM(IFAC,1,2) = 0.0D0
  581. C
  582. RETUY.AM(IFAC,1,1) = 0.0D0
  583. RETUY.AM(IFAC,1,2) = 0.0D0
  584. C
  585. RETRET.AM(IFAC,1,1) = 0.0D0
  586. RETRET.AM(IFAC,1,2) = 0.0D0
  587. C
  588. C********** Dual RN
  589. C
  590. RR.AM(IFAC,2,2) = 0.0D0
  591. RR.AM(IFAC,2,1) = 0.0D0
  592. C
  593. RUX.AM(IFAC,2,2) = 0.0D0
  594. RUX.AM(IFAC,2,1) = 0.0D0
  595. C
  596. RUY.AM(IFAC,2,2) = 0.0D0
  597. RUY.AM(IFAC,2,1) = 0.0D0
  598. C
  599. RRET.AM(IFAC,2,2) = 0.0D0
  600. RRET.AM(IFAC,2,1) = 0.0D0
  601. C
  602. C********** Dual RUXN
  603. C
  604. UXR.AM(IFAC,2,2) = 0.0D0
  605. UXR.AM(IFAC,2,1) = 0.0D0
  606. C
  607. UXUX.AM(IFAC,2,2) = 0.0D0
  608. UXUX.AM(IFAC,2,1) = 0.0D0
  609. C
  610. UXUY.AM(IFAC,2,2) = 0.0D0
  611. UXUY.AM(IFAC,2,1) = 0.0D0
  612. C
  613. UXRET.AM(IFAC,2,2) = 0.0D0
  614. UXRET.AM(IFAC,2,1) = 0.0D0
  615. C
  616. C********** Dual RUYN
  617. C
  618. UYR.AM(IFAC,2,2) = 0.0D0
  619. UYR.AM(IFAC,2,1) = 0.0D0
  620. C
  621. UYUX.AM(IFAC,2,2) = 0.0D0
  622. UYUX.AM(IFAC,2,1) = 0.0D0
  623. C
  624. UYUY.AM(IFAC,2,2) = 0.0D0
  625. UYUY.AM(IFAC,2,1) = 0.0D0
  626. C
  627. UYRET.AM(IFAC,2,2) = 0.0D0
  628. UYRET.AM(IFAC,2,1) = 0.0D0
  629. C
  630. C********** Dual RETN
  631. C
  632. RETR.AM(IFAC,2,2) = 0.0D0
  633. RETR.AM(IFAC,2,1) = 0.0D0
  634. C
  635. RETUX.AM(IFAC,2,2) = 0.0D0
  636. RETUX.AM(IFAC,2,1) = 0.0D0
  637. C
  638. RETUY.AM(IFAC,2,2) = 0.0D0
  639. RETUY.AM(IFAC,2,1) = 0.0D0
  640. C
  641. RETRET.AM(IFAC,2,2) = 0.0D0
  642. RETRET.AM(IFAC,2,1) = 0.0D0
  643. C
  644. ENDIF
  645. ENDDO
  646. C
  647. SEGDES MELEMC
  648. SEGDES MELEFE
  649. SEGDES MELEMF
  650. C
  651. SEGDES MPOVSU
  652. SEGDES MPVOLU
  653. SEGDES MPNORM
  654. C
  655. SEGDES MPRN
  656. SEGDES MPPN
  657. SEGDES MPUN
  658. SEGDES MPGAMN
  659. C
  660. SEGDES MELEDU
  661. SEGDES MATRIK
  662. SEGDES IMATRI
  663. C
  664. SEGDES RR , RUX , RUY , RRET ,
  665. & UXR , UXUX , UXUY , UXRET ,
  666. & UYR , UYUX , UYUY , UYRET ,
  667. & RETR , RETUX , RETUY , RETRET
  668.  
  669. SEGSUP MLENTC
  670. SEGSUP MLENTF
  671. SEGDES MLMINC
  672. SEGSUP MLELIM
  673. IF(MELLIM .NE.0) SEGDES MELLIM
  674. C
  675. 9999 CONTINUE
  676. RETURN
  677. END
  678.  
  679.  
  680.  
  681.  
  682.  
  683.  
  684.  
  685.  

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