Télécharger pre121.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE121 SOURCE PV 09/03/12 21:30:35 6325
  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. -INC CCOPTIO
  183. -INC SMCHPOI
  184. POINTEUR MPROC.MPOVAL, MPGRR.MPOVAL,
  185. & MPVITC.MPOVAL, MPGRV.MPOVAL,
  186. & MPPC.MPOVAL, MPGRP.MPOVAL,
  187. & MPGAMC.MPOVAL, MPNORM.MPOVAL,
  188. & MPROP.MPOVAL, MPPP.MPOVAL, MPVITP.MPOVAL
  189. -INC SMCHAML
  190. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  191. & MELT1X.MELVAL, MELT1Y.MELVAL
  192. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  193. POINTEUR MELRO.MELVAL, MELP.MELVAL,
  194. & MELGAM.MELVAL
  195. POINTEUR MELALR.MPOVAL,
  196. & MELALV.MPOVAL,
  197. & MELALP.MPOVAL
  198. -INC SMLENTI
  199. -INC SMELEME
  200. C
  201. C
  202. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  203. C
  204. C LOGNEG = .FALSE.
  205. C LOGBOR = .FALSE.
  206. C MESERR = ' '
  207. C MOTERR(1:40) = MESERR(1:40)
  208. C VALER = 0.0D0
  209. C VAL1 = 0.0D0
  210. C VAL2 = 0.0D0
  211. C
  212. C
  213. C**** KRIPAD pour la correspondance global/local de centre
  214. C
  215. CALL KRIPAD(ICEN,MLENT1)
  216. C
  217. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  218. C
  219. C Si i est le numero global d'un noeud de ICEN,
  220. C MLENT1.LECT(i) contient sa position, i.e.
  221. C
  222. C I = numero global du noeud centre
  223. C MLENT1.LECT(i) = numero local du noeud centre
  224. C
  225. C MLENT1 déjà activé, i.e.
  226. C
  227. C SEGACT MLENT1
  228. C
  229. C**** Activation de CHPOINTs
  230. C
  231. C densité + grad + limiteur
  232. C vitesse + grad + limiteur
  233. C pression + grad + limiteur
  234. C gamma
  235. C cosinus directeurs des normales aux surface
  236. C
  237. CALL LICHT(IROC , MPROC , TYPE, IGEOM)
  238. CALL LICHT(IGRROC, MPGRR , TYPE, IGEOM)
  239. CALL LICHT(IVITC, MPVITC , TYPE, IGEOM)
  240. CALL LICHT(IGRVC, MPGRV , TYPE, IGEOM)
  241. CALL LICHT(IPC , MPPC , TYPE, IGEOM)
  242. CALL LICHT(IGRPC, MPGRP , TYPE, IGEOM)
  243. CALL LICHT(IGAMC, MPGAMC , TYPE, IGEOM)
  244. CALL LICHT(INORM, MPNORM , TYPE, IGEOM)
  245. C
  246. C**** Les MPOVALs 'Prediction'
  247. C
  248. IF(LOGTEM)THEN
  249. SEGINI, MPROP = MPROC
  250. SEGINI, MPPP = MPPC
  251. SEGINI, MPVITP = MPVITC
  252. ELSE
  253. MPROP = MPROC
  254. MPPP = MPPC
  255. MPVITP = MPVITC
  256. ENDIF
  257. C
  258. C**** Les Limiteurs
  259. C
  260. CALL LICHT(IALROC, MELALR , TYPE, IGEOM)
  261. CALL LICHT(IALVC, MELALV , TYPE, IGEOM)
  262. CALL LICHT(IALPC, MELALP , TYPE, IGEOM)
  263. C
  264. C
  265. C**** MPOVAL sont déjà activés i.e.:
  266. C
  267. C SEGACT MPROC
  268. C SEGACT MPGRR
  269. C SEGACT MPIALR
  270. C SEGACT MPVITC
  271. C SEGACT MPGRV
  272. C SEGACT MPIALV
  273. C SEGACT MPPC
  274. C SEGACT MPGRP
  275. C SEGACT MPIALP
  276. C SEGACT MPGAMC
  277. C SEGACT MPNORM
  278. C
  279. C**** Le MELEME FACEL
  280. C
  281. IPT1 = IFACEL
  282. IPT2 = IFACE
  283. SEGACT IPT1
  284. SEGACT IPT2
  285. NFAC = IPT1.NUM(/2)
  286. C
  287. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  288. C
  289. C i.e.:
  290. C
  291. C vitesse + cosinus directors du repere local
  292. C densité
  293. C pression
  294. C gamma
  295. C
  296. C**** Cosinus directors du repere local et vitesse
  297. C
  298. C Les cosinus directeurs
  299. C
  300. N1 = 2
  301. N3 = 6
  302. L1 = 28
  303. SEGINI MCHEL1
  304. IVITF = MCHEL1
  305. MCHEL1.TITCHE = 'U '
  306. MCHEL1.IMACHE(1) = IFACE
  307. MCHEL1.IMACHE(2) = IFACEL
  308. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  309. MCHEL1.CONCHE(2) = ' U in (n,t) '
  310. C
  311. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  312. C
  313. MCHEL1.INFCHE(1,1) = 2
  314. MCHEL1.INFCHE(1,3) = NIFOUR
  315. MCHEL1.INFCHE(1,4) = 0
  316. MCHEL1.INFCHE(1,5) = 0
  317. MCHEL1.INFCHE(1,6) = 0
  318. MCHEL1.IFOCHE = IFOUR
  319. C
  320. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  321. C
  322. MCHEL1.INFCHE(2,1) = 1
  323. MCHEL1.INFCHE(2,3) = NIFOUR
  324. MCHEL1.INFCHE(2,4) = 0
  325. MCHEL1.INFCHE(2,5) = 0
  326. MCHEL1.INFCHE(2,6) = 0
  327. C
  328. C**** Le cosinus directeurs
  329. C
  330. N1PTEL = 1
  331. N1EL = NFAC
  332. N2PTEL = 0
  333. N2EL = 0
  334. C
  335. C**** MCHAML a N2 composantes:
  336. C
  337. C cosinus directeurs du repere local (n,t1)
  338. C
  339. C IDIM = 2 -> 4 composantes
  340. C
  341. N2 = 4
  342. SEGINI MCHAM1
  343. MCHEL1.ICHAML(1) = MCHAM1
  344. MCHAM1.NOMCHE(1) = 'NX '
  345. MCHAM1.NOMCHE(2) = 'NY '
  346. MCHAM1.NOMCHE(3) = 'TX '
  347. MCHAM1.NOMCHE(4) = 'TY '
  348. MCHAM1.TYPCHE(1) = 'REAL*8 '
  349. MCHAM1.TYPCHE(2) = 'REAL*8 '
  350. MCHAM1.TYPCHE(3) = 'REAL*8 '
  351. MCHAM1.TYPCHE(4) = 'REAL*8 '
  352. SEGINI MELVNX
  353. SEGINI MELVNY
  354. SEGINI MELT1X
  355. SEGINI MELT1Y
  356. MCHAM1.IELVAL(1) = MELVNX
  357. MCHAM1.IELVAL(2) = MELVNY
  358. MCHAM1.IELVAL(3) = MELT1X
  359. MCHAM1.IELVAL(4) = MELT1Y
  360. SEGDES MCHAM1
  361. C
  362. C**** Vitesse
  363. C
  364. N1EL = NFAC
  365. N1PTEL = 3
  366. N2EL = 0
  367. N2PTEL = 0
  368. C
  369. C**** MCHAML a N2 composantes:
  370. C
  371. C IDIM = 2 -> 2 composantes
  372. C
  373. N2 = 2
  374. SEGINI MCHAM1
  375. MCHEL1.ICHAML(2) = MCHAM1
  376. SEGDES MCHEL1
  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. SEGDES MCHAM1
  386. C
  387. C**** Densite
  388. C
  389. N1 = 1
  390. N3 = 6
  391. L1 = 15
  392. SEGINI MCHEL2
  393. IROF = MCHEL2
  394. MCHEL2.IMACHE(1) = IFACEL
  395. MCHEL2.TITCHE = 'RO '
  396. MCHEL2.CONCHE(1) = ' '
  397. C
  398. C**** Valeurs independente du repére, i.e.
  399. C
  400. MCHEL2.INFCHE(1,1) = 0
  401. MCHEL2.INFCHE(1,3) = NIFOUR
  402. MCHEL2.INFCHE(1,4) = 0
  403. MCHEL2.INFCHE(1,5) = 0
  404. MCHEL2.INFCHE(1,6) = 0
  405. MCHEL2.IFOCHE = IFOUR
  406. N2 = 1
  407. SEGINI MCHAM1
  408. MCHEL2.ICHAML(1) = MCHAM1
  409. SEGDES MCHEL2
  410. MCHAM1.NOMCHE(1) = 'SCAL '
  411. MCHAM1.TYPCHE(1) = 'REAL*8 '
  412. SEGINI MELRO
  413. MCHAM1.IELVAL(1) = MELRO
  414. SEGDES MCHAM1
  415. C
  416. C**** Pression
  417. C
  418. MCHEL1 = IROF
  419. SEGINI, MCHEL2 = MCHEL1
  420. IPF = MCHEL2
  421. MCHEL2.TITCHE = 'P '
  422. C
  423. C**** MCHAM1 = MCHAML de la densite
  424. C
  425. SEGINI, MCHAM2 = MCHAM1
  426. MCHEL2.ICHAML(1) = MCHAM2
  427. SEGDES MCHEL2
  428. SEGINI MELP
  429. MCHAM2.IELVAL(1) = MELP
  430. SEGDES MCHAM2
  431. C
  432. C**** Gamma
  433. C
  434. MCHEL1 = IROF
  435. SEGINI, MCHEL2 = MCHEL1
  436. IGAMF = MCHEL2
  437. MCHEL2.TITCHE = 'GAMMA '
  438. C
  439. C**** MCHAM1 = MCHAML de la densite
  440. C
  441. SEGINI, MCHAM2 = MCHAM1
  442. MCHEL2.ICHAML(1) = MCHAM2
  443. SEGDES MCHEL2
  444. SEGINI MELGAM
  445. MCHAM2.IELVAL(1) = MELGAM
  446. SEGDES MCHAM2
  447. C
  448. C**** Recapitulatif: les MELVALs et les MPOVALs actives
  449. C
  450. C MELVNX, MELVNY
  451. C MELT1X, MELT1Y
  452. C
  453. C MELVUN, MELVUT -> vitesse
  454. C
  455. C MELRO -> densite
  456. C
  457. C MELP -> pression
  458. C
  459. C MELGAM -> gamma
  460. C
  461. C MPROC, MPROP -> densite
  462. C
  463. C MPVITC, MPVITP -> vitesse
  464. C
  465. C MPPC, MPPP -> pression
  466. C
  467. C MPGAMC -> gamma
  468. C
  469. C MPNORM -> normales aux faces
  470. C
  471. C
  472. C***********************************************************************
  473. C********* PREDICTION **************************************************
  474. C***********************************************************************
  475. C
  476. IF(LOGTEM)THEN
  477. C
  478. IPT3 = ICEN
  479. SEGACT IPT3
  480. NCEN = IPT3.NUM(/2)
  481. DO NLCE = 1, NCEN
  482. IF(LOGALP)THEN
  483. C
  484. C************* Gradients limités
  485. C
  486. ALPHA(1) = MELALR.VPOCHA(NLCE,1)
  487. ALPHA(2) = MELALV.VPOCHA(NLCE,1)
  488. ALPHA(3) = MELALV.VPOCHA(NLCE,2)
  489. ALPHA(4) = MELALP.VPOCHA(NLCE,1)
  490. ELSE
  491. C
  492. C************* Gradients non limités
  493. C
  494. ALPHA(1) = 1.0D0
  495. ALPHA(2) = 1.0D0
  496. ALPHA(3) = 1.0D0
  497. ALPHA(4) = 1.0D0
  498. ENDIF
  499. ROG = MPROP.VPOCHA(NLCE,1)
  500. UXG = MPVITP.VPOCHA(NLCE,1)
  501. UYG = MPVITP.VPOCHA(NLCE,2)
  502. PG = MPPP.VPOCHA(NLCE,1)
  503. DROX = MPGRR.VPOCHA(NLCE,1)*ALPHA(1)
  504. DROY = MPGRR.VPOCHA(NLCE,2)*ALPHA(1)
  505. DUXX = MPGRV.VPOCHA(NLCE,1)*ALPHA(2)
  506. DUXY = MPGRV.VPOCHA(NLCE,2)*ALPHA(2)
  507. DUYX = MPGRV.VPOCHA(NLCE,3)*ALPHA(3)
  508. DUYY = MPGRV.VPOCHA(NLCE,4)*ALPHA(3)
  509. DPX = MPGRP.VPOCHA(NLCE,1)*ALPHA(4)
  510. DPY = MPGRP.VPOCHA(NLCE,2)*ALPHA(4)
  511. GAMG = MPGAMC.VPOCHA(NLCE,1)
  512. DRO = UXG * DROX + ROG * ( DUXX + DUYY )
  513. & + UYG * DROY
  514. DUX = UXG * DUXX + DPX / ROG + UYG * DUXY
  515. DUY = UXG * DUYX + UYG * DUYY + DPY / ROG
  516. DP = GAMG * PG * (DUXX + DUYY)
  517. & + UXG * DPX + UYG * DPY
  518. C
  519. C************* Prediction avec/sans gradients limités
  520. C
  521. MPROP.VPOCHA(NLCE,1) = ROG - DELTAT * DRO
  522. MPVITP.VPOCHA(NLCE,1) = UXG - DELTAT * DUX
  523. MPVITP.VPOCHA(NLCE,2) = UYG - DELTAT * DUY
  524. MPPP.VPOCHA(NLCE,1) = PG - DELTAT * DP
  525. ENDDO
  526. C
  527. ENDIF
  528. C
  529. C
  530. C***********************************************************************
  531. C********* CORRECTION **************************************************
  532. C***********************************************************************
  533. C
  534. C**** Boucle sur le faces
  535. C
  536. IDIMP1 = IDIM + 1
  537. DO NLCF = 1, NFAC
  538. C
  539. C******* NLCF = numero local du centre de face
  540. C NGCF = numero global du centre de face
  541. C NGCEG = numero global du centre ELT "gauche"
  542. C NLCEG = numero local du centre ELT "gauche"
  543. C NGCED = numero global du centre ELT "droite"
  544. C NLCED = numero local du centre ELT "droite"
  545. C
  546. NGCEG = IPT1.NUM(1,NLCF)
  547. NGCF = IPT1.NUM(2,NLCF)
  548. NGCED = IPT1.NUM(3,NLCF)
  549. NLCEG = MLENT1.LECT(NGCEG)
  550. NLCED = MLENT1.LECT(NGCED)
  551. C
  552. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  553. C
  554. NGCF1 = IPT2.NUM(1,NLCF)
  555. IF( NGCF1 .NE. NGCF) THEN
  556. LOGAN = .TRUE.
  557. MESERR(1:40) = 'PRET, subroutine pre121.eso '
  558. GOTO 9999
  559. ENDIF
  560. C
  561. C******* Cosinus directeurs des NORMALES aux faces
  562. C
  563. C On impose que les normales sont direct "Gauche" -> "Centre"
  564. C
  565. INDCEL = (NGCEG-1)*IDIMP1
  566. XG = XCOOR(INDCEL+1)
  567. YG = XCOOR(INDCEL+2)
  568. INDCEL = (NGCF-1)*IDIMP1
  569. XC = XCOOR(INDCEL + 1)
  570. YC = XCOOR(INDCEL + 2)
  571. INDCEL = (NGCED-1)*IDIMP1
  572. XD = XCOOR(INDCEL+1)
  573. YD = XCOOR(INDCEL+2)
  574. DXG = XC - XG
  575. DYG = YC - YG
  576. DXD = XC - XD
  577. DYD = YC - YD
  578. C
  579. C******* On calcule le sign du pruduit scalare
  580. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  581. C
  582. CNX = MPNORM.VPOCHA(NLCF,1)
  583. CNY = MPNORM.VPOCHA(NLCF,2)
  584. ORIENT = CNX * DXG + CNY * DYG
  585. ORIENT = SIGN(1.0D0,ORIENT)
  586. IF(ORIENT .NE. 1.0D0)THEN
  587. LOGAN = .TRUE.
  588. MESERR(1:30)=
  589. & 'PRET , subroutine pre121.eso. '
  590. GOTO 9999
  591. ENDIF
  592. CNX = CNX * ORIENT
  593. CNY = CNY * ORIENT
  594. C
  595. C********** Cosinus directeurs de tangent 2D
  596. C
  597. CTX = -1.0D0 * CNY
  598. CTY = CNX
  599. C
  600. C
  601. C******* Les autres MELVALs
  602. C
  603. C
  604. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  605. C GAMMA \in (1,3)
  606. C Si non il faut le faire, en utilisant LOGBOR,
  607. C LOGNEG, VALER, VAL1, VAL2
  608. C
  609. C
  610. C
  611. C******* NGCEG = NGCED -> Mur
  612. C
  613. IF( NGCEG .EQ. NGCED)THEN
  614. C
  615. C********** Sur le mur on fait de reconstruction sur l'etat gauche
  616. C
  617. C
  618. C********** Etat gauche
  619. C
  620. VALCEL = MPROP.VPOCHA(NLCEG, 1)
  621. ALCEL = MELALR.VPOCHA(NLCEG, 1)
  622. DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG +
  623. & MPGRR.VPOCHA(NLCEG, 2)*DYG
  624. ROG = VALCEL + ALCEL * DCEL
  625. C
  626. VALCEL = MPPP.VPOCHA(NLCEG, 1)
  627. ALCEL = MELALP.VPOCHA(NLCEG, 1)
  628. DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG +
  629. & MPGRP.VPOCHA(NLCEG, 2)*DYG
  630. PG = VALCEL + ALCEL * DCEL
  631. C
  632. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  633. C
  634. VALCEL = MPVITP.VPOCHA(NLCEG, 1)
  635. ALCEL = MELALV.VPOCHA(NLCEG, 1)
  636. DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG +
  637. & MPGRV.VPOCHA(NLCEG, 2)*DYG
  638. UXG = VALCEL + ALCEL * DCEL
  639. C
  640. VALCEL = MPVITP.VPOCHA(NLCEG, 2)
  641. ALCEL = MELALV.VPOCHA(NLCEG, 2)
  642. DCEL = MPGRV.VPOCHA(NLCEG, 3)*DXG +
  643. & MPGRV.VPOCHA(NLCEG, 4)*DYG
  644. UYG = VALCEL + ALCEL * DCEL
  645. C
  646. UNG = UXG * CNX + UYG * CNY
  647. UTG = UXG * CTX + UYG * CTY
  648. C
  649. C********** Si l'on fait pas de prediction, ce n'est pas necessaire de
  650. C controller la positivite' de la pression et de la densité; elle
  651. C est déjà garantie par la proprieté LED de limiteur; mais, vu
  652. C que le limiteur n'est pas calculé ici, mais dans un autre
  653. C operateur, on le fait
  654. C
  655. LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0)
  656. C
  657. IF(LOGI1)THEN
  658. C
  659. C************* Premier ordre en espace local
  660. C
  661. ROG = MPROC.VPOCHA(NLCEG,1)
  662. PG = MPPC.VPOCHA(NLCEG,1)
  663. UNG = MPVITC.VPOCHA(NLCEG,1)*CNX +
  664. & MPVITC.VPOCHA(NLCEG,2)*CNY
  665. UTG = MPVITC.VPOCHA(NLCEG,1)*CTX +
  666. & MPVITC.VPOCHA(NLCEG,2)*CTY
  667. ENDIF
  668. C
  669. C********** Son etat droite
  670. C
  671. ROD = ROG
  672. PD = PG
  673. GAMD = GAMG
  674. UND = -1.0D0 * UNG
  675. UTD = UTG
  676. C
  677. C************* Fin cas mur
  678. C
  679. ELSE
  680. C
  681. C************* Etat gauche
  682. C
  683. VALCEL = MPROP.VPOCHA(NLCEG, 1)
  684. ALCEL = MELALR.VPOCHA(NLCEG, 1)
  685. DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG +
  686. & MPGRR.VPOCHA(NLCEG, 2)*DYG
  687. ROG = VALCEL + ALCEL * DCEL
  688. C
  689. VALCEL = MPPP.VPOCHA(NLCEG, 1)
  690. ALCEL = MELALP.VPOCHA(NLCEG, 1)
  691. DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG +
  692. & MPGRP.VPOCHA(NLCEG, 2)*DYG
  693. PG = VALCEL + ALCEL * DCEL
  694. C
  695. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  696. C
  697. VALCEL = MPVITP.VPOCHA(NLCEG, 1)
  698. ALCEL = MELALV.VPOCHA(NLCEG, 1)
  699. DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG +
  700. & MPGRV.VPOCHA(NLCEG, 2)*DYG
  701. UXG = VALCEL + ALCEL * DCEL
  702. C
  703. VALCEL = MPVITP.VPOCHA(NLCEG, 2)
  704. ALCEL = MELALV.VPOCHA(NLCEG, 2)
  705. DCEL = MPGRV.VPOCHA(NLCEG, 3)*DXG +
  706. & MPGRV.VPOCHA(NLCEG, 4)*DYG
  707. UYG = VALCEL + ALCEL * DCEL
  708. C
  709. UNG = UXG * CNX + UYG * CNY
  710. UTG = UXG * CTX + UYG * CTY
  711. C
  712. C********** Positivite
  713. C
  714. LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0)
  715. C
  716. IF(LOGI1)THEN
  717. C
  718. C************* Premier ordre en espace local
  719. C
  720. ROG = MPROC.VPOCHA(NLCEG,1)
  721. PG = MPPC.VPOCHA(NLCEG,1)
  722. UNG = MPVITC.VPOCHA(NLCEG,1)*CNX +
  723. & MPVITC.VPOCHA(NLCEG,2)*CNY
  724. UTG = MPVITC.VPOCHA(NLCEG,1)*CTX +
  725. & MPVITC.VPOCHA(NLCEG,2)*CTY
  726. ENDIF
  727. C
  728. C********** Etat droite
  729. C
  730. VALCEL = MPROP.VPOCHA(NLCED, 1)
  731. ALCEL = MELALR.VPOCHA(NLCED, 1)
  732. DCEL = MPGRR.VPOCHA(NLCED, 1)*DXD +
  733. & MPGRR.VPOCHA(NLCED, 2)*DYD
  734. ROD = VALCEL + ALCEL * DCEL
  735. C
  736. VALCEL = MPPP.VPOCHA(NLCED, 1)
  737. ALCEL = MELALP.VPOCHA(NLCED, 1)
  738. DCEL = MPGRP.VPOCHA(NLCED, 1)*DXD +
  739. & MPGRP.VPOCHA(NLCED, 2)*DYD
  740. PD = VALCEL + ALCEL * DCEL
  741. C
  742. GAMD = MPGAMC.VPOCHA(NLCED, 1)
  743. C
  744. VALCEL = MPVITP.VPOCHA(NLCED, 1)
  745. ALCEL = MELALV.VPOCHA(NLCED, 1)
  746. DCEL = MPGRV.VPOCHA(NLCED, 1)*DXD +
  747. & MPGRV.VPOCHA(NLCED, 2)*DYD
  748. UXD = VALCEL + ALCEL * DCEL
  749. C
  750. VALCEL = MPVITP.VPOCHA(NLCED, 2)
  751. ALCEL = MELALV.VPOCHA(NLCED, 2)
  752. DCEL = MPGRV.VPOCHA(NLCED, 3)*DXD +
  753. & MPGRV.VPOCHA(NLCED, 4)*DYD
  754. UYD = VALCEL + ALCEL * DCEL
  755. C
  756. UND = UXD * CNX + UYD * CNY
  757. UTD = UXD * CTX + UYD * CTY
  758. C
  759. C********** Positivite
  760. C
  761. LOGI1 = (PD .LT. 0.0D0) .OR. (ROD .LT. 0.0D0)
  762. C
  763. IF(LOGI1)THEN
  764. C
  765. C************* Premier ordre en espace local
  766. C
  767. ROD = MPROC.VPOCHA(NLCED,1)
  768. PD = MPPC.VPOCHA(NLCED,1)
  769. UND = MPVITC.VPOCHA(NLCED,1)*CNX +
  770. & MPVITC.VPOCHA(NLCED,2)*CNY
  771. UTD = MPVITC.VPOCHA(NLCED,1)*CTX +
  772. & MPVITC.VPOCHA(NLCED,2)*CTY
  773. ENDIF
  774. ENDIF
  775. C
  776. C******** Les MELVALs
  777. C
  778. MELRO.VELCHE(1,NLCF) = ROG
  779. MELRO.VELCHE(3,NLCF) = ROD
  780. MELP.VELCHE(1,NLCF) = PG
  781. MELP.VELCHE(3,NLCF) = PD
  782. MELGAM.VELCHE(1,NLCF) = GAMG
  783. MELGAM.VELCHE(3,NLCF) = GAMD
  784. MELVUN.VELCHE(1,NLCF) = UNG
  785. MELVUN.VELCHE(3,NLCF) = UND
  786. MELVUT.VELCHE(1,NLCF) = UTG
  787. MELVUT.VELCHE(3,NLCF) = UTD
  788. MELVNX.VELCHE(1,NLCF) = CNX
  789. MELVNY.VELCHE(1,NLCF) = CNY
  790. MELT1X.VELCHE(1,NLCF) = CTX
  791. MELT1Y.VELCHE(1,NLCF) = CTY
  792. C
  793. ENDDO
  794. C
  795. C**** Desactivation des SEGMENTs
  796. C
  797. SEGDES IPT1
  798. SEGDES IPT2
  799. C
  800. C**** Le MPOVALs 'Prediction' sont detruits (si existentes)
  801. C
  802. IF(LOGTEM)THEN
  803. SEGSUP MPROP
  804. SEGSUP MPVITP
  805. SEGSUP MPPP
  806. ENDIF
  807. C
  808. SEGDES MPROC
  809. SEGDES MPGRR
  810. SEGDES MELALR
  811. SEGDES MPVITC
  812. SEGDES MPGRV
  813. SEGDES MELALV
  814. SEGDES MPPC
  815. SEGDES MPGRP
  816. SEGDES MELALP
  817. SEGDES MPGAMC
  818. SEGDES MPNORM
  819. C
  820. SEGDES MELRO
  821. SEGDES MELP
  822. SEGDES MELGAM
  823. SEGDES MELVUN
  824. SEGDES MELVUT
  825. SEGDES MELVNX
  826. SEGDES MELVNY
  827. SEGDES MELT1X
  828. SEGDES MELT1Y
  829. C
  830. C
  831. C**** Destruction du MELNTI correspondance local/global
  832. C
  833. SEGSUP MLENT1
  834. C
  835. 9999 CONTINUE
  836. C
  837. RETURN
  838. END
  839.  
  840.  
  841.  
  842.  
  843.  
  844.  
  845.  
  846.  
  847.  

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