Télécharger konja6.eso

Retour à la liste

Numérotation des lignes :

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

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