Télécharger konjp5.eso

Retour à la liste

Numérotation des lignes :

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

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