Télécharger pre611.eso

Retour à la liste

Numérotation des lignes :

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

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