Télécharger pre222.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE222 SOURCE BECC 10/10/07 21:15:11 6774
  2. C PRE221 SOURCE BECC 98/08/24 21:21:08 3286
  3. SUBROUTINE PRE222(LOGTEM,
  4. & ICEN,IFACE,IFACEL,INORM,
  5. & IROC, IGRROC, IALROC,
  6. & IVITC, IGRVC, IALVC,
  7. & IPC ,IGRPC, IALPC,
  8. & MLRECV, MLRECP, MLMOT1,
  9. & IYC ,IGRYC, IALYC,
  10. & IGAMC,
  11. & DELTAT,
  12. & IROF,IVITF,IPF,IGAMF,IYF,
  13. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  14. C************************************************************************
  15. C
  16. C PROJET : CASTEM 2000
  17. C
  18. C NOM : PRE221
  19. C
  20. C DESCRIPTION : Voir PRE22
  21. C
  22. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  23. C
  24. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  25. C
  26. C************************************************************************
  27. C
  28. C
  29. C APPELES (Outils) : KRIPAD, LICHT
  30. C
  31. C APPELES (Calcul) : AUCUN
  32. C
  33. C
  34. C************************************************************************
  35. C
  36. C ENTREES
  37. C
  38. C LOGTEM : LOGICAL; si .TRUE. 2em ordre en temps
  39. C sinon 1er ordre en temps
  40. C
  41. C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
  42. C
  43. C ICEN : MELEME de 'POI1' SPG des CENTRES
  44. C
  45. C IFACE : MELEME de 'POI1' SPG des FACES
  46. C
  47. C IFACEL : MELEME de 'SEG3' avec
  48. C CENTRE d'Elt "gauche"
  49. C CENTRE de Face
  50. C CENTRE d'Elt "droite"
  51. C
  52. C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
  53. C
  54. C INORM : CHPOINT des cosinus directeurs de normales aux faces
  55. C
  56. C 2) Autres pointeurs
  57. C
  58. C IROC : CHPOINT "CENTRE" contenant la masse volumique RHO
  59. C
  60. C IGRROC : CHPOINT "CENTRE" contenant le gradient de la
  61. C masse volumique RHO (2 composantes)
  62. C
  63. C IALROC : CHPOINT "CENTRE" contenant le limiteur du gradient
  64. C de la masse volumique
  65. C
  66. C IVITC : CHPOINT "CENTRE" contenant la vitesse UX, UY ;
  67. C
  68. C IGRVC : CHPOINT "CENTRE" contenant le gradient de la
  69. C vitesse (4 composantes)
  70. C
  71. C IALVC : CHPOINT "CENTRE" contenant le limiteur du gradient
  72. C de la vitesse (2 composantes)
  73. C
  74. C IPC : CHPOINT "CENTRE" contenat la pression P;
  75. C
  76. C IGRPC : CHPOINT "CENTRE" contenant le gradient de la
  77. C pression (2 composantes)
  78. C
  79. C IALPC : CHPOINT "CENTRE" contenant le limiteur du gradient
  80. C de la pression
  81. C
  82. C MLRECV : pointeur de la LISTREEL des cv
  83. C
  84. C MLRECP : pointeur de la LISTREEL des cp
  85. C
  86. C MLMOT1 : pointeur des noms des gaz qui apparessent dans les
  87. C equations d'Euler
  88. C
  89. C IYC : CHPOINT "CENTRE" contenat les fractions massiques ;
  90. C
  91. C IGRYC : CHPOINT "CENTRE" contenant les gradient des fr.mass.;
  92. C
  93. C IALPC : CHPOINT "CENTRE" contenant les limiteurs des gradients
  94. C des fr.mass.;
  95. C
  96. C IGAMC : CHPOINT "CENTRE" contenat le "Gamma" du gaz
  97. C
  98. C 3)
  99. C
  100. C DELTAT : REAL*8, encrement en temps pour calculer la prediction
  101. C
  102. C
  103. C SORTIES
  104. C
  105. C
  106. C IROF : MCHAML defini sur le MELEME de pointeur IFACEL,
  107. C contenant la masse volumique RHO
  108. C
  109. C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL,
  110. C contenant la vitesse UN, UT dans le repaire local
  111. C (n,t) et defini sur le MELEME de pointeur IFACE,
  112. C contenant les cosinus directeurs du repere local
  113. C
  114. C IPF : MCHAML defini sur le MELEME de pointeur IFACEL,
  115. C contenant la pression P
  116. C
  117. C IYF : MCHAML defini sur le MELEME de pointeur IFACEL,
  118. C contenant les fractions massiques;
  119. C
  120. C IGAMF : MCHAML defini sur le MELEME de pointeur IFACEL,
  121. C contenant le "gamma" du gaz
  122. C
  123. C LOGAN : anomalie detectee
  124. C
  125. C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité
  126. C negative a été detectée -> en interactif le
  127. C programme s'arrete en GIBIANE
  128. C (erreur stocké en MESERR et VALER)
  129. C
  130. C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte
  131. C dehor 1 et 3 (sa valeur stockée en MESERR et VALER;
  132. C en VAL1 et en VAL2 on stocke 1.0 et 3.0)
  133. C
  134. C MESERR
  135. C VALER
  136. C VAL1,
  137. C VAL2 : pour les messages d'erreur
  138. C
  139. C************************************************************************
  140. C
  141. C HISTORIQUE (Anomalies et modifications éventuelles)
  142. C
  143. C HISTORIQUE : Créée le 10.7.98.
  144. C
  145. C************************************************************************
  146. C
  147. C
  148. C ATTENTION: Cet programme marche si le MAILLAGE est convex;
  149. C si non il faut changer l'algoritme de calcul de
  150. C l'orientation des normales aux faces.
  151. C
  152. C La positivité n'est pas controlle parce que c'est déjà fait
  153. C dans l'operateur PRIM
  154. C
  155. C
  156. C************************************************************************
  157. C
  158. C**** Variables de COOPTIO
  159. C
  160. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  161. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  162. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  163. C & ,IECHO, IIMPI, IOSPI
  164. C & ,IDIM
  165. CC & ,MCOORD
  166. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  167. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  168. C & ,NORINC,NORVAL,NORIND,NORVAD
  169. C & ,NUCROU, IPSAUV
  170. C
  171. C**** Les variables
  172. C
  173. IMPLICIT INTEGER(I-N)
  174. INTEGER ICEN, IFACE, IFACEL, INORM,IROC, IGRROC, IALROC
  175. & , IVITC, IGRVC, IALVC
  176. & , IPC ,IGRPC, IALPC
  177. & , IYC, IGRYC, IALYC
  178. & , IGAMC
  179. & , IROF, IVITF, IPF, IGAMF, IYF
  180. & , IGEOM, NFAC, NCEN
  181. & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1, NLCE
  182. & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
  183. & , IDIMP1, INDCEL, I1, NESP
  184. REAL*8 VALER, VAL1, VAL2, XG, YG, ZG, XC, YC, ZC, XD, YD, ZD,
  185. & DELTAT
  186. & ,DXG, DYG, DZG, DXD, DYD, DZD,ORIENT
  187. & , CNX, CNY, CNZ, CTX, CTY, CTZ, CVX, CVY, CVZ
  188. & , ROG, PG, GAMG, UXG, UYG, UZG, UNG, UTG, UVG
  189. & , ROD, PD, GAMD, UXD, UYD, UZD, UND, UTD, UVD
  190. & , VALCEL, DCEL, ALCEL
  191. & , DROX, DROY, DROZ, DUXX, DUXY, DUXZ, DUYX, DUYY,
  192. & DUYZ, DUZX, DUZY, DUZZ, DPX, DPY, DPZ
  193. & , DRO, DUX, DUY, DUZ, DP
  194. & , ALPHA, CPCEL, CVCEL, DYMAS, SUMY
  195. CHARACTER*(40) MESERR
  196. CHARACTER*(8) TYPE
  197. CHARACTER*(4) CARCEL
  198. LOGICAL LOGAN,LOGNEG, LOGBOR, LOGTEM, LOGI1, LOGI2
  199. C
  200. C**** Les Includes
  201. C
  202. -INC SMCOORD
  203. -INC CCOPTIO
  204. -INC SMCHPOI
  205. POINTEUR MPROC.MPOVAL, MPGRR.MPOVAL,
  206. & MPVITC.MPOVAL, MPGRV.MPOVAL,
  207. & MPPC.MPOVAL, MPGRP.MPOVAL,
  208. & MPYC.MPOVAL, MPGRY.MPOVAL,
  209. & MPGAMC.MPOVAL, MPNORM.MPOVAL,
  210. & MPROP.MPOVAL, MPPP.MPOVAL, MPVITP.MPOVAL,
  211. & MPYP.MPOVAL
  212. -INC SMCHAML
  213. POINTEUR MCHAMY.MCHAML
  214. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL,
  215. & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL,
  216. & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL
  217. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL
  218. POINTEUR MELRO.MELVAL, MELP.MELVAL,
  219. & MELGAM.MELVAL
  220. POINTEUR MELALR.MPOVAL,
  221. & MELALV.MPOVAL,
  222. & MELALP.MPOVAL,
  223. & MELALY.MPOVAL
  224. -INC SMLENTI
  225. -INC SMELEME
  226. -INC SMLREEL
  227. POINTEUR MLRECV.MLREEL, MLRECP.MLREEL
  228. -INC SMLMOTS
  229. C
  230. C**** Segments des fractions massiques gauche et droit
  231. C
  232. SEGMENT FRAMAS
  233. REAL*8 FRAMG(NESP), FRAMD(NESP)
  234. ENDSEGMENT
  235. C
  236. SEGACT MLMOT1
  237. C
  238. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  239. C
  240. C LOGNEG = .FALSE.
  241. C LOGBOR = .FALSE.
  242. C MESERR = ' '
  243. C MOTERR(1:40) = MESERR(1:40)
  244. C VALER = 0.0D0
  245. C VAL1 = 0.0D0
  246. C VAL2 = 0.0D0
  247. C
  248. C AB
  249. C 2010/09/14: LOGI1 computed can destroy the symmetry!
  250. C LOGI1 = .FALSE.
  251. LOGI1 = .FALSE.
  252. C
  253. C**** KRIPAD pour la correspondance global/local de centre
  254. C
  255. CALL KRIPAD(ICEN,MLENT1)
  256. C
  257. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  258. C
  259. C Si i est le numero global d'un noeud de ICEN,
  260. C MLENT1.LECT(i) contient sa position, i.e.
  261. C
  262. C I = numero global du noeud centre
  263. C MLENT1.LECT(i) = numero local du noeud centre
  264. C
  265. C MLENT1 déjà activé, i.e.
  266. C
  267. C SEGACT MLENT1
  268. C
  269. C**** Activation de CHPOINTs
  270. C
  271. C densité + grad + limiteur
  272. C vitesse + grad + limiteur
  273. C pression + grad + limiteur
  274. C fract.mass + grad + limiteur
  275. C gamma
  276. C cosinus directeurs des normales aux surface
  277. C
  278. CALL LICHT(IROC , MPROC , TYPE, IGEOM)
  279. CALL LICHT(IGRROC, MPGRR , TYPE, IGEOM)
  280. CALL LICHT(IVITC, MPVITC , TYPE, IGEOM)
  281. CALL LICHT(IGRVC, MPGRV , TYPE, IGEOM)
  282. CALL LICHT(IPC , MPPC , TYPE, IGEOM)
  283. CALL LICHT(IGRPC, MPGRP , TYPE, IGEOM)
  284. CALL LICHT(IYC , MPYC , TYPE, IGEOM)
  285. CALL LICHT(IGRYC, MPGRY , TYPE, IGEOM)
  286. CALL LICHT(IGAMC, MPGAMC , TYPE, IGEOM)
  287. CALL LICHT(INORM, MPNORM , TYPE, IGEOM)
  288. C
  289. C**** Les MPOVALs 'Prediction'
  290. C
  291. IF(LOGTEM)THEN
  292. SEGINI, MPROP = MPROC
  293. SEGINI, MPPP = MPPC
  294. SEGINI, MPVITP = MPVITC
  295. SEGINI, MPYP = MPYC
  296. ELSE
  297. MPROP = MPROC
  298. MPPP = MPPC
  299. MPVITP = MPVITC
  300. MPYP = MPYC
  301. ENDIF
  302. C
  303. C**** Les Limiteurs
  304. C
  305. CALL LICHT(IALROC, MELALR , TYPE, IGEOM)
  306. CALL LICHT(IALVC, MELALV , TYPE, IGEOM)
  307. CALL LICHT(IALPC, MELALP , TYPE, IGEOM)
  308. CALL LICHT(IALYC, MELALY , TYPE, IGEOM)
  309. C
  310. C
  311. C**** Les MPOVAL sont déjà activés i.e.:
  312. C
  313. C SEGACT MPROC
  314. C SEGACT MPGRR
  315. C SEGACT MPIALR
  316. C SEGACT MPVITC
  317. C SEGACT MPGRV
  318. C SEGACT MPIALV
  319. C SEGACT MPPC
  320. C SEGACT MPGRP
  321. C SEGACT MPIALP
  322. C SEGACT MPYC
  323. C SEGACT MPGRY
  324. C SEGACT MPIALY
  325. C SEGACT MPGAMC
  326. C SEGACT MPNORM
  327. C
  328. C**** Le MELEME FACEL
  329. C
  330. IPT1 = IFACEL
  331. IPT2 = IFACE
  332. SEGACT IPT1
  333. SEGACT IPT2
  334. NFAC = IPT1.NUM(/2)
  335. C
  336. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  337. C
  338. C i.e.:
  339. C
  340. C vitesse + cosinus directors du repere local
  341. C densité
  342. C pression
  343. C gamma
  344. C
  345. C**** Cosinus directors du repere local et vitesse
  346. C
  347. C Les cosinus directeurs
  348. C
  349. N1 = 2
  350. N3 = 6
  351. L1 = 28
  352. SEGINI MCHEL1
  353. IVITF = MCHEL1
  354. MCHEL1.TITCHE = 'U '
  355. MCHEL1.IMACHE(1) = IFACE
  356. MCHEL1.IMACHE(2) = IFACEL
  357. MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)'
  358. MCHEL1.CONCHE(2) = ' U in (n,t,v) '
  359. C
  360. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  361. C
  362. MCHEL1.INFCHE(1,1) = 2
  363. MCHEL1.INFCHE(1,3) = NIFOUR
  364. MCHEL1.INFCHE(1,4) = 0
  365. MCHEL1.INFCHE(1,5) = 0
  366. MCHEL1.INFCHE(1,6) = 0
  367. MCHEL1.IFOCHE = IFOUR
  368. C
  369. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  370. C
  371. MCHEL1.INFCHE(2,1) = 1
  372. MCHEL1.INFCHE(2,3) = NIFOUR
  373. MCHEL1.INFCHE(2,4) = 0
  374. MCHEL1.INFCHE(2,5) = 0
  375. MCHEL1.INFCHE(2,6) = 0
  376. C
  377. C**** Le cosinus directeurs
  378. C
  379. N1PTEL = 1
  380. N1EL = NFAC
  381. N2PTEL = 0
  382. N2EL = 0
  383. C
  384. C**** MCHAML a N2 composantes:
  385. C
  386. C cosinus directeurs du repere local (n,t1)
  387. C
  388. C IDIM = 3 -> 9 composantes
  389. C
  390. N2 = 9
  391. SEGINI MCHAM1
  392. MCHEL1.ICHAML(1) = MCHAM1
  393. MCHAM1.NOMCHE(1) = 'NX '
  394. MCHAM1.NOMCHE(2) = 'NY '
  395. MCHAM1.NOMCHE(3) = 'NZ '
  396. MCHAM1.NOMCHE(4) = 'TX '
  397. MCHAM1.NOMCHE(5) = 'TY '
  398. MCHAM1.NOMCHE(6) = 'TZ '
  399. MCHAM1.NOMCHE(7) = 'VX '
  400. MCHAM1.NOMCHE(8) = 'VY '
  401. MCHAM1.NOMCHE(9) = 'VZ '
  402. MCHAM1.TYPCHE(1) = 'REAL*8 '
  403. MCHAM1.TYPCHE(2) = 'REAL*8 '
  404. MCHAM1.TYPCHE(3) = 'REAL*8 '
  405. MCHAM1.TYPCHE(4) = 'REAL*8 '
  406. MCHAM1.TYPCHE(5) = 'REAL*8 '
  407. MCHAM1.TYPCHE(6) = 'REAL*8 '
  408. MCHAM1.TYPCHE(7) = 'REAL*8 '
  409. MCHAM1.TYPCHE(8) = 'REAL*8 '
  410. MCHAM1.TYPCHE(9) = 'REAL*8 '
  411. SEGINI MELVNX
  412. SEGINI MELVNY
  413. SEGINI MELVNZ
  414. SEGINI MELT1X
  415. SEGINI MELT1Y
  416. SEGINI MELT1Z
  417. SEGINI MELT2X
  418. SEGINI MELT2Y
  419. SEGINI MELT2Z
  420. MCHAM1.IELVAL(1) = MELVNX
  421. MCHAM1.IELVAL(2) = MELVNY
  422. MCHAM1.IELVAL(3) = MELVNZ
  423. MCHAM1.IELVAL(4) = MELT1X
  424. MCHAM1.IELVAL(5) = MELT1Y
  425. MCHAM1.IELVAL(6) = MELT1Z
  426. MCHAM1.IELVAL(7) = MELT2X
  427. MCHAM1.IELVAL(8) = MELT2Y
  428. MCHAM1.IELVAL(9) = MELT2Z
  429. SEGDES MCHAM1
  430. C
  431. C**** Vitesse
  432. C
  433. N1EL = NFAC
  434. N1PTEL = 3
  435. N2EL = 0
  436. N2PTEL = 0
  437. C
  438. C**** MCHAML a N2 composantes:
  439. C
  440. C IDIM = 3 -> 3 composantes
  441. C
  442. N2 = 3
  443. SEGINI MCHAM1
  444. MCHEL1.ICHAML(2) = MCHAM1
  445. SEGDES MCHEL1
  446. MCHAM1.NOMCHE(1) = 'UN '
  447. MCHAM1.NOMCHE(2) = 'UT '
  448. MCHAM1.NOMCHE(3) = 'UV '
  449. MCHAM1.TYPCHE(1) = 'REAL*8 '
  450. MCHAM1.TYPCHE(2) = 'REAL*8 '
  451. MCHAM1.TYPCHE(3) = 'REAL*8 '
  452. SEGINI MELVUN
  453. SEGINI MELVUT
  454. SEGINI MELVUV
  455. MCHAM1.IELVAL(1) = MELVUN
  456. MCHAM1.IELVAL(2) = MELVUT
  457. MCHAM1.IELVAL(3) = MELVUV
  458. SEGDES MCHAM1
  459. C
  460. C**** Densite
  461. C
  462. N1 = 1
  463. N3 = 6
  464. L1 = 15
  465. SEGINI MCHEL2
  466. IROF = MCHEL2
  467. MCHEL2.IMACHE(1) = IFACEL
  468. MCHEL2.TITCHE = 'RO '
  469. MCHEL2.CONCHE(1) = ' '
  470. C
  471. C**** Valeurs independente du repére, i.e.
  472. C
  473. MCHEL2.INFCHE(1,1) = 0
  474. MCHEL2.INFCHE(1,3) = NIFOUR
  475. MCHEL2.INFCHE(1,4) = 0
  476. MCHEL2.INFCHE(1,5) = 0
  477. MCHEL2.INFCHE(1,6) = 0
  478. MCHEL2.IFOCHE = IFOUR
  479. N2 = 1
  480. SEGINI MCHAM1
  481. MCHEL2.ICHAML(1) = MCHAM1
  482. SEGDES MCHEL2
  483. MCHAM1.NOMCHE(1) = 'SCAL '
  484. MCHAM1.TYPCHE(1) = 'REAL*8 '
  485. SEGINI MELRO
  486. MCHAM1.IELVAL(1) = MELRO
  487. SEGDES MCHAM1
  488. C
  489. C**** Pression
  490. C
  491. MCHEL1 = IROF
  492. SEGINI, MCHEL2 = MCHEL1
  493. IPF = MCHEL2
  494. MCHEL2.TITCHE = 'P '
  495. C
  496. C**** MCHAM1 = MCHAML de la densite
  497. C
  498. SEGINI, MCHAM2 = MCHAM1
  499. MCHEL2.ICHAML(1) = MCHAM2
  500. SEGDES MCHEL2
  501. SEGINI MELP
  502. MCHAM2.IELVAL(1) = MELP
  503. SEGDES MCHAM2
  504. C
  505. C**** Gamma
  506. C
  507. MCHEL1 = IROF
  508. SEGINI, MCHEL2 = MCHEL1
  509. IGAMF = MCHEL2
  510. MCHEL2.TITCHE = 'GAMMA '
  511. C
  512. C**** MCHAM1 = MCHAML de la densite
  513. C
  514. SEGINI, MCHAM2 = MCHAM1
  515. MCHEL2.ICHAML(1) = MCHAM2
  516. SEGDES MCHEL2
  517. SEGINI MELGAM
  518. MCHAM2.IELVAL(1) = MELGAM
  519. SEGDES MCHAM2
  520. C
  521. C**** Le CHAMELEM des fractions massiques
  522. C
  523. NESP = MPYC.VPOCHA(/2)
  524. SEGINI FRAMAS
  525. MCHEL1 = IROF
  526. SEGINI, MCHEL2 = MCHEL1
  527. IYF = MCHEL2
  528. MCHEL2.TITCHE = 'Y '
  529. N2 = NESP
  530. SEGINI MCHAMY
  531. MCHEL2.ICHAML(1) = MCHAMY
  532. SEGDES MCHEL2
  533. N1EL = NFAC
  534. N1PTEL = 3
  535. N2EL = 0
  536. N2PTEL = 0
  537. DO I1 = 1, NESP
  538. SEGINI MELVA1
  539. MCHAMY.IELVAL(I1) = MELVA1
  540. CARCEL = MLMOT1.MOTS(I1)
  541. TYPE = ' '
  542. TYPE(1:4) = CARCEL(1:4)
  543. MCHAMY.NOMCHE(I1) = TYPE
  544. MCHAMY.TYPCHE(I1) = 'REAL*8 '
  545. ENDDO
  546. C
  547. C
  548. C***********************************************************************
  549. C********* PREDICTION **************************************************
  550. C***********************************************************************
  551. C
  552. C**** Prediction avec gradients limités
  553. C
  554. C
  555. IF(LOGTEM)THEN
  556. C
  557. IPT3 = ICEN
  558. SEGACT IPT3
  559. NCEN = IPT3.NUM(/2)
  560. DO NLCE = 1, NCEN
  561. ROG = MPROP.VPOCHA(NLCE,1)
  562. UXG = MPVITP.VPOCHA(NLCE,1)
  563. UYG = MPVITP.VPOCHA(NLCE,2)
  564. UZG = MPVITP.VPOCHA(NLCE,3)
  565. PG = MPPP.VPOCHA(NLCE,1)
  566. DROX = MPGRR.VPOCHA(NLCE,1)*MELALR.VPOCHA(NLCE,1)
  567. DROY = MPGRR.VPOCHA(NLCE,2)*MELALR.VPOCHA(NLCE,1)
  568. DROZ = MPGRR.VPOCHA(NLCE,3)*MELALR.VPOCHA(NLCE,1)
  569. DUXX = MPGRV.VPOCHA(NLCE,1)*MELALV.VPOCHA(NLCE,1)
  570. DUXY = MPGRV.VPOCHA(NLCE,2)*MELALV.VPOCHA(NLCE,1)
  571. DUXZ = MPGRV.VPOCHA(NLCE,3)*MELALV.VPOCHA(NLCE,1)
  572. DUYX = MPGRV.VPOCHA(NLCE,4)*MELALV.VPOCHA(NLCE,2)
  573. DUYY = MPGRV.VPOCHA(NLCE,5)*MELALV.VPOCHA(NLCE,2)
  574. DUYZ = MPGRV.VPOCHA(NLCE,6)*MELALV.VPOCHA(NLCE,2)
  575. DUZX = MPGRV.VPOCHA(NLCE,7)*MELALV.VPOCHA(NLCE,3)
  576. DUZY = MPGRV.VPOCHA(NLCE,8)*MELALV.VPOCHA(NLCE,3)
  577. DUZZ = MPGRV.VPOCHA(NLCE,9)*MELALV.VPOCHA(NLCE,3)
  578. DPX = MPGRP.VPOCHA(NLCE,1)*MELALP.VPOCHA(NLCE,1)
  579. DPY = MPGRP.VPOCHA(NLCE,2)*MELALP.VPOCHA(NLCE,1)
  580. DPZ = MPGRP.VPOCHA(NLCE,3)*MELALP.VPOCHA(NLCE,1)
  581. GAMG = MPGAMC.VPOCHA(NLCE,1)
  582. DRO = UXG * DROX + ROG * ( DUXX + DUYY + DUZZ)
  583. & + UYG * DROY + UZG * DROZ
  584. DUX = UXG * DUXX + DPX / ROG + UYG * DUXY
  585. & + UZG * DUXZ
  586. DUY = UXG * DUYX + UYG * DUYY + DPY / ROG
  587. & + UZG * DUYZ
  588. DUZ = UXG * DUZX + UYG * DUZY + UZG * DUZZ
  589. & + DPZ / ROG
  590. DP = GAMG * PG * (DUXX + DUYY + DUZZ)
  591. & + UXG * DPX + UYG * DPY + UZG * DPZ
  592. C
  593. MPROP.VPOCHA(NLCE,1) = ROG - DELTAT * DRO
  594. MPVITP.VPOCHA(NLCE,1) = UXG - DELTAT * DUX
  595. MPVITP.VPOCHA(NLCE,2) = UYG - DELTAT * DUY
  596. MPVITP.VPOCHA(NLCE,3) = UZG - DELTAT * DUZ
  597. MPPP.VPOCHA(NLCE,1) = PG - DELTAT * DP
  598. DO I1 = 1, NESP
  599. INDCEL = IDIM * (I1-1) + 1
  600. ALPHA = MELALY.VPOCHA(NLCE,I1)
  601. DYMAS = UXG * MPGRY.VPOCHA(NLCE,INDCEL) * ALPHA +
  602. & UYG * MPGRY.VPOCHA(NLCE,INDCEL+1) * ALPHA +
  603. & UZG * MPGRY.VPOCHA(NLCE,INDCEL+2) * ALPHA
  604. MPYP.VPOCHA(NLCE,I1) = MPYC.VPOCHA(NLCE,I1) -
  605. & DELTAT * DYMAS
  606. ENDDO
  607. ENDDO
  608. C
  609. ENDIF
  610. C
  611. C
  612. C***********************************************************************
  613. C********* CORRECTION **************************************************
  614. C***********************************************************************
  615. C
  616. C**** Boucle sur le faces
  617. C
  618. IDIMP1 = IDIM + 1
  619. DO NLCF = 1, NFAC
  620. C
  621. C******* NLCF = numero local du centre de face
  622. C NGCF = numero global du centre de face
  623. C NGCEG = numero global du centre ELT "gauche"
  624. C NLCEG = numero local du centre ELT "gauche"
  625. C NGCED = numero global du centre ELT "droite"
  626. C NLCED = numero local du centre ELT "droite"
  627. C
  628. NGCEG = IPT1.NUM(1,NLCF)
  629. NGCF = IPT1.NUM(2,NLCF)
  630. NGCED = IPT1.NUM(3,NLCF)
  631. NLCEG = MLENT1.LECT(NGCEG)
  632. NLCED = MLENT1.LECT(NGCED)
  633. C
  634. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  635. C
  636. NGCF1 = IPT2.NUM(1,NLCF)
  637. IF( NGCF1 .NE. NGCF) THEN
  638. LOGAN = .TRUE.
  639. MESERR(1:40) = 'PRET, subroutine pre221.eso '
  640. GOTO 9999
  641. ENDIF
  642. C
  643. C******* Cosinus directeurs des NORMALES aux faces
  644. C
  645. C On impose que les normales sont direct "Gauche" -> "Centre"
  646. C
  647. INDCEL = (NGCEG-1)*IDIMP1
  648. XG = XCOOR(INDCEL+1)
  649. YG = XCOOR(INDCEL+2)
  650. ZG = XCOOR(INDCEL+3)
  651. INDCEL = (NGCF-1)*IDIMP1
  652. XC = XCOOR(INDCEL + 1)
  653. YC = XCOOR(INDCEL + 2)
  654. ZC = XCOOR(INDCEL+3)
  655. INDCEL = (NGCED-1)*IDIMP1
  656. XD = XCOOR(INDCEL+1)
  657. YD = XCOOR(INDCEL+2)
  658. ZD = XCOOR(INDCEL+3)
  659. DXG = XC - XG
  660. DYG = YC - YG
  661. DZG = ZC - ZG
  662. DXD = XC - XD
  663. DYD = YC - YD
  664. DZD = ZC - ZD
  665. C
  666. C******* On calcule le sign du pruduit scalare
  667. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  668. C
  669. CNX = MPNORM.VPOCHA(NLCF,7)
  670. CNY = MPNORM.VPOCHA(NLCF,8)
  671. CNZ = MPNORM.VPOCHA(NLCF,9)
  672. ORIENT = CNX * DXG + CNY * DYG + CNZ * DZG
  673. ORIENT = SIGN(1.0D0,ORIENT)
  674. IF(ORIENT .NE. 1.0D0)THEN
  675. LOGAN = .TRUE.
  676. MESERR(1:30)=
  677. & 'PRET , subroutine pre121.eso. '
  678. GOTO 9999
  679. ENDIF
  680. CNX = CNX * ORIENT
  681. CNY = CNY * ORIENT
  682. CNZ = CNZ * ORIENT
  683. C
  684. C********** Cosinus directeurs de tangente 1
  685. C
  686. CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT
  687. CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT
  688. CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT
  689. C
  690. C********** Cosinus directeurs de tangente 2
  691. C
  692. CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT
  693. CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT
  694. CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT
  695. C
  696. C
  697. C******* Les autres MELVALs
  698. C
  699. C
  700. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  701. C GAMMA \in (1,3)
  702. C Si non il faut le faire, en utilisant LOGBOR,
  703. C LOGNEG, VALER, VAL1, VAL2
  704. C
  705. C
  706. C
  707. C******* NGCEG = NGCED -> Mur
  708. C
  709. IF( NGCEG .EQ. NGCED)THEN
  710. C
  711. C********** Sur le mur on fait de reconstruction sur l'etat gauche
  712. C
  713. C
  714. C********** Etat gauche
  715. C
  716. VALCEL = MPROP.VPOCHA(NLCEG, 1)
  717. ALCEL = MELALR.VPOCHA(NLCEG, 1)
  718. DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG +
  719. & MPGRR.VPOCHA(NLCEG, 2)*DYG +
  720. & MPGRR.VPOCHA(NLCEG, 3)*DZG
  721.  
  722. ROG = VALCEL + ALCEL * DCEL
  723. C
  724. VALCEL = MPPP.VPOCHA(NLCEG, 1)
  725. ALCEL = MELALP.VPOCHA(NLCEG, 1)
  726. DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG +
  727. & MPGRP.VPOCHA(NLCEG, 2)*DYG +
  728. & MPGRP.VPOCHA(NLCEG, 3)*DZG
  729. PG = VALCEL + ALCEL * DCEL
  730. C
  731. LOGI2 = .FALSE.
  732. SUMY = 0.0D0
  733. CPCEL = 0.0D0
  734. CVCEL = 0.0D0
  735. DO I1 = 1, NESP
  736. INDCEL = IDIM * (I1-1) + 1
  737. VALCEL = MPYP.VPOCHA(NLCEG,I1)
  738. ALCEL = MELALY.VPOCHA(NLCEG, I1)
  739. DCEL = MPGRY.VPOCHA(NLCEG, INDCEL)*DXG +
  740. & MPGRY.VPOCHA(NLCEG,INDCEL + 1 )*DYG +
  741. & MPGRY.VPOCHA(NLCEG,INDCEL + 2 )*DZG
  742. ALCEL = VALCEL + ALCEL * DCEL
  743. SUMY = SUMY + ALCEL
  744. CPCEL = CPCEL + MLRECP.PROG(I1) * ALCEL
  745. CVCEL = CVCEL + MLRECV.PROG(I1) * ALCEL
  746. LOGI2 = LOGI2 .OR. (ALCEL .LT. 0.0D0)
  747. FRAMAS.FRAMG(I1) = ALCEL
  748. ENDDO
  749. LOGI2 = LOGI2 .OR. (SUMY .GT. 1.0D0)
  750. CPCEL = CPCEL + (1.0D0 - SUMY) * MLRECP.PROG(NESP+1)
  751. CVCEL = CVCEL + (1.0D0 - SUMY) * MLRECV.PROG(NESP+1)
  752. GAMG = CPCEL / CVCEL
  753. C
  754. VALCEL = MPVITP.VPOCHA(NLCEG, 1)
  755. ALCEL = MELALV.VPOCHA(NLCEG, 1)
  756. DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG +
  757. & MPGRV.VPOCHA(NLCEG, 2)*DYG +
  758. & MPGRV.VPOCHA(NLCEG, 3)*DZG
  759. UXG = VALCEL + ALCEL * DCEL
  760. C
  761. VALCEL = MPVITP.VPOCHA(NLCEG, 2)
  762. ALCEL = MELALV.VPOCHA(NLCEG, 2)
  763. DCEL = MPGRV.VPOCHA(NLCEG, 4)*DXG +
  764. & MPGRV.VPOCHA(NLCEG, 5)*DYG +
  765. & MPGRV.VPOCHA(NLCEG, 6)*DZG
  766. UYG = VALCEL + ALCEL * DCEL
  767. C
  768. VALCEL = MPVITP.VPOCHA(NLCEG, 3)
  769. ALCEL = MELALV.VPOCHA(NLCEG, 3)
  770. DCEL = MPGRV.VPOCHA(NLCEG, 7)*DXG +
  771. & MPGRV.VPOCHA(NLCEG, 8)*DYG +
  772. & MPGRV.VPOCHA(NLCEG, 9)*DZG
  773. UZG = VALCEL + ALCEL * DCEL
  774. C
  775. UNG = UXG * CNX + UYG * CNY + UZG * CNZ
  776. UTG = UXG * CTX + UYG * CTY + UZG * CTZ
  777. UVG = UXG * CVX + UYG * CVY + UZG * CVZ
  778. C
  779. C********** Si l'on fait pas de prediction, ce n'est pas necessaire de
  780. C controller la positivite' de la pression et de la densité; elle
  781. C est déjà garantie par la proprieté LED de limiteur; mais, vu
  782. C que le limiteur n'est pas calculé ici, mais dans un autre
  783. C operateur, on le fait
  784. C
  785. C AB
  786. C 2010/09/14: LOGI1 computed can destroy the symmetry!
  787. C LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0) .OR. LOGI2
  788. C
  789. IF(LOGI1)THEN
  790. C
  791. C************* Premier ordre en espace local
  792. C
  793. ROG = MPROC.VPOCHA(NLCEG,1)
  794. ROD = ROG
  795. PG = MPPC.VPOCHA(NLCEG,1)
  796. PD = PG
  797. UNG = MPVITC.VPOCHA(NLCEG,1)*CNX +
  798. & MPVITC.VPOCHA(NLCEG,2)*CNY +
  799. & MPVITC.VPOCHA(NLCEG,3)*CNZ
  800. UTG = MPVITC.VPOCHA(NLCEG,1)*CTX +
  801. & MPVITC.VPOCHA(NLCEG,2)*CTY +
  802. & MPVITC.VPOCHA(NLCEG,3)*CTZ
  803. UVG = MPVITC.VPOCHA(NLCEG,1)*CVX +
  804. & MPVITC.VPOCHA(NLCEG,2)*CVY +
  805. & MPVITC.VPOCHA(NLCEG,3)*CVZ
  806. UND = -1.0D0 * UNG
  807. UTD = UTG
  808. UVD = UVG
  809. DO I1 = 1, NESP
  810. FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1)
  811. FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1)
  812. ENDDO
  813. GAMG = MPGAMC.VPOCHA(NLCEG,1)
  814. GAMD = GAMG
  815. ELSE
  816. C
  817. C********** Son etat droite
  818. C
  819. ROD = ROG
  820. PD = PG
  821. UND = -1.0D0 * UNG
  822. UTD = UTG
  823. UVD = UVG
  824. DO I1 = 1, NESP
  825. FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1)
  826. ENDDO
  827. GAMD = GAMG
  828. ENDIF
  829. C
  830. C************* Fin cas mur
  831. C
  832. ELSE
  833. C
  834. C************* Etat gauche
  835. C
  836. VALCEL = MPROP.VPOCHA(NLCEG, 1)
  837. ALCEL = MELALR.VPOCHA(NLCEG, 1)
  838. DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG +
  839. & MPGRR.VPOCHA(NLCEG, 2)*DYG +
  840. & MPGRR.VPOCHA(NLCEG, 3)*DZG
  841.  
  842. ROG = VALCEL + ALCEL * DCEL
  843. C
  844. VALCEL = MPPP.VPOCHA(NLCEG, 1)
  845. ALCEL = MELALP.VPOCHA(NLCEG, 1)
  846. DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG +
  847. & MPGRP.VPOCHA(NLCEG, 2)*DYG +
  848. & MPGRP.VPOCHA(NLCEG, 3)*DZG
  849. PG = VALCEL + ALCEL * DCEL
  850. C
  851. LOGI2 = .FALSE.
  852. SUMY = 0.0D0
  853. CPCEL = 0.0D0
  854. CVCEL = 0.0D0
  855. DO I1 = 1, NESP
  856. INDCEL = IDIM * (I1-1) + 1
  857. VALCEL = MPYP.VPOCHA(NLCEG,I1)
  858. ALCEL = MELALY.VPOCHA(NLCEG, I1)
  859. DCEL = MPGRY.VPOCHA(NLCEG, INDCEL)*DXG +
  860. & MPGRY.VPOCHA(NLCEG,INDCEL + 1 )*DYG +
  861. & MPGRY.VPOCHA(NLCEG,INDCEL + 2 )*DZG
  862. ALCEL = VALCEL + ALCEL * DCEL
  863. SUMY = SUMY + ALCEL
  864. CPCEL = CPCEL + MLRECP.PROG(I1) * ALCEL
  865. CVCEL = CVCEL + MLRECV.PROG(I1) * ALCEL
  866. LOGI2 = LOGI2 .OR. (ALCEL .LT. 0.0D0)
  867. FRAMAS.FRAMG(I1) = ALCEL
  868. ENDDO
  869. LOGI2 = LOGI2 .OR. (SUMY .GT. 1.0D0)
  870. CPCEL = CPCEL + (1.0D0 - SUMY) * MLRECP.PROG(NESP+1)
  871. CVCEL = CVCEL + (1.0D0 - SUMY) * MLRECV.PROG(NESP+1)
  872. GAMG = CPCEL / CVCEL
  873. C
  874. VALCEL = MPVITP.VPOCHA(NLCEG, 1)
  875. ALCEL = MELALV.VPOCHA(NLCEG, 1)
  876. DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG +
  877. & MPGRV.VPOCHA(NLCEG, 2)*DYG +
  878. & MPGRV.VPOCHA(NLCEG, 3)*DZG
  879. UXG = VALCEL + ALCEL * DCEL
  880. C
  881. VALCEL = MPVITP.VPOCHA(NLCEG, 2)
  882. ALCEL = MELALV.VPOCHA(NLCEG, 2)
  883. DCEL = MPGRV.VPOCHA(NLCEG, 4)*DXG +
  884. & MPGRV.VPOCHA(NLCEG, 5)*DYG +
  885. & MPGRV.VPOCHA(NLCEG, 6)*DZG
  886. UYG = VALCEL + ALCEL * DCEL
  887. C
  888. VALCEL = MPVITP.VPOCHA(NLCEG, 3)
  889. ALCEL = MELALV.VPOCHA(NLCEG, 3)
  890. DCEL = MPGRV.VPOCHA(NLCEG, 7)*DXG +
  891. & MPGRV.VPOCHA(NLCEG, 8)*DYG +
  892. & MPGRV.VPOCHA(NLCEG, 9)*DZG
  893. UZG = VALCEL + ALCEL * DCEL
  894. C
  895. UNG = UXG * CNX + UYG * CNY + UZG * CNZ
  896. UTG = UXG * CTX + UYG * CTY + UZG * CTZ
  897. UVG = UXG * CVX + UYG * CVY + UZG * CVZ
  898. C
  899. C********** Positivite
  900. C
  901. C AB
  902. C 2010/09/14: LOGI1 computed can destroy the symmetry!
  903. C LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0) .OR. LOGI2
  904. C
  905. IF(LOGI1)THEN
  906. C
  907. C************* Premier ordre en espace local
  908. C
  909. ROG = MPROC.VPOCHA(NLCEG,1)
  910. PG = MPPC.VPOCHA(NLCEG,1)
  911. UNG = MPVITC.VPOCHA(NLCEG,1)*CNX +
  912. & MPVITC.VPOCHA(NLCEG,2)*CNY +
  913. & MPVITC.VPOCHA(NLCEG,3)*CNZ
  914. UTG = MPVITC.VPOCHA(NLCEG,1)*CTX +
  915. & MPVITC.VPOCHA(NLCEG,2)*CTY +
  916. & MPVITC.VPOCHA(NLCEG,3)*CTZ
  917. UVG = MPVITC.VPOCHA(NLCEG,1)*CVX +
  918. & MPVITC.VPOCHA(NLCEG,2)*CVY +
  919. & MPVITC.VPOCHA(NLCEG,3)*CVZ
  920. DO I1 = 1, NESP
  921. FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1)
  922. ENDDO
  923. GAMG = MPGAMC.VPOCHA(NLCEG,1)
  924. ENDIF
  925. C
  926. C********** Etat droite
  927. C
  928. VALCEL = MPROP.VPOCHA(NLCED, 1)
  929. ALCEL = MELALR.VPOCHA(NLCED, 1)
  930. DCEL = MPGRR.VPOCHA(NLCED, 1)*DXD +
  931. & MPGRR.VPOCHA(NLCED, 2)*DYD +
  932. & MPGRR.VPOCHA(NLCED, 3)*DZD
  933. ROD = VALCEL + ALCEL * DCEL
  934. C
  935. VALCEL = MPPP.VPOCHA(NLCED, 1)
  936. ALCEL = MELALP.VPOCHA(NLCED, 1)
  937. DCEL = MPGRP.VPOCHA(NLCED, 1)*DXD +
  938. & MPGRP.VPOCHA(NLCED, 2)*DYD +
  939. & MPGRP.VPOCHA(NLCED, 3)*DZD
  940. PD = VALCEL + ALCEL * DCEL
  941. C
  942. LOGI2 = .FALSE.
  943. SUMY = 0.0D0
  944. CPCEL = 0.0D0
  945. CVCEL = 0.0D0
  946. DO I1 = 1, NESP
  947. INDCEL = IDIM * (I1-1) + 1
  948. VALCEL = MPYP.VPOCHA(NLCED,I1)
  949. ALCEL = MELALY.VPOCHA(NLCED, I1)
  950. DCEL = MPGRY.VPOCHA(NLCED, INDCEL)*DXD +
  951. & MPGRY.VPOCHA(NLCED,INDCEL + 1 )*DYD +
  952. & MPGRY.VPOCHA(NLCED,INDCEL + 2 )*DZD
  953. ALCEL = VALCEL + ALCEL * DCEL
  954. SUMY = SUMY + ALCEL
  955. CPCEL = CPCEL + MLRECP.PROG(I1) * ALCEL
  956. CVCEL = CVCEL + MLRECV.PROG(I1) * ALCEL
  957. LOGI2 = LOGI2 .OR. (ALCEL .LT. 0.0D0)
  958. FRAMAS.FRAMD(I1) = ALCEL
  959. ENDDO
  960. LOGI2 = LOGI2 .OR. (SUMY .GT. 1.0D0)
  961. CPCEL = CPCEL + (1.0D0 - SUMY) * MLRECP.PROG(NESP+1)
  962. CVCEL = CVCEL + (1.0D0 - SUMY) * MLRECV.PROG(NESP+1)
  963. GAMD = CPCEL / CVCEL
  964. C
  965. VALCEL = MPVITP.VPOCHA(NLCED, 1)
  966. ALCEL = MELALV.VPOCHA(NLCED, 1)
  967. DCEL = MPGRV.VPOCHA(NLCED, 1)*DXD +
  968. & MPGRV.VPOCHA(NLCED, 2)*DYD +
  969. & MPGRV.VPOCHA(NLCED, 3)*DZD
  970. UXD = VALCEL + ALCEL * DCEL
  971. C
  972. VALCEL = MPVITP.VPOCHA(NLCED, 2)
  973. ALCEL = MELALV.VPOCHA(NLCED, 2)
  974. DCEL = MPGRV.VPOCHA(NLCED, 4)*DXD +
  975. & MPGRV.VPOCHA(NLCED, 5)*DYD +
  976. & MPGRV.VPOCHA(NLCED, 6)*DZD
  977. UYD = VALCEL + ALCEL * DCEL
  978. C
  979. VALCEL = MPVITP.VPOCHA(NLCED, 3)
  980. ALCEL = MELALV.VPOCHA(NLCED, 3)
  981. DCEL = MPGRV.VPOCHA(NLCED, 7)*DXD +
  982. & MPGRV.VPOCHA(NLCED, 8)*DYD +
  983. & MPGRV.VPOCHA(NLCED, 9)*DZD
  984. UZD = VALCEL + ALCEL * DCEL
  985. C
  986. UND = UXD * CNX + UYD * CNY + UZD * CNZ
  987. UTD = UXD * CTX + UYD * CTY + UZD * CTZ
  988. UVD = UXD * CVX + UYD * CVY + UZD * CVZ
  989. C
  990. C********** Positivite
  991. C
  992. C AB
  993. C 2010/09/14: LOGI1 computed can destroy the symmetry!
  994. C LOGI1 = (PD .LT. 0.0D0) .OR. (ROD .LT. 0.0D0) .OR. LOGI2
  995. C
  996. IF(LOGI1)THEN
  997. C
  998. C************* Premier ordre en espace local
  999. C
  1000. ROD = MPROC.VPOCHA(NLCED,1)
  1001. PD = MPPC.VPOCHA(NLCED,1)
  1002. UND = MPVITC.VPOCHA(NLCED,1)*CNX +
  1003. & MPVITC.VPOCHA(NLCED,2)*CNY +
  1004. & MPVITC.VPOCHA(NLCED,3)*CNZ
  1005. UTD = MPVITC.VPOCHA(NLCED,1)*CTX +
  1006. & MPVITC.VPOCHA(NLCED,2)*CTY +
  1007. & MPVITC.VPOCHA(NLCED,3)*CTZ
  1008. UVD = MPVITC.VPOCHA(NLCED,1)*CVX +
  1009. & MPVITC.VPOCHA(NLCED,2)*CVY +
  1010. & MPVITC.VPOCHA(NLCED,3)*CVZ
  1011. DO I1 = 1, NESP
  1012. FRAMAS.FRAMD(I1) = MPYC.VPOCHA(NLCED,I1)
  1013. ENDDO
  1014. GAMD = MPGAMC.VPOCHA(NLCED,1)
  1015. ENDIF
  1016. ENDIF
  1017. C
  1018. C******** Les MELVALs
  1019. C
  1020. MELRO.VELCHE(1,NLCF) = ROG
  1021. MELRO.VELCHE(3,NLCF) = ROD
  1022. MELP.VELCHE(1,NLCF) = PG
  1023. MELP.VELCHE(3,NLCF) = PD
  1024. MELGAM.VELCHE(1,NLCF) = GAMG
  1025. MELGAM.VELCHE(3,NLCF) = GAMD
  1026. MELVUN.VELCHE(1,NLCF) = UNG
  1027. MELVUN.VELCHE(3,NLCF) = UND
  1028. MELVUT.VELCHE(1,NLCF) = UTG
  1029. MELVUT.VELCHE(3,NLCF) = UTD
  1030. MELVUV.VELCHE(1,NLCF) = UVG
  1031. MELVUV.VELCHE(3,NLCF) = UVD
  1032. MELVNX.VELCHE(1,NLCF) = CNX
  1033. MELVNY.VELCHE(1,NLCF) = CNY
  1034. MELVNZ.VELCHE(1,NLCF) = CNZ
  1035. MELT1X.VELCHE(1,NLCF) = CTX
  1036. MELT1Y.VELCHE(1,NLCF) = CTY
  1037. MELT1Z.VELCHE(1,NLCF) = CTZ
  1038. MELT2X.VELCHE(1,NLCF) = CVX
  1039. MELT2Y.VELCHE(1,NLCF) = CVY
  1040. MELT2Z.VELCHE(1,NLCF) = CVZ
  1041. DO I1 = 1, NESP
  1042. MELVA1 = MCHAMY.IELVAL(I1)
  1043. MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1)
  1044. MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1)
  1045. ENDDO
  1046. ENDDO
  1047. C
  1048. C**** Desactivation des SEGMENTs
  1049. C
  1050. SEGDES IPT1
  1051. SEGDES IPT2
  1052. C
  1053. C**** Le MPOVALs 'Prediction' sont detruits (si existentes)
  1054. C
  1055. IF(LOGTEM)THEN
  1056. SEGSUP MPROP
  1057. SEGSUP MPVITP
  1058. SEGSUP MPPP
  1059. SEGSUP MPYP
  1060. ENDIF
  1061. C
  1062. SEGDES MPROC
  1063. SEGDES MPGRR
  1064. SEGDES MELALR
  1065. SEGDES MPVITC
  1066. SEGDES MPGRV
  1067. SEGDES MELALV
  1068. SEGDES MPPC
  1069. SEGDES MPGRP
  1070. SEGDES MELALP
  1071. SEGDES MPYC
  1072. SEGDES MPGRY
  1073. SEGDES MELALY
  1074. SEGDES MPGAMC
  1075. SEGDES MPNORM
  1076. C
  1077. SEGDES MELRO
  1078. SEGDES MELP
  1079. SEGDES MELGAM
  1080. SEGDES MELVUN
  1081. SEGDES MELVUT
  1082. SEGDES MELVUV
  1083. SEGDES MELVNX
  1084. SEGDES MELVNY
  1085. SEGDES MELVNZ
  1086. SEGDES MELT1X
  1087. SEGDES MELT1Y
  1088. SEGDES MELT1Z
  1089. SEGDES MELT2X
  1090. SEGDES MELT2Y
  1091. SEGDES MELT2Z
  1092. C
  1093. SEGDES MPYC
  1094. DO I1 = 1, NESP
  1095. MELVA1 = MCHAMY.IELVAL(I1)
  1096. SEGDES MELVA1
  1097. ENDDO
  1098. SEGDES MCHAMY
  1099. SEGSUP FRAMAS
  1100. C
  1101. SEGDES MLMOT1
  1102. CC
  1103. C**** Destruction du MELNTI correspondance local/global
  1104. C
  1105. SEGSUP MLENT1
  1106. C
  1107. 9999 CONTINUE
  1108. C
  1109. RETURN
  1110. END
  1111.  
  1112.  
  1113.  
  1114.  
  1115.  
  1116.  
  1117.  
  1118.  
  1119.  
  1120.  
  1121.  

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