Télécharger pre611.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE611 SOURCE PV 20/03/26 21:16:16 10563
  2. SUBROUTINE PRE611(ICEN,IFACE,IFACEL,INORM,
  3. & IAL1, IGRAL1, ILIAL1,
  4. & IAL2, IGRAL2, ILIAL2,
  5. & IRN1, IGRRN1, ILIRN1,
  6. & IRN2, IGRRN2, ILIRN2,
  7. & IVN1, IGRVN1, ILIVN1,
  8. & IVN2, IGRVN2, ILIVN2,
  9. & IPN1, IGRPN1, ILIPN1,
  10. & IPN2, IGRPN2, ILIPN2,
  11. & IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F)
  12. C************************************************************************
  13. C
  14. C PROJET : CASTEM 2000
  15. C
  16. C NOM : PRE611
  17. C
  18. C DESCRIPTION : Voir PRE61
  19. C
  20. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  21. C
  22. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  23. C
  24. C************************************************************************
  25. C
  26. C ENTREES
  27. C
  28. C
  29. C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
  30. C
  31. C ICEN : MELEME de 'POI1' SPG des CENTRES
  32. C
  33. C IFACE : MELEME de 'POI1' SPG des FACES
  34. C
  35. C IFACEL : MELEME de 'SEG3' avec
  36. C CENTRE d'Elt "gauche"
  37. C CENTRE de Face
  38. C CENTRE d'Elt "droite"
  39. C
  40. C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
  41. C
  42. C INORM : CHPOINT des cosinus directeurs de normales aux faces
  43. C
  44. C 2) Autres pointeurs
  45. C
  46. C IAL1, IGRAL1, ILIAL1,
  47. C IAL2, IGRAL2, ILIAL2.
  48. C CHPOINT "CENTRE" de fractions volumiques, gradients et limiteurs
  49. C
  50. C IRN1, IGRRN1, ILIRN1,
  51. C IRN2, IGRRN2, ILIRN2.
  52. C CHPOINT "CENTRE" de densités, gradients et limiteurs
  53. C
  54. C IVN1, IGRVN1, ILIVN1,
  55. C IVN2, IGRVN2, ILIVN2.
  56. C CHPOINT "CENTRE" de vitesses, gradients et limiteurs
  57. C
  58. C IPN1, IGRPN1, ILIPN1,
  59. C IPN2, IGRPN2, ILIPN2.
  60. C CHPOINT "CENTRE" de pression, gradients et limiteurs
  61. C
  62. C
  63. C SORTIES
  64. C
  65. C IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F.
  66. C MCHAMLs definis sur le MELEME de pointeur IFACEL
  67. C
  68. C************************************************************************
  69. C
  70. C HISTORIQUE (Anomalies et modifications éventuelles)
  71. C
  72. C HISTORIQUE : Crée le 03.12.09.
  73. C Estension au 3D le 21.12.2010
  74. C
  75. C************************************************************************
  76. C
  77. C
  78. C ATTENTION: Cet programme marche si le MAILLAGE est convex;
  79. C si non il faut changer l'algoritme de calcul de
  80. C l'orientation des normales aux faces.
  81. C
  82. C La positivité n'est pas controlle parce que c'est déjà fait
  83. C dans l'operateur PRIM
  84. C
  85. C
  86. C************************************************************************
  87. C
  88. IMPLICIT INTEGER(I-N)
  89. C
  90. C**** Les variables
  91. C
  92. INTEGER IAL1, IGRAL1, ILIAL1
  93. & , IAL2, IGRAL2, ILIAL2
  94. & , IRN1, IGRRN1, ILIRN1
  95. & , IRN2, IGRRN2, ILIRN2
  96. & , IVN1, IGRVN1, ILIVN1
  97. & , IVN2, IGRVN2, ILIVN2
  98. & , IPN1, IGRPN1, ILIPN1
  99. & , IPN2, IGRPN2, ILIPN2
  100. & , IAL1F, IAL2F, IRN1F, IRN2F
  101. & , IVN1F, IVN2F, IPN1F, IPN2F
  102. & , IGEOM, NFAC, NCEN
  103. & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
  104. & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
  105. & , IDIMP1, INDCEL
  106. REAL*8 XG, YG, ZG, XC, YC, ZC, XD, YD, ZD
  107. & ,DXG, DYG, DZG, DXD, DYD, DZD
  108. & , CNX, CNY, CNZ, CTX, CTY, CTZ, ORIENT
  109. & , CVX, CVY, CVZ
  110. & , AL1G, AL2G, RN1G, RN2G, PN1G, PN2G
  111. & , UX1G, UX2G, UY1G, UY2G, UZ1G, UZ2G
  112. & , UN1G, UN2G, UT1G, UT2G, UV1G, UV2G
  113. & , AL1D, AL2D, RN1D, RN2D, PN1D, PN2D
  114. & , UX1D, UX2D, UY1D, UY2D, UZ1D, UZ2D
  115. & , UN1D, UN2D, UT1D, UT2D, UV1D, UV2D
  116. & , VALCEL, DCEL, LIMCEL
  117. CHARACTER*(40) MESERR
  118. CHARACTER*(8) TYPE
  119. LOGICAL LOGI1
  120. C
  121. C**** Les Includes
  122. C
  123. -INC SMCOORD
  124.  
  125. -INC PPARAM
  126. -INC CCOPTIO
  127. -INC SMCHPOI
  128. POINTEUR MPAL1.MPOVAL, MPGAL1.MPOVAL, MPLAL1.MPOVAL
  129. POINTEUR MPAL2.MPOVAL, MPGAL2.MPOVAL, MPLAL2.MPOVAL
  130. POINTEUR MPRN1.MPOVAL, MPGRN1.MPOVAL, MPLRN1.MPOVAL
  131. POINTEUR MPRN2.MPOVAL, MPGRN2.MPOVAL, MPLRN2.MPOVAL
  132. POINTEUR MPVN1.MPOVAL, MPGVN1.MPOVAL, MPLVN1.MPOVAL
  133. POINTEUR MPVN2.MPOVAL, MPGVN2.MPOVAL, MPLVN2.MPOVAL
  134. POINTEUR MPPN1.MPOVAL, MPGPN1.MPOVAL, MPLPN1.MPOVAL
  135. POINTEUR MPPN2.MPOVAL, MPGPN2.MPOVAL, MPLPN2.MPOVAL
  136. POINTEUR MPNORM.MPOVAL
  137. -INC SMCHAML
  138. C Melval des cosinus directeurs
  139. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL,
  140. & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL,
  141. & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL
  142. C Melval des vitesses
  143. POINTEUR MEVUN1.MELVAL, MEVUT1.MELVAL, MEVUV1.MELVAL,
  144. & MEVUN2.MELVAL, MEVUT2.MELVAL, MEVUV2.MELVAL
  145. C Melval des densités, pressions, alphas
  146. POINTEUR MELRN1.MELVAL, MELRN2.MELVAL
  147. POINTEUR MELPN1.MELVAL, MELPN2.MELVAL
  148. POINTEUR MELAL1.MELVAL, MELAL2.MELVAL
  149. -INC SMLENTI
  150. -INC SMELEME
  151. C
  152. mcham1 = 0
  153. C
  154. C**** KRIPAD pour la correspondance global/local de centre
  155. C
  156. CALL KRIPAD(ICEN,MLENT1)
  157. C
  158. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  159. C
  160. C Si i est le numero global d'un noeud de ICEN,
  161. C MLENT1.LECT(i) contient sa position, i.e.
  162. C
  163. C I = numero global du noeud centre
  164. C MLENT1.LECT(i) = numero local du noeud centre
  165. C
  166. C MLENT1 déjà activé, i.e.
  167. C
  168. C SEGACT MLENT1
  169. C
  170. C**** Activation de CHPOINTs
  171. C
  172. C alpha + grad + limiteur
  173. C densité + grad + limiteur
  174. C vitesse + grad + limiteur
  175. C pression + grad + limiteur
  176. C cosinus directeurs des normales aux surface
  177. C
  178. CALL LICHT(IAL1 , MPAL1 , TYPE, IGEOM)
  179. C SEGACT MPAL1
  180. CALL LICHT(IGRAL1 , MPGAL1 , TYPE, IGEOM)
  181. C SEGACT MPGAL1
  182. CALL LICHT(ILIAL1 , MPLAL1 , TYPE, IGEOM)
  183. C SEGACT MPLAL1
  184. CALL LICHT(IAL2 , MPAL2 , TYPE, IGEOM)
  185. C SEGACT MPAL2
  186. CALL LICHT(IGRAL2 , MPGAL2 , TYPE, IGEOM)
  187. C SEGACT MPGAL2
  188. CALL LICHT(ILIAL2 , MPLAL2 , TYPE, IGEOM)
  189. C SEGACT MPLAL2
  190. CALL LICHT(IRN1 , MPRN1 , TYPE, IGEOM)
  191. C SEGACT MPRN1
  192. CALL LICHT(IGRRN1 , MPGRN1 , TYPE, IGEOM)
  193. C SEGACT MPGRN1
  194. CALL LICHT(ILIRN1 , MPLRN1 , TYPE, IGEOM)
  195. C SEGACT MPLRN1
  196. CALL LICHT(IRN2 , MPRN2 , TYPE, IGEOM)
  197. C SEGACT MPRN2
  198. CALL LICHT(IGRRN2 , MPGRN2 , TYPE, IGEOM)
  199. C SEGACT MPGRN2
  200. CALL LICHT(ILIRN2 , MPLRN2 , TYPE, IGEOM)
  201. C SEGACT MPLRN2
  202. CALL LICHT(IVN1 , MPVN1 , TYPE, IGEOM)
  203. C SEGACT MPVN1
  204. CALL LICHT(IGRVN1 , MPGVN1 , TYPE, IGEOM)
  205. C SEGACT MPGVN1
  206. CALL LICHT(ILIVN1 , MPLVN1 , TYPE, IGEOM)
  207. C SEGACT MPLVN1
  208. CALL LICHT(IVN2 , MPVN2 , TYPE, IGEOM)
  209. C SEGACT MPVN2
  210. CALL LICHT(IGRVN2 , MPGVN2 , TYPE, IGEOM)
  211. C SEGACT MPGVN2
  212. CALL LICHT(ILIVN2 , MPLVN2 , TYPE, IGEOM)
  213. C SEGACT MPLVN2
  214. CALL LICHT(IPN1 , MPPN1 , TYPE, IGEOM)
  215. C SEGACT MPPN1
  216. CALL LICHT(IGRPN1 , MPGPN1 , TYPE, IGEOM)
  217. C SEGACT MPGPN1
  218. CALL LICHT(ILIPN1 , MPLPN1 , TYPE, IGEOM)
  219. C SEGACT MPLPN1
  220. CALL LICHT(IPN2 , MPPN2 , TYPE, IGEOM)
  221. C SEGACT MPPN2
  222. CALL LICHT(IGRPN2 , MPGPN2 , TYPE, IGEOM)
  223. C SEGACT MPGPN2
  224. CALL LICHT(ILIPN2 , MPLPN2 , TYPE, IGEOM)
  225. C SEGACT MPLPN2
  226. C
  227. C**** Le cosinus directeurs
  228. C
  229. CALL LICHT(INORM , MPNORM , TYPE, IGEOM)
  230. C SEGACT MPNORM
  231. C
  232. C**** Les MPOVAL sont déjà activés i.e.:
  233. C
  234. C
  235. C**** Le MELEME FACEL
  236. C
  237. IPT1 = IFACEL
  238. IPT2 = IFACE
  239. SEGACT IPT1
  240. SEGACT IPT2
  241. NFAC = IPT1.NUM(/2)
  242. C
  243. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  244. C
  245. C i.e.:
  246. C
  247. C vitesse + cosinus directors du repere local
  248. C alpha
  249. C densité
  250. C pression
  251. C
  252. C**********************************************************
  253. C**** Cosinus directors du repere local et vitesse ********
  254. C**********************************************************
  255. C
  256. C Les cosinus directeurs
  257. C
  258. N1 = 2
  259. N3 = 6
  260. L1 = 28
  261. SEGINI MCHEL1
  262. IVN1F = MCHEL1
  263. MCHEL1.TITCHE = 'U '
  264. MCHEL1.IMACHE(1) = IFACE
  265. MCHEL1.IMACHE(2) = IFACEL
  266. IF (IDIM .EQ. 2) THEN
  267. MCHEL1.CONCHE(1) = '(n,t) in (x,y) '
  268. MCHEL1.CONCHE(2) = ' U in (n,t) '
  269. ELSE
  270. MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)'
  271. MCHEL1.CONCHE(2) = ' U in (n,t,v) '
  272. ENDIF
  273. * MCHEL1.NOPHAS(1) = ' '
  274. * MCHEL1.NOPHAS(2) = ' '
  275. C
  276. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  277. C
  278. MCHEL1.INFCHE(1,1) = 2
  279. MCHEL1.INFCHE(1,3) = NIFOUR
  280. MCHEL1.INFCHE(1,4) = 0
  281. MCHEL1.INFCHE(1,5) = 0
  282. MCHEL1.INFCHE(1,6) = 0
  283. MCHEL1.IFOCHE = IFOUR
  284. C
  285. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  286. C
  287. MCHEL1.INFCHE(2,1) = 1
  288. MCHEL1.INFCHE(2,3) = NIFOUR
  289. MCHEL1.INFCHE(2,4) = 0
  290. MCHEL1.INFCHE(2,5) = 0
  291. MCHEL1.INFCHE(2,6) = 0
  292. C
  293. C**** Le cosinus directeurs
  294. C
  295. N1PTEL = 1
  296. N1EL = NFAC
  297. N2PTEL = 0
  298. N2EL = 0
  299. C
  300. C**** MCHAML a N2 composantes:
  301. C
  302. C cosinus directeurs du repere local (n,t1)
  303. C
  304. C IDIM = 3 -> 9 composantes
  305. C IDIM = 2 -> 4 composantes
  306. C
  307. IF (IDIM .EQ. 2)THEN
  308. N2 = 4
  309. SEGINI MCHAM1
  310. MCHEL1.ICHAML(1) = MCHAM1
  311. MCHAM1.NOMCHE(1) = 'NX '
  312. MCHAM1.NOMCHE(2) = 'NY '
  313. MCHAM1.NOMCHE(3) = 'TX '
  314. MCHAM1.NOMCHE(4) = 'TY '
  315. MCHAM1.TYPCHE(1) = 'REAL*8 '
  316. MCHAM1.TYPCHE(2) = 'REAL*8 '
  317. MCHAM1.TYPCHE(3) = 'REAL*8 '
  318. MCHAM1.TYPCHE(4) = 'REAL*8 '
  319. SEGINI MELVNX
  320. SEGINI MELVNY
  321. SEGINI MELT1X
  322. SEGINI MELT1Y
  323. MCHAM1.IELVAL(1) = MELVNX
  324. MCHAM1.IELVAL(2) = MELVNY
  325. MCHAM1.IELVAL(3) = MELT1X
  326. MCHAM1.IELVAL(4) = MELT1Y
  327. ELSEIF (IDIM .EQ. 3) THEN
  328. N2 = 9
  329. SEGINI MCHAM1
  330. MCHEL1.ICHAML(1) = MCHAM1
  331. MCHAM1.NOMCHE(1) = 'NX '
  332. MCHAM1.NOMCHE(2) = 'NY '
  333. MCHAM1.NOMCHE(3) = 'NZ '
  334. MCHAM1.NOMCHE(4) = 'TX '
  335. MCHAM1.NOMCHE(5) = 'TY '
  336. MCHAM1.NOMCHE(6) = 'TZ '
  337. MCHAM1.NOMCHE(7) = 'VX '
  338. MCHAM1.NOMCHE(8) = 'VY '
  339. MCHAM1.NOMCHE(9) = 'VZ '
  340. MCHAM1.TYPCHE(1) = 'REAL*8 '
  341. MCHAM1.TYPCHE(2) = 'REAL*8 '
  342. MCHAM1.TYPCHE(3) = 'REAL*8 '
  343. MCHAM1.TYPCHE(4) = 'REAL*8 '
  344. MCHAM1.TYPCHE(5) = 'REAL*8 '
  345. MCHAM1.TYPCHE(6) = 'REAL*8 '
  346. MCHAM1.TYPCHE(7) = 'REAL*8 '
  347. MCHAM1.TYPCHE(8) = 'REAL*8 '
  348. MCHAM1.TYPCHE(9) = 'REAL*8 '
  349. SEGINI MELVNX
  350. SEGINI MELVNY
  351. SEGINI MELVNZ
  352. SEGINI MELT1X
  353. SEGINI MELT1Y
  354. SEGINI MELT1Z
  355. SEGINI MELT2X
  356. SEGINI MELT2Y
  357. SEGINI MELT2Z
  358. MCHAM1.IELVAL(1) = MELVNX
  359. MCHAM1.IELVAL(2) = MELVNY
  360. MCHAM1.IELVAL(3) = MELVNZ
  361. MCHAM1.IELVAL(4) = MELT1X
  362. MCHAM1.IELVAL(5) = MELT1Y
  363. MCHAM1.IELVAL(6) = MELT1Z
  364. MCHAM1.IELVAL(7) = MELT2X
  365. MCHAM1.IELVAL(8) = MELT2Y
  366. MCHAM1.IELVAL(9) = MELT2Z
  367. ENDIF
  368. C
  369. C**** Vitesse
  370. C
  371. N1EL = NFAC
  372. N1PTEL = 3
  373. N2EL = 0
  374. N2PTEL = 0
  375. C
  376. C**** MCHAML a N2 composantes:
  377. C
  378. C IDIM = 2 -> 2 composantes
  379. C IDIM = 3 -> 3 composantes
  380. C
  381. N2 = IDIM
  382. SEGINI MCHAM1
  383. MCHEL1.ICHAML(2) = MCHAM1
  384. MCHAM1.NOMCHE(1) = 'UN '
  385. MCHAM1.NOMCHE(2) = 'UT '
  386. MCHAM1.TYPCHE(1) = 'REAL*8 '
  387. MCHAM1.TYPCHE(2) = 'REAL*8 '
  388. SEGINI MEVUN1
  389. SEGINI MEVUT1
  390. MCHAM1.IELVAL(1) = MEVUN1
  391. MCHAM1.IELVAL(2) = MEVUT1
  392. IF (IDIM .EQ. 3) THEN
  393. MCHAM1.NOMCHE(3) = 'UV '
  394. MCHAM1.TYPCHE(3) = 'REAL*8 '
  395. SEGINI MEVUV1
  396. MCHAM1.IELVAL(3) = MEVUV1
  397. ENDIF
  398. C
  399. C**** Vitesse 2
  400. C
  401. MCHEL1 = IVN1F
  402. SEGINI, MCHEL2 = MCHEL1
  403. IVN2F = MCHEL2
  404. C The MCHEL2.ICHAML(1) contiens le cosinus directeurs
  405. C => MCHEL2.ICHAML(1) = MCHEL1.ICHAML(1)
  406. MCHAM1 = MCHEL1.ICHAML(2)
  407. SEGDES MCHEL1
  408. SEGINI, MCHAM2 = MCHAM1
  409. MCHEL2.ICHAML(2) = MCHAM2
  410. SEGDES MCHEL2
  411. SEGINI, MEVUN2 = MEVUN1
  412. SEGINI, MEVUT2 = MEVUT1
  413. MCHAM2.IELVAL(1) = MEVUN2
  414. MCHAM2.IELVAL(2) = MEVUT2
  415. IF (IDIM .EQ. 3)THEN
  416. SEGINI, MEVUV2 = MEVUV1
  417. MCHAM2.IELVAL(3) = MEVUV2
  418. ENDIF
  419. SEGDES MCHAM2
  420. C
  421. C**********************************************************
  422. C**** Alpha1 and alpha2 ********
  423. C**********************************************************
  424. C
  425. C**** Alpha1
  426. C
  427. N1 = 1
  428. N3 = 6
  429. L1 = 15
  430. SEGINI MCHEL2
  431. IAL1F = MCHEL2
  432. MCHEL2.IMACHE(1) = IFACEL
  433. MCHEL2.TITCHE = 'ALPHA1 '
  434. MCHEL2.CONCHE(1) = ' '
  435. * MCHEL2.NOPHAS(1) = ' '
  436. C
  437. C**** Valeurs independente du repére, i.e.
  438. C
  439. MCHEL2.INFCHE(1,1) = 0
  440. MCHEL2.INFCHE(1,3) = NIFOUR
  441. MCHEL2.INFCHE(1,4) = 0
  442. MCHEL2.INFCHE(1,5) = 0
  443. MCHEL2.INFCHE(1,6) = 0
  444. MCHEL2.IFOCHE = IFOUR
  445. N2 = 1
  446. SEGINI MCHAM1
  447. MCHEL2.ICHAML(1) = MCHAM1
  448. C SEGDES MCHEL2
  449. MCHAM1.NOMCHE(1) = 'SCAL '
  450. MCHAM1.TYPCHE(1) = 'REAL*8 '
  451. SEGINI MELAL1
  452. MCHAM1.IELVAL(1) = MELAL1
  453. SEGDES MCHAM1
  454. C
  455. C**** Alpha2
  456. C
  457. MCHEL1 = IAL1F
  458. SEGINI, MCHEL2 = MCHEL1
  459. IAL2F = MCHEL2
  460. MCHEL2.TITCHE = 'ALPHA2 '
  461. MCHAM1 = MCHEL1.ICHAML(1)
  462. SEGINI, MCHAM2 = MCHAM1
  463. MCHEL2.ICHAML(1) = MCHAM2
  464. SEGDES MCHEL2
  465. SEGINI MELAL2
  466. MCHAM2.IELVAL(1) = MELAL2
  467. SEGDES MCHAM2
  468. C
  469. C**********************************************************
  470. C**** IRN1F and IRN2F ********
  471. C**********************************************************
  472. C
  473. MCHEL1 = IAL1F
  474. SEGINI, MCHEL2 = MCHEL1
  475. IRN1F = MCHEL2
  476. MCHEL2.TITCHE = 'RHO1 '
  477. MCHAM1 = MCHEL1.ICHAML(1)
  478. SEGINI, MCHAM2 = MCHAM1
  479. MCHEL2.ICHAML(1) = MCHAM2
  480. SEGDES MCHEL2
  481. SEGINI MELRN1
  482. MCHAM2.IELVAL(1) = MELRN1
  483. SEGDES MCHAM2
  484. C
  485. C
  486. MCHEL1 = IAL1F
  487. SEGINI, MCHEL2 = MCHEL1
  488. IRN2F = MCHEL2
  489. MCHEL2.TITCHE = 'RHO2 '
  490. MCHAM1 = MCHEL1.ICHAML(1)
  491. SEGINI, MCHAM2 = MCHAM1
  492. MCHEL2.ICHAML(1) = MCHAM2
  493. SEGDES MCHEL2
  494. SEGINI MELRN2
  495. MCHAM2.IELVAL(1) = MELRN2
  496. SEGDES MCHAM2
  497. C
  498. C
  499. C**********************************************************
  500. C**** IRN1F and IRN2F ********
  501. C**********************************************************
  502. C
  503. MCHEL1 = IAL1F
  504. SEGINI, MCHEL2 = MCHEL1
  505. IPN1F = MCHEL2
  506. MCHEL2.TITCHE = 'P1 '
  507. MCHAM1 = MCHEL1.ICHAML(1)
  508. SEGINI, MCHAM2 = MCHAM1
  509. MCHEL2.ICHAML(1) = MCHAM2
  510. SEGDES MCHEL2
  511. SEGINI MELPN1
  512. MCHAM2.IELVAL(1) = MELPN1
  513. SEGDES MCHAM2
  514. C
  515. C
  516. MCHEL1 = IAL1F
  517. SEGINI, MCHEL2 = MCHEL1
  518. IPN2F = MCHEL2
  519. MCHEL2.TITCHE = 'P2 '
  520. MCHAM1 = MCHEL1.ICHAML(1)
  521. SEGINI, MCHAM2 = MCHAM1
  522. MCHEL2.ICHAML(1) = MCHAM2
  523. SEGDES MCHEL2
  524. SEGINI MELPN2
  525. MCHAM2.IELVAL(1) = MELPN2
  526. SEGDES MCHAM2
  527. SEGDES MCHEL1
  528. C
  529. C**********************************************************
  530. C**** Boucle sur le faces *********
  531. C**********************************************************
  532. C
  533. CNZ = 0.0D0
  534. CTZ = 0.0D0
  535. DZG = 0.0D0
  536. DZD = 0.0D0
  537. CVX = 0.0D0
  538. CVY = 0.0D0
  539. CVZ = 0.0D0
  540. UZ1G = 0.0D0
  541. UZ1D = 0.0D0
  542. UZ2G = 0.0D0
  543. UZ2D = 0.0D0
  544. C
  545. IDIMP1 = IDIM + 1
  546. DO NLCF = 1, NFAC
  547. C
  548. C******* NLCF = numero local du centre de face
  549. C NGCF = numero global du centre de face
  550. C NGCEG = numero global du centre ELT "gauche"
  551. C NLCEG = numero local du centre ELT "gauche"
  552. C NGCED = numero global du centre ELT "droite"
  553. C NLCED = numero local du centre ELT "droite"
  554. C
  555. NGCEG = IPT1.NUM(1,NLCF)
  556. NGCF = IPT1.NUM(2,NLCF)
  557. NGCED = IPT1.NUM(3,NLCF)
  558. NLCEG = MLENT1.LECT(NGCEG)
  559. NLCED = MLENT1.LECT(NGCED)
  560. C
  561. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  562. C
  563. NGCF1 = IPT2.NUM(1,NLCF)
  564. IF( NGCF1 .NE. NGCF) THEN
  565. MESERR(1:40) = 'PRET, subroutine pre611.eso '
  566. WRITE(IOIMP,*) MESERR
  567. CALL ERREUR(5)
  568. GOTO 9999
  569. ENDIF
  570. C
  571. C******* Cosinus directeurs des NORMALES aux faces
  572. C
  573. C On impose que les normales sont direct "Gauche" -> "Centre"
  574. C
  575. INDCEL = (NGCEG-1)*IDIMP1
  576. XG = XCOOR(INDCEL+1)
  577. YG = XCOOR(INDCEL+2)
  578. INDCEL = (NGCF-1)*IDIMP1
  579. XC = XCOOR(INDCEL + 1)
  580. YC = XCOOR(INDCEL + 2)
  581. INDCEL = (NGCED-1)*IDIMP1
  582. XD = XCOOR(INDCEL+1)
  583. YD = XCOOR(INDCEL+2)
  584. DXG = XC - XG
  585. DYG = YC - YG
  586. DXD = XC - XD
  587. DYD = YC - YD
  588. C
  589. C******* On calcule le sign du pruduit scalare
  590. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  591. C
  592. CNX = MPNORM.VPOCHA(NLCF,1)
  593. CNY = MPNORM.VPOCHA(NLCF,2)
  594. ORIENT = CNX * DXG + CNY * DYG
  595. IF (IDIM .EQ. 3) THEN
  596. INDCEL = (NGCEG-1)*IDIMP1
  597. ZG = XCOOR(INDCEL+3)
  598. INDCEL = (NGCF-1)*IDIMP1
  599. ZC = XCOOR(INDCEL + 3)
  600. INDCEL = (NGCED-1)*IDIMP1
  601. ZD = XCOOR(INDCEL+3)
  602. DZG = ZC - ZG
  603. DZD = ZC - ZD
  604. C
  605. CNX = MPNORM.VPOCHA(NLCF,7)
  606. CNY = MPNORM.VPOCHA(NLCF,8)
  607. CNZ = MPNORM.VPOCHA(NLCF,9)
  608. ORIENT = (CNX * DXG) + (CNY * DYG) + (CNZ * DZG)
  609. ENDIF
  610. ORIENT = SIGN(1.0D0,ORIENT)
  611. IF(ORIENT .NE. 1.0D0)THEN
  612. MESERR(1:30)=
  613. & 'PRET , subroutine pre612.eso. '
  614. GOTO 9999
  615. ENDIF
  616. CNX = CNX * ORIENT
  617. CNY = CNY * ORIENT
  618. CNZ = CNZ * ORIENT
  619. C
  620. C******* Cosinus directeurs de tangent 2D
  621. C
  622. CTX = -1.0D0 * CNY
  623. CTY = CNX
  624. IF (IDIM .EQ. 3) THEN
  625. C
  626. C********** Cosinus directeurs de tangente 1
  627. C
  628. CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT
  629. CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT
  630. CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT
  631. C
  632. C********** Cosinus directeurs de tangente 2
  633. C
  634. CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT
  635. CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT
  636. CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT
  637. C
  638. ENDIF
  639. C
  640. C******* Les autres MELVALs
  641. C
  642. C
  643. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0...
  644. C
  645. C
  646. C******* Etat gauche
  647. C
  648. C ALPHA
  649. C
  650. VALCEL = MPAL1.VPOCHA(NLCEG, 1)
  651. LIMCEL = MPLAL1.VPOCHA(NLCEG, 1)
  652. DCEL = (MPGAL1.VPOCHA(NLCEG, 1) * DXG) +
  653. & (MPGAL1.VPOCHA(NLCEG, 2) * DYG)
  654. IF (IDIM .EQ. 3) DCEL = DCEL +
  655. & (MPGAL1.VPOCHA(NLCEG, 3) * DZG)
  656. AL1G = VALCEL + (LIMCEL * DCEL)
  657. C write(*,*) valcel, limcel, dcel
  658. C
  659. VALCEL = MPAL2.VPOCHA(NLCEG, 1)
  660. LIMCEL = MPLAL2.VPOCHA(NLCEG, 1)
  661. DCEL = (MPGAL2.VPOCHA(NLCEG, 1) * DXG) +
  662. & (MPGAL2.VPOCHA(NLCEG, 2) * DYG)
  663. IF (IDIM .EQ. 3) DCEL = DCEL +
  664. & (MPGAL2.VPOCHA(NLCEG, 3) * DZG)
  665. AL2G = VALCEL + (LIMCEL * DCEL)
  666. C
  667. C RN
  668. C
  669. VALCEL = MPRN1.VPOCHA(NLCEG, 1)
  670. LIMCEL = MPLRN1.VPOCHA(NLCEG, 1)
  671. DCEL = (MPGRN1.VPOCHA(NLCEG, 1) * DXG) +
  672. & (MPGRN1.VPOCHA(NLCEG, 2) * DYG)
  673. IF (IDIM .EQ. 3) DCEL = DCEL +
  674. & (MPGRN1.VPOCHA(NLCEG, 3) * DZG)
  675. RN1G = VALCEL + (LIMCEL * DCEL)
  676. C
  677. VALCEL = MPRN2.VPOCHA(NLCEG, 1)
  678. LIMCEL = MPLRN2.VPOCHA(NLCEG, 1)
  679. DCEL = (MPGRN2.VPOCHA(NLCEG, 1) * DXG) +
  680. & (MPGRN2.VPOCHA(NLCEG, 2) * DYG)
  681. IF (IDIM .EQ. 3) DCEL = DCEL +
  682. & (MPGRN2.VPOCHA(NLCEG, 3) * DZG)
  683. RN2G = VALCEL + (LIMCEL * DCEL)
  684. C
  685. C PN
  686. C
  687. VALCEL = MPPN1.VPOCHA(NLCEG, 1)
  688. LIMCEL = MPLPN1.VPOCHA(NLCEG, 1)
  689. DCEL = (MPGPN1.VPOCHA(NLCEG, 1) * DXG) +
  690. & (MPGPN1.VPOCHA(NLCEG, 2) * DYG)
  691. IF (IDIM .EQ. 3) DCEL = DCEL +
  692. & (MPGPN1.VPOCHA(NLCEG, 3) * DZG)
  693. PN1G = VALCEL + (LIMCEL * DCEL)
  694. C
  695. VALCEL = MPPN2.VPOCHA(NLCEG, 1)
  696. LIMCEL = MPLPN2.VPOCHA(NLCEG, 1)
  697. DCEL = (MPGPN2.VPOCHA(NLCEG, 1) * DXG) +
  698. & (MPGPN2.VPOCHA(NLCEG, 2) * DYG)
  699. IF (IDIM .EQ. 3) DCEL = DCEL +
  700. & (MPGPN2.VPOCHA(NLCEG, 3) * DZG)
  701. PN2G = VALCEL + (LIMCEL * DCEL)
  702. C
  703. C VN
  704. C
  705. IF (IDIM .EQ. 2) THEN
  706. VALCEL = MPVN1.VPOCHA(NLCEG, 1)
  707. LIMCEL = MPLVN1.VPOCHA(NLCEG, 1)
  708. DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG +
  709. & MPGVN1.VPOCHA(NLCEG, 2)*DYG
  710. UX1G = VALCEL + LIMCEL * DCEL
  711. C
  712. VALCEL = MPVN1.VPOCHA(NLCEG, 2)
  713. LIMCEL = MPLVN1.VPOCHA(NLCEG, 2)
  714. DCEL = MPGVN1.VPOCHA(NLCEG, 3)*DXG +
  715. & MPGVN1.VPOCHA(NLCEG, 4)*DYG
  716. UY1G = VALCEL + LIMCEL * DCEL
  717. C
  718. VALCEL = MPVN2.VPOCHA(NLCEG, 1)
  719. LIMCEL = MPLVN2.VPOCHA(NLCEG, 1)
  720. DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG +
  721. & MPGVN2.VPOCHA(NLCEG, 2)*DYG
  722. UX2G = VALCEL + LIMCEL * DCEL
  723. C
  724. VALCEL = MPVN2.VPOCHA(NLCEG, 2)
  725. LIMCEL = MPLVN2.VPOCHA(NLCEG, 2)
  726. DCEL = MPGVN2.VPOCHA(NLCEG, 3)*DXG +
  727. & MPGVN2.VPOCHA(NLCEG, 4)*DYG
  728. UY2G = VALCEL + LIMCEL * DCEL
  729. ELSE
  730. VALCEL = MPVN1.VPOCHA(NLCEG, 1)
  731. LIMCEL = MPLVN1.VPOCHA(NLCEG, 1)
  732. DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG +
  733. & MPGVN1.VPOCHA(NLCEG, 2)*DYG +
  734. & MPGVN1.VPOCHA(NLCEG, 3)*DZG
  735. UX1G = VALCEL + LIMCEL * DCEL
  736. C
  737. VALCEL = MPVN1.VPOCHA(NLCEG, 2)
  738. LIMCEL = MPLVN1.VPOCHA(NLCEG, 2)
  739. DCEL = MPGVN1.VPOCHA(NLCEG, 4)*DXG +
  740. & MPGVN1.VPOCHA(NLCEG, 5)*DYG +
  741. & MPGVN1.VPOCHA(NLCEG, 6)*DZG
  742. UY1G = VALCEL + LIMCEL * DCEL
  743. C
  744. VALCEL = MPVN1.VPOCHA(NLCEG, 3)
  745. LIMCEL = MPLVN1.VPOCHA(NLCEG, 3)
  746. DCEL = MPGVN1.VPOCHA(NLCEG, 7)*DXG +
  747. & MPGVN1.VPOCHA(NLCEG, 8)*DYG +
  748. & MPGVN1.VPOCHA(NLCEG, 9)*DZG
  749. UZ1G = VALCEL + LIMCEL * DCEL
  750. C
  751. VALCEL = MPVN2.VPOCHA(NLCEG, 1)
  752. LIMCEL = MPLVN2.VPOCHA(NLCEG, 1)
  753. DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG +
  754. & MPGVN2.VPOCHA(NLCEG, 2)*DYG +
  755. & MPGVN2.VPOCHA(NLCEG, 3)*DZG
  756. UX2G = VALCEL + LIMCEL * DCEL
  757. C
  758. VALCEL = MPVN2.VPOCHA(NLCEG, 2)
  759. LIMCEL = MPLVN2.VPOCHA(NLCEG, 2)
  760. DCEL = MPGVN2.VPOCHA(NLCEG, 4)*DXG +
  761. & MPGVN2.VPOCHA(NLCEG, 5)*DYG +
  762. & MPGVN2.VPOCHA(NLCEG, 6)*DZG
  763. UY2G = VALCEL + LIMCEL * DCEL
  764. C
  765. VALCEL = MPVN2.VPOCHA(NLCEG, 3)
  766. LIMCEL = MPLVN2.VPOCHA(NLCEG, 3)
  767. DCEL = MPGVN2.VPOCHA(NLCEG, 7)*DXG +
  768. & MPGVN2.VPOCHA(NLCEG, 8)*DYG +
  769. & MPGVN2.VPOCHA(NLCEG, 9)*DZG
  770. UZ2G = VALCEL + LIMCEL * DCEL
  771. ENDIF
  772.  
  773. C
  774. C******* Si l'on fait pas de prediction, ce n'est pas necessaire de
  775. C controller la positivite' de la pression et de la densité; elle
  776. C est déjà garantie par la proprieté LED de limiteur; mais, vu
  777. C que le limiteur n'est pas calculé ici, mais dans un autre
  778. C operateur, on le fait
  779. C
  780. LOGI1 = (RN1G .LT. 0.0D0) .OR. (RN2G .LT. 0.0D0) .OR.
  781. & (PN1G .LT. 0.0D0) .OR. (PN2G .LT. 0.0D0) .OR.
  782. & (AL1G .LT. 0.0D0) .OR. (AL2G .LT. 0.0D0) .OR.
  783. & (AL1G .GT. 1.0D0) .OR. (AL2G .GT. 1.0D0)
  784. C
  785. IF ( NGCEG .EQ. NGCED) THEN
  786. C
  787. C********** Cas mur
  788. C
  789. IF(LOGI1)THEN
  790. C
  791. C********** Premier ordre en espace local
  792. C
  793. AL1G = MPAL1.VPOCHA(NLCEG,1)
  794. AL2G = MPAL2.VPOCHA(NLCEG,1)
  795. RN1G = MPRN1.VPOCHA(NLCEG,1)
  796. RN2G = MPRN2.VPOCHA(NLCEG,1)
  797. PN1G = MPPN1.VPOCHA(NLCEG,1)
  798. PN2G = MPPN2.VPOCHA(NLCEG,1)
  799. UX1G = MPVN1.VPOCHA(NLCEG,1)
  800. UY1G = MPVN1.VPOCHA(NLCEG,2)
  801. UX2G = MPVN2.VPOCHA(NLCEG,1)
  802. UY2G = MPVN2.VPOCHA(NLCEG,2)
  803. IF (IDIM .EQ. 3) THEN
  804. UZ1G = MPVN1.VPOCHA(NLCEG,3)
  805. UZ2G = MPVN2.VPOCHA(NLCEG,3)
  806. ENDIF
  807. ENDIF
  808. C
  809. UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ
  810. UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ
  811. UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ
  812. UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ
  813. UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ
  814. UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ
  815. C
  816. C********** Son etat droite
  817. C
  818. AL1D = AL1G
  819. AL2D = AL2G
  820. RN1D = RN1G
  821. RN2D = RN2G
  822. PN1D = PN1G
  823. PN2D = PN2G
  824. UN1D = -1.0D0 * UN1G
  825. UN2D = -1.0D0 * UN2G
  826. UT1D = UT1G
  827. UT2D = UT2G
  828. UV1D = UV1G
  829. UV2D = UV2G
  830. C
  831. C********** Fin cas mur
  832. C
  833. ELSE
  834. VALCEL = MPAL1.VPOCHA(NLCED, 1)
  835. LIMCEL = MPLAL1.VPOCHA(NLCED, 1)
  836. DCEL = (MPGAL1.VPOCHA(NLCED, 1) * DXD) +
  837. & (MPGAL1.VPOCHA(NLCED, 2) * DYD)
  838. IF (IDIM .EQ. 3) DCEL = DCEL +
  839. & (MPGAL1.VPOCHA(NLCED, 3) * DZD)
  840. AL1D = VALCEL + (LIMCEL * DCEL)
  841. C
  842. VALCEL = MPAL2.VPOCHA(NLCED, 1)
  843. LIMCEL = MPLAL2.VPOCHA(NLCED, 1)
  844. DCEL = (MPGAL2.VPOCHA(NLCED, 1) * DXD) +
  845. & (MPGAL2.VPOCHA(NLCED, 2) * DYD)
  846. IF (IDIM .EQ. 3) DCEL = DCEL +
  847. & (MPGAL2.VPOCHA(NLCED, 3) * DZD)
  848. AL2D = VALCEL + (LIMCEL * DCEL)
  849. C
  850. C RN
  851. C
  852. VALCEL = MPRN1.VPOCHA(NLCED, 1)
  853. LIMCEL = MPLRN1.VPOCHA(NLCED, 1)
  854. DCEL = (MPGRN1.VPOCHA(NLCED, 1) * DXD) +
  855. & (MPGRN1.VPOCHA(NLCED, 2) * DYD)
  856. IF (IDIM .EQ. 3) DCEL = DCEL +
  857. & (MPGRN1.VPOCHA(NLCED, 3) * DZD)
  858. RN1D = VALCEL + (LIMCEL * DCEL)
  859. C
  860. VALCEL = MPRN2.VPOCHA(NLCED, 1)
  861. LIMCEL = MPLRN2.VPOCHA(NLCED, 1)
  862. DCEL = (MPGRN2.VPOCHA(NLCED, 1) * DXD) +
  863. & (MPGRN2.VPOCHA(NLCED, 2) * DYD)
  864. IF (IDIM .EQ. 3) DCEL = DCEL +
  865. & (MPGRN2.VPOCHA(NLCED, 3) * DZD)
  866. RN2D = VALCEL + (LIMCEL * DCEL)
  867. C
  868. C PN
  869. C
  870. VALCEL = MPPN1.VPOCHA(NLCED, 1)
  871. LIMCEL = MPLPN1.VPOCHA(NLCED, 1)
  872. DCEL = (MPGPN1.VPOCHA(NLCED, 1) * DXD) +
  873. & (MPGPN1.VPOCHA(NLCED, 2) * DYD)
  874. IF (IDIM .EQ. 3) DCEL = DCEL +
  875. & (MPGPN1.VPOCHA(NLCED, 3) * DZD)
  876. PN1D = VALCEL + (LIMCEL * DCEL)
  877. C
  878. VALCEL = MPPN2.VPOCHA(NLCED, 1)
  879. LIMCEL = MPLPN2.VPOCHA(NLCED, 1)
  880. DCEL = (MPGPN2.VPOCHA(NLCED, 1) * DXD) +
  881. & (MPGPN2.VPOCHA(NLCED, 2) * DYD)
  882. IF (IDIM .EQ. 3) DCEL = DCEL +
  883. & (MPGPN2.VPOCHA(NLCED, 3) * DZD)
  884. PN2D = VALCEL + (LIMCEL * DCEL)
  885. C
  886. C VN
  887. C
  888. IF (IDIM .EQ. 2) THEN
  889. VALCEL = MPVN1.VPOCHA(NLCED, 1)
  890. LIMCEL = MPLVN1.VPOCHA(NLCED, 1)
  891. DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD +
  892. & MPGVN1.VPOCHA(NLCED, 2)*DYD
  893. UX1D = VALCEL + LIMCEL * DCEL
  894. C
  895. VALCEL = MPVN1.VPOCHA(NLCED, 2)
  896. LIMCEL = MPLVN1.VPOCHA(NLCED, 2)
  897. DCEL = MPGVN1.VPOCHA(NLCED, 3)*DXD +
  898. & MPGVN1.VPOCHA(NLCED, 4)*DYD
  899. UY1D = VALCEL + LIMCEL * DCEL
  900. C
  901. VALCEL = MPVN2.VPOCHA(NLCED, 1)
  902. LIMCEL = MPLVN2.VPOCHA(NLCED, 1)
  903. DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD +
  904. & MPGVN2.VPOCHA(NLCED, 2)*DYD
  905. UX2D = VALCEL + LIMCEL * DCEL
  906. C
  907. VALCEL = MPVN2.VPOCHA(NLCED, 2)
  908. LIMCEL = MPLVN2.VPOCHA(NLCED, 2)
  909. DCEL = MPGVN2.VPOCHA(NLCED, 3)*DXD +
  910. & MPGVN2.VPOCHA(NLCED, 4)*DYD
  911. UY2D = VALCEL + LIMCEL * DCEL
  912. ELSE
  913. VALCEL = MPVN1.VPOCHA(NLCED, 1)
  914. LIMCEL = MPLVN1.VPOCHA(NLCED, 1)
  915. DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD +
  916. & MPGVN1.VPOCHA(NLCED, 2)*DYD +
  917. & MPGVN1.VPOCHA(NLCED, 3)*DZD
  918. UX1D = VALCEL + LIMCEL * DCEL
  919. C
  920. VALCEL = MPVN1.VPOCHA(NLCED, 2)
  921. LIMCEL = MPLVN1.VPOCHA(NLCED, 2)
  922. DCEL = MPGVN1.VPOCHA(NLCED, 4)*DXD +
  923. & MPGVN1.VPOCHA(NLCED, 5)*DYD +
  924. & MPGVN1.VPOCHA(NLCED, 6)*DZD
  925. UY1D = VALCEL + LIMCEL * DCEL
  926. C
  927. VALCEL = MPVN1.VPOCHA(NLCED, 3)
  928. LIMCEL = MPLVN1.VPOCHA(NLCED, 3)
  929. DCEL = MPGVN1.VPOCHA(NLCED, 7)*DXD +
  930. & MPGVN1.VPOCHA(NLCED, 8)*DYD +
  931. & MPGVN1.VPOCHA(NLCED, 9)*DZD
  932. UZ1D = VALCEL + LIMCEL * DCEL
  933. C
  934. VALCEL = MPVN2.VPOCHA(NLCED, 1)
  935. LIMCEL = MPLVN2.VPOCHA(NLCED, 1)
  936. DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD +
  937. & MPGVN2.VPOCHA(NLCED, 2)*DYD +
  938. & MPGVN2.VPOCHA(NLCED, 3)*DZD
  939. UX2D = VALCEL + LIMCEL * DCEL
  940. C
  941. VALCEL = MPVN2.VPOCHA(NLCED, 2)
  942. LIMCEL = MPLVN2.VPOCHA(NLCED, 2)
  943. DCEL = MPGVN2.VPOCHA(NLCED, 4)*DXD +
  944. & MPGVN2.VPOCHA(NLCED, 5)*DYD +
  945. & MPGVN2.VPOCHA(NLCED, 6)*DZD
  946. UY2D = VALCEL + LIMCEL * DCEL
  947. C
  948. VALCEL = MPVN2.VPOCHA(NLCED, 3)
  949. LIMCEL = MPLVN2.VPOCHA(NLCED, 3)
  950. DCEL = MPGVN2.VPOCHA(NLCED, 7)*DXD +
  951. & MPGVN2.VPOCHA(NLCED, 8)*DYD +
  952. & MPGVN2.VPOCHA(NLCED, 9)*DZD
  953. UZ2D = VALCEL + LIMCEL * DCEL
  954. C
  955. ENDIF
  956. C
  957. C********** Si l'on fait pas de prediction, ce n'est pas necessaire de
  958. C controller la positivite' de la pression et de la densité; elle
  959. C est déjà garantie par la proprieté LED de limiteur; mais, vu
  960. C que le limiteur n'est pas calculé ici, mais dans un autre
  961. C operateur, on le fait
  962. C
  963. LOGI1 = LOGI1 .OR. (RN1D .LT. 0.0D0) .OR. (RN2D .LT. 0.0D0)
  964. $ .OR.(PN1D .LT. 0.0D0) .OR. (PN2D .LT. 0.0D0) .OR.
  965. $ (AL1D .LT. 0.0D0) .OR. (AL2D .LT. 0.0D0) .OR.
  966. $ (AL1D .GT. 1.0D0) .OR. (AL2D .GT. 1.0D0)
  967. C
  968. IF(LOGI1)THEN
  969. C
  970. C************* Premier ordre en espace local
  971. C
  972. AL1G = MPAL1.VPOCHA(NLCEG,1)
  973. AL2G = MPAL2.VPOCHA(NLCEG,1)
  974. RN1G = MPRN1.VPOCHA(NLCEG,1)
  975. RN2G = MPRN2.VPOCHA(NLCEG,1)
  976. PN1G = MPPN1.VPOCHA(NLCEG,1)
  977. PN2G = MPPN2.VPOCHA(NLCEG,1)
  978. UX1G = MPVN1.VPOCHA(NLCEG,1)
  979. UY1G = MPVN1.VPOCHA(NLCEG,2)
  980. UX2G = MPVN2.VPOCHA(NLCEG,1)
  981. UY2G = MPVN2.VPOCHA(NLCEG,2)
  982. C
  983. AL1D = MPAL1.VPOCHA(NLCED,1)
  984. AL2D = MPAL2.VPOCHA(NLCED,1)
  985. RN1D = MPRN1.VPOCHA(NLCED,1)
  986. RN2D = MPRN2.VPOCHA(NLCED,1)
  987. PN1D = MPPN1.VPOCHA(NLCED,1)
  988. PN2D = MPPN2.VPOCHA(NLCED,1)
  989. UX1D = MPVN1.VPOCHA(NLCED,1)
  990. UY1D = MPVN1.VPOCHA(NLCED,2)
  991. UX2D = MPVN2.VPOCHA(NLCED,1)
  992. UY2D = MPVN2.VPOCHA(NLCED,2)
  993. C
  994. IF (IDIM .EQ. 3) THEN
  995. UZ1G = MPVN1.VPOCHA(NLCEG,3)
  996. UZ2G = MPVN2.VPOCHA(NLCEG,3)
  997. UZ1D = MPVN1.VPOCHA(NLCED,3)
  998. UZ2D = MPVN2.VPOCHA(NLCED,3)
  999. ENDIF
  1000.  
  1001. ENDIF
  1002. C
  1003. UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ
  1004. UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ
  1005. UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ
  1006. UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ
  1007. UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ
  1008. UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ
  1009. C
  1010. UN1D = UX1D * CNX + UY1D * CNY + UZ1D * CNZ
  1011. UT1D = UX1D * CTX + UY1D * CTY + UZ1D * CTZ
  1012. UV1D = UX1D * CVX + UY1D * CVY + UZ1D * CVZ
  1013. UN2D = UX2D * CNX + UY2D * CNY + UZ2D * CNZ
  1014. UT2D = UX2D * CTX + UY2D * CTY + UZ2D * CTZ
  1015. UV2D = UX2D * CVX + UY2D * CVY + UZ2D * CVZ
  1016. C
  1017. ENDIF
  1018. C
  1019. C
  1020. C******** Les MELVALs
  1021. C
  1022. MELAL1.VELCHE(1,NLCF) = AL1G
  1023. MELAL1.VELCHE(3,NLCF) = AL1D
  1024. MELAL2.VELCHE(1,NLCF) = AL2G
  1025. MELAL2.VELCHE(3,NLCF) = AL2D
  1026. C
  1027. MELRN1.VELCHE(1,NLCF) = RN1G
  1028. MELRN1.VELCHE(3,NLCF) = RN1D
  1029. MELRN2.VELCHE(1,NLCF) = RN2G
  1030. MELRN2.VELCHE(3,NLCF) = RN2D
  1031. C
  1032. MELPN1.VELCHE(1,NLCF) = PN1G
  1033. MELPN1.VELCHE(3,NLCF) = PN1D
  1034. MELPN2.VELCHE(1,NLCF) = PN2G
  1035. MELPN2.VELCHE(3,NLCF) = PN2D
  1036. C
  1037. MEVUN1.VELCHE(1,NLCF) = UN1G
  1038. MEVUN1.VELCHE(3,NLCF) = UN1D
  1039. MEVUT1.VELCHE(1,NLCF) = UT1G
  1040. MEVUT1.VELCHE(3,NLCF) = UT1D
  1041. MEVUN2.VELCHE(1,NLCF) = UN2G
  1042. MEVUN2.VELCHE(3,NLCF) = UN2D
  1043. MEVUT2.VELCHE(1,NLCF) = UT2G
  1044. MEVUT2.VELCHE(3,NLCF) = UT2D
  1045. MELVNX.VELCHE(1,NLCF) = CNX
  1046. MELVNY.VELCHE(1,NLCF) = CNY
  1047. MELT1X.VELCHE(1,NLCF) = CTX
  1048. MELT1Y.VELCHE(1,NLCF) = CTY
  1049. IF (IDIM .EQ. 3) THEN
  1050. MELVNZ.VELCHE(1,NLCF) = CNZ
  1051. MELT1Z.VELCHE(1,NLCF) = CTZ
  1052. MELT2X.VELCHE(1,NLCF) = CVX
  1053. MELT2Y.VELCHE(1,NLCF) = CVY
  1054. MELT2Z.VELCHE(1,NLCF) = CVZ
  1055. C
  1056. MEVUV1.VELCHE(1,NLCF) = UV1G
  1057. MEVUV1.VELCHE(3,NLCF) = UV1D
  1058. MEVUV2.VELCHE(1,NLCF) = UV2G
  1059. MEVUV2.VELCHE(3,NLCF) = UV2D
  1060. ENDIF
  1061. ENDDO
  1062. C
  1063. C**** Desactivation des SEGMENTs
  1064. C
  1065. SEGDES IPT1
  1066. SEGDES IPT2
  1067. C
  1068. C MPOVALs
  1069. C
  1070. SEGDES MPNORM
  1071. C
  1072. SEGDES MPAL1
  1073. SEGDES MPGAL1
  1074. SEGDES MPLAL1
  1075. SEGDES MPAL2
  1076. SEGDES MPGAL2
  1077. SEGDES MPLAL2
  1078. C
  1079. SEGDES MPRN1
  1080. SEGDES MPGRN1
  1081. SEGDES MPLRN1
  1082. SEGDES MPRN2
  1083. SEGDES MPGRN2
  1084. SEGDES MPLRN2
  1085. C
  1086. SEGDES MPPN1
  1087. SEGDES MPGPN1
  1088. SEGDES MPLPN1
  1089. SEGDES MPPN2
  1090. SEGDES MPGPN2
  1091. SEGDES MPLPN2
  1092. C
  1093. SEGDES MPVN1
  1094. SEGDES MPGVN1
  1095. SEGDES MPLVN1
  1096. SEGDES MPVN2
  1097. SEGDES MPGVN2
  1098. SEGDES MPLVN2
  1099. C
  1100. C MELVALs
  1101. C
  1102. SEGDES MELVNX
  1103. SEGDES MELVNY
  1104. SEGDES MELT1X
  1105. SEGDES MELT1Y
  1106. SEGDES MEVUN1
  1107. SEGDES MEVUT1
  1108. SEGDES MEVUN2
  1109. SEGDES MEVUT2
  1110. IF (IDIM .EQ. 3) THEN
  1111. SEGDES MELVNZ
  1112. SEGDES MELT1Z
  1113. SEGDES MELT2X
  1114. SEGDES MELT2Y
  1115. SEGDES MELT2Z
  1116. SEGDES MEVUV1
  1117. SEGDES MEVUV2
  1118. ENDIF
  1119. C
  1120. SEGDES MELAL1
  1121. SEGDES MELAL2
  1122. C
  1123. SEGDES MELRN1
  1124. SEGDES MELRN2
  1125. C
  1126. SEGDES MELPN1
  1127. SEGDES MELPN2
  1128. C
  1129. C
  1130. C**** Destruction du MELNTI correspondance local/global
  1131. C
  1132. SEGSUP MLENT1
  1133. C
  1134. 9999 CONTINUE
  1135. if (mcham1.ne.0) segdes mcham1
  1136. C
  1137. RETURN
  1138. END
  1139.  
  1140.  
  1141.  
  1142.  
  1143.  
  1144.  
  1145.  
  1146.  
  1147.  
  1148.  
  1149.  
  1150.  
  1151.  
  1152.  
  1153.  

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