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

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