Télécharger pre711.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE711 SOURCE BECC 11/05/18 21:15:27 6974
  2. SUBROUTINE PRE711(NESP,MLMESP,
  3. & ICEN,IFACE,IFACEL,INORM,
  4. & IPHI, IGRPHI, ILIPHI,
  5. & IRN1, IGRRN1, ILIRN1,
  6. & IVN1, IGRVN1, ILIVN1,
  7. & IPN1, IGRPN1, ILIPN1,
  8. & IYMA, IGRYMA, ILIYMA,
  9. & IALC, IGRALC, ILIALC,
  10. & IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF)
  11. C************************************************************************
  12. C
  13. C PROJET : CASTEM 2000
  14. C
  15. C NOM : PRE711
  16. C
  17. C DESCRIPTION : Voir PRE71
  18. C
  19. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  20. C
  21. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  22. C
  23. C************************************************************************
  24. C
  25. C ENTREES
  26. C
  27. C NESP : number of the species involved in the EULER equations.
  28. C
  29. C MLMESP : MLMOTS object; names of the species involved in the
  30. C EULER equations.
  31. C
  32. C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
  33. C
  34. C ICEN : MELEME de 'POI1' SPG des CENTRES
  35. C
  36. C IFACE : MELEME de 'POI1' SPG des FACES
  37. C
  38. C IFACEL : MELEME de 'SEG3' avec
  39. C CENTRE d'Elt "gauche"
  40. C CENTRE de Face
  41. C CENTRE d'Elt "droite"
  42. C
  43. C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
  44. C
  45. C INORM : CHPOINT des cosinus directeurs de normales aux faces
  46. C
  47. C 2) Autres pointeurs
  48. C
  49. C IPHI, IGRPHI, ILIPHI,
  50. C CHPOINT "CENTRE" de phi, gradient et limiteur
  51. C
  52. C IRN1, IGRRN1, ILIRN1,
  53. C CHPOINT "CENTRE" de densité, gradient et limiteur
  54. C
  55. C IVN1, IGRVN1, ILIVN1,
  56. C CHPOINT "CENTRE" de vitesse, gradient et limiteur
  57. C
  58. C IPN1, IGRPN1, ILIPN1.
  59. C CHPOINT "CENTRE" de pression, gradients et limiteurs
  60. C
  61. C IYMA, IGRYMA, ILIYMA,
  62. C CHPOINT "CENTRE" de Y, gradient et limiteur
  63. C
  64. C IALC, IGRALC, ILIALC,
  65. C CHPOINT "CENTRE" de ALPHA, gradient et limiteur
  66. C
  67. C SORTIES
  68. C
  69. C IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF
  70. C MCHAMLs definis sur le MELEME de pointeur IFACEL
  71. C
  72. C************************************************************************
  73. C
  74. C HISTORIQUE (Anomalies et modifications éventuelles)
  75. C
  76. C HISTORIQUE : Crée le 03.12.10.
  77. C
  78. C************************************************************************
  79. C
  80. C
  81. C ATTENTION: Cet programme marche si le MAILLAGE est convex;
  82. C si non il faut changer l'algoritme de calcul de
  83. C l'orientation des normales aux faces.
  84. C
  85. C La positivité n'est pas controlle parce que c'est déjà fait
  86. C dans l'operateur PRIM
  87. C
  88. C
  89. C************************************************************************
  90. C
  91. IMPLICIT INTEGER(I-N)
  92. C
  93. C**** Les variables
  94. C
  95. INTEGER NESP, I1
  96. & , ICEN, IFACE, IFACEL, INORM
  97. & , IPHI, IGRPHI, ILIPHI
  98. & , IRN1, IGRRN1, ILIRN1
  99. & , IVN1, IGRVN1, ILIVN1
  100. & , IPN1, IGRPN1, ILIPN1
  101. & , IYMA, IGRYMA, ILIYMA
  102. & , IALC, IGRALC, ILIALC
  103. & , IPHIF, IRN1F
  104. & , IVN1F, IPN1F
  105. & , IYF, IALF
  106. & , IGEOM, NFAC
  107. & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
  108. & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
  109. & , IDIMP1, INDCEL
  110.  
  111. REAL*8 XG, YG, XC, YC, XD, YD
  112. & ,DXG, DYG, DXD, DYD
  113. & , CNX, CNY, CTX, CTY, ORIENT
  114. & , PHIG, RN1G, PN1G
  115. & , UX1G, UY1G
  116. & , UN1G, UT1G
  117. & , PHID, RN1D, PN1D
  118. & , UX1D, UY1D
  119. & , UN1D, UT1D
  120. & , VALCEL, DCEL, LIMCEL
  121. CHARACTER*(40) MESERR
  122. CHARACTER*(8) TYPE
  123. CHARACTER*(4) CARCEL
  124. LOGICAL LOGI1
  125. C
  126. C**** Segments des fractions massiques gauche et droit
  127. C
  128. INTEGER NS
  129. SEGMENT FRAMAS
  130. REAL*8 FRAMG(NS), FRAMD(NS)
  131. ENDSEGMENT
  132. POINTEUR ALPHA.FRAMAS
  133. C
  134. C**** Les Includes
  135. C
  136. -INC SMCOORD
  137. -INC CCOPTIO
  138. -INC SMCHPOI
  139. POINTEUR MPPHI.MPOVAL, MPGPHI.MPOVAL, MPLPHI.MPOVAL
  140. POINTEUR MPRN1.MPOVAL, MPGRN1.MPOVAL, MPLRN1.MPOVAL
  141. POINTEUR MPVN1.MPOVAL, MPGVN1.MPOVAL, MPLVN1.MPOVAL
  142. POINTEUR MPPN1.MPOVAL, MPGPN1.MPOVAL, MPLPN1.MPOVAL
  143. POINTEUR MPYMA.MPOVAL, MPGYMA.MPOVAL, MPLYMA.MPOVAL
  144. POINTEUR MPALC.MPOVAL, MPGALC.MPOVAL, MPLALC.MPOVAL
  145. POINTEUR MPNORM.MPOVAL
  146. -INC SMCHAML
  147. C Melval des cosinus directeurs
  148. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  149. & MELT1X.MELVAL, MELT1Y.MELVAL
  150. C Melval des vitesses
  151. POINTEUR MEVUN1.MELVAL, MEVUT1.MELVAL
  152. C Melval des densités, pressions, alphas
  153. POINTEUR MELRN1.MELVAL
  154. POINTEUR MELPN1.MELVAL
  155. POINTEUR MELPHI.MELVAL
  156. POINTEUR MCHAMY.MCHAML
  157. POINTEUR MCHAMA.MCHAML
  158. -INC SMLENTI
  159. -INC SMELEME
  160. -INC SMLMOTS
  161. POINTEUR MLMESP.MLMOTS
  162. C
  163. LOGI1 = .FALSE.
  164. C
  165. C**** KRIPAD pour la correspondance global/local de centre
  166. C
  167. CALL KRIPAD(ICEN,MLENT1)
  168. C
  169. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  170. C
  171. C Si i est le numero global d'un noeud de ICEN,
  172. C MLENT1.LECT(i) contient sa position, i.e.
  173. C
  174. C I = numero global du noeud centre
  175. C MLENT1.LECT(i) = numero local du noeud centre
  176. C
  177. C MLENT1 déjà activé, i.e.
  178. C
  179. C SEGACT MLENT1
  180. C
  181. C**** Activation de CHPOINTs
  182. C
  183. C phi + grad + limiteur
  184. C densité + grad + limiteur
  185. C vitesse + grad + limiteur
  186. C pression + grad + limiteur
  187. C ymass + grad + limiteur
  188. C alpha + grad + limiteur
  189. C cosinus directeurs des normales aux surface
  190. C
  191. CALL LICHT(IPHI , MPPHI , TYPE, IGEOM)
  192. C SEGACT MPPHI
  193. CALL LICHT(IGRPHI , MPGPHI , TYPE, IGEOM)
  194. C SEGACT MPGPHI
  195. CALL LICHT(ILIPHI , MPLPHI , TYPE, IGEOM)
  196. C SEGACT MPLPHI
  197. CALL LICHT(IRN1 , MPRN1 , TYPE, IGEOM)
  198. C SEGACT MPRN1
  199. CALL LICHT(IGRRN1 , MPGRN1 , TYPE, IGEOM)
  200. C SEGACT MPGRN1
  201. CALL LICHT(ILIRN1 , MPLRN1 , TYPE, IGEOM)
  202. C SEGACT MPLRN1
  203. CALL LICHT(IVN1 , MPVN1 , TYPE, IGEOM)
  204. C SEGACT MPVN1
  205. CALL LICHT(IGRVN1 , MPGVN1 , TYPE, IGEOM)
  206. C SEGACT MPGVN1
  207. CALL LICHT(ILIVN1 , MPLVN1 , TYPE, IGEOM)
  208. C SEGACT MPLVN1
  209. CALL LICHT(IPN1 , MPPN1 , TYPE, IGEOM)
  210. C SEGACT MPPN1
  211. CALL LICHT(IGRPN1 , MPGPN1 , TYPE, IGEOM)
  212. C SEGACT MPGPN1
  213. CALL LICHT(ILIPN1 , MPLPN1 , TYPE, IGEOM)
  214. C SEGACT MPLPN1
  215. IF (NESP .GE. 1)THEN
  216. CALL LICHT(IYMA , MPYMA , TYPE, IGEOM)
  217. C SEGACT MPYMA
  218. CALL LICHT(IGRYMA , MPGYMA , TYPE, IGEOM)
  219. C SEGACT MPGYMA
  220. CALL LICHT(ILIYMA , MPLYMA , TYPE, IGEOM)
  221. C SEGACT MPLYMA
  222. CALL LICHT(IALC , MPALC , TYPE, IGEOM)
  223. C SEGACT MPALC
  224. CALL LICHT(IGRALC , MPGALC , TYPE, IGEOM)
  225. C SEGACT MPGALC
  226. CALL LICHT(ILIALC , MPLALC , TYPE, IGEOM)
  227. C SEGACT MPLALC
  228. ENDIF
  229. C
  230. C**** Le cosinus directeurs
  231. C
  232. CALL LICHT(INORM , MPNORM , TYPE, IGEOM)
  233. C SEGACT MPNORM
  234. C
  235. C**** Les MPOVAL sont déjà activés i.e.:
  236. C
  237. C
  238. C**** Le MELEME FACEL
  239. C
  240. IPT1 = IFACEL
  241. IPT2 = IFACE
  242. SEGACT IPT1
  243. SEGACT IPT2
  244. NFAC = IPT1.NUM(/2)
  245. C
  246. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  247. C
  248. C i.e.:
  249. C
  250. C vitesse + cosinus directors du repere local
  251. C alpha
  252. C densité
  253. C pression
  254. C
  255. C**********************************************************
  256. C**** Cosinus directors du repere local et vitesse ********
  257. C**********************************************************
  258. C
  259. C Les cosinus directeurs
  260. C
  261. N1 = 2
  262. N3 = 6
  263. L1 = 28
  264. SEGINI MCHEL1
  265. IVN1F = MCHEL1
  266. MCHEL1.TITCHE = 'U '
  267. MCHEL1.IMACHE(1) = IFACE
  268. MCHEL1.IMACHE(2) = IFACEL
  269. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  270. MCHEL1.CONCHE(2) = ' U in (n,t) '
  271. * MCHEL1.NOPHAS(1) = ' '
  272. * MCHEL1.NOPHAS(2) = ' '
  273. C
  274. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  275. C
  276. MCHEL1.INFCHE(1,1) = 2
  277. MCHEL1.INFCHE(1,3) = NIFOUR
  278. MCHEL1.INFCHE(1,4) = 0
  279. MCHEL1.INFCHE(1,5) = 0
  280. MCHEL1.INFCHE(1,6) = 0
  281. MCHEL1.IFOCHE = IFOUR
  282. C
  283. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  284. C
  285. MCHEL1.INFCHE(2,1) = 1
  286. MCHEL1.INFCHE(2,3) = NIFOUR
  287. MCHEL1.INFCHE(2,4) = 0
  288. MCHEL1.INFCHE(2,5) = 0
  289. MCHEL1.INFCHE(2,6) = 0
  290. C
  291. C**** Le cosinus directeurs
  292. C
  293. N1PTEL = 1
  294. N1EL = NFAC
  295. N2PTEL = 0
  296. N2EL = 0
  297. C
  298. C**** MCHAML a N2 composantes:
  299. C
  300. C cosinus directeurs du repere local (n,t1)
  301. C
  302. C IDIM = 2 -> 4 composantes
  303. C
  304. N2 = 4
  305. SEGINI MCHAM1
  306. MCHEL1.ICHAML(1) = MCHAM1
  307. MCHAM1.NOMCHE(1) = 'NX '
  308. MCHAM1.NOMCHE(2) = 'NY '
  309. MCHAM1.NOMCHE(3) = 'TX '
  310. MCHAM1.NOMCHE(4) = 'TY '
  311. MCHAM1.TYPCHE(1) = 'REAL*8 '
  312. MCHAM1.TYPCHE(2) = 'REAL*8 '
  313. MCHAM1.TYPCHE(3) = 'REAL*8 '
  314. MCHAM1.TYPCHE(4) = 'REAL*8 '
  315. SEGINI MELVNX
  316. SEGINI MELVNY
  317. SEGINI MELT1X
  318. SEGINI MELT1Y
  319. MCHAM1.IELVAL(1) = MELVNX
  320. MCHAM1.IELVAL(2) = MELVNY
  321. MCHAM1.IELVAL(3) = MELT1X
  322. MCHAM1.IELVAL(4) = MELT1Y
  323. SEGDES MCHAM1
  324. C
  325. C**** Vitesse
  326. C
  327. N1EL = NFAC
  328. N1PTEL = 3
  329. N2EL = 0
  330. N2PTEL = 0
  331. C
  332. C**** MCHAML a N2 composantes:
  333. C
  334. C IDIM = 2 -> 2 composantes
  335. C
  336. N2 = 2
  337. SEGINI MCHAM1
  338. MCHEL1.ICHAML(2) = MCHAM1
  339. MCHAM1.NOMCHE(1) = 'UN '
  340. MCHAM1.NOMCHE(2) = 'UT '
  341. MCHAM1.TYPCHE(1) = 'REAL*8 '
  342. MCHAM1.TYPCHE(2) = 'REAL*8 '
  343. SEGINI MEVUN1
  344. SEGINI MEVUT1
  345. MCHAM1.IELVAL(1) = MEVUN1
  346. MCHAM1.IELVAL(2) = MEVUT1
  347. SEGDES MCHAM1
  348. C
  349. C**********************************************************
  350. C**** PHI1 ********
  351. C**********************************************************
  352. C
  353. C**** PHI1
  354. C
  355. N1 = 1
  356. N3 = 6
  357. L1 = 15
  358. SEGINI MCHEL2
  359. IPHIF = MCHEL2
  360. MCHEL2.IMACHE(1) = IFACEL
  361. MCHEL2.TITCHE = 'PHI '
  362. MCHEL2.CONCHE(1) = ' '
  363. * MCHEL2.NOPHAS(1) = ' '
  364. C
  365. C**** Valeurs independente du repére, i.e.
  366. C
  367. MCHEL2.INFCHE(1,1) = 0
  368. MCHEL2.INFCHE(1,3) = NIFOUR
  369. MCHEL2.INFCHE(1,4) = 0
  370. MCHEL2.INFCHE(1,5) = 0
  371. MCHEL2.INFCHE(1,6) = 0
  372. MCHEL2.IFOCHE = IFOUR
  373. N2 = 1
  374. SEGINI MCHAM1
  375. MCHEL2.ICHAML(1) = MCHAM1
  376. C We cannot deseactivate MCHEL2 = IPHIF now since we
  377. C use it after...
  378. MCHAM1.NOMCHE(1) = 'SCAL '
  379. MCHAM1.TYPCHE(1) = 'REAL*8 '
  380. SEGINI MELPHI
  381. MCHAM1.IELVAL(1) = MELPHI
  382. SEGDES MCHAM1
  383. C
  384. C**********************************************************
  385. C**** IRN1F and IRN2F ********
  386. C**********************************************************
  387. C
  388. MCHEL1 = IPHIF
  389. SEGINI, MCHEL2 = MCHEL1
  390. IRN1F = MCHEL2
  391. MCHEL2.TITCHE = 'RHO1 '
  392. MCHAM1 = MCHEL1.ICHAML(1)
  393. SEGINI, MCHAM2 = MCHAM1
  394. MCHEL2.ICHAML(1) = MCHAM2
  395. SEGDES MCHEL2
  396. SEGINI MELRN1
  397. MCHAM2.IELVAL(1) = MELRN1
  398. SEGDES MCHAM2
  399. C
  400. C
  401. C
  402. C**********************************************************
  403. C**** IPN1F
  404. C**********************************************************
  405. C
  406. MCHEL1 = IPHIF
  407. SEGINI, MCHEL2 = MCHEL1
  408. IPN1F = MCHEL2
  409. MCHEL2.TITCHE = 'P1 '
  410. MCHAM1 = MCHEL1.ICHAML(1)
  411. SEGINI, MCHAM2 = MCHAM1
  412. MCHEL2.ICHAML(1) = MCHAM2
  413. SEGDES MCHEL2
  414. SEGDES MCHEL1
  415. C We desactivate MCHEL1 = IPHIF now !
  416. SEGINI MELPN1
  417. MCHAM2.IELVAL(1) = MELPN1
  418. SEGDES MCHAM2
  419. C
  420. C write(*,*) 'Qui ci arrivo 1...'
  421. IF (NESP .GE. 1) THEN
  422. C
  423. SEGACT MLMESP
  424. C
  425. C******* YF
  426. C
  427. NS = NESP
  428. SEGINI FRAMAS
  429. MCHEL1 = IRN1F
  430. SEGINI, MCHEL2 = MCHEL1
  431. IYF = MCHEL2
  432. MCHEL2.TITCHE = 'Y '
  433. N2 = NESP
  434. SEGINI MCHAMY
  435. MCHEL2.ICHAML(1) = MCHAMY
  436. SEGDES MCHEL2
  437. N1EL = NFAC
  438. N1PTEL = 3
  439. N2EL = 0
  440. N2PTEL = 0
  441. DO I1 = 1, NESP
  442. SEGINI MELVA1
  443. MCHAMY.IELVAL(I1) = MELVA1
  444. C AB Error. It is corrected by the following line
  445. CARCEL = MLMESP.MOTS(I1)
  446. TYPE = ' '
  447. TYPE(1:4) = CARCEL(1:4)
  448. MCHAMY.NOMCHE(I1) = TYPE
  449. MCHAMY.TYPCHE(I1) = 'REAL*8 '
  450. ENDDO
  451. C
  452. C******* IALF
  453. C
  454. NS = NESP
  455. SEGINI ALPHA
  456. MCHEL1 = IRN1F
  457. SEGINI, MCHEL2 = MCHEL1
  458. IALF = MCHEL2
  459. MCHEL2.TITCHE = 'ALPHA '
  460. N2 = NESP
  461. SEGINI MCHAMA
  462. MCHEL2.ICHAML(1) = MCHAMA
  463. SEGDES MCHEL2
  464. N1EL = NFAC
  465. N1PTEL = 3
  466. N2EL = 0
  467. N2PTEL = 0
  468. DO I1 = 1, NESP
  469. SEGINI MELVA1
  470. MCHAMA.IELVAL(I1) = MELVA1
  471. C AB Error. It is corrected by the following line
  472. CARCEL = MLMESP.MOTS(I1)
  473. TYPE = ' '
  474. TYPE(1:4) = CARCEL(1:4)
  475. MCHAMA.NOMCHE(I1) = TYPE
  476. MCHAMA.TYPCHE(I1) = 'REAL*8 '
  477. ENDDO
  478. C
  479. SEGDES MLMESP
  480. ENDIF
  481. C
  482. C write(*,*) 'Qui ci arrivo 2...'
  483. C
  484. C
  485. C**********************************************************
  486. C**** Boucle sur le faces *********
  487. C**********************************************************
  488. C
  489. IDIMP1 = IDIM + 1
  490. DO NLCF = 1, NFAC
  491. C
  492. C******* NLCF = numero local du centre de face
  493. C NGCF = numero global du centre de face
  494. C NGCEG = numero global du centre ELT "gauche"
  495. C NLCEG = numero local du centre ELT "gauche"
  496. C NGCED = numero global du centre ELT "droite"
  497. C NLCED = numero local du centre ELT "droite"
  498. C
  499. NGCEG = IPT1.NUM(1,NLCF)
  500. NGCF = IPT1.NUM(2,NLCF)
  501. NGCED = IPT1.NUM(3,NLCF)
  502. NLCEG = MLENT1.LECT(NGCEG)
  503. NLCED = MLENT1.LECT(NGCED)
  504. C
  505. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  506. C
  507. NGCF1 = IPT2.NUM(1,NLCF)
  508. IF( NGCF1 .NE. NGCF) THEN
  509. MESERR(1:40) = 'PRET, subroutine pre611.eso '
  510. WRITE(IOIMP,*) MESERR
  511. CALL ERREUR(5)
  512. GOTO 9999
  513. ENDIF
  514. C
  515. C******* Cosinus directeurs des NORMALES aux faces
  516. C
  517. C On impose que les normales sont direct "Gauche" -> "Centre"
  518. C
  519. INDCEL = (NGCEG-1)*IDIMP1
  520. XG = XCOOR(INDCEL+1)
  521. YG = XCOOR(INDCEL+2)
  522. INDCEL = (NGCF-1)*IDIMP1
  523. XC = XCOOR(INDCEL + 1)
  524. YC = XCOOR(INDCEL + 2)
  525. INDCEL = (NGCED-1)*IDIMP1
  526. XD = XCOOR(INDCEL+1)
  527. YD = XCOOR(INDCEL+2)
  528. DXG = XC - XG
  529. DYG = YC - YG
  530. DXD = XC - XD
  531. DYD = YC - YD
  532. C
  533. C******* On calcule le sign du pruduit scalare
  534. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  535. C
  536. CNX = MPNORM.VPOCHA(NLCF,1)
  537. CNY = MPNORM.VPOCHA(NLCF,2)
  538. ORIENT = CNX * DXG + CNY * DYG
  539. ORIENT = SIGN(1.0D0,ORIENT)
  540. IF(ORIENT .NE. 1.0D0)THEN
  541. MESERR(1:30)=
  542. & 'PRET , subroutine pre611.eso. '
  543. GOTO 9999
  544. ENDIF
  545. CNX = CNX * ORIENT
  546. CNY = CNY * ORIENT
  547. C
  548. C******* Cosinus directeurs de tangent 2D
  549. C
  550. CTX = -1.0D0 * CNY
  551. CTY = CNX
  552. C
  553. C******* Les autres MELVALs
  554. C
  555. C
  556. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0...
  557. C
  558. C
  559. C******* Etat gauche
  560. C
  561. C PHI
  562. C
  563. VALCEL = MPPHI.VPOCHA(NLCEG, 1)
  564. LIMCEL = MPLPHI.VPOCHA(NLCEG, 1)
  565. DCEL = (MPGPHI.VPOCHA(NLCEG, 1) * DXG) +
  566. & (MPGPHI.VPOCHA(NLCEG, 2) * DYG)
  567. PHIG = VALCEL + (LIMCEL * DCEL)
  568. C write(*,*) valcel, limcel, dcel
  569. C
  570. C
  571. C RN
  572. C
  573. VALCEL = MPRN1.VPOCHA(NLCEG, 1)
  574. LIMCEL = MPLRN1.VPOCHA(NLCEG, 1)
  575. DCEL = (MPGRN1.VPOCHA(NLCEG, 1) * DXG) +
  576. & (MPGRN1.VPOCHA(NLCEG, 2) * DYG)
  577. RN1G = VALCEL + (LIMCEL * DCEL)
  578. C
  579. C
  580. C PN
  581. C
  582. VALCEL = MPPN1.VPOCHA(NLCEG, 1)
  583. LIMCEL = MPLPN1.VPOCHA(NLCEG, 1)
  584. DCEL = (MPGPN1.VPOCHA(NLCEG, 1) * DXG) +
  585. & (MPGPN1.VPOCHA(NLCEG, 2) * DYG)
  586. PN1G = VALCEL + (LIMCEL * DCEL)
  587. C
  588. C VN
  589. C
  590. VALCEL = MPVN1.VPOCHA(NLCEG, 1)
  591. LIMCEL = MPLVN1.VPOCHA(NLCEG, 1)
  592. DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG +
  593. & MPGVN1.VPOCHA(NLCEG, 2)*DYG
  594. UX1G = VALCEL + (LIMCEL * DCEL)
  595. C
  596. VALCEL = MPVN1.VPOCHA(NLCEG, 2)
  597. LIMCEL = MPLVN1.VPOCHA(NLCEG, 2)
  598. DCEL = MPGVN1.VPOCHA(NLCEG, 3)*DXG +
  599. & MPGVN1.VPOCHA(NLCEG, 4)*DYG
  600. UY1G = VALCEL + (LIMCEL * DCEL)
  601. C
  602. C YN
  603. C
  604. DO I1 = 1, NESP
  605. INDCEL = 2 * I1 - 1
  606. VALCEL = MPYMA.VPOCHA(NLCEG,I1)
  607. DCEL = MPGYMA.VPOCHA(NLCEG, INDCEL)*DXG +
  608. & MPGYMA.VPOCHA(NLCEG,INDCEL + 1 )*DYG
  609. LIMCEL = MPLYMA.VPOCHA(NLCEG,I1)
  610. FRAMAS.FRAMG(I1) = VALCEL + (LIMCEL * DCEL)
  611. ENDDO
  612. C
  613. C ALPHAN
  614. C
  615. DO I1 = 1, NESP
  616. INDCEL = 2 * I1 - 1
  617. VALCEL = MPALC.VPOCHA(NLCEG,I1)
  618. DCEL = MPGALC.VPOCHA(NLCEG, INDCEL)*DXG +
  619. & MPGALC.VPOCHA(NLCEG,INDCEL + 1 )*DYG
  620. LIMCEL = MPLALC.VPOCHA(NLCEG,I1)
  621. ALPHA.FRAMG(I1) = VALCEL + (LIMCEL * DCEL)
  622. ENDDO
  623. C
  624. C
  625. C******* Si l'on fait pas de prediction, ce n'est pas necessaire de
  626. C controller la positivite' de la pression et de la densité; elle
  627. C est déjà garantie par la proprieté LED de limiteur.
  628. C If we want to check it, just uncomment LOGI1.
  629. C
  630. C LOGI1 = (RN1G .LT. 0.0D0) .OR.
  631. C & (PN1G .LT. 0.0D0)
  632. C
  633. IF ( NGCEG .EQ. NGCED) THEN
  634. C
  635. C********** Cas mur
  636. C
  637. IF(LOGI1)THEN
  638. C
  639. C********** Premier ordre en espace local
  640. C
  641. PHIG = MPPHI.VPOCHA(NLCEG,1)
  642. RN1G = MPRN1.VPOCHA(NLCEG,1)
  643. PN1G = MPPN1.VPOCHA(NLCEG,1)
  644. UX1G = MPVN1.VPOCHA(NLCEG,1)
  645. UY1G = MPVN1.VPOCHA(NLCEG,2)
  646. DO I1 = 1, NESP
  647. FRAMAS.FRAMG(I1) = MPYMA.VPOCHA(NLCEG,I1)
  648. ENDDO
  649. DO I1 = 1, NESP
  650. ALPHA.FRAMG(I1) = MPALC.VPOCHA(NLCEG,I1)
  651. ENDDO
  652. ENDIF
  653. C
  654. UN1G = UX1G * CNX + UY1G * CNY
  655. UT1G = UX1G * CTX + UY1G * CTY
  656. C
  657. C********** Son etat droite
  658. C
  659. PHID = PHIG
  660. RN1D = RN1G
  661. PN1D = PN1G
  662. UN1D = -1.0D0 * UN1G
  663. UT1D = UT1G
  664. DO I1 = 1, NESP
  665. FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1)
  666. ENDDO
  667. DO I1 = 1, NESP
  668. ALPHA.FRAMD(I1) = ALPHA.FRAMG(I1)
  669. ENDDO
  670. C
  671. C********** Fin cas mur
  672. C
  673. ELSE
  674. VALCEL = MPPHI.VPOCHA(NLCED, 1)
  675. LIMCEL = MPLPHI.VPOCHA(NLCED, 1)
  676. DCEL = (MPGPHI.VPOCHA(NLCED, 1) * DXD) +
  677. & (MPGPHI.VPOCHA(NLCED, 2) * DYD)
  678. PHID = VALCEL + (LIMCEL * DCEL)
  679. C
  680. C RN
  681. C
  682. VALCEL = MPRN1.VPOCHA(NLCED, 1)
  683. LIMCEL = MPLRN1.VPOCHA(NLCED, 1)
  684. DCEL = (MPGRN1.VPOCHA(NLCED, 1) * DXD) +
  685. & (MPGRN1.VPOCHA(NLCED, 2) * DYD)
  686. RN1D = VALCEL + (LIMCEL * DCEL)
  687. C
  688. C PN
  689. C
  690. VALCEL = MPPN1.VPOCHA(NLCED, 1)
  691. LIMCEL = MPLPN1.VPOCHA(NLCED, 1)
  692. DCEL = (MPGPN1.VPOCHA(NLCED, 1) * DXD) +
  693. & (MPGPN1.VPOCHA(NLCED, 2) * DYD)
  694. PN1D = VALCEL + (LIMCEL * DCEL)
  695. C
  696. C VN
  697. C
  698. VALCEL = MPVN1.VPOCHA(NLCED, 1)
  699. LIMCEL = MPLVN1.VPOCHA(NLCED, 1)
  700. DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD +
  701. & MPGVN1.VPOCHA(NLCED, 2)*DYD
  702. UX1D = VALCEL + LIMCEL * DCEL
  703. C
  704. VALCEL = MPVN1.VPOCHA(NLCED, 2)
  705. LIMCEL = MPLVN1.VPOCHA(NLCED, 2)
  706. DCEL = MPGVN1.VPOCHA(NLCED, 3)*DXD +
  707. & MPGVN1.VPOCHA(NLCED, 4)*DYD
  708. UY1D = VALCEL + LIMCEL * DCEL
  709. C
  710. C YN
  711. C
  712. DO I1 = 1, NESP
  713. INDCEL = 2 * I1 - 1
  714. VALCEL = MPYMA.VPOCHA(NLCED,I1)
  715. DCEL = MPGYMA.VPOCHA(NLCED, INDCEL)*DXD +
  716. & MPGYMA.VPOCHA(NLCED,INDCEL + 1 )*DYD
  717. LIMCEL = MPLYMA.VPOCHA(NLCED,I1)
  718. FRAMAS.FRAMD(I1) = VALCEL + (LIMCEL * DCEL)
  719. ENDDO
  720. C
  721. C ALPHAN
  722. C
  723. DO I1 = 1, NESP
  724. INDCEL = 2 * I1 - 1
  725. VALCEL = MPALC.VPOCHA(NLCED,I1)
  726. DCEL = MPGALC.VPOCHA(NLCED, INDCEL)*DXD +
  727. & MPGALC.VPOCHA(NLCED,INDCEL + 1 )*DYD
  728. LIMCEL = MPLALC.VPOCHA(NLCED,I1)
  729. ALPHA.FRAMD(I1) = VALCEL + (LIMCEL * DCEL)
  730. ENDDO
  731.  
  732. C
  733. C
  734. C********** Si l'on fait pas de prediction, ce n'est pas necessaire de
  735. C controller la positivite' de la pression et de la densité; elle
  736. C est déjà garantie par la proprieté LED de limiteur.
  737. C If we want to check it, just uncomment LOGI1.
  738. C
  739. C LOGI1 = LOGI1 .OR. (RN1D .LT. 0.0D0)
  740. C $ .OR.(PN1D .LT. 0.0D0)
  741. C
  742. IF(LOGI1)THEN
  743. C
  744. C************* Premier ordre en espace local
  745. C
  746. PHIG = MPPHI.VPOCHA(NLCEG,1)
  747. RN1G = MPRN1.VPOCHA(NLCEG,1)
  748. PN1G = MPPN1.VPOCHA(NLCEG,1)
  749. UX1G = MPVN1.VPOCHA(NLCEG,1)
  750. UY1G = MPVN1.VPOCHA(NLCEG,2)
  751. DO I1 = 1, NESP
  752. FRAMAS.FRAMG(I1) = MPYMA.VPOCHA(NLCEG,I1)
  753. ENDDO
  754. DO I1 = 1, NESP
  755. ALPHA.FRAMG(I1) = MPALC.VPOCHA(NLCEG,I1)
  756. ENDDO
  757. C
  758. PHID = MPPHI.VPOCHA(NLCED,1)
  759. RN1D = MPRN1.VPOCHA(NLCED,1)
  760. PN1D = MPPN1.VPOCHA(NLCED,1)
  761. UX1D = MPVN1.VPOCHA(NLCED,1)
  762. UY1D = MPVN1.VPOCHA(NLCED,2)
  763. DO I1 = 1, NESP
  764. FRAMAS.FRAMD(I1) = MPYMA.VPOCHA(NLCED,I1)
  765. ENDDO
  766. DO I1 = 1, NESP
  767. ALPHA.FRAMD(I1) = MPALC.VPOCHA(NLCED,I1)
  768. ENDDO
  769. ENDIF
  770. C
  771. UN1G = UX1G * CNX + UY1G * CNY
  772. UT1G = UX1G * CTX + UY1G * CTY
  773. C
  774. UN1D = UX1D * CNX + UY1D * CNY
  775. UT1D = UX1D * CTX + UY1D * CTY
  776. C
  777. ENDIF
  778. C
  779. C
  780. C******** Les MELVALs
  781. C
  782. MELPHI.VELCHE(1,NLCF) = PHIG
  783. MELPHI.VELCHE(3,NLCF) = PHID
  784. C
  785. MELRN1.VELCHE(1,NLCF) = RN1G
  786. MELRN1.VELCHE(3,NLCF) = RN1D
  787. C
  788. MELPN1.VELCHE(1,NLCF) = PN1G
  789. MELPN1.VELCHE(3,NLCF) = PN1D
  790. C
  791. MEVUN1.VELCHE(1,NLCF) = UN1G
  792. MEVUN1.VELCHE(3,NLCF) = UN1D
  793. MEVUT1.VELCHE(1,NLCF) = UT1G
  794. MEVUT1.VELCHE(3,NLCF) = UT1D
  795. MELVNX.VELCHE(1,NLCF) = CNX
  796. MELVNY.VELCHE(1,NLCF) = CNY
  797. MELT1X.VELCHE(1,NLCF) = CTX
  798. MELT1Y.VELCHE(1,NLCF) = CTY
  799. C
  800. DO I1 = 1, NESP
  801. MELVA1 = MCHAMY.IELVAL(I1)
  802. MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1)
  803. MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1)
  804. ENDDO
  805. C
  806. DO I1 = 1, NESP
  807. MELVA1 = MCHAMA.IELVAL(I1)
  808. MELVA1.VELCHE(1,NLCF) = ALPHA.FRAMG(I1)
  809. MELVA1.VELCHE(3,NLCF) = ALPHA.FRAMD(I1)
  810. ENDDO
  811. C
  812. ENDDO
  813. C
  814. C**** Desactivation des SEGMENTs
  815. C
  816. SEGDES IPT1
  817. SEGDES IPT2
  818. C
  819. C MPOVALs
  820. C
  821. SEGDES MPNORM
  822. C
  823. SEGDES MPPHI
  824. SEGDES MPGPHI
  825. SEGDES MPLPHI
  826. C
  827. SEGDES MPRN1
  828. SEGDES MPGRN1
  829. SEGDES MPLRN1
  830. C
  831. SEGDES MPPN1
  832. SEGDES MPGPN1
  833. SEGDES MPLPN1
  834. C
  835. SEGDES MPVN1
  836. SEGDES MPGVN1
  837. SEGDES MPLVN1
  838. C
  839. C MELVALs
  840. C
  841. SEGDES MELVNX
  842. SEGDES MELVNY
  843. SEGDES MELT1X
  844. SEGDES MELT1Y
  845. SEGDES MEVUN1
  846. SEGDES MEVUT1
  847. C
  848. SEGDES MELPHI
  849. C
  850. SEGDES MELRN1
  851. C
  852. SEGDES MELPN1
  853. C
  854. IF (NESP .GE. 1)THEN
  855. SEGDES MPYMA
  856. SEGDES MPGYMA
  857. SEGDES MPLYMA
  858. SEGDES MPALC
  859. SEGDES MPGALC
  860. SEGDES MPLALC
  861. DO I1 = 1, NESP
  862. MELVA1 = MCHAMY.IELVAL(I1)
  863. SEGDES MELVA1
  864. MELVA1 = MCHAMA.IELVAL(I1)
  865. SEGDES MELVA1
  866. ENDDO
  867. SEGDES MCHAMA
  868. SEGDES MCHAMY
  869. SEGSUP FRAMAS
  870. SEGSUP ALPHA
  871. ENDIF
  872. C
  873. C**** Destruction du MELNTI correspondance local/global
  874. C
  875. SEGSUP MLENT1
  876. C
  877. 9999 CONTINUE
  878. C
  879. RETURN
  880. END
  881.  
  882.  
  883.  
  884.  
  885.  
  886.  
  887.  
  888.  
  889.  
  890.  
  891.  
  892.  
  893.  
  894.  

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