Télécharger konja2.eso

Retour à la liste

Numérotation des lignes :

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

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