Télécharger konja7.eso

Retour à la liste

Numérotation des lignes :

  1. C KONJA7 SOURCE PV 16/11/17 22:00:02 9180
  2. SUBROUTINE KONJA7(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 : KONJA7
  10. C
  11. C DESCRIPTION : Voir KON12
  12. C Calcul du jacobien du résidu pour la méthode de
  13. C AUSM+low mach
  14. C
  15. C Cas 3D, gaz "calorically perfect"
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18. C
  19. C AUTEUR : A. BECCANTINI, SFME/LTMF
  20. C
  21. C************************************************************************
  22. C
  23. C
  24. C APPELES (Outils
  25. C CASTEM) :
  26. C
  27. C APPELES (Calcul) :
  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 ICHPOVO : CHPOINT VOLUME contenant le volume
  48. C
  49. C ICHPOSU : CHPOINT FACE contenant la surface des faces
  50. C
  51. C IUINF : CHPOINT, one component, "cut-off velocity"
  52. C 0 if no Bas MACH
  53. C
  54. C IUPRI : CHPOINT, one component, "minimum reference velocity"
  55. C 0 if no BAs Mach
  56. C
  57. C 2) Pointeurs de MELEME de la table DOMAINE
  58. C
  59. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  60. C
  61. C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts
  62. C
  63. C MELLIM : MELEME SPG des conditions aux bords
  64. C
  65. C SORTIES
  66. C
  67. C IMAT : pointeur de la MATRIK du jacobien du residu
  68. C
  69. C************************************************************************
  70. C
  71. C HISTORIQUE (Anomalies et modifications éventuelles)
  72. C
  73. C HISTORIQUE :
  74. C
  75. C************************************************************************
  76. C
  77. C
  78. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  79. C GAMMA \in (1,3)
  80. C Si non il faut le faire!!!
  81. C
  82. C************************************************************************
  83. C
  84. C
  85. C**** Variables de COOPTIO
  86. C
  87. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  88. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  89. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  90. C & ,IECHO, IIMPI, IOSPI
  91. C & ,IDIM
  92. C & ,MCOORD
  93. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  94. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  95. C & ,NORINC,NORVAL,NORIND,NORVAD
  96. C & ,NUCROU, IPSAUV
  97. C
  98. IMPLICIT INTEGER(I-N)
  99. INTEGER ILINC, IRN,IUN,IPN,IGAMN,INORM,ICHPVO,ICHPSU
  100. & , IMAT, IGEOMC, IGEOMF, IUINF, IUPRI
  101. & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  102. & , NKMT, NBME, NBEL, MP, NP
  103. & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD
  104. & , NLFL
  105. REAL*8 ROG, PG, UXG, UYG, UZG, GAMG, VOLG
  106. & , ROD, PD, UXD, UYD, UZD, VOLD
  107. & , SURF
  108. & , FUNCEL
  109. REAL*8 WVEC_L(5), WVEC_R(5), NVECT(3), TVECT1(3),TVECT2(3)
  110. REAL*8 JTL(5,5), JTR(5,5), V_INF
  111. REAL*8 C11,C12,C13,C21,C22,C23,C31,C32,C33,DET
  112. REAL*8 ZC11,ZC12,ZC13,ZC21,ZC22,ZC23,ZC31,ZC32,ZC33
  113. CHARACTER*8 TYPE
  114. C
  115. C**** LES INCLUDES
  116. C
  117.  
  118. -INC PPARAM
  119. -INC CCOPTIO
  120. -INC SMCHPOI
  121. -INC SMELEME
  122. -INC SMLMOTS
  123. -INC SMLENTI
  124. POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL,
  125. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.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, RUZ.IZAFM, RRET.IZAFM,
  130. & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXUZ.IZAFM, UXRET.IZAFM,
  131. & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYUZ.IZAFM, UYRET.IZAFM,
  132. & UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZUZ.IZAFM, UZRET.IZAFM,
  133. & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM,
  134. & 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 = 25
  210. NBSOUS = 1
  211. SEGINI IMATRI
  212. MLMINC = ILINC
  213. SEGACT MLMINC
  214. MATRIK.IRIGEL(4,1) = IMATRI
  215. C
  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(5)
  221. C
  222. IMATRI.LISPRI(6) = MLMINC.MOTS(1)
  223. IMATRI.LISPRI(7) = MLMINC.MOTS(2)
  224. IMATRI.LISPRI(8) = MLMINC.MOTS(3)
  225. IMATRI.LISPRI(9) = MLMINC.MOTS(4)
  226. IMATRI.LISPRI(10) = MLMINC.MOTS(5)
  227. C
  228. IMATRI.LISPRI(11) = MLMINC.MOTS(1)
  229. IMATRI.LISPRI(12) = MLMINC.MOTS(2)
  230. IMATRI.LISPRI(13) = MLMINC.MOTS(3)
  231. IMATRI.LISPRI(14) = MLMINC.MOTS(4)
  232. IMATRI.LISPRI(15) = MLMINC.MOTS(5)
  233. C
  234. IMATRI.LISPRI(16) = MLMINC.MOTS(1)
  235. IMATRI.LISPRI(17) = MLMINC.MOTS(2)
  236. IMATRI.LISPRI(18) = MLMINC.MOTS(3)
  237. IMATRI.LISPRI(19) = MLMINC.MOTS(4)
  238. IMATRI.LISPRI(20) = MLMINC.MOTS(5)
  239. C
  240. IMATRI.LISPRI(21) = MLMINC.MOTS(1)
  241. IMATRI.LISPRI(22) = MLMINC.MOTS(2)
  242. IMATRI.LISPRI(23) = MLMINC.MOTS(3)
  243. IMATRI.LISPRI(24) = MLMINC.MOTS(4)
  244. IMATRI.LISPRI(25) = MLMINC.MOTS(5)
  245. C
  246. IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  247. IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  248. IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  249. IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  250. IMATRI.LISDUA(5) = MLMINC.MOTS(1)
  251. C
  252. IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  253. IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  254. IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  255. IMATRI.LISDUA(9) = MLMINC.MOTS(2)
  256. IMATRI.LISDUA(10) = MLMINC.MOTS(2)
  257. C
  258. IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  259. IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  260. IMATRI.LISDUA(13) = MLMINC.MOTS(3)
  261. IMATRI.LISDUA(14) = MLMINC.MOTS(3)
  262. IMATRI.LISDUA(15) = MLMINC.MOTS(3)
  263. C
  264. IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  265. IMATRI.LISDUA(17) = MLMINC.MOTS(4)
  266. IMATRI.LISDUA(18) = MLMINC.MOTS(4)
  267. IMATRI.LISDUA(19) = MLMINC.MOTS(4)
  268. IMATRI.LISDUA(20) = MLMINC.MOTS(4)
  269. C
  270. IMATRI.LISDUA(21) = MLMINC.MOTS(5)
  271. IMATRI.LISDUA(22) = MLMINC.MOTS(5)
  272. IMATRI.LISDUA(23) = MLMINC.MOTS(5)
  273. IMATRI.LISDUA(24) = MLMINC.MOTS(5)
  274. IMATRI.LISDUA(25) = MLMINC.MOTS(5)
  275. C
  276. NBEL = NBELEM
  277. NBSOUS = 1
  278. NP = 2
  279. MP = 2
  280. SEGINI RR , RUX , RUY , RUZ, RRET ,
  281. & UXR , UXUX , UXUY , UXUZ, UXRET ,
  282. & UYR , UYUX , UYUY , UYUZ, UYRET ,
  283. & UZR , UZUX , UZUY , UZUZ, UZRET ,
  284. & RETR , RETUX , RETUY , RETUZ, RETRET
  285. C
  286. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  287. C Primale = IMATRI.LISPRI(1) = 'RN'
  288. C -> IMATRI.LIZAFM(1,1) = RR
  289. C
  290. C Duale = IMATRI.LISDUA(2) = 'RN'
  291. C Primale = IMATRI.LISPRI(1) = 'RUXN'
  292. C -> IMATRI.LIZAFM(1,2) = RUX
  293. C ...
  294. C
  295. IMATRI.LIZAFM(1,1) = RR
  296. IMATRI.LIZAFM(1,2) = RUX
  297. IMATRI.LIZAFM(1,3) = RUY
  298. IMATRI.LIZAFM(1,4) = RUZ
  299. IMATRI.LIZAFM(1,5) = RRET
  300. C
  301. IMATRI.LIZAFM(1,6) = UXR
  302. IMATRI.LIZAFM(1,7) = UXUX
  303. IMATRI.LIZAFM(1,8) = UXUY
  304. IMATRI.LIZAFM(1,9) = UXUZ
  305. IMATRI.LIZAFM(1,10) = UXRET
  306. C
  307. IMATRI.LIZAFM(1,11) = UYR
  308. IMATRI.LIZAFM(1,12) = UYUX
  309. IMATRI.LIZAFM(1,13) = UYUY
  310. IMATRI.LIZAFM(1,14) = UYUZ
  311. IMATRI.LIZAFM(1,15) = UYRET
  312. C
  313. IMATRI.LIZAFM(1,16) = UZR
  314. IMATRI.LIZAFM(1,17) = UZUX
  315. IMATRI.LIZAFM(1,18) = UZUY
  316. IMATRI.LIZAFM(1,19) = UZUZ
  317. IMATRI.LIZAFM(1,20) = UZRET
  318. C
  319. IMATRI.LIZAFM(1,21) = RETR
  320. IMATRI.LIZAFM(1,22) = RETUX
  321. IMATRI.LIZAFM(1,23) = RETUY
  322. IMATRI.LIZAFM(1,24) = RETUZ
  323. IMATRI.LIZAFM(1,25) = RETRET
  324. C**************************************************************
  325. C Bas Mach
  326. C**************************************************************
  327. CALL LICHT(IUPRI,MPUPRI,TYPE,IGEOMC)
  328. CALL LICHT(IUINF,MPUINF,TYPE,IGEOMC)
  329. C**************************************************************
  330. DO IFAC = 1, NFAC, 1
  331. NGCF = MELEFE.NUM(2,IFAC)
  332. NLCF = MLENTF.LECT(NGCF)
  333. IF(NLCF .NE. IFAC)THEN
  334. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  335. CALL ERREUR(5)
  336. GOTO 9999
  337. ENDIF
  338. NLFL = MLELIM.LECT(NGCF)
  339. NGCG = MELEFE.NUM(1,IFAC)
  340. NGCD = MELEFE.NUM(3,IFAC)
  341. IF(NLFL .NE. 0)THEN
  342. C
  343. C********** The point belongs on BC -> No contribution to jacobian!
  344. C
  345. MELEDU.NUM(1,IFAC) = NGCG
  346. MELEDU.NUM(2,IFAC) = NGCD
  347. ELSEIF(NGCG .NE. NGCD)THEN
  348. C
  349. C********** Les MELEMEs
  350. C
  351. MELEDU.NUM(1,IFAC) = NGCG
  352. MELEDU.NUM(2,IFAC) = NGCD
  353. C
  354. C********** Les etats G et D
  355. C
  356. NLCG = MLENTC.LECT(NGCG)
  357. NLCD = MLENTC.LECT(NGCD)
  358. C
  359. ROG = MPRN.VPOCHA(NLCG,1)
  360. PG = MPPN.VPOCHA(NLCG,1)
  361. UXG = MPUN.VPOCHA(NLCG,1)
  362. UYG = MPUN.VPOCHA(NLCG,2)
  363. UZG = MPUN.VPOCHA(NLCG,3)
  364. GAMG = MPGAMN.VPOCHA(NLCG,1)
  365. VOLG = MPVOLU.VPOCHA(NLCG,1)
  366. C-----------------------------------------
  367. WVEC_L(1)=ROG
  368. WVEC_L(2)=UXG
  369. WVEC_L(3)=UYG
  370. WVEC_L(4)=UZG
  371. WVEC_L(5)=PG
  372. C-----------------------------------------
  373. ROD = MPRN.VPOCHA(NLCD,1)
  374. PD = MPPN.VPOCHA(NLCD,1)
  375. UXD = MPUN.VPOCHA(NLCD,1)
  376. UYD = MPUN.VPOCHA(NLCD,2)
  377. UZD = MPUN.VPOCHA(NLCD,3)
  378. VOLD = MPVOLU.VPOCHA(NLCD,1)
  379. c-----------------------------------------------------
  380. WVEC_R(1)=ROD
  381. WVEC_R(2)=UXD
  382. WVEC_R(3)=UYD
  383. WVEC_R(4)=UZD
  384. WVEC_R(5)=PD
  385. C-----------------------------------------------------
  386. C********** La normale G->D
  387. C La tangente
  388. C-----------------------------------------------------
  389. c SURF = MPOVSU.VPOCHA(NLCF,1)
  390. c CNX = MPNORM.VPOCHA(NLCF,7)
  391. c CNY = MPNORM.VPOCHA(NLCF,8)
  392. c CNZ = MPNORM.VPOCHA(NLCF,9)
  393. cC
  394. cC********** Cosinus directeurs de tangente 1
  395. cC
  396. c CT1X = MPNORM.VPOCHA(NLCF,1)
  397. c CT1Y = MPNORM.VPOCHA(NLCF,2)
  398. c CT1Z = MPNORM.VPOCHA(NLCF,3)
  399. cC
  400. cC********** Cosinus directeurs de tangente 2
  401. cC
  402. c CT2X = MPNORM.VPOCHA(NLCF,4)
  403. c CT2Y = MPNORM.VPOCHA(NLCF,5)
  404. c CT2Z = MPNORM.VPOCHA(NLCF,6)
  405. C-------------------------------------------------------
  406. SURF = MPOVSU.VPOCHA(NLCF,1)
  407. NVECT(1) = MPNORM.VPOCHA(NLCF,7)
  408. NVECT(2) = MPNORM.VPOCHA(NLCF,8)
  409. NVECT(3) = MPNORM.VPOCHA(NLCF,9)
  410. c-----------------------------------------------
  411. TVECT1(1) = MPNORM.VPOCHA(NLCF,1)
  412. TVECT1(2) = MPNORM.VPOCHA(NLCF,2)
  413. TVECT1(3) = MPNORM.VPOCHA(NLCF,3)
  414. c----------------------------------------------
  415. TVECT2(1) = MPNORM.VPOCHA(NLCF,4)
  416. TVECT2(2) = MPNORM.VPOCHA(NLCF,5)
  417. TVECT2(3) = MPNORM.VPOCHA(NLCF,6)
  418. C-------------------------------------------------------
  419. C********** La contribution de Gauche
  420. C--------------------------------------------------------
  421. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),
  422. & MPUINF.VPOCHA(NLCD,1),
  423. & MPUPRI.VPOCHA(NLCG,1),
  424. & MPUPRI.VPOCHA(NLCD,1))
  425. CALL JA3DBM(jtl,jtr,wvec_l,wvec_r,nvect,tvect1,tvect2,
  426. & gamg,v_inf)
  427. C
  428. C
  429. C********** AB.AM(IFAC,IPRIM,IDUAL)
  430. C A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  431. C B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  432. C IPRIM = 1, 2 -> G, D
  433. C IDUAL = 1, 2 -> G, D
  434. C i.e.
  435. C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  436. C
  437. C
  438. C********** Dual RN
  439. FUNCEL = SURF * JTL(1,1)
  440. RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  441. RR.AM(IFAC,1,2) = FUNCEL / VOLD
  442. C----------------------------------------------------
  443. FUNCEL = SURF * JTL(1,2)
  444. RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  445. RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  446. C----------------------------------------------------
  447. FUNCEL = SURF * JTL(1,3)
  448. RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  449. RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  450. C----------------------------------------------------
  451. FUNCEL = SURF * JTL(1,4)
  452. RUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  453. RUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  454. C----------------------------------------------------
  455. FUNCEL = SURF * JTL(1,5)
  456. RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  457. RRET.AM(IFAC,1,2) = FUNCEL / VOLD
  458. c----------------------------------------------------
  459. C********** Dual RUXN
  460. C----------------------------------------------------
  461. FUNCEL = SURF * JTL(2,1)
  462. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  463. UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  464. C----------------------------------------------------
  465. FUNCEL = SURF * JTL(2,2)
  466. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  467. UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  468. C----------------------------------------------------
  469. FUNCEL = SURF * JTL(2,3)
  470. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  471. UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  472. C----------------------------------------------------
  473. FUNCEL = SURF * JTL(2,4)
  474. UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  475. UXUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  476. C----------------------------------------------------
  477. FUNCEL = SURF * JTL(2,5)
  478. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  479. UXRET.AM(IFAC,1,2) = FUNCEL / VOLD
  480. C----------------------------------------------------
  481. C********** Dual RUYN
  482. C----------------------------------------------------
  483. FUNCEL = SURF * JTL(3,1)
  484. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  485. UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  486. C----------------------------------------------------
  487. FUNCEL = SURF * JTL(3,2)
  488. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  489. UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  490. C----------------------------------------------------
  491. FUNCEL = SURF * JTL(3,3)
  492. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  493. UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  494. C----------------------------------------------------
  495. FUNCEL = SURF * JTL(3,4)
  496. UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  497. UYUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  498. C----------------------------------------------------
  499. FUNCEL = SURF * JTL(3,5)
  500. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  501. UYRET.AM(IFAC,1,2) = FUNCEL / VOLD
  502. C----------------------------------------------------
  503. C********** Dual RUZN
  504. C----------------------------------------------------
  505. FUNCEL = SURF * JTL(4,1)
  506. UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  507. UZR.AM(IFAC,1,2) = FUNCEL / VOLD
  508. C----------------------------------------------------
  509. FUNCEL = SURF * JTL(4,2)
  510. UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  511. UZUX.AM(IFAC,1,2) = FUNCEL / VOLD
  512. C----------------------------------------------------
  513. FUNCEL = SURF * JTL(4,3)
  514. UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  515. UZUY.AM(IFAC,1,2) = FUNCEL / VOLD
  516. C----------------------------------------------------
  517. FUNCEL = SURF * JTL(4,4)
  518. UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  519. UZUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  520. C----------------------------------------------------
  521. FUNCEL = SURF * JTL(4,5)
  522. UZRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  523. UZRET.AM(IFAC,1,2) = FUNCEL / VOLD
  524. C----------------------------------------------------
  525. C********** Dual RETN
  526. C----------------------------------------------------
  527. FUNCEL = SURF * JTL(5,1)
  528. RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  529. RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  530. C-----------------------------------------------------
  531. FUNCEL = SURF * JTL(5,2)
  532. RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  533. RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  534. C-----------------------------------------------------
  535. FUNCEL = SURF * JTL(5,3)
  536. RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  537. RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  538. C-----------------------------------------------------
  539. FUNCEL = SURF * JTL(5,4)
  540. RETUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  541. RETUZ.AM(IFAC,1,2) = FUNCEL / VOLD
  542. C-----------------------------------------------------
  543. FUNCEL = SURF * JTL(5,5)
  544. RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  545. RETRET.AM(IFAC,1,2) = FUNCEL / VOLD
  546. C-----------------------------------------------------
  547. C
  548. C********** La contribution de D
  549. C
  550. c CNX = -1.0D0 * CNX
  551. c CNY = -1.0D0 * CNY
  552. c CNZ = -1.0D0 * CNZ
  553. c CT1X = -1.0D0 * CT1X
  554. c CT1Y = -1.0D0 * CT1Y
  555. c CT1Z = -1.0D0 * CT1Z
  556. c CT2X = -1.0D0 * CT2X
  557. c CT2Y = -1.0D0 * CT2Y
  558. c CT2Z = -1.0D0 * CT2Z
  559. C
  560. c CALL VLHJ4(ROD,UXD,UYD,UZD,PD,RETD,GAMD,CNX,CNY,CNZ,
  561. c & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z,
  562. c & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET)
  563. C
  564. C
  565. C********** Dual RN
  566. C------------------------------------------------------
  567. FUNCEL = SURF * JTR(1,1)
  568. RR.AM(IFAC,2,2) = FUNCEL / VOLD
  569. RR.AM(IFAC,2,1) = -FUNCEL / VOLG
  570. C--------------------------------------------
  571. FUNCEL = SURF * JTR(1,2)
  572. RUX.AM(IFAC,2,2) = FUNCEL / VOLD
  573. RUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  574. C--------------------------------------------
  575. FUNCEL = SURF * JTR(1,3)
  576. RUY.AM(IFAC,2,2) = FUNCEL / VOLD
  577. RUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  578. C--------------------------------------------
  579. FUNCEL = SURF * JTR(1,4)
  580. RUZ.AM(IFAC,2,2) = FUNCEL / VOLD
  581. RUZ.AM(IFAC,2,1) = -FUNCEL / VOLG
  582. C--------------------------------------------
  583. FUNCEL = SURF * JTR(1,5)
  584. RRET.AM(IFAC,2,2) = FUNCEL / VOLD
  585. RRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  586. C--------------------------------------------
  587. C********** Dual RUXN
  588. C--------------------------------------------
  589. FUNCEL = SURF * JTR(2,1)
  590. UXR.AM(IFAC,2,2) = FUNCEL / VOLD
  591. UXR.AM(IFAC,2,1) = -FUNCEL / VOLG
  592. C--------------------------------------------
  593. FUNCEL = SURF * JTR(2,2)
  594. UXUX.AM(IFAC,2,2) = FUNCEL / VOLD
  595. UXUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  596. C--------------------------------------------
  597. FUNCEL = SURF * JTR(2,3)
  598. UXUY.AM(IFAC,2,2) = FUNCEL / VOLD
  599. UXUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  600. C--------------------------------------------
  601. FUNCEL = SURF * JTR(2,4)
  602. UXUZ.AM(IFAC,2,2) = FUNCEL / VOLD
  603. UXUZ.AM(IFAC,2,1) = -FUNCEL / VOLG
  604. C--------------------------------------------
  605. FUNCEL = SURF * JTR(2,5)
  606. UXRET.AM(IFAC,2,2) = FUNCEL / VOLD
  607. UXRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  608. C--------------------------------------------
  609. C********** Dual RUYN
  610. C--------------------------------------------
  611. FUNCEL = SURF * JTR(3,1)
  612. UYR.AM(IFAC,2,2) = FUNCEL / VOLD
  613. UYR.AM(IFAC,2,1) = -FUNCEL / VOLG
  614. C--------------------------------------------
  615. FUNCEL = SURF * JTR(3,2)
  616. UYUX.AM(IFAC,2,2) = FUNCEL / VOLD
  617. UYUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  618. C--------------------------------------------
  619. FUNCEL = SURF * JTR(3,3)
  620. UYUY.AM(IFAC,2,2) = FUNCEL / VOLD
  621. UYUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  622. C--------------------------------------------
  623. FUNCEL = SURF * JTR(3,4)
  624. UYUZ.AM(IFAC,2,2) = FUNCEL / VOLD
  625. UYUZ.AM(IFAC,2,1) = -FUNCEL / VOLG
  626. C--------------------------------------------
  627. FUNCEL = SURF * JTR(3,5)
  628. UYRET.AM(IFAC,2,2) = FUNCEL / VOLD
  629. UYRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  630. C--------------------------------------------
  631. C********** Dual RUZN
  632. C--------------------------------------------
  633. FUNCEL = SURF * JTR(4,1)
  634. UZR.AM(IFAC,2,2) = FUNCEL / VOLD
  635. UZR.AM(IFAC,2,1) = -FUNCEL / VOLG
  636. C--------------------------------------------
  637. FUNCEL = SURF * JTR(4,2)
  638. UZUX.AM(IFAC,2,2) = FUNCEL / VOLD
  639. UZUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  640. C--------------------------------------------
  641. FUNCEL = SURF * JTR(4,3)
  642. UZUY.AM(IFAC,2,2) = FUNCEL / VOLD
  643. UZUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  644. C--------------------------------------------
  645. FUNCEL = SURF * JTR(4,4)
  646. UZUZ.AM(IFAC,2,2) = FUNCEL / VOLD
  647. UZUZ.AM(IFAC,2,1) = -FUNCEL / VOLG
  648. C--------------------------------------------
  649. FUNCEL = SURF * JTR(4,5)
  650. UZRET.AM(IFAC,2,2) = FUNCEL / VOLD
  651. UZRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  652. C--------------------------------------------
  653. C********** Dual RETN
  654. C--------------------------------------------
  655. FUNCEL = SURF * JTR(5,1)
  656. RETR.AM(IFAC,2,2) = FUNCEL / VOLD
  657. RETR.AM(IFAC,2,1) = -FUNCEL / VOLG
  658. C---------------------------------------------
  659. FUNCEL = SURF * JTR(5,2)
  660. RETUX.AM(IFAC,2,2) = FUNCEL / VOLD
  661. RETUX.AM(IFAC,2,1) = -FUNCEL / VOLG
  662. C---------------------------------------------
  663. FUNCEL = SURF * JTR(5,3)
  664. RETUY.AM(IFAC,2,2) = FUNCEL / VOLD
  665. RETUY.AM(IFAC,2,1) = -FUNCEL / VOLG
  666. C---------------------------------------------
  667. FUNCEL = SURF * JTR(5,4)
  668. RETUZ.AM(IFAC,2,2) = FUNCEL / VOLD
  669. RETUZ.AM(IFAC,2,1) = -FUNCEL / VOLG
  670. C---------------------------------------------
  671. FUNCEL = SURF * JTR(5,5)
  672. RETRET.AM(IFAC,2,2) = FUNCEL / VOLD
  673. RETRET.AM(IFAC,2,1) = -FUNCEL / VOLG
  674. C
  675. ELSE
  676. C----------------------------------------------
  677. C********** Murs (NGCG = NGCD)
  678. C
  679. C
  680. C********** Les MELEMEs
  681. C----------------------------------------------
  682. MELEDU.NUM(1,IFAC) = NGCG
  683. MELEDU.NUM(2,IFAC) = NGCD
  684. NLCG = MLENTC.LECT(NGCG)
  685. C---------------------------------------------
  686. ROG = MPRN.VPOCHA(NLCG,1)
  687. PG = MPPN.VPOCHA(NLCG,1)
  688. UXG = MPUN.VPOCHA(NLCG,1)
  689. UYG = MPUN.VPOCHA(NLCG,2)
  690. UZG = MPUN.VPOCHA(NLCG,3)
  691. GAMG = MPGAMN.VPOCHA(NLCG,1)
  692. VOLG = MPVOLU.VPOCHA(NLCG,1)
  693. C-------------------------------------------
  694. WVEC_L(1)=ROG
  695. WVEC_L(2)=UXG
  696. WVEC_L(3)=UYG
  697. WVEC_L(4)=UZG
  698. WVEC_L(5)=PG
  699. C--------------------------------------------
  700. C********** La normale sortante
  701. C-------------------------------------------
  702. c SURF = MPOVSU.VPOCHA(NLCF,1)
  703. c CNX = MPNORM.VPOCHA(NLCF,7)
  704. c CNY = MPNORM.VPOCHA(NLCF,8)
  705. c CNZ = MPNORM.VPOCHA(NLCF,9)
  706. cC
  707. c CALL VLHJ6(ROG,UXG,UYG,UZG,PG,GAMG,CNX,CNY,CNZ,
  708. c & DFRUN)
  709. C---------------------------------------------------------
  710. SURF = MPOVSU.VPOCHA(NLCF,1)
  711. NVECT(1) = MPNORM.VPOCHA(NLCF,7)
  712. NVECT(2) = MPNORM.VPOCHA(NLCF,8)
  713. NVECT(3) = MPNORM.VPOCHA(NLCF,9)
  714. c--------------------------------------------
  715. TVECT1(1) = MPNORM.VPOCHA(NLCF,1)
  716. TVECT1(2) = MPNORM.VPOCHA(NLCF,2)
  717. TVECT1(3) = MPNORM.VPOCHA(NLCF,3)
  718. c----------------------------------------------
  719. TVECT2(1) = MPNORM.VPOCHA(NLCF,4)
  720. TVECT2(2) = MPNORM.VPOCHA(NLCF,5)
  721. TVECT2(3) = MPNORM.VPOCHA(NLCF,6)
  722. C------- COEFFICIENTS ----------------------------
  723. C11=TVECT1(2)*TVECT2(3)-TVECT1(3)*TVECT2(2)
  724. C12=NVECT(2)*TVECT2(3)-TVECT2(2)*NVECT(3)
  725. C13=NVECT(2)*TVECT1(3)-TVECT1(2)*NVECT(3)
  726. C---------------------------------
  727. C21=TVECT1(1)*TVECT2(3)-TVECT1(3)*TVECT2(1)
  728. C22=NVECT(1)*TVECT2(3)-TVECT2(1)*NVECT(3)
  729. C23=NVECT(1)*TVECT1(3)-TVECT1(1)*NVECT(3)
  730. C---------------------------------
  731. C31=TVECT1(1)*TVECT2(2)-TVECT1(2)*TVECT2(1)
  732. C32=NVECT(1)*TVECT2(2)-TVECT2(1)*NVECT(2)
  733. C33=NVECT(1)*TVECT1(2)-TVECT1(1)*NVECT(2)
  734. DET=NVECT(1)*C11-NVECT(2)*C21+NVECT(3)*C31
  735. C---------------------------------
  736. ZC11=-NVECT(1)*C11-TVECT1(1)*C12+TVECT2(1)*C13
  737. ZC12=-NVECT(2)*C11-TVECT1(2)*C12+TVECT2(2)*C13
  738. ZC13=-NVECT(3)*C11-TVECT1(3)*C12+TVECT2(3)*C13
  739. C---------------------------------
  740. ZC21=NVECT(1)*C21+TVECT1(1)*C22-TVECT2(1)*C23
  741. ZC22=NVECT(2)*C21+TVECT1(2)*C22-TVECT2(2)*C23
  742. ZC23=NVECT(3)*C21+TVECT1(3)*C22-TVECT2(3)*C23
  743. C---------------------------------
  744. ZC31=-NVECT(1)*C31-TVECT1(1)*C32+TVECT2(1)*C33
  745. ZC32=-NVECT(2)*C31-TVECT1(2)*C32+TVECT2(2)*C33
  746. ZC33=-NVECT(3)*C31-TVECT1(3)*C32+TVECT2(3)*C33
  747. C-------------------------------------------------
  748. ROD = ROG
  749. PD = PG
  750. UXD = (ZC11*UXG+ZC12*UYG+ZC13*UZG)/DET
  751. UYD = (ZC21*UXG+ZC22*UYG+ZC23*UZG)/DET
  752. UZD = (ZC31*UXG+ZC32*UYG+ZC33*UZG)/DET
  753. VOLD = VOLG
  754. C------------------------------------------------
  755. WVEC_R(1)=ROD
  756. WVEC_R(2)=UXD
  757. WVEC_R(3)=UYD
  758. WVEC_R(4)=UZD
  759. WVEC_R(5)=PD
  760. C-------------------------------------------
  761. C********** La normale sortante
  762. C-------------------------------------------
  763. V_INF=MAX(MPUINF.VPOCHA(NLCG,1),
  764. & MPUPRI.VPOCHA(NLCG,1))
  765. CALL jw3Dbm(jtl,wvec_l,wvec_r,nvect,tvect1,tvect2,
  766. & gamg,v_inf)
  767. C---------------------------------------------------------
  768. C********** Dual RN
  769. C---------------------------------------------------------
  770. RR.AM(IFAC,1,1) = 0.0D0
  771. RR.AM(IFAC,1,2) = 0.0D0
  772. C---------------------------------------------------------
  773. RUX.AM(IFAC,1,1) = 0.0D0
  774. RUX.AM(IFAC,1,2) = 0.0D0
  775. C---------------------------------------------------------
  776. RUY.AM(IFAC,1,1) = 0.0D0
  777. RUY.AM(IFAC,1,2) = 0.0D0
  778. C---------------------------------------------------------
  779. RUZ.AM(IFAC,1,1) = 0.0D0
  780. RUZ.AM(IFAC,1,2) = 0.0D0
  781. C--------------------------------------------------------
  782. RRET.AM(IFAC,1,1) = 0.0D0
  783. RRET.AM(IFAC,1,2) = 0.0D0
  784. C---------------------------------------------------------
  785. C********** Dual RUXN
  786. C---------------------------------------------------------
  787. FUNCEL = SURF * JTL(2,1)
  788. UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  789. UXR.AM(IFAC,1,2) = 0.0D0
  790. C----------------------------------------------------
  791. FUNCEL = SURF * JTL(2,2)
  792. UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  793. UXUX.AM(IFAC,1,2) = 0.0D0
  794. C----------------------------------------------------
  795. FUNCEL = SURF * JTL(2,3)
  796. UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  797. UXUY.AM(IFAC,1,2) = 0.0D0
  798. C----------------------------------------------------
  799. FUNCEL = SURF * JTL(2,4)
  800. UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  801. UXUZ.AM(IFAC,1,2) = 0.0D0
  802. C----------------------------------------------------
  803. FUNCEL = SURF * JTL(2,5)
  804. UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  805. UXRET.AM(IFAC,1,2) = 0.0D0
  806. C----------------------------------------------------
  807. C********** Dual RUYN
  808. C----------------------------------------------------
  809. FUNCEL = SURF * JTL(3,1)
  810. UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  811. UYR.AM(IFAC,1,2) = 0.0D0
  812. C----------------------------------------------------
  813. FUNCEL = SURF * JTL(3,2)
  814. UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  815. UYUX.AM(IFAC,1,2) = 0.0D0
  816. C----------------------------------------------------
  817. FUNCEL = SURF * JTL(3,3)
  818. UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  819. UYUY.AM(IFAC,1,2) = 0.0D0
  820. C----------------------------------------------------
  821. FUNCEL = SURF * JTL(3,4)
  822. UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  823. UYUZ.AM(IFAC,1,2) = 0.0D0
  824. C----------------------------------------------------
  825. FUNCEL = SURF * JTL(3,5)
  826. UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  827. UYRET.AM(IFAC,1,2) = 0.0D0
  828. C-----------------------------------------------------
  829. C********** Dual RUZN
  830. C-----------------------------------------------------
  831. FUNCEL = SURF * JTL(4,1)
  832. UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  833. UZR.AM(IFAC,1,2) = 0.0D0
  834. C----------------------------------------------------
  835. FUNCEL = SURF * JTL(4,2)
  836. UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  837. UZUX.AM(IFAC,1,2) = 0.0D0
  838. C----------------------------------------------------
  839. FUNCEL = SURF * JTL(4,3)
  840. UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  841. UZUY.AM(IFAC,1,2) = 0.0D0
  842. C----------------------------------------------------
  843. FUNCEL = SURF * JTL(4,4)
  844. UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  845. UZUZ.AM(IFAC,1,2) = 0.0D0
  846. C----------------------------------------------------
  847. FUNCEL = SURF * JTL(4,5)
  848. UZRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  849. UZRET.AM(IFAC,1,2) = 0.0D0
  850. C----------------------------------------------------
  851. C********** Dual RETN
  852. C----------------------------------------------------
  853. RETR.AM(IFAC,1,1) = 0.0D0
  854. RETR.AM(IFAC,1,2) = 0.0D0
  855. C----------------------------------------------------
  856. RETUX.AM(IFAC,1,1) = 0.0D0
  857. RETUX.AM(IFAC,1,2) = 0.0D0
  858. C----------------------------------------------------
  859. RETUY.AM(IFAC,1,1) = 0.0D0
  860. RETUY.AM(IFAC,1,2) = 0.0D0
  861. C----------------------------------------------------
  862. RETUZ.AM(IFAC,1,1) = 0.0D0
  863. RETUZ.AM(IFAC,1,2) = 0.0D0
  864. C---------------------------------------------------
  865. RETRET.AM(IFAC,1,1) = 0.0D0
  866. RETRET.AM(IFAC,1,2) = 0.0D0
  867. C---------------------------------------------------
  868. C********** Dual RN
  869. C---------------------------------------------------
  870. RR.AM(IFAC,2,2) = 0.0D0
  871. RR.AM(IFAC,2,1) = 0.0D0
  872. C---------------------------------------------------
  873. RUX.AM(IFAC,2,2) = 0.0D0
  874. RUX.AM(IFAC,2,1) = 0.0D0
  875. C---------------------------------------------------
  876. RUY.AM(IFAC,2,2) = 0.0D0
  877. RUY.AM(IFAC,2,1) = 0.0D0
  878. C---------------------------------------------------
  879. RUZ.AM(IFAC,2,2) = 0.0D0
  880. RUZ.AM(IFAC,2,1) = 0.0D0
  881. C---------------------------------------------------
  882. RRET.AM(IFAC,2,2) = 0.0D0
  883. RRET.AM(IFAC,2,1) = 0.0D0
  884. C---------------------------------------------------
  885. C********** Dual RUXN
  886. C---------------------------------------------------
  887. UXR.AM(IFAC,2,2) = 0.0D0
  888. UXR.AM(IFAC,2,1) = 0.0D0
  889. C---------------------------------------------------
  890. UXUX.AM(IFAC,2,2) = 0.0D0
  891. UXUX.AM(IFAC,2,1) = 0.0D0
  892. C---------------------------------------------------
  893. UXUY.AM(IFAC,2,2) = 0.0D0
  894. UXUY.AM(IFAC,2,1) = 0.0D0
  895. C---------------------------------------------------
  896. UXUZ.AM(IFAC,2,2) = 0.0D0
  897. UXUZ.AM(IFAC,2,1) = 0.0D0
  898. C---------------------------------------------------
  899. UXRET.AM(IFAC,2,2) = 0.0D0
  900. UXRET.AM(IFAC,2,1) = 0.0D0
  901. C---------------------------------------------------
  902. C********** Dual RUYN
  903. C---------------------------------------------------
  904. UYR.AM(IFAC,2,2) = 0.0D0
  905. UYR.AM(IFAC,2,1) = 0.0D0
  906. C---------------------------------------------------
  907. UYUX.AM(IFAC,2,2) = 0.0D0
  908. UYUX.AM(IFAC,2,1) = 0.0D0
  909. C---------------------------------------------------
  910. UYUY.AM(IFAC,2,2) = 0.0D0
  911. UYUY.AM(IFAC,2,1) = 0.0D0
  912. C---------------------------------------------------
  913. UYUZ.AM(IFAC,2,2) = 0.0D0
  914. UYUZ.AM(IFAC,2,1) = 0.0D0
  915. C---------------------------------------------------
  916. UYRET.AM(IFAC,2,2) = 0.0D0
  917. UYRET.AM(IFAC,2,1) = 0.0D0
  918. C---------------------------------------------------
  919. C********** Dual RUZN
  920. C---------------------------------------------------
  921. UZR.AM(IFAC,2,2) = 0.0D0
  922. UZR.AM(IFAC,2,1) = 0.0D0
  923. C---------------------------------------------------
  924. UZUX.AM(IFAC,2,2) = 0.0D0
  925. UZUX.AM(IFAC,2,1) = 0.0D0
  926. C---------------------------------------------------
  927. UZUY.AM(IFAC,2,2) = 0.0D0
  928. UZUY.AM(IFAC,2,1) = 0.0D0
  929. C---------------------------------------------------
  930. UZUZ.AM(IFAC,2,2) = 0.0D0
  931. UZUZ.AM(IFAC,2,1) = 0.0D0
  932. C---------------------------------------------------
  933. UZRET.AM(IFAC,2,2) = 0.0D0
  934. UZRET.AM(IFAC,2,1) = 0.0D0
  935. C---------------------------------------------------
  936. C********** Dual RETN
  937. C---------------------------------------------------
  938. RETR.AM(IFAC,2,2) = 0.0D0
  939. RETR.AM(IFAC,2,1) = 0.0D0
  940. C---------------------------------------------------
  941. RETUX.AM(IFAC,2,2) = 0.0D0
  942. RETUX.AM(IFAC,2,1) = 0.0D0
  943. C---------------------------------------------------
  944. RETUY.AM(IFAC,2,2) = 0.0D0
  945. RETUY.AM(IFAC,2,1) = 0.0D0
  946. C---------------------------------------------------
  947. RETUZ.AM(IFAC,2,2) = 0.0D0
  948. RETUZ.AM(IFAC,2,1) = 0.0D0
  949. C---------------------------------------------------
  950. RETRET.AM(IFAC,2,2) = 0.0D0
  951. RETRET.AM(IFAC,2,1) = 0.0D0
  952. C---------------------------------------------------
  953. ENDIF
  954. ENDDO
  955. C
  956. SEGDES MELEMC
  957. SEGDES MELEFE
  958. SEGDES MELEMF
  959. C
  960. SEGDES MPOVSU
  961. SEGDES MPVOLU
  962. SEGDES MPNORM
  963. C
  964. SEGDES MPRN
  965. SEGDES MPPN
  966. SEGDES MPUN
  967. SEGDES MPGAMN
  968. C
  969. SEGDES MELEDU
  970. SEGDES MATRIK
  971. SEGDES IMATRI
  972. C
  973. SEGDES RR , RUX , RUY , RUZ, RRET ,
  974. & UXR , UXUX , UXUY , UXUZ, UXRET ,
  975. & UYR , UYUX , UYUY , UYUZ, UYRET ,
  976. & UZR , UZUX , UZUY , UZUZ, UYRET ,
  977. & RETR , RETUX , RETUY , RETUZ, RETRET
  978.  
  979. SEGSUP MLENTC
  980. SEGSUP MLENTF
  981. SEGDES MLMINC
  982. SEGSUP MLELIM
  983. C
  984. SEGDES MPUPRI
  985. SEGDES MPUINF
  986. IF(MELLIM .NE.0) SEGDES MELLIM
  987. C
  988. 9999 CONTINUE
  989. RETURN
  990. END
  991.  
  992.  
  993.  
  994.  
  995.  
  996.  
  997.  
  998.  
  999.  
  1000.  
  1001.  
  1002.  
  1003.  
  1004.  
  1005.  
  1006.  

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