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

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