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
    C cosinus directeurs du repere local (n,t1,t2)=(n,t,v)
  285. C
  286. C IDIM = 3 -> 9 composantes
  287. C
  288. N2 = 9
  289. SEGINI MCHAM1
  290. MCHEL1.ICHAML(1) = MCHAM1
  291. MCHAM1.NOMCHE(1) = 'NX '
  292. MCHAM1.NOMCHE(2) = 'NY '
  293. MCHAM1.NOMCHE(3) = 'NZ '
  294. MCHAM1.NOMCHE(4) = 'TX '
  295. MCHAM1.NOMCHE(5) = 'TY '
  296. MCHAM1.NOMCHE(6) = 'TZ '
  297. MCHAM1.NOMCHE(7) = 'VX '
  298. MCHAM1.NOMCHE(8) = 'VY '
  299. MCHAM1.NOMCHE(9) = 'VZ '
  300. MCHAM1.TYPCHE(1) = 'REAL*8 '
  301. MCHAM1.TYPCHE(2) = 'REAL*8 '
  302. MCHAM1.TYPCHE(3) = 'REAL*8 '
  303. MCHAM1.TYPCHE(4) = 'REAL*8 '
  304. MCHAM1.TYPCHE(5) = 'REAL*8 '
  305. MCHAM1.TYPCHE(6) = 'REAL*8 '
  306. MCHAM1.TYPCHE(7) = 'REAL*8 '
  307. MCHAM1.TYPCHE(8) = 'REAL*8 '
  308. MCHAM1.TYPCHE(9) = 'REAL*8 '
  309. SEGINI MELVNX
  310. SEGINI MELVNY
  311. SEGINI MELVNZ
  312. SEGINI MELT1X
  313. SEGINI MELT1Y
  314. SEGINI MELT1Z
  315. SEGINI MELT2X
  316. SEGINI MELT2Y
  317. SEGINI MELT2Z
  318. MCHAM1.IELVAL(1) = MELVNX
  319. MCHAM1.IELVAL(2) = MELVNY
  320. MCHAM1.IELVAL(3) = MELVNZ
  321. MCHAM1.IELVAL(4) = MELT1X
  322. MCHAM1.IELVAL(5) = MELT1Y
  323. MCHAM1.IELVAL(6) = MELT1Z
  324. MCHAM1.IELVAL(7) = MELT2X
  325. MCHAM1.IELVAL(8) = MELT2Y
  326. MCHAM1.IELVAL(9) = MELT2Z
  327. SEGDES MCHAM1
  328. C
  329. C**** Vitesse
  330. C
  331. N1EL = NFAC
  332. N1PTEL = 3
  333. N2EL = 0
  334. N2PTEL = 0
  335. C
  336. C**** MCHAML a N2 composantes:
  337. C
  338. C
  339. C IDIM = 3 -> 3 composantes
  340. C
  341. N2 = 3
  342. SEGINI MCHAM1
  343. MCHEL1.ICHAML(2) = MCHAM1
  344. SEGDES MCHEL1
  345. MCHAM1.NOMCHE(1) = 'UN '
  346. MCHAM1.NOMCHE(2) = 'UT '
  347. MCHAM1.NOMCHE(3) = 'UV '
  348. MCHAM1.TYPCHE(1) = 'REAL*8 '
  349. MCHAM1.TYPCHE(2) = 'REAL*8 '
  350. MCHAM1.TYPCHE(3) = 'REAL*8 '
  351. SEGINI MELVUN
  352. SEGINI MELVUT
  353. SEGINI MELVUV
  354. MCHAM1.IELVAL(1) = MELVUN
  355. MCHAM1.IELVAL(2) = MELVUT
  356. MCHAM1.IELVAL(3) = MELVUV
  357. SEGDES MCHAM1
  358. C
  359. C**** Densite
  360. C
  361. N1 = 1
  362. N3 = 6
  363. L1 = 15
  364. SEGINI MCHEL2
  365. IROF = MCHEL2
  366. MCHEL2.IMACHE(1) = IFACEL
  367. MCHEL2.TITCHE = 'RO '
  368. MCHEL2.CONCHE(1) = ' '
  369. C
  370. C**** Valeurs independente du repére, i.e.
  371. C
  372. MCHEL2.INFCHE(1,1) = 0
  373. MCHEL2.INFCHE(1,3) = NIFOUR
  374. MCHEL2.INFCHE(1,4) = 0
  375. MCHEL2.INFCHE(1,5) = 0
  376. MCHEL2.INFCHE(1,6) = 0
  377. MCHEL2.IFOCHE = IFOUR
  378. N2 = 1
  379. SEGINI MCHAM1
  380. MCHEL2.ICHAML(1) = MCHAM1
  381. SEGDES MCHEL2
  382. MCHAM1.NOMCHE(1) = 'SCAL '
  383. MCHAM1.TYPCHE(1) = 'REAL*8 '
  384. SEGINI MELRO
  385. MCHAM1.IELVAL(1) = MELRO
  386. SEGDES MCHAM1
  387. C
  388. C**** Pression
  389. C
  390. MCHEL1 = IROF
  391. SEGINI, MCHEL2 = MCHEL1
  392. IPF = MCHEL2
  393. MCHEL2.TITCHE = 'P '
  394. C
  395. C**** MCHAM1 = MCHAML de la densite
  396. C
  397. SEGINI, MCHAM2 = MCHAM1
  398. MCHEL2.ICHAML(1) = MCHAM2
  399. SEGDES MCHEL2
  400. SEGINI MELP
  401. MCHAM2.IELVAL(1) = MELP
  402. SEGDES MCHAM2
  403. C
  404. C**** Les fractions massiques: le CHPOINT et le relative CHAMELEM
  405. C
  406. MCHPO1 = IYC
  407. SEGACT MCHPO1
  408. MSOUP1 = MCHPO1.IPCHP(1)
  409. SEGDES MCHPO1
  410. SEGACT MSOUP1
  411. NESP = MSOUP1.NOCOMP(/2)
  412. MPYC = MSOUP1.IPOVAL
  413. SEGACT MPYC
  414. C
  415. MCHEL1 = IROF
  416. SEGINI, MCHEL2 = MCHEL1
  417. IYF = MCHEL2
  418. MCHEL2.TITCHE = 'Y '
  419. N2 = NESP
  420. SEGINI MCHAMY
  421. MCHEL2.ICHAML(1) = MCHAMY
  422. SEGDES MCHEL2
  423. N1EL = NFAC
  424. N1PTEL = 3
  425. N2EL = 0
  426. N2PTEL = 0
  427. DO I1 = 1, NESP
  428. SEGINI MELVA1
  429. MCHAMY.IELVAL(I1) = MELVA1
  430. CARCEL = ' '
  431. CARCEL(1:4) = MSOUP1.NOCOMP(I1)
  432. MCHAMY.NOMCHE(I1) = CARCEL
  433. MCHAMY.TYPCHE(I1) = 'REAL*8 '
  434. ENDDO
  435. C
  436. SEGDES MSOUP1
  437. SEGINI FRAMAS
  438. C
  439. C**** On laisse actives les segments pointes par
  440. C MPYC, MCHAMY,FRAMAS, et le MELVALs relatifs aux
  441. C fractions massiques
  442. C
  443. C
  444. C
  445. C**** Gamma
  446. C
  447. MCHEL1 = IROF
  448. SEGINI, MCHEL2 = MCHEL1
  449. IGAMF = MCHEL2
  450. MCHEL2.TITCHE = 'GAMMA '
  451. C
  452. C**** MCHAM1 = MCHAML de la densite
  453. C
  454. SEGINI, MCHAM2 = MCHAM1
  455. MCHEL2.ICHAML(1) = MCHAM2
  456. SEGDES MCHEL2
  457. SEGINI MELGAM
  458. MCHAM2.IELVAL(1) = MELGAM
  459. SEGDES MCHAM2
  460. C
  461. C**** Recapitulatif
  462. C
  463. C MELVNX, MELVNY, MELVNZ
  464. C MELT1X, MELT1Y, MELT1Z
  465. C MELT2X, MELT2Y, MELT2Z
  466. C
  467. C MELVUN, MELVUT, MELVUV -> vitesse
  468. C
  469. C MELRO -> densite
  470. C
  471. C MELP -> pression
  472. C
  473. C MELGAM -> gamma
  474. C
  475. C MPROC -> densite
  476. C
  477. C MPVITC -> vitesse
  478. C
  479. C MPPC -> pression
  480. C
  481. C MPGAMC -> gamma
  482. C
  483. C MPNORM -> normales aux faces
  484. C
  485. C**** Boucle sur le faces
  486. C
  487. DO NLCF = 1, NFAC
  488. C
  489. C******* NLCF = numero local du centre de face
  490. C NGCF = numero global du centre de face
  491. C NGCEG = numero global du centre ELT "gauche"
  492. C NLCEG = numero local du centre ELT "gauche"
  493. C NGCED = numero global du centre ELT "droite"
  494. C NLCED = numero local du centre ELT "droite"
  495. C
  496. NGCEG = IPT1.NUM(1,NLCF)
  497. NGCF = IPT1.NUM(2,NLCF)
  498. NGCED = IPT1.NUM(3,NLCF)
  499. NLCEG = MLENT1.LECT(NGCEG)
  500. NLCED = MLENT1.LECT(NGCED)
  501. C
  502. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  503. C
  504. NGCF1 = IPT2.NUM(1,NLCF)
  505. IF( NGCF1 .NE. NGCF) THEN
  506. LOGAN = .TRUE.
  507. MESERR(1:40) = 'PRET, subroutine pre211.eso '
  508. GOTO 9999
  509. ENDIF
  510. C
  511. C******* Cosinus directeurs des NORMALES aux faces
  512. C
  513. C On impose que les normales sont direct "Gauche" -> "Centre"
  514. C
  515. INDCEL = (NGCEG-1)*IDIMP1
  516. XG = XCOOR(INDCEL+1)
  517. YG = XCOOR(INDCEL+2)
  518. ZG = XCOOR(INDCEL+3)
  519. INDCEL = (NGCF-1)*IDIMP1
  520. XC = XCOOR(INDCEL + 1)
  521. YC = XCOOR(INDCEL + 2)
  522. ZC = XCOOR(INDCEL+3)
  523. DXG = XC - XG
  524. DYG = YC - YG
  525. DZG = ZC - ZG
  526. C
  527. C******* On calcule le sign du pruduit scalare
  528. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  529. CNX = MPNORM.VPOCHA(NLCF,7)
  530. CNY = MPNORM.VPOCHA(NLCF,8)
  531. CNZ = MPNORM.VPOCHA(NLCF,9)
  532. ORIENT = CNX * DXG + CNY * DYG + CNZ * DZG
  533. ORIENT = SIGN(1.0D0,ORIENT)
  534. IF(ORIENT .NE. 1.0D0)THEN
  535. LOGAN = .TRUE.
  536. MESERR(1:30)=
  537. & 'PRET , subroutine pre121.eso. '
  538. GOTO 9999
  539. ENDIF
  540. CNX = CNX * ORIENT
  541. CNY = CNY * ORIENT
  542. CNZ = CNZ * ORIENT
  543. C
  544. C********** Cosinus directeurs de tangente 1
  545. C
  546. CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT
  547. CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT
  548. CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT
  549. C
  550. C********** Cosinus directeurs de tangente 2
  551. C
  552. CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT
  553. CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT
  554. CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT
  555. C
  556. C
  557. C******* Les autres MELVALs
  558. C
  559. C
  560. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  561. C GAMMA \in (1,3)
  562. C Si non il faut le faire, en utlisant LOGBOR,
  563. C LOGNEG, VALER, VAL1, VAL2
  564. C
  565. C
  566. C
  567. C******* NGCEG = NGCED -> Mur
  568. C
  569. IF( NGCEG .EQ. NGCED)THEN
  570. ROG = MPROC.VPOCHA(NLCEG , 1)
  571. PG = MPPC.VPOCHA(NLCEG, 1)
  572. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  573. UXG = MPVITC.VPOCHA(NLCEG , 1)
  574. UYG = MPVITC.VPOCHA(NLCEG , 2)
  575. UZG = MPVITC.VPOCHA(NLCEG , 3)
  576. UNG = UXG * CNX + UYG * CNY + UZG * CNZ
  577. UTG = UXG * CTX + UYG * CTY + UZG * CTZ
  578. UVG = UXG * CVX + UYG * CVY + UZG * CVZ
  579. C
  580. C********** Son etat droite
  581. C
  582. ROD = ROG
  583. PD = PG
  584. GAMD = GAMG
  585. UND = -1.0D0 * UNG
  586. UTD = UTG
  587. UVD = UVG
  588. C
  589. C********** Les fractiones massiques
  590. C
  591. DO I1 = 1, NESP
  592. FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1)
  593. FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1)
  594. ENDDO
  595. C
  596. C************* Fin cas mur
  597. C
  598. ELSE
  599. C
  600. C************* Etat gauche
  601. C
  602. ROG = MPROC.VPOCHA(NLCEG, 1)
  603. PG = MPPC.VPOCHA(NLCEG, 1)
  604. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  605. UXG = MPVITC.VPOCHA(NLCEG , 1)
  606. UYG = MPVITC.VPOCHA(NLCEG , 2)
  607. UZG = MPVITC.VPOCHA(NLCEG , 3)
  608. UNG = UXG * CNX + UYG * CNY + UZG * CNZ
  609. UTG = UXG * CTX + UYG * CTY + UZG * CTZ
  610. UVG = UXG * CVX + UYG * CVY + UZG * CVZ
  611. C
  612. C********** Etat droit
  613. C
  614. ROD = MPROC.VPOCHA(NLCED,1)
  615. PD = MPPC.VPOCHA(NLCED,1)
  616. GAMD = MPGAMC.VPOCHA(NLCED,1)
  617. C
  618. C************* On suppose qu'on a déjà controlle ROG, PG > 0
  619. C Si non il faut le faire!!!
  620. C
  621. UXD = MPVITC.VPOCHA(NLCED,1)
  622. UYD = MPVITC.VPOCHA(NLCED,2)
  623. UZD = MPVITC.VPOCHA(NLCED,3)
  624. UND = UXD * CNX + UYD * CNY + UZD * CNZ
  625. UTD = UXD * CTX + UYD * CTY + UZD * CTZ
  626. UVD = UXD * CVX + UYD * CVY + UZD * CVZ
  627. C
  628. C********** Les fractions massiques
  629. C
  630. DO I1 = 1, NESP
  631. FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1)
  632. FRAMAS.FRAMD(I1) = MPYC.VPOCHA(NLCED,I1)
  633. ENDDO
  634. ENDIF
  635. C
  636. C************* Les MELVALs
  637. C
  638. MELRO.VELCHE(1,NLCF) = ROG
  639. MELRO.VELCHE(3,NLCF) = ROD
  640. MELP.VELCHE(1,NLCF) = PG
  641. MELP.VELCHE(3,NLCF) = PD
  642. MELGAM.VELCHE(1,NLCF) = GAMG
  643. MELGAM.VELCHE(3,NLCF) = GAMD
  644. MELVUN.VELCHE(1,NLCF) = UNG
  645. MELVUN.VELCHE(3,NLCF) = UND
  646. MELVUT.VELCHE(1,NLCF) = UTG
  647. MELVUT.VELCHE(3,NLCF) = UTD
  648. MELVUV.VELCHE(1,NLCF) = UVG
  649. MELVUV.VELCHE(3,NLCF) = UVD
  650. MELVNX.VELCHE(1,NLCF) = CNX
  651. MELVNY.VELCHE(1,NLCF) = CNY
  652. MELVNZ.VELCHE(1,NLCF) = CNZ
  653. MELT1X.VELCHE(1,NLCF) = CTX
  654. MELT1Y.VELCHE(1,NLCF) = CTY
  655. MELT1Z.VELCHE(1,NLCF) = CTZ
  656. MELT2X.VELCHE(1,NLCF) = CVX
  657. MELT2Y.VELCHE(1,NLCF) = CVY
  658. MELT2Z.VELCHE(1,NLCF) = CVZ
  659. DO I1 = 1, NESP
  660. MELVA1 = MCHAMY.IELVAL(I1)
  661. MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1)
  662. MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1)
  663. ENDDO
  664. ENDDO
  665. C
  666. C**** Desactivation des SEGMENTs
  667. C
  668. SEGDES IPT1
  669. SEGDES IPT2
  670. C
  671. SEGDES MPROC
  672. SEGDES MPVITC
  673. SEGDES MPPC
  674. SEGDES MPGAMC
  675. SEGDES MPNORM
  676. C
  677. SEGDES MELRO
  678. SEGDES MELP
  679. SEGDES MELGAM
  680. SEGDES MELVUN
  681. SEGDES MELVUT
  682. SEGDES MELVUV
  683. SEGDES MELVNX
  684. SEGDES MELVNY
  685. SEGDES MELVNZ
  686. SEGDES MELT1X
  687. SEGDES MELT1Y
  688. SEGDES MELT1Z
  689. SEGDES MELT2X
  690. SEGDES MELT2Y
  691. SEGDES MELT2Z
  692. C
  693. SEGDES MPYC
  694. DO I1 = 1, NESP
  695. MELVA1 = MCHAMY.IELVAL(I1)
  696. SEGDES MELVA1
  697. ENDDO
  698. SEGDES MCHAMY
  699. SEGSUP FRAMAS
  700. C
  701. C**** Destruction du MELNTI correspondance local/global
  702. C
  703. SEGSUP MLENT1
  704. C
  705. 9999 CONTINUE
  706. C
  707. RETURN
  708. END
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  

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