Télécharger pre212.eso

Retour à la liste

Numérotation des lignes :

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

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