Télécharger pre121.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE121 SOURCE CB215821 19/08/20 21:20:33 10287
  2. SUBROUTINE PRE121(LOGTEM,
  3. & ICEN,IFACE,IFACEL,INORM,
  4. & IROC, IGRROC, IALROC,
  5. & IVITC, IGRVC, IALVC,
  6. & IPC ,IGRPC, IALPC,
  7. & IGAMC,
  8. & DELTAT,
  9. & IROF,IVITF,IPF,IGAMF,
  10. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  11. C************************************************************************
  12. C
  13. C PROJET : CASTEM 2000
  14. C
  15. C NOM : PRE121
  16. C
  17. C DESCRIPTION : Voir PRE12
  18. C
  19. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  20. C
  21. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  22. C
  23. C************************************************************************
  24. C
  25. C
  26. C APPELES (Outils) : KRIPAD, LICHT
  27. C
  28. C APPELES (Calcul) : AUCUN
  29. C
  30. C
  31. C************************************************************************
  32. C
  33. C ENTREES
  34. C
  35. C LOGTEM : LOGICAL; si .TRUE. 2em ordre en temps
  36. C sinon 1er ordre en temps
  37. C
  38. C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
  39. C
  40. C ICEN : MELEME de 'POI1' SPG des CENTRES
  41. C
  42. C IFACE : MELEME de 'POI1' SPG des FACES
  43. C
  44. C IFACEL : MELEME de 'SEG3' avec
  45. C CENTRE d'Elt "gauche"
  46. C CENTRE de Face
  47. C CENTRE d'Elt "droite"
  48. C
  49. C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
  50. C
  51. C INORM : CHPOINT des cosinus directeurs de normales aux faces
  52. C
  53. C 2) Pointeurs des CHPOINTs
  54. C
  55. C IROC : CHPOINT "CENTRE" contenant la masse volumique RHO
  56. C
  57. C IGRROC : CHPOINT "CENTRE" contenant le gradient de la
  58. C masse volumique RHO (2 composantes)
  59. C
  60. C IALROC : CHPOINT "CENTRE" contenant le limiteur du gradient
  61. C de la masse volumique
  62. C
  63. C IVITC : CHPOINT "CENTRE" contenant la vitesse UX, UY ;
  64. C
  65. C IGRVC : CHPOINT "CENTRE" contenant le gradient de la
  66. C vitesse (4 composantes)
  67. C
  68. C IALVC : CHPOINT "CENTRE" contenant le limiteur du gradient
  69. C de la vitesse (2 composantes)
  70. C
  71. C IPC : CHPOINT "CENTRE" contenat la pression P;
  72. C
  73. C IGRPC : CHPOINT "CENTRE" contenant le gradient de la
  74. C pression (2 composantes)
  75. C
  76. C IALPC : CHPOINT "CENTRE" contenant le limiteur du gradient
  77. C de la pression
  78. C
  79. C IGAMC : CHPOINT "CENTRE" contenat le "Gamma" du gaz
  80. C
  81. C 3)
  82. C
  83. C DELTAT : REAL*8, encrement en temps pour calculer la prediction
  84. C
  85. C
  86. C SORTIES
  87. C
  88. C
  89. C IROF : MCHAML defini sur le MELEME de pointeur IFACEL,
  90. C contenant la masse volumique RHO
  91. C
  92. C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL,
  93. C contenant la vitesse UN, UT dans le repaire local
  94. C (n,t) et defini sur le MELEME de pointeur IFACE,
  95. C contenant les cosinus directeurs du repere local
  96. C
  97. C IPF : MCHAML defini sur le MELEME de pointeur IFACEL,
  98. C contenant la pression P
  99. C
  100. C IGAMF : MCHAML defini sur le MELEME de pointeur IFACEL,
  101. C contenant le "gamma" du gaz
  102. C
  103. C LOGAN : anomalie detectee
  104. C
  105. C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité
  106. C negative a été detectée -> en interactif le
  107. C programme s'arrete en GIBIANE
  108. C (erreur stocké en MESERR et VALER)
  109. C
  110. C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte
  111. C dehor 1 et 3 (sa valeur stockée en MESERR et VALER;
  112. C en VAL1 et en VAL2 on stocke 1.0 et 3.0)
  113. C
  114. C MESERR
  115. C VALER
  116. C VAL1,
  117. C VAL2 : pour les messages d'erreur
  118. C
  119. C************************************************************************
  120. C
  121. C HISTORIQUE (Anomalies et modifications éventuelles)
  122. C
  123. C HISTORIQUE : Créée le 11.6.98.
  124. C
  125. C************************************************************************
  126. C
  127. C
  128. C ATTENTION: Cet programme marche si le MAILLAGE est convex;
  129. C si non il faut changer l'argoritme de calcul de
  130. C l'orientation des normales aux faces.
  131. C
  132. C La positivité n'est pas controlle parce que c'est déjà fait
  133. C dans l'operateur PRIM
  134. C
  135. C
  136. C************************************************************************
  137. C
  138. C**** Variables de COOPTIO
  139. C
  140. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  141. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  142. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  143. C & ,IECHO, IIMPI, IOSPI
  144. C & ,IDIM
  145. CC & ,MCOORD
  146. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  147. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  148. C & ,NORINC,NORVAL,NORIND,NORVAD
  149. C & ,NUCROU, IPSAUV
  150. C
  151. C**** Les variables
  152. C
  153. IMPLICIT INTEGER(I-N)
  154. INTEGER ICEN, IFACE, IFACEL, INORM,IROC, IGRROC, IALROC
  155. & , IVITC, IGRVC, IALVC
  156. & , IPC ,IGRPC, IALPC
  157. & , IGAMC
  158. & , IROF, IVITF, IPF, IGAMF
  159. & , IGEOM, NFAC, NCEN
  160. & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1, NLCE
  161. & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
  162. & , IDIMP1, INDCEL
  163. REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, XD, YD, DELTAT
  164. & ,DXG, DYG, DXD, DYD
  165. & , CNX, CNY, CTX, CTY, ORIENT
  166. & , ROG, PG, GAMG, UXG, UYG, UNG, UTG
  167. & , ROD, PD, GAMD, UXD, UYD, UND, UTD
  168. & , VALCEL, DCEL, ALCEL
  169. & , DROX, DROY, DUXX, DUXY, DUYX, DUYY, DPX, DPY
  170. & , DRO, DUX, DUY, DP, ALPHA(4)
  171. CHARACTER*(40) MESERR
  172. CHARACTER*(8) TYPE
  173. LOGICAL LOGAN,LOGNEG, LOGBOR, LOGTEM, LOGI1, LOGALP
  174. C
  175. C**** LOGALP = .TRUE. -> Prediction avec limiteur
  176. C
  177. PARAMETER(LOGALP = .TRUE.)
  178. C
  179. C**** Les Includes
  180. C
  181. -INC SMCOORD
  182.  
  183. -INC PPARAM
  184. -INC CCOPTIO
  185. -INC SMCHPOI
  186. POINTEUR MPROC.MPOVAL, MPGRR.MPOVAL,
  187. & MPVITC.MPOVAL, MPGRV.MPOVAL,
  188. & MPPC.MPOVAL, MPGRP.MPOVAL,
  189. & MPGAMC.MPOVAL, MPNORM.MPOVAL,
  190. & MPROP.MPOVAL, MPPP.MPOVAL, MPVITP.MPOVAL
  191. -INC SMCHAML
  192. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  193. & MELT1X.MELVAL, MELT1Y.MELVAL
  194. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  195. POINTEUR MELRO.MELVAL, MELP.MELVAL,
  196. & MELGAM.MELVAL
  197. POINTEUR MELALR.MPOVAL,
  198. & MELALV.MPOVAL,
  199. & MELALP.MPOVAL
  200. -INC SMLENTI
  201. -INC SMELEME
  202. C
  203. C
  204. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  205. C
  206. C LOGNEG = .FALSE.
  207. C LOGBOR = .FALSE.
  208. C MESERR = ' '
  209. C MOTERR(1:40) = MESERR(1:40)
  210. C VALER = 0.0D0
  211. C VAL1 = 0.0D0
  212. C VAL2 = 0.0D0
  213. C
  214. C
  215. C**** KRIPAD pour la correspondance global/local de centre
  216. C
  217. CALL KRIPAD(ICEN,MLENT1)
  218. C
  219. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  220. C
  221. C Si i est le numero global d'un noeud de ICEN,
  222. C MLENT1.LECT(i) contient sa position, i.e.
  223. C
  224. C I = numero global du noeud centre
  225. C MLENT1.LECT(i) = numero local du noeud centre
  226. C
  227. C MLENT1 déjà activé, i.e.
  228. C
  229. C SEGACT MLENT1
  230. C
  231. C**** Activation de CHPOINTs
  232. C
  233. C densité + grad + limiteur
  234. C vitesse + grad + limiteur
  235. C pression + grad + limiteur
  236. C gamma
  237. C cosinus directeurs des normales aux surface
  238. C
  239. CALL LICHT(IROC , MPROC , TYPE, IGEOM)
  240. CALL LICHT(IGRROC, MPGRR , TYPE, IGEOM)
  241. CALL LICHT(IVITC, MPVITC , TYPE, IGEOM)
  242. CALL LICHT(IGRVC, MPGRV , TYPE, IGEOM)
  243. CALL LICHT(IPC , MPPC , TYPE, IGEOM)
  244. CALL LICHT(IGRPC, MPGRP , TYPE, IGEOM)
  245. CALL LICHT(IGAMC, MPGAMC , TYPE, IGEOM)
  246. CALL LICHT(INORM, MPNORM , TYPE, IGEOM)
  247. C
  248. C**** Les MPOVALs 'Prediction'
  249. C
  250. IF(LOGTEM)THEN
  251. SEGINI, MPROP = MPROC
  252. SEGINI, MPPP = MPPC
  253. SEGINI, MPVITP = MPVITC
  254. ELSE
  255. MPROP = MPROC
  256. MPPP = MPPC
  257. MPVITP = MPVITC
  258. ENDIF
  259. C
  260. C**** Les Limiteurs
  261. C
  262. CALL LICHT(IALROC, MELALR , TYPE, IGEOM)
  263. CALL LICHT(IALVC, MELALV , TYPE, IGEOM)
  264. CALL LICHT(IALPC, MELALP , TYPE, IGEOM)
  265. C
  266. C
  267. C**** MPOVAL sont déjà activés i.e.:
  268. C
  269. C SEGACT MPROC
  270. C SEGACT MPGRR
  271. C SEGACT MPIALR
  272. C SEGACT MPVITC
  273. C SEGACT MPGRV
  274. C SEGACT MPIALV
  275. C SEGACT MPPC
  276. C SEGACT MPGRP
  277. C SEGACT MPIALP
  278. C SEGACT MPGAMC
  279. C SEGACT MPNORM
  280. C
  281. C**** Le MELEME FACEL
  282. C
  283. IPT1 = IFACEL
  284. IPT2 = IFACE
  285. SEGACT IPT1
  286. SEGACT IPT2
  287. NFAC = IPT1.NUM(/2)
  288. C
  289. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  290. C
  291. C i.e.:
  292. C
  293. C vitesse + cosinus directors du repere local
  294. C densité
  295. C pression
  296. C gamma
  297. C
  298. C**** Cosinus directors du repere local et vitesse
  299. C
  300. C Les cosinus directeurs
  301. C
  302. N1 = 2
  303. N3 = 6
  304. L1 = 28
  305. SEGINI MCHEL1
  306. IVITF = MCHEL1
  307. MCHEL1.TITCHE = 'U '
  308. MCHEL1.IMACHE(1) = IFACE
  309. MCHEL1.IMACHE(2) = IFACEL
  310. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  311. MCHEL1.CONCHE(2) = ' U in (n,t) '
  312. C
  313. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  314. C
  315. MCHEL1.INFCHE(1,1) = 2
  316. MCHEL1.INFCHE(1,3) = NIFOUR
  317. MCHEL1.INFCHE(1,4) = 0
  318. MCHEL1.INFCHE(1,5) = 0
  319. MCHEL1.INFCHE(1,6) = 0
  320. MCHEL1.IFOCHE = IFOUR
  321. C
  322. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  323. C
  324. MCHEL1.INFCHE(2,1) = 1
  325. MCHEL1.INFCHE(2,3) = NIFOUR
  326. MCHEL1.INFCHE(2,4) = 0
  327. MCHEL1.INFCHE(2,5) = 0
  328. MCHEL1.INFCHE(2,6) = 0
  329. C
  330. C**** Le cosinus directeurs
  331. C
  332. N1PTEL = 1
  333. N1EL = NFAC
  334. N2PTEL = 0
  335. N2EL = 0
  336. C
  337. C**** MCHAML a N2 composantes:
  338. C
  339. C cosinus directeurs du repere local (n,t1)
  340. C
  341. C IDIM = 2 -> 4 composantes
  342. C
  343. N2 = 4
  344. SEGINI MCHAM1
  345. MCHEL1.ICHAML(1) = MCHAM1
  346. MCHAM1.NOMCHE(1) = 'NX '
  347. MCHAM1.NOMCHE(2) = 'NY '
  348. MCHAM1.NOMCHE(3) = 'TX '
  349. MCHAM1.NOMCHE(4) = 'TY '
  350. MCHAM1.TYPCHE(1) = 'REAL*8 '
  351. MCHAM1.TYPCHE(2) = 'REAL*8 '
  352. MCHAM1.TYPCHE(3) = 'REAL*8 '
  353. MCHAM1.TYPCHE(4) = 'REAL*8 '
  354. SEGINI MELVNX
  355. SEGINI MELVNY
  356. SEGINI MELT1X
  357. SEGINI MELT1Y
  358. MCHAM1.IELVAL(1) = MELVNX
  359. MCHAM1.IELVAL(2) = MELVNY
  360. MCHAM1.IELVAL(3) = MELT1X
  361. MCHAM1.IELVAL(4) = MELT1Y
  362. C
  363. C**** Vitesse
  364. C
  365. N1EL = NFAC
  366. N1PTEL = 3
  367. N2EL = 0
  368. N2PTEL = 0
  369. C
  370. C**** MCHAML a N2 composantes:
  371. C
  372. C IDIM = 2 -> 2 composantes
  373. C
  374. N2 = 2
  375. SEGINI MCHAM1
  376. MCHEL1.ICHAML(2) = MCHAM1
  377. MCHAM1.NOMCHE(1) = 'UN '
  378. MCHAM1.NOMCHE(2) = 'UT '
  379. MCHAM1.TYPCHE(1) = 'REAL*8 '
  380. MCHAM1.TYPCHE(2) = 'REAL*8 '
  381. SEGINI MELVUN
  382. SEGINI MELVUT
  383. MCHAM1.IELVAL(1) = MELVUN
  384. MCHAM1.IELVAL(2) = MELVUT
  385. C
  386. C**** Densite
  387. C
  388. N1 = 1
  389. N3 = 6
  390. L1 = 15
  391. SEGINI MCHEL2
  392. IROF = MCHEL2
  393. MCHEL2.IMACHE(1) = IFACEL
  394. MCHEL2.TITCHE = 'RO '
  395. MCHEL2.CONCHE(1) = ' '
  396. C
  397. C**** Valeurs independente du repére, i.e.
  398. C
  399. MCHEL2.INFCHE(1,1) = 0
  400. MCHEL2.INFCHE(1,3) = NIFOUR
  401. MCHEL2.INFCHE(1,4) = 0
  402. MCHEL2.INFCHE(1,5) = 0
  403. MCHEL2.INFCHE(1,6) = 0
  404. MCHEL2.IFOCHE = IFOUR
  405. N2 = 1
  406. SEGINI MCHAM1
  407. MCHEL2.ICHAML(1) = MCHAM1
  408. MCHAM1.NOMCHE(1) = 'SCAL '
  409. MCHAM1.TYPCHE(1) = 'REAL*8 '
  410. SEGINI MELRO
  411. MCHAM1.IELVAL(1) = MELRO
  412. C
  413. C**** Pression
  414. C
  415. MCHEL1 = IROF
  416. SEGINI, MCHEL2 = MCHEL1
  417. IPF = MCHEL2
  418. MCHEL2.TITCHE = 'P '
  419. C
  420. C**** MCHAM1 = MCHAML de la densite
  421. C
  422. SEGINI, MCHAM2 = MCHAM1
  423. MCHEL2.ICHAML(1) = MCHAM2
  424. SEGINI MELP
  425. MCHAM2.IELVAL(1) = MELP
  426. C
  427. C**** Gamma
  428. C
  429. MCHEL1 = IROF
  430. SEGINI, MCHEL2 = MCHEL1
  431. IGAMF = MCHEL2
  432. MCHEL2.TITCHE = 'GAMMA '
  433. C
  434. C**** MCHAM1 = MCHAML de la densite
  435. C
  436. SEGINI, MCHAM2 = MCHAM1
  437. MCHEL2.ICHAML(1) = MCHAM2
  438. SEGINI MELGAM
  439. MCHAM2.IELVAL(1) = MELGAM
  440. C
  441. C**** Recapitulatif: les MELVALs et les MPOVALs actives
  442. C
  443. C MELVNX, MELVNY
  444. C MELT1X, MELT1Y
  445. C
  446. C MELVUN, MELVUT -> vitesse
  447. C
  448. C MELRO -> densite
  449. C
  450. C MELP -> pression
  451. C
  452. C MELGAM -> gamma
  453. C
  454. C MPROC, MPROP -> densite
  455. C
  456. C MPVITC, MPVITP -> vitesse
  457. C
  458. C MPPC, MPPP -> pression
  459. C
  460. C MPGAMC -> gamma
  461. C
  462. C MPNORM -> normales aux faces
  463. C
  464. C
  465. C***********************************************************************
  466. C********* PREDICTION **************************************************
  467. C***********************************************************************
  468. C
  469. IF(LOGTEM)THEN
  470. C
  471. IPT3 = ICEN
  472. SEGACT IPT3
  473. NCEN = IPT3.NUM(/2)
  474. DO NLCE = 1, NCEN
  475. IF(LOGALP)THEN
  476. C
  477. C************* Gradients limités
  478. C
  479. ALPHA(1) = MELALR.VPOCHA(NLCE,1)
  480. ALPHA(2) = MELALV.VPOCHA(NLCE,1)
  481. ALPHA(3) = MELALV.VPOCHA(NLCE,2)
  482. ALPHA(4) = MELALP.VPOCHA(NLCE,1)
  483. ELSE
  484. C
  485. C************* Gradients non limités
  486. C
  487. ALPHA(1) = 1.0D0
  488. ALPHA(2) = 1.0D0
  489. ALPHA(3) = 1.0D0
  490. ALPHA(4) = 1.0D0
  491. ENDIF
  492. ROG = MPROP.VPOCHA(NLCE,1)
  493. UXG = MPVITP.VPOCHA(NLCE,1)
  494. UYG = MPVITP.VPOCHA(NLCE,2)
  495. PG = MPPP.VPOCHA(NLCE,1)
  496. DROX = MPGRR.VPOCHA(NLCE,1)*ALPHA(1)
  497. DROY = MPGRR.VPOCHA(NLCE,2)*ALPHA(1)
  498. DUXX = MPGRV.VPOCHA(NLCE,1)*ALPHA(2)
  499. DUXY = MPGRV.VPOCHA(NLCE,2)*ALPHA(2)
  500. DUYX = MPGRV.VPOCHA(NLCE,3)*ALPHA(3)
  501. DUYY = MPGRV.VPOCHA(NLCE,4)*ALPHA(3)
  502. DPX = MPGRP.VPOCHA(NLCE,1)*ALPHA(4)
  503. DPY = MPGRP.VPOCHA(NLCE,2)*ALPHA(4)
  504. GAMG = MPGAMC.VPOCHA(NLCE,1)
  505. DRO = UXG * DROX + ROG * ( DUXX + DUYY )
  506. & + UYG * DROY
  507. DUX = UXG * DUXX + DPX / ROG + UYG * DUXY
  508. DUY = UXG * DUYX + UYG * DUYY + DPY / ROG
  509. DP = GAMG * PG * (DUXX + DUYY)
  510. & + UXG * DPX + UYG * DPY
  511. C
  512. C************* Prediction avec/sans gradients limités
  513. C
  514. MPROP.VPOCHA(NLCE,1) = ROG - DELTAT * DRO
  515. MPVITP.VPOCHA(NLCE,1) = UXG - DELTAT * DUX
  516. MPVITP.VPOCHA(NLCE,2) = UYG - DELTAT * DUY
  517. MPPP.VPOCHA(NLCE,1) = PG - DELTAT * DP
  518. ENDDO
  519. C
  520. ENDIF
  521. C
  522. C
  523. C***********************************************************************
  524. C********* CORRECTION **************************************************
  525. C***********************************************************************
  526. C
  527. C**** Boucle sur le faces
  528. C
  529. IDIMP1 = IDIM + 1
  530. DO NLCF = 1, NFAC
  531. C
  532. C******* NLCF = numero local du centre de face
  533. C NGCF = numero global du centre de face
  534. C NGCEG = numero global du centre ELT "gauche"
  535. C NLCEG = numero local du centre ELT "gauche"
  536. C NGCED = numero global du centre ELT "droite"
  537. C NLCED = numero local du centre ELT "droite"
  538. C
  539. NGCEG = IPT1.NUM(1,NLCF)
  540. NGCF = IPT1.NUM(2,NLCF)
  541. NGCED = IPT1.NUM(3,NLCF)
  542. NLCEG = MLENT1.LECT(NGCEG)
  543. NLCED = MLENT1.LECT(NGCED)
  544. C
  545. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  546. C
  547. NGCF1 = IPT2.NUM(1,NLCF)
  548. IF( NGCF1 .NE. NGCF) THEN
  549. LOGAN = .TRUE.
  550. MESERR(1:40) = 'PRET, subroutine pre121.eso '
  551. GOTO 9999
  552. ENDIF
  553. C
  554. C******* Cosinus directeurs des NORMALES aux faces
  555. C
  556. C On impose que les normales sont direct "Gauche" -> "Centre"
  557. C
  558. INDCEL = (NGCEG-1)*IDIMP1
  559. XG = XCOOR(INDCEL+1)
  560. YG = XCOOR(INDCEL+2)
  561. INDCEL = (NGCF-1)*IDIMP1
  562. XC = XCOOR(INDCEL + 1)
  563. YC = XCOOR(INDCEL + 2)
  564. INDCEL = (NGCED-1)*IDIMP1
  565. XD = XCOOR(INDCEL+1)
  566. YD = XCOOR(INDCEL+2)
  567. DXG = XC - XG
  568. DYG = YC - YG
  569. DXD = XC - XD
  570. DYD = YC - YD
  571. C
  572. C******* On calcule le sign du pruduit scalare
  573. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  574. C
  575. CNX = MPNORM.VPOCHA(NLCF,1)
  576. CNY = MPNORM.VPOCHA(NLCF,2)
  577. ORIENT = CNX * DXG + CNY * DYG
  578. ORIENT = SIGN(1.0D0,ORIENT)
  579. IF(ORIENT .NE. 1.0D0)THEN
  580. LOGAN = .TRUE.
  581. MESERR(1:30)=
  582. & 'PRET , subroutine pre121.eso. '
  583. GOTO 9999
  584. ENDIF
  585. CNX = CNX * ORIENT
  586. CNY = CNY * ORIENT
  587. C
  588. C********** Cosinus directeurs de tangent 2D
  589. C
  590. CTX = -1.0D0 * CNY
  591. CTY = CNX
  592. C
  593. C
  594. C******* Les autres MELVALs
  595. C
  596. C
  597. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  598. C GAMMA \in (1,3)
  599. C Si non il faut le faire, en utilisant LOGBOR,
  600. C LOGNEG, VALER, VAL1, VAL2
  601. C
  602. C
  603. C
  604. C******* NGCEG = NGCED -> Mur
  605. C
  606. IF( NGCEG .EQ. NGCED)THEN
  607. C
  608. C********** Sur le mur on fait de reconstruction sur l'etat gauche
  609. C
  610. C
  611. C********** Etat gauche
  612. C
  613. VALCEL = MPROP.VPOCHA(NLCEG, 1)
  614. ALCEL = MELALR.VPOCHA(NLCEG, 1)
  615. DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG +
  616. & MPGRR.VPOCHA(NLCEG, 2)*DYG
  617. ROG = VALCEL + ALCEL * DCEL
  618. C
  619. VALCEL = MPPP.VPOCHA(NLCEG, 1)
  620. ALCEL = MELALP.VPOCHA(NLCEG, 1)
  621. DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG +
  622. & MPGRP.VPOCHA(NLCEG, 2)*DYG
  623. PG = VALCEL + ALCEL * DCEL
  624. C
  625. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  626. C
  627. VALCEL = MPVITP.VPOCHA(NLCEG, 1)
  628. ALCEL = MELALV.VPOCHA(NLCEG, 1)
  629. DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG +
  630. & MPGRV.VPOCHA(NLCEG, 2)*DYG
  631. UXG = VALCEL + ALCEL * DCEL
  632. C
  633. VALCEL = MPVITP.VPOCHA(NLCEG, 2)
  634. ALCEL = MELALV.VPOCHA(NLCEG, 2)
  635. DCEL = MPGRV.VPOCHA(NLCEG, 3)*DXG +
  636. & MPGRV.VPOCHA(NLCEG, 4)*DYG
  637. UYG = VALCEL + ALCEL * DCEL
  638. C
  639. UNG = UXG * CNX + UYG * CNY
  640. UTG = UXG * CTX + UYG * CTY
  641. C
  642. C********** Si l'on fait pas de prediction, ce n'est pas necessaire de
  643. C controller la positivite' de la pression et de la densité; elle
  644. C est déjà garantie par la proprieté LED de limiteur; mais, vu
  645. C que le limiteur n'est pas calculé ici, mais dans un autre
  646. C operateur, on le fait
  647. C
  648. LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0)
  649. C
  650. IF(LOGI1)THEN
  651. C
  652. C************* Premier ordre en espace local
  653. C
  654. ROG = MPROC.VPOCHA(NLCEG,1)
  655. PG = MPPC.VPOCHA(NLCEG,1)
  656. UNG = MPVITC.VPOCHA(NLCEG,1)*CNX +
  657. & MPVITC.VPOCHA(NLCEG,2)*CNY
  658. UTG = MPVITC.VPOCHA(NLCEG,1)*CTX +
  659. & MPVITC.VPOCHA(NLCEG,2)*CTY
  660. ENDIF
  661. C
  662. C********** Son etat droite
  663. C
  664. ROD = ROG
  665. PD = PG
  666. GAMD = GAMG
  667. UND = -1.0D0 * UNG
  668. UTD = UTG
  669. C
  670. C************* Fin cas mur
  671. C
  672. ELSE
  673. C
  674. C************* Etat gauche
  675. C
  676. VALCEL = MPROP.VPOCHA(NLCEG, 1)
  677. ALCEL = MELALR.VPOCHA(NLCEG, 1)
  678. DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG +
  679. & MPGRR.VPOCHA(NLCEG, 2)*DYG
  680. ROG = VALCEL + ALCEL * DCEL
  681. C
  682. VALCEL = MPPP.VPOCHA(NLCEG, 1)
  683. ALCEL = MELALP.VPOCHA(NLCEG, 1)
  684. DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG +
  685. & MPGRP.VPOCHA(NLCEG, 2)*DYG
  686. PG = VALCEL + ALCEL * DCEL
  687. C
  688. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  689. C
  690. VALCEL = MPVITP.VPOCHA(NLCEG, 1)
  691. ALCEL = MELALV.VPOCHA(NLCEG, 1)
  692. DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG +
  693. & MPGRV.VPOCHA(NLCEG, 2)*DYG
  694. UXG = VALCEL + ALCEL * DCEL
  695. C
  696. VALCEL = MPVITP.VPOCHA(NLCEG, 2)
  697. ALCEL = MELALV.VPOCHA(NLCEG, 2)
  698. DCEL = MPGRV.VPOCHA(NLCEG, 3)*DXG +
  699. & MPGRV.VPOCHA(NLCEG, 4)*DYG
  700. UYG = VALCEL + ALCEL * DCEL
  701. C
  702. UNG = UXG * CNX + UYG * CNY
  703. UTG = UXG * CTX + UYG * CTY
  704. C
  705. C********** Positivite
  706. C
  707. LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0)
  708. C
  709. IF(LOGI1)THEN
  710. C
  711. C************* Premier ordre en espace local
  712. C
  713. ROG = MPROC.VPOCHA(NLCEG,1)
  714. PG = MPPC.VPOCHA(NLCEG,1)
  715. UNG = MPVITC.VPOCHA(NLCEG,1)*CNX +
  716. & MPVITC.VPOCHA(NLCEG,2)*CNY
  717. UTG = MPVITC.VPOCHA(NLCEG,1)*CTX +
  718. & MPVITC.VPOCHA(NLCEG,2)*CTY
  719. ENDIF
  720. C
  721. C********** Etat droite
  722. C
  723. VALCEL = MPROP.VPOCHA(NLCED, 1)
  724. ALCEL = MELALR.VPOCHA(NLCED, 1)
  725. DCEL = MPGRR.VPOCHA(NLCED, 1)*DXD +
  726. & MPGRR.VPOCHA(NLCED, 2)*DYD
  727. ROD = VALCEL + ALCEL * DCEL
  728. C
  729. VALCEL = MPPP.VPOCHA(NLCED, 1)
  730. ALCEL = MELALP.VPOCHA(NLCED, 1)
  731. DCEL = MPGRP.VPOCHA(NLCED, 1)*DXD +
  732. & MPGRP.VPOCHA(NLCED, 2)*DYD
  733. PD = VALCEL + ALCEL * DCEL
  734. C
  735. GAMD = MPGAMC.VPOCHA(NLCED, 1)
  736. C
  737. VALCEL = MPVITP.VPOCHA(NLCED, 1)
  738. ALCEL = MELALV.VPOCHA(NLCED, 1)
  739. DCEL = MPGRV.VPOCHA(NLCED, 1)*DXD +
  740. & MPGRV.VPOCHA(NLCED, 2)*DYD
  741. UXD = VALCEL + ALCEL * DCEL
  742. C
  743. VALCEL = MPVITP.VPOCHA(NLCED, 2)
  744. ALCEL = MELALV.VPOCHA(NLCED, 2)
  745. DCEL = MPGRV.VPOCHA(NLCED, 3)*DXD +
  746. & MPGRV.VPOCHA(NLCED, 4)*DYD
  747. UYD = VALCEL + ALCEL * DCEL
  748. C
  749. UND = UXD * CNX + UYD * CNY
  750. UTD = UXD * CTX + UYD * CTY
  751. C
  752. C********** Positivite
  753. C
  754. LOGI1 = (PD .LT. 0.0D0) .OR. (ROD .LT. 0.0D0)
  755. C
  756. IF(LOGI1)THEN
  757. C
  758. C************* Premier ordre en espace local
  759. C
  760. ROD = MPROC.VPOCHA(NLCED,1)
  761. PD = MPPC.VPOCHA(NLCED,1)
  762. UND = MPVITC.VPOCHA(NLCED,1)*CNX +
  763. & MPVITC.VPOCHA(NLCED,2)*CNY
  764. UTD = MPVITC.VPOCHA(NLCED,1)*CTX +
  765. & MPVITC.VPOCHA(NLCED,2)*CTY
  766. ENDIF
  767. ENDIF
  768. C
  769. C******** Les MELVALs
  770. C
  771. MELRO.VELCHE(1,NLCF) = ROG
  772. MELRO.VELCHE(3,NLCF) = ROD
  773. MELP.VELCHE(1,NLCF) = PG
  774. MELP.VELCHE(3,NLCF) = PD
  775. MELGAM.VELCHE(1,NLCF) = GAMG
  776. MELGAM.VELCHE(3,NLCF) = GAMD
  777. MELVUN.VELCHE(1,NLCF) = UNG
  778. MELVUN.VELCHE(3,NLCF) = UND
  779. MELVUT.VELCHE(1,NLCF) = UTG
  780. MELVUT.VELCHE(3,NLCF) = UTD
  781. MELVNX.VELCHE(1,NLCF) = CNX
  782. MELVNY.VELCHE(1,NLCF) = CNY
  783. MELT1X.VELCHE(1,NLCF) = CTX
  784. MELT1Y.VELCHE(1,NLCF) = CTY
  785. C
  786. ENDDO
  787. C
  788. C**** Le MPOVALs 'Prediction' sont detruits (si existentes)
  789. C
  790. IF(LOGTEM)THEN
  791. SEGSUP MPROP
  792. SEGSUP MPVITP
  793. SEGSUP MPPP
  794. ENDIF
  795. C**** Destruction du MLENTI correspondance local/global
  796. C
  797. SEGSUP MLENT1
  798. C
  799. 9999 CONTINUE
  800.  
  801. END
  802.  
  803.  
  804.  

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