Télécharger pre322.eso

Retour à la liste

Numérotation des lignes :

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

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