Télécharger pre311.eso

Retour à la liste

Numérotation des lignes :

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

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