Télécharger pre22f.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE22F SOURCE KK2000 14/04/10 21:15:29 8032
  2. SUBROUTINE PRE22F(ICEN,IFACE,IFACEL,INORM,
  3. & IALP, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
  4. & IALPF, IUVF, IULF, IPF, ITVF, ITLF,
  5. & IRVF, IRLF,
  6. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  7. C************************************************************************
  8. C
  9. C PROJET : CASTEM 2000
  10. C
  11. C NOM : PRE22F
  12. C
  13. C DESCRIPTION : Voir PRE12F
  14. C
  15. C Two Dimensions
  16. C
  17. C Two Fluid Flow, 1st order in time and space
  18. C
  19. C Creations des objets MCHAML IALPF, IUVF, IULF,
  20. C IPF, ITVF, ITLF, IRVF, IRLF
  21. C
  22. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  23. C
  24. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  25. C Modified for two-fluid flow by
  26. C Jose R. Garcia-Cascales
  27. C
  28. C************************************************************************
  29. C
  30. C APPELES (Outils) : KRIPAD, LICHT
  31. C
  32. C APPELES (Calcul) : AUCUN
  33. C
  34. C************************************************************************
  35. C
  36. C ENTREES
  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 IALP : CHPOINT "CENTRE" containing void fraction
  56. C
  57. C IUVC : CHPOINT "CENTRE" containing UVX & UVY
  58. C
  59. C IULC : CHPOINT "CENTRE" containing ULX & ULY
  60. C
  61. C IPC : CHPOINT "CENTRE" containing P
  62. C
  63. C ITV : CHPOINT "CENTRE" containing TV
  64. C
  65. C ITL : CHPOINT "CENTRE" containing TL
  66. C
  67. C IRVC : CHPOINT "CENTRE" containing RV
  68. C
  69. C IRLC : CHPOINT "CENTRE" containing RL
  70. C
  71. C SORTIES
  72. C
  73. C IALPF : MCHAML defined en la MELEME of pointers
  74. C IFACEL, it contains the void fraction
  75. C (a gauche et a droite de chaque face).
  76. C Only one component ('SCAL')
  77. C
  78. C IUVF : MCHAML "FACEL" vapour velocity and the
  79. C director cosines (n,t) in the corresponding face;
  80. C in the 2D case 6 composantes:
  81. C 'UVN' = normal velocity,
  82. C 'UVT' = tangent velocity,
  83. C 'UVV' = tangent velocity,
  84. C these two velocities are defined in a local
  85. C reference framework defined over the MELEME
  86. C of pointers IFACE
  87. C 'NX' = n.x
  88. C 'NY' = n.y
  89. C 'TX' = t.x
  90. C 'TY' = t.y
  91. C
  92. C IULF : MCHAML "FACEL" liquid velocity
  93. C in the 2D case 2 composantes:
  94. C 'ULN' = normal velocity,
  95. C 'ULT' = tangent velocity,
  96. C
  97. C IPF : MCHAML "FACEL" pressure
  98. C Only one component ('SCAL')
  99. C
  100. C ITVF : MCHAML "FACEL" vapour temperature
  101. C Only one component ('SCAL')
  102. C
  103. C ITVL : MCHAML "FACEL" liquid temperature
  104. C Only one component ('SCAL')
  105. C
  106. C IRVF : MCHAML "FACEL" vapour density
  107. C Only one component ('SCAL')
  108. C
  109. C IRLF : MCHAML "FACEL" liquid temperature
  110. C Only one component ('SCAL')
  111. C
  112. C LOGAN : anomalie detectee (changement de la convention dans
  113. C la table domaine)
  114. C
  115. C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité
  116. C negative a été detectée -> en interactif le
  117. C programme s'arrete en GIBIANE
  118. C (erreur stocké en MESERR et VALER)
  119. C
  120. C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte
  121. C dehor 1 et 3 (sa valeur stockée en MESERR et VALER;
  122. C en VAL1 et en VAL2 on stocke 1.0 et 3.0)
  123. C
  124. C MESERR
  125. C VALER
  126. C VAL1,
  127. C VAL2 : pour les messages d'erreur
  128. C
  129. C************************************************************************
  130. C
  131. C HISTORIQUE (Anomalies et modifications éventuelles)
  132. C
  133. C HISTORIQUE : Créée le 11.6.98.(Adapted to two phase flow 26th
  134. C February 2002)
  135. C
  136. C************************************************************************
  137. C
  138. C
  139. C ATTENTION: Cet programme marche que si le MAILLAGE est convex;
  140. C si non il faut changer l'argoritme de calcul de
  141. C l'orientation des normales aux faces.
  142. C
  143. C
  144. C************************************************************************
  145. C
  146. IMPLICIT INTEGER(I-N)
  147. IMPLICIT REAL*8(A-H,O-Z)
  148.  
  149. C**** Les variables
  150. C
  151. INTEGER ICEN, IFACE, IFACEL,
  152. & IALP, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, INORM,
  153. & IALPF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF,
  154. & IGEOM, NFAC,
  155. & N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1,
  156. & NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
  157. REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, DXG, DYG,
  158. & CNX, CNY, CTX, CTY, ORIENT,
  159. & AG, UVXG, UVYG, UVNG, UVTG, ULXG, ULYG, ULNG, ULTG,
  160. & PG, TVG, TLG, RVG, RLG,
  161. & AD, UVXD, UVYD, UVND, UVTD, ULXD, ULYD, ULND, ULTD,
  162. & PD, TVD, TLD, RVD, RLD
  163. CHARACTER*(40) MESERR
  164. CHARACTER*(8) TYPE
  165. LOGICAL LOGAN,LOGNEG, LOGBOR
  166. C
  167. C**** Les Includes
  168. C
  169. -INC SMCOORD
  170. -INC CCOPTIO
  171. -INC SMCHPOI
  172. POINTEUR MPALP.MPOVAL, MPUVC.MPOVAL, MPULC.MPOVAL,
  173. & MPPC.MPOVAL, MPTVC.MPOVAL, MPTLC.MPOVAL,
  174. & MPRVC.MPOVAL, MPRLC.MPOVAL, MPNORM.MPOVAL
  175. -INC SMCHAML
  176. POINTEUR MLALP.MELVAL, MLP.MELVAL,
  177. & MLTV.MELVAL, MLTL.MELVAL,
  178. & MLRV.MELVAL, MLRL.MELVAL
  179. POINTEUR MLUVN.MELVAL, MLUVT.MELVAL,
  180. & MLULN.MELVAL, MLULT.MELVAL,
  181. & MLVNX.MELVAL, MLVNY.MELVAL, MLVTX.MELVAL, MLVTY.MELVAL,
  182. & MLLNX.MELVAL, MLLNY.MELVAL, MLLTX.MELVAL, MLLTY.MELVAL
  183. -INC SMLENTI
  184. -INC SMELEME
  185. C
  186. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  187. C
  188. C LOGNEG = .FALSE.
  189. C LOGBOR = .FALSE.
  190. C MESERR = ' '
  191. C MOTERR(1:40) = MESERR(1:40)
  192. C VALER = 0.0D0
  193. C VAL1 = 0.0D0
  194. C VAL2 = 0.0D0
  195. C
  196. C
  197. C**** KRIPAD pour la correspondance global/local de centre
  198. C
  199. CALL KRIPAD(ICEN,MLENT1)
  200. C
  201. C
  202. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  203. C
  204. C Si i est le numero global d'un noeud de ICEN,
  205. C MLENT1.LECT(i) contient sa position, i.e.
  206. C
  207. C I = numero global du noeud centre
  208. C MLENT1.LECT(i) = numero local du noeud centre
  209. C
  210. C MLENT1 déjà activé, i.e.
  211. C
  212. C SEGINI MLENTI1
  213. C
  214. C**** Activation de CHPOINTs
  215. C
  216. C void fraction
  217. C vapour velocities
  218. C liquid velocities
  219. C pressure
  220. C vapour temperature
  221. C liquid temperature
  222. C vapour density
  223. C liquid density
  224. C
  225. C cosinus directeurs des normales aux surface
  226. C
  227. CALL LICHT(IALP, MPALP, TYPE, IGEOM)
  228. CALL LICHT(IUVC, MPUVC, TYPE, IGEOM)
  229. CALL LICHT(IULC, MPULC, TYPE, IGEOM)
  230. CALL LICHT(IPC , MPPC , TYPE, IGEOM)
  231. CALL LICHT(ITVC, MPTVC, TYPE, IGEOM)
  232. CALL LICHT(ITLC, MPTLC, TYPE, IGEOM)
  233. CALL LICHT(IRVC, MPRVC, TYPE, IGEOM)
  234. CALL LICHT(IRLC, MPRLC, TYPE, IGEOM)
  235. CALL LICHT(INORM, MPNORM, TYPE, IGEOM)
  236. C
  237. C SEGACT MPALP
  238. C SEGACT MPUVC
  239. C SEGACT MPULC
  240. C SEGACT MPPC
  241. C SEGACT MPTVC
  242. C SEGACT MPTLC
  243. C SEGACT MPRVC
  244. C SEGACT MPRLC
  245. C SEGACT MPNORM
  246. C
  247. C**** MPOVA1 - MPOVA5 sont déjà activés i.e.:
  248. C
  249. C**** Le MELEME FACEL
  250. C
  251. IPT1 = IFACEL
  252. IPT2 = IFACE
  253. SEGACT IPT1
  254. SEGACT IPT2
  255. NFAC = IPT1.NUM(/2)
  256. C
  257. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  258. C
  259. C i.e.:
  260. C
  261. C vitesse + cosinus directors du repere local
  262. C densité
  263. C pression
  264. C gamma
  265.  
  266. C
  267. C**** Cosinus directors du repere local et vitesse
  268. C
  269. C Les cosinus directeurs
  270. C
  271. C VAPOUR PHASE
  272.  
  273. N1 = 2
  274. N3 = 6
  275. L1 = 28
  276. SEGINI MCHEL1
  277. IUVF = MCHEL1
  278. MCHEL1.TITCHE = 'UV '
  279. MCHEL1.IMACHE(1) = IFACE
  280. MCHEL1.IMACHE(2) = IFACEL
  281. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  282. MCHEL1.CONCHE(2) = ' UV in (n,t) '
  283. C
  284. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  285. C
  286. MCHEL1.INFCHE(1,1) = 2
  287. MCHEL1.INFCHE(1,3) = NIFOUR
  288. MCHEL1.INFCHE(1,4) = 0
  289. MCHEL1.INFCHE(1,5) = 0
  290. MCHEL1.INFCHE(1,6) = 0
  291. MCHEL1.IFOCHE = IFOUR
  292. C
  293. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  294. C
  295. MCHEL1.INFCHE(2,1) = 1
  296. MCHEL1.INFCHE(2,3) = NIFOUR
  297. MCHEL1.INFCHE(2,4) = 0
  298. MCHEL1.INFCHE(2,5) = 0
  299. MCHEL1.INFCHE(2,6) = 0
  300. C
  301. C**** Le cosinus directeurs
  302. C
  303. N1PTEL = 1
  304. N1EL = NFAC
  305. N2PTEL = 0
  306. N2EL = 0
  307. C
  308. C**** MCHAML a N2 composantes:
  309. C
  310. C cosinus directeurs du repere local (n,t1)
  311. C
  312. C IDIM = 2 -> 4 composantes
  313. C
  314. N2 = 4
  315. SEGINI MCHAM1
  316. MCHEL1.ICHAML(1) = MCHAM1
  317. MCHAM1.NOMCHE(1) = 'NVX '
  318. MCHAM1.NOMCHE(2) = 'NVY '
  319. MCHAM1.NOMCHE(3) = 'TVX '
  320. MCHAM1.NOMCHE(4) = 'TVY '
  321. MCHAM1.TYPCHE(1) = 'REAL*8 '
  322. MCHAM1.TYPCHE(2) = 'REAL*8 '
  323. MCHAM1.TYPCHE(3) = 'REAL*8 '
  324. MCHAM1.TYPCHE(4) = 'REAL*8 '
  325. SEGINI MLVNX
  326. SEGINI MLVNY
  327. SEGINI MLVTX
  328. SEGINI MLVTY
  329. MCHAM1.IELVAL(1) = MLVNX
  330. MCHAM1.IELVAL(2) = MLVNY
  331. MCHAM1.IELVAL(3) = MLVTX
  332. MCHAM1.IELVAL(4) = MLVTY
  333. SEGDES MCHAM1
  334. C
  335. C**** Vitesse
  336. C
  337. N1EL = NFAC
  338. N1PTEL = 3
  339. N2EL = 0
  340. N2PTEL = 0
  341. C
  342. C**** MCHAML a N2 composantes:
  343. C
  344. C IDIM = 2 -> 2 composantes
  345. C
  346. N2 = 2
  347. SEGINI MCHAM1
  348. MCHEL1.ICHAML(2) = MCHAM1
  349. SEGDES MCHEL1
  350. MCHAM1.NOMCHE(1) = 'UVN '
  351. MCHAM1.NOMCHE(2) = 'UVT '
  352. MCHAM1.TYPCHE(1) = 'REAL*8 '
  353. MCHAM1.TYPCHE(2) = 'REAL*8 '
  354. SEGINI MLUVN
  355. SEGINI MLUVT
  356. MCHAM1.IELVAL(1) = MLUVN
  357. MCHAM1.IELVAL(2) = MLUVT
  358. SEGDES MCHAM1
  359. C
  360. C**** Cosinus directors du repere local et vitesse
  361. C
  362. C Les cosinus directeurs
  363. C
  364. C LIQUID PHASE
  365.  
  366. N1 = 2
  367. N3 = 6
  368. L1 = 28
  369. SEGINI MCHEL1
  370. IULF = MCHEL1
  371. MCHEL1.TITCHE = 'UL '
  372. MCHEL1.IMACHE(1) = IFACE
  373. MCHEL1.IMACHE(2) = IFACEL
  374. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  375. MCHEL1.CONCHE(2) = ' UL in (n,t) '
  376. C
  377. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  378. C
  379. MCHEL1.INFCHE(1,1) = 2
  380. MCHEL1.INFCHE(1,3) = NIFOUR
  381. MCHEL1.INFCHE(1,4) = 0
  382. MCHEL1.INFCHE(1,5) = 0
  383. MCHEL1.INFCHE(1,6) = 0
  384. MCHEL1.IFOCHE = IFOUR
  385. C
  386. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  387. C
  388. MCHEL1.INFCHE(2,1) = 1
  389. MCHEL1.INFCHE(2,3) = NIFOUR
  390. MCHEL1.INFCHE(2,4) = 0
  391. MCHEL1.INFCHE(2,5) = 0
  392. MCHEL1.INFCHE(2,6) = 0
  393. C
  394. C**** Le cosinus directeurs
  395. C
  396. N1PTEL = 1
  397. N1EL = NFAC
  398. N2PTEL = 0
  399. N2EL = 0
  400. C
  401. C**** MCHAML a N2 composantes:
  402. C
  403. C cosinus directeurs du repere local (n,t1)
  404. C
  405. C IDIM = 2 -> 4 composantes
  406. C
  407. N2 = 4
  408. SEGINI MCHAM1
  409. MCHEL1.ICHAML(1) = MCHAM1
  410. MCHAM1.NOMCHE(1) = 'NLX '
  411. MCHAM1.NOMCHE(2) = 'NLY '
  412. MCHAM1.NOMCHE(3) = 'TLX '
  413. MCHAM1.NOMCHE(4) = 'TLY '
  414. MCHAM1.TYPCHE(1) = 'REAL*8 '
  415. MCHAM1.TYPCHE(2) = 'REAL*8 '
  416. MCHAM1.TYPCHE(3) = 'REAL*8 '
  417. MCHAM1.TYPCHE(4) = 'REAL*8 '
  418. SEGINI MLLNX
  419. SEGINI MLLNY
  420. SEGINI MLLTX
  421. SEGINI MLLTY
  422. MCHAM1.IELVAL(1) = MLLNX
  423. MCHAM1.IELVAL(2) = MLLNY
  424. MCHAM1.IELVAL(3) = MLLTX
  425. MCHAM1.IELVAL(4) = MLLTY
  426. SEGDES MCHAM1
  427. C
  428. C**** Vitesse
  429. C
  430. N1EL = NFAC
  431. N1PTEL = 3
  432. N2EL = 0
  433. N2PTEL = 0
  434. C
  435. C**** MCHAML a N2 composantes:
  436. C
  437. C IDIM = 2 -> 2 composantes
  438. C
  439. N2 = 2
  440. SEGINI MCHAM1
  441. MCHEL1.ICHAML(2) = MCHAM1
  442. SEGDES MCHEL1
  443. MCHAM1.NOMCHE(1) = 'ULN '
  444. MCHAM1.NOMCHE(2) = 'ULT '
  445. MCHAM1.TYPCHE(1) = 'REAL*8 '
  446. MCHAM1.TYPCHE(2) = 'REAL*8 '
  447. SEGINI MLULN
  448. SEGINI MLULT
  449. MCHAM1.IELVAL(1) = MLULN
  450. MCHAM1.IELVAL(2) = MLULT
  451. SEGDES MCHAM1
  452. C
  453. C**** Void fraction
  454. C
  455. N1 = 1
  456. N3 = 6
  457. L1 = 15
  458. SEGINI MCHEL2
  459. IALPF = MCHEL2
  460. MCHEL2.IMACHE(1) = IFACEL
  461. MCHEL2.TITCHE = 'ALPHA '
  462. MCHEL2.CONCHE(1) = ' '
  463. C
  464. C**** Valeurs independente du repére, i.e.
  465. C
  466. MCHEL2.INFCHE(1,1) = 0
  467. MCHEL2.INFCHE(1,3) = NIFOUR
  468. MCHEL2.INFCHE(1,4) = 0
  469. MCHEL2.INFCHE(1,5) = 0
  470. MCHEL2.INFCHE(1,6) = 0
  471. MCHEL2.IFOCHE = IFOUR
  472. N2 = 1
  473. SEGINI MCHAM1
  474. MCHEL2.ICHAML(1) = MCHAM1
  475. SEGDES MCHEL2
  476. MCHAM1.NOMCHE(1) = 'SCAL '
  477. MCHAM1.TYPCHE(1) = 'REAL*8 '
  478. SEGINI MLALP
  479. MCHAM1.IELVAL(1) = MLALP
  480. SEGDES MCHAM1
  481. C
  482. C**** Pressure
  483. C
  484. MCHEL1 = IALPF
  485. SEGINI, MCHEL2 = MCHEL1
  486. IPF = MCHEL2
  487. MCHEL2.TITCHE = 'P '
  488. C
  489. C**** MCHAM1 = MCHAML de la alpha
  490. C
  491. SEGINI, MCHAM2 = MCHAM1
  492. MCHEL2.ICHAML(1) = MCHAM2
  493. SEGDES MCHEL2
  494. SEGINI MLP
  495. MCHAM2.IELVAL(1) = MLP
  496. SEGDES MCHAM2
  497. C
  498. C**** Vapour temperature
  499. C
  500. MCHEL1 = IALPF
  501. SEGINI, MCHEL2 = MCHEL1
  502. ITVF = MCHEL2
  503. MCHEL2.TITCHE = 'TV '
  504. C
  505. C**** MCHAM1 = MCHAML de la alpha
  506. C
  507. SEGINI, MCHAM2 = MCHAM1
  508. MCHEL2.ICHAML(1) = MCHAM2
  509. SEGDES MCHEL2
  510. SEGINI MLTV
  511. MCHAM2.IELVAL(1) = MLTV
  512. SEGDES MCHAM2
  513. C
  514. C**** Liquid temperature
  515. C
  516. MCHEL1 = IALPF
  517. SEGINI, MCHEL2 = MCHEL1
  518. ITLF = MCHEL2
  519. MCHEL2.TITCHE = 'TL '
  520. C
  521. C**** MCHAM1 = MCHAML de la alpha
  522. C
  523. SEGINI, MCHAM2 = MCHAM1
  524. MCHEL2.ICHAML(1) = MCHAM2
  525. SEGDES MCHEL2
  526. SEGINI MLTL
  527. MCHAM2.IELVAL(1) = MLTL
  528. SEGDES MCHAM2
  529. C
  530. C**** Vapour density
  531. C
  532. MCHEL1 = IALPF
  533. SEGINI, MCHEL2 = MCHEL1
  534. IRVF = MCHEL2
  535. MCHEL2.TITCHE = 'RV '
  536. C
  537. C**** MCHAM1 = MCHAML de la alpha
  538. C
  539. SEGINI, MCHAM2 = MCHAM1
  540. MCHEL2.ICHAML(1) = MCHAM2
  541. SEGDES MCHEL2
  542. SEGINI MLRV
  543. MCHAM2.IELVAL(1) = MLRV
  544. SEGDES MCHAM2
  545. C
  546. C**** Liquid density
  547. C
  548. MCHEL1 = IALPF
  549. SEGINI, MCHEL2 = MCHEL1
  550. IRLF = MCHEL2
  551. MCHEL2.TITCHE = 'RL '
  552. C
  553. C**** MCHAM1 = MCHAML de la alpha
  554. C
  555. SEGINI, MCHAM2 = MCHAM1
  556. MCHEL2.ICHAML(1) = MCHAM2
  557. SEGDES MCHEL2
  558. SEGINI MLRL
  559. MCHAM2.IELVAL(1) = MLRL
  560. SEGDES MCHAM2
  561.  
  562. C
  563. C**** Recapitulatif: les MELVALs et les MPOVALs actives
  564. C
  565. C MLVNX, MLVNY,
  566. C MLVTX, MLVTY,
  567. C
  568. C MLLNX, MLLNY,
  569. C MLLTX, MLLTY
  570. C
  571. C MLUVN, MLUVT -> vapour velocities
  572. C
  573. C MLULN, MLULT -> liquid velocities
  574. C
  575. C MLALP -> void fraction
  576. C
  577. C MLP -> pressure
  578. C
  579. C MLTV -> vapour temperature
  580. C
  581. C MLTL -> liquid temperature
  582. C
  583. C MLRV -> vapour density
  584. C
  585. C MLRL -> liquid density
  586. C****
  587. C MPALP -> void fraction
  588. C
  589. C MPUVC -> vapour velocity
  590. C
  591. C MPULC -> liquid velocity
  592. C
  593. C MPPC -> pressure
  594. C
  595. C MPTVC -> vapour temperature
  596. C
  597. C MPTLC -> liquid temperature
  598. C
  599. C MPRVC -> vapour density
  600. C
  601. C MPRLC -> liquid density
  602. C
  603. C MPNORM -> normales aux faces
  604. C
  605. C**** Boucle sur le faces
  606. C
  607. DO NLCF = 1, NFAC
  608. C
  609. C******* NLCF = numero local du centre de face
  610. C NGCF = numero global du centre de face
  611. C NGCEG = numero global du centre ELT "gauche"
  612. C NLCEG = numero local du centre ELT "gauche"
  613. C NGCED = numero global du centre ELT "droite"
  614. C NLCED = numero local du centre ELT "droite"
  615. C
  616. NGCEG = IPT1.NUM(1,NLCF)
  617. NGCF = IPT1.NUM(2,NLCF)
  618. NGCED = IPT1.NUM(3,NLCF)
  619. NLCEG = MLENT1.LECT(NGCEG)
  620. NLCED = MLENT1.LECT(NGCED)
  621. C
  622. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  623. C
  624. NGCF1 = IPT2.NUM(1,NLCF)
  625. IF( NGCF1 .NE. NGCF) THEN
  626. LOGAN = .TRUE.
  627. MESERR(1:40) = 'PRET, subroutine pre111.eso '
  628. GOTO 9999
  629. ENDIF
  630. C
  631. C******* Cosinus directeurs des NORMALES aux faces
  632. C
  633. C On impose que les normales sont direct "Gauche" -> "Centre"
  634. C
  635. XG = XCOOR((NGCEG-1)*(IDIM+1)+1)
  636. YG = XCOOR((NGCEG-1)*(IDIM+1)+2)
  637. XC = XCOOR((NGCF-1)*(IDIM+1)+1)
  638. YC = XCOOR((NGCF-1)*(IDIM+1)+2)
  639. DXG = XC - XG
  640. DYG = YC - YG
  641.  
  642. C
  643. C******* On calcule le sign du pruduit scalare
  644. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  645. C
  646. CNX = MPNORM.VPOCHA(NLCF,1)
  647. CNY = MPNORM.VPOCHA(NLCF,2)
  648. ORIENT = CNX * DXG + CNY * DYG
  649. ORIENT = SIGN(1.0D0,ORIENT)
  650. IF(ORIENT .NE. 1.0D0)THEN
  651. LOGAN = .TRUE.
  652. MESERR(1:30)=
  653. & 'PRET , subroutine pre111.eso. '
  654. GOTO 9999
  655. ENDIF
  656. CNX = CNX * ORIENT
  657. CNY = CNY * ORIENT
  658. C
  659. C********** Cosinus directeurs de tangent 2D
  660. C
  661. CTX = -1.0D0 * CNY
  662. CTY = CNX
  663. C
  664. C
  665. C******* Les autres MELVALs
  666. C
  667. C
  668. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  669. C GAMMA \in (1,3)
  670. C Si non il faut le faire, en utlisant LOGBOR,
  671. C LOGNEG, VALER, VAL1, VAL2
  672. C
  673. C
  674. C
  675. C******* NGCEG = NGCED -> Mur
  676. C
  677.  
  678. IF( NGCEG .EQ. NGCED)THEN
  679. AG = MPALP.VPOCHA(NLCEG, 1)
  680. PG = MPPC.VPOCHA(NLCEG, 1)
  681. TVG = MPTVC.VPOCHA(NLCEG, 1)
  682. TLG = MPTLC.VPOCHA(NLCEG, 1)
  683. RVG = MPRVC.VPOCHA(NLCEG, 1)
  684. RLG = MPRLC.VPOCHA(NLCEG, 1)
  685. UVXG = MPUVC.VPOCHA(NLCEG, 1)
  686. UVYG = MPUVC.VPOCHA(NLCEG, 2)
  687. ULXG = MPULC.VPOCHA(NLCEG, 1)
  688. ULYG = MPULC.VPOCHA(NLCEG, 2)
  689. UVNG = UVXG * CNX + UVYG * CNY
  690. UVTG = UVXG * CTX + UVYG * CTY
  691. ULNG = ULXG * CNX + ULYG * CNY
  692. ULTG = ULXG * CTX + ULYG * CTY
  693. C
  694. C********** Son etat droite
  695. C
  696. AD = AG
  697. PD = PG
  698. TVD = TVG
  699. TLD = TLG
  700. RVD = RVG
  701. RLD = RLG
  702. UVND = -1.0D0 * UVNG
  703. UVTD = UVTG
  704. ULND = -1.0D0 * ULNG
  705. ULTD = ULTG
  706. C
  707. C************* Fin cas mur
  708. C
  709. ELSE
  710. C
  711. C************* Etat gauche
  712. C
  713. AG = MPALP.VPOCHA(NLCEG, 1)
  714. PG = MPPC.VPOCHA(NLCEG, 1)
  715. TVG = MPTVC.VPOCHA(NLCEG, 1)
  716. TLG = MPTLC.VPOCHA(NLCEG, 1)
  717. RVG = MPRVC.VPOCHA(NLCEG, 1)
  718. RLG = MPRLC.VPOCHA(NLCEG, 1)
  719. UVXG = MPUVC.VPOCHA(NLCEG, 1)
  720. UVYG = MPUVC.VPOCHA(NLCEG, 2)
  721. ULXG = MPULC.VPOCHA(NLCEG, 1)
  722. ULYG = MPULC.VPOCHA(NLCEG, 2)
  723. UVNG = UVXG * CNX + UVYG * CNY
  724. UVTG = UVXG * CTX + UVYG * CTY
  725. ULNG = ULXG * CNX + ULYG * CNY
  726. ULTG = ULXG * CTX + ULYG * CTY
  727. C
  728. C********** Etat gauche
  729. C
  730. AD = MPALP.VPOCHA(NLCED, 1)
  731. PD = MPPC.VPOCHA(NLCED, 1)
  732. TVD = MPTVC.VPOCHA(NLCED, 1)
  733. TLD = MPTLC.VPOCHA(NLCED, 1)
  734. RVD = MPRVC.VPOCHA(NLCED, 1)
  735. RLD = MPRLC.VPOCHA(NLCED, 1)
  736. UVXD = MPUVC.VPOCHA(NLCED, 1)
  737. UVYD = MPUVC.VPOCHA(NLCED, 2)
  738. ULXD = MPULC.VPOCHA(NLCED, 1)
  739. ULYD = MPULC.VPOCHA(NLCED, 2)
  740. UVND = UVXD * CNX + UVYD * CNY
  741. UVTD = UVXD * CTX + UVYD * CTY
  742. ULND = ULXD * CNX + ULYD * CNY
  743. ULTD = ULXD * CTX + ULYD * CTY
  744. ENDIF
  745. C
  746. C************* Les MELVALs
  747. C
  748. MLALP.VELCHE(1,NLCF) = AG
  749. MLALP.VELCHE(3,NLCF) = AD
  750. MLP.VELCHE(1,NLCF) = PG
  751. MLP.VELCHE(3,NLCF) = PD
  752. MLTV.VELCHE(1,NLCF) = TVG
  753. MLTV.VELCHE(3,NLCF) = TVD
  754. MLTL.VELCHE(1,NLCF) = TLG
  755. MLTL.VELCHE(3,NLCF) = TLD
  756. MLRV.VELCHE(1,NLCF) = RVG
  757. MLRV.VELCHE(3,NLCF) = RVD
  758. MLRL.VELCHE(1,NLCF) = RLG
  759. MLRL.VELCHE(3,NLCF) = RLD
  760.  
  761. MLUVN.VELCHE(1,NLCF) = UVNG
  762. MLUVN.VELCHE(3,NLCF) = UVND
  763. MLUVT.VELCHE(1,NLCF) = UVTG
  764. MLUVT.VELCHE(3,NLCF) = UVTD
  765. MLULN.VELCHE(1,NLCF) = ULNG
  766. MLULN.VELCHE(3,NLCF) = ULND
  767. MLULT.VELCHE(1,NLCF) = ULTG
  768. MLULT.VELCHE(3,NLCF) = ULTD
  769.  
  770. C LAS QUE VIENEN A CONTINUACION NO SIRVEN, TENEMOS LAS
  771. C MISMAS DIRECCIONES TANTO PARA LA FASE LIQUIDA COMO PARA
  772. C LA GASEOSA
  773.  
  774. MLVNX.VELCHE(1,NLCF) = CNX
  775. MLVNY.VELCHE(1,NLCF) = CNY
  776. MLVTX.VELCHE(1,NLCF) = CTX
  777. MLVTY.VELCHE(1,NLCF) = CTY
  778.  
  779. MLLNX.VELCHE(1,NLCF) = CNX
  780. MLLNY.VELCHE(1,NLCF) = CNY
  781. MLLTX.VELCHE(1,NLCF) = CTX
  782. MLLTY.VELCHE(1,NLCF) = CTY
  783.  
  784. ENDDO
  785. C
  786. C**** Desactivation des SEGMENTs
  787. C
  788. SEGDES IPT1
  789. SEGDES IPT2
  790. C
  791. SEGDES MPALP
  792. SEGDES MPUVC
  793. SEGDES MPULC
  794. SEGDES MPPC
  795. SEGDES MPTVC
  796. SEGDES MPTLC
  797. SEGDES MPRVC
  798. SEGDES MPRLC
  799. SEGDES MPNORM
  800. C
  801. SEGDES MLALP
  802. SEGDES MLP
  803. SEGDES MLTV
  804. SEGDES MLTL
  805. SEGDES MLRV
  806. SEGDES MLRL
  807.  
  808. C liquid vectors same as vapour ones,
  809. C there should have been only one set
  810.  
  811. SEGDES MLUVN
  812. SEGDES MLUVT
  813. SEGDES MLULN
  814. SEGDES MLULT
  815.  
  816. SEGDES MLVNX
  817. SEGDES MLVNY
  818. SEGDES MLVTX
  819. SEGDES MLVTY
  820. SEGDES MLLNX
  821. SEGDES MLLNY
  822. SEGDES MLLTX
  823. SEGDES MLLTY
  824. C
  825. C**** Destruction du MELNTI correspondance local/global
  826. C
  827. SEGSUP MLENT1
  828. C
  829. 9999 CONTINUE
  830. C
  831. RETURN
  832. END
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  

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