Télécharger pre312.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE312 SOURCE PV 09/03/12 21:30:54 6325
  2. SUBROUTINE PRE312(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 : PRE312
  11. C
  12. C DESCRIPTION : Voir PRE31
  13. C
  14. C Cas Trois 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, UZ ;
  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
  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, UT1, UT2 dans le repaire
  77. C local (n,t1,t2) et defini sur le MELEME de pointeur
  78. C IFACE, 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 (ou 0 dans le cas
  85. C monoespece);
  86. C
  87. C ISCAF : MCHAML defini sur le MELEME de pointeur IFACEL,
  88. C contenant les scalaire passifs (ou 0)
  89. C
  90. C LOGAN : anomalie detectee (changement de la convention dans
  91. C la table domaine)
  92. C
  93. C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité
  94. C negative a été detectée -> en interactif le
  95. C programme s'arrete en GIBIANE
  96. C (erreur stocké en MESERR et VALER)
  97. C
  98. C LOGBOR : (LOGICAL): si .TRUE. un Y a ete detecte
  99. C dehor 1 et 3 (sa valeur stockée en MESERR et VALER;
  100. C en VAL1 et en VAL2 on stocke 1.0 et 3.0)
  101. C
  102. C MESERR
  103. C VALER
  104. C VAL1,
  105. C VAL2 : pour les messages d'erreur
  106. C
  107. C************************************************************************
  108. C
  109. C HISTORIQUE (Anomalies et modifications éventuelles)
  110. C
  111. C HISTORIQUE : Créée le 18.12.98.
  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, INORM
  142. & , IROF, IVITF, IPF, IYF, NESP, ISCAC, 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. & , INDCEL
  147. REAL*8 VALER, VAL1, VAL2,XG,YG,ZG,XC,YC,ZC
  148. & ,DXG, DYG, DZG,ORIENT
  149. & , CNX, CNY, CNZ, CTX, CTY, CTZ, CVX, CVY, CVZ
  150. & , ROG, PG, UXG, UYG, UZG, UNG, UTG, UVG
  151. & , ROD, PD, UXD, UYD, UZD, UND, UTD, UVD
  152. CHARACTER*(40) MESERR
  153. CHARACTER*(8) TYPE, CARCEL
  154. LOGICAL LOGAN,LOGNEG, LOGBOR
  155. C
  156. C**** Les Includes
  157. C
  158. -INC SMCOORD
  159. -INC CCOPTIO
  160. -INC SMCHPOI
  161. POINTEUR MPROC.MPOVAL, MPVITC.MPOVAL, MPPC.MPOVAL,
  162. & MPNORM.MPOVAL, MPYC.MPOVAL, MPSC.MPOVAL
  163. -INC SMCHAML
  164. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL,
  165. & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL,
  166. & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL
  167. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL
  168. POINTEUR MELRO.MELVAL, MELP.MELVAL
  169. POINTEUR MCHAMY.MCHAML, MCHAMS.MCHAML
  170. -INC SMLENTI
  171. -INC SMELEME
  172. C
  173. C**** Segments des fractions massiques gauche et droit
  174. C
  175. SEGMENT FRAMAS
  176. REAL*8 FRAMG(NMA), FRAMD(NMA)
  177. ENDSEGMENT
  178. POINTEUR SCALPA.FRAMAS
  179. C
  180. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  181. C
  182. C LOGNEG = .FALSE.
  183. C LOGBOR = .FALSE.
  184. C MESERR = ' '
  185. C MOTERR(1:40) = MESERR(1:40)
  186. C VALER = 0.0D0
  187. C VAL1 = 0.0D0
  188. C VAL2 = 0.0D0
  189. C
  190. C
  191. C**** KRIPAD pour la correspondance global/local de centre
  192. C
  193. CALL KRIPAD(ICEN,MLENT1)
  194. C
  195. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  196. C
  197. C Si i est le numero global d'un noeud de ICEN,
  198. C MLENT1.LECT(i) contient sa position, i.e.
  199. C
  200. C I = numero global du noeud centre
  201. C MLENT1.LECT(i) = numero local du noeud centre
  202. C
  203. C MLENT1 déjà activé, i.e.
  204. C
  205. C SEGACT MLENT1
  206. C
  207. C**** Activation de CHPOINTs
  208. C
  209. C densité
  210. C vitesse
  211. C pression
  212. C cosinus directeurs des normales aux surface
  213. C
  214. CALL LICHT(IROC ,MPROC ,TYPE,IGEOM)
  215. CALL LICHT(IVITC,MPVITC,TYPE,IGEOM)
  216. CALL LICHT(IPC ,MPPC ,TYPE,IGEOM)
  217. CALL LICHT(INORM,MPNORM,TYPE,IGEOM)
  218. C
  219. C**** MPOVA1 - MPOVA5 sont déjà activés i.e.:
  220. C
  221. C SEGACT MPROC
  222. C SEGACT MPVITC
  223. C SEGACT MPPC
  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 fractions massiques
  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)
  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 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. IF(IYC .NE. 0)THEN
  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. NMA = NESP
  439. SEGINI FRAMAS
  440. C
  441. C**** On laisse actives les segments pointes par
  442. C MPYC, MCHAMY,FRAMAS, et le MELVALs relatifs aux
  443. C fractions massiques
  444. C
  445. C
  446. ELSE
  447. IYF = 0
  448. NESP = 0
  449. ENDIF
  450. C
  451. C**** Les scalaires passifs: le CHPOINT et le relative CHAMELEM
  452. C
  453. IF(ISCAC .NE. 0)THEN
  454. MCHPO1 = ISCAC
  455. SEGACT MCHPO1
  456. MSOUP1 = MCHPO1.IPCHP(1)
  457. SEGDES MCHPO1
  458. SEGACT MSOUP1
  459. NSCA = MSOUP1.NOCOMP(/2)
  460. MPSC = MSOUP1.IPOVAL
  461. SEGACT MPSC
  462. C
  463. MCHEL1 = IROF
  464. SEGINI, MCHEL2 = MCHEL1
  465. ISCAF = MCHEL2
  466. MCHEL2.TITCHE = 'SCALPASS '
  467. N2 = NSCA
  468. SEGINI MCHAMS
  469. MCHEL2.ICHAML(1) = MCHAMS
  470. SEGDES MCHEL2
  471. N1EL = NFAC
  472. N1PTEL = 3
  473. N2EL = 0
  474. N2PTEL = 0
  475. DO I1 = 1, NSCA
  476. SEGINI MELVA1
  477. MCHAMS.IELVAL(I1) = MELVA1
  478. CARCEL = ' '
  479. CARCEL(1:4) = MSOUP1.NOCOMP(I1)
  480. MCHAMS.NOMCHE(I1) = CARCEL
  481. MCHAMS.TYPCHE(I1) = 'REAL*8 '
  482. ENDDO
  483. C
  484. SEGDES MSOUP1
  485. NMA = NSCA
  486. SEGINI SCALPA
  487. C
  488. C**** On laisse actives les segments pointes par
  489. C MPYC, MCHAMY,FRAMAS, et le MELVALs relatifs aux
  490. C fractions massiques
  491. C
  492. C
  493. ELSE
  494. ISCAF = 0
  495. NSCA = 0
  496. ENDIF
  497. C
  498. C**** Recapitulatif
  499. C
  500. C MELVNX, MELVNY, MELVNZ
  501. C MELT1X, MELT1Y, MELT1Z
  502. C MELT2X, MELT2Y, MELT2Z
  503. C
  504. C MELVUN, MELVUT, MELVUV -> vitesse
  505. C
  506. C MELRO -> densite
  507. C
  508. C MELP -> pression
  509. C
  510. C MPROC -> densite
  511. C
  512. C MPVITC -> vitesse
  513. C
  514. C MPPC -> pression
  515. C
  516. C MPNORM -> normales aux faces
  517. C
  518. C**** Boucle sur le faces
  519. C
  520. DO NLCF = 1, NFAC
  521. C
  522. C******* NLCF = numero local du centre de face
  523. C NGCF = numero global du centre de face
  524. C NGCEG = numero global du centre ELT "gauche"
  525. C NLCEG = numero local du centre ELT "gauche"
  526. C NGCED = numero global du centre ELT "droite"
  527. C NLCED = numero local du centre ELT "droite"
  528. C
  529. NGCEG = IPT1.NUM(1,NLCF)
  530. NGCF = IPT1.NUM(2,NLCF)
  531. NGCED = IPT1.NUM(3,NLCF)
  532. NLCEG = MLENT1.LECT(NGCEG)
  533. NLCED = MLENT1.LECT(NGCED)
  534. C
  535. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  536. C
  537. NGCF1 = IPT2.NUM(1,NLCF)
  538. IF( NGCF1 .NE. NGCF) THEN
  539. LOGAN = .TRUE.
  540. MESERR(1:40) = 'PRET, subroutine pre312.eso '
  541. GOTO 9999
  542. ENDIF
  543. C
  544. C******* Cosinus directeurs des NORMALES aux faces
  545. C
  546. C On impose que les normales sont direct "Gauche" -> "Centre"
  547. C
  548. INDCEL = (NGCEG-1)*(IDIM+1)
  549. XG = XCOOR(INDCEL+1)
  550. YG = XCOOR(INDCEL+2)
  551. ZG = XCOOR(INDCEL+3)
  552. INDCEL = (NGCF-1)*(IDIM+1)
  553. XC = XCOOR(INDCEL + 1)
  554. YC = XCOOR(INDCEL + 2)
  555. ZC = XCOOR(INDCEL+3)
  556. DXG = XC - XG
  557. DYG = YC - YG
  558. DZG = ZC - ZG
  559.  
  560. C
  561. C******* On calcule le sign du pruduit scalare
  562. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  563. C
  564. CNX = MPNORM.VPOCHA(NLCF,7)
  565. CNY = MPNORM.VPOCHA(NLCF,8)
  566. CNZ = MPNORM.VPOCHA(NLCF,9)
  567. ORIENT = CNX * DXG + CNY * DYG + CNZ * DZG
  568. ORIENT = SIGN(1.0D0,ORIENT)
  569. IF(ORIENT .NE. 1.0D0)THEN
  570. LOGAN = .TRUE.
  571. MESERR(1:30)=
  572. & 'PRET , subroutine pre312.eso. '
  573. GOTO 9999
  574. ENDIF
  575. CNX = CNX * ORIENT
  576. CNY = CNY * ORIENT
  577. CNZ = CNZ * ORIENT
  578. C
  579. C********** Cosinus directeurs de tangente 1
  580. C
  581. CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT
  582. CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT
  583. CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT
  584. C
  585. C********** Cosinus directeurs de tangente 2
  586. C
  587. CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT
  588. CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT
  589. CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT
  590. C
  591. C
  592. C******* Les autres MELVALs
  593. C
  594. C
  595. C******* N.B.: On suppose qu'on a déjà controlle RO, P, > 0
  596. C Y \in (1,3)
  597. C
  598. C******* NGCEG = NGCED -> Mur
  599. C
  600. IF( NGCEG .EQ. NGCED)THEN
  601. ROG = MPROC.VPOCHA(NLCEG , 1)
  602. PG = MPPC.VPOCHA(NLCEG, 1)
  603. UXG = MPVITC.VPOCHA(NLCEG , 1)
  604. UYG = MPVITC.VPOCHA(NLCEG , 2)
  605. UZG = MPVITC.VPOCHA(NLCEG , 3)
  606. UNG = UXG * CNX + UYG * CNY + UZG * CNZ
  607. UTG = UXG * CTX + UYG * CTY + UZG * CTZ
  608. UVG = UXG * CVX + UYG * CVY + UZG * CVZ
  609. C
  610. C********** Son etat droite
  611. C
  612. ROD = ROG
  613. PD = PG
  614. UND = -1.0D0 * UNG
  615. UTD = UTG
  616. UVD = UVG
  617. C
  618. C********** Les fractiones massiques
  619. C
  620. DO I1 = 1, NESP, 1
  621. FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1)
  622. FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1)
  623. ENDDO
  624. C
  625. C********** Les scalaires passifs
  626. C
  627. DO I1 = 1, NSCA, 1
  628. SCALPA.FRAMG(I1) = MPSC.VPOCHA(NLCEG,I1)
  629. SCALPA.FRAMD(I1) = SCALPA.FRAMG(I1)
  630. ENDDO
  631. C
  632. C************* Fin cas mur
  633. C
  634. ELSE
  635. C
  636. C************* Etat gauche
  637. C
  638. ROG = MPROC.VPOCHA(NLCEG, 1)
  639. PG = MPPC.VPOCHA(NLCEG, 1)
  640. UXG = MPVITC.VPOCHA(NLCEG , 1)
  641. UYG = MPVITC.VPOCHA(NLCEG , 2)
  642. UZG = MPVITC.VPOCHA(NLCEG , 3)
  643. UNG = UXG * CNX + UYG * CNY + UZG * CNZ
  644. UTG = UXG * CTX + UYG * CTY + UZG * CTZ
  645. UVG = UXG * CVX + UYG * CVY + UZG * CVZ
  646. C
  647. C********** Etat droit
  648. C
  649. ROD = MPROC.VPOCHA(NLCED,1)
  650. PD = MPPC.VPOCHA(NLCED,1)
  651. C
  652. C************* On suppose qu'on a déjà controlle ROG, PG > 0
  653. C Si non il faut le faire!!!
  654. C
  655. UXD = MPVITC.VPOCHA(NLCED,1)
  656. UYD = MPVITC.VPOCHA(NLCED,2)
  657. UZD = MPVITC.VPOCHA(NLCED,3)
  658. UND = UXD * CNX + UYD * CNY + UZD * CNZ
  659. UTD = UXD * CTX + UYD * CTY + UZD * CTZ
  660. UVD = UXD * CVX + UYD * CVY + UZD * CVZ
  661. C
  662. C********** Les fractions massiques
  663. C
  664. DO I1 = 1, NESP, 1
  665. FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1)
  666. FRAMAS.FRAMD(I1) = MPYC.VPOCHA(NLCED,I1)
  667. ENDDO
  668. C
  669. C********** Les scalaires passifs
  670. C
  671. DO I1 = 1, NSCA, 1
  672. SCALPA.FRAMG(I1) = MPSC.VPOCHA(NLCEG,I1)
  673. SCALPA.FRAMD(I1) = MPSC.VPOCHA(NLCED,I1)
  674. ENDDO
  675. ENDIF
  676. C
  677. C************* Les MELVALs
  678. C
  679. MELRO.VELCHE(1,NLCF) = ROG
  680. MELRO.VELCHE(3,NLCF) = ROD
  681. MELP.VELCHE(1,NLCF) = PG
  682. MELP.VELCHE(3,NLCF) = PD
  683. MELVUN.VELCHE(1,NLCF) = UNG
  684. MELVUN.VELCHE(3,NLCF) = UND
  685. MELVUT.VELCHE(1,NLCF) = UTG
  686. MELVUT.VELCHE(3,NLCF) = UTD
  687. MELVUV.VELCHE(1,NLCF) = UVG
  688. MELVUV.VELCHE(3,NLCF) = UVD
  689. MELVNX.VELCHE(1,NLCF) = CNX
  690. MELVNY.VELCHE(1,NLCF) = CNY
  691. MELVNZ.VELCHE(1,NLCF) = CNZ
  692. MELT1X.VELCHE(1,NLCF) = CTX
  693. MELT1Y.VELCHE(1,NLCF) = CTY
  694. MELT1Z.VELCHE(1,NLCF) = CTZ
  695. MELT2X.VELCHE(1,NLCF) = CVX
  696. MELT2Y.VELCHE(1,NLCF) = CVY
  697. MELT2Z.VELCHE(1,NLCF) = CVZ
  698. DO I1 = 1, NESP, 1
  699. MELVA1 = MCHAMY.IELVAL(I1)
  700. MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1)
  701. MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1)
  702. ENDDO
  703. DO I1 = 1, NSCA, 1
  704. MELVA1 = MCHAMS.IELVAL(I1)
  705. MELVA1.VELCHE(1,NLCF) = SCALPA.FRAMG(I1)
  706. MELVA1.VELCHE(3,NLCF) = SCALPA.FRAMD(I1)
  707. ENDDO
  708. ENDDO
  709. C
  710. C**** Desactivation des SEGMENTs
  711. C
  712. SEGDES IPT1
  713. SEGDES IPT2
  714. C
  715. SEGDES MPROC
  716. SEGDES MPVITC
  717. SEGDES MPPC
  718. SEGDES MPNORM
  719. C
  720. SEGDES MELRO
  721. SEGDES MELP
  722. SEGDES MELVUN
  723. SEGDES MELVUT
  724. SEGDES MELVUV
  725. SEGDES MELVNX
  726. SEGDES MELVNY
  727. SEGDES MELVNZ
  728. SEGDES MELT1X
  729. SEGDES MELT1Y
  730. SEGDES MELT1Z
  731. SEGDES MELT2X
  732. SEGDES MELT2Y
  733. SEGDES MELT2Z
  734. C
  735. IF(NESP .GT. 0)THEN
  736. SEGDES MPYC
  737. DO I1 = 1, NESP
  738. MELVA1 = MCHAMY.IELVAL(I1)
  739. SEGDES MELVA1
  740. ENDDO
  741. SEGDES MCHAMY
  742. SEGSUP FRAMAS
  743. ENDIF
  744. IF(NSCA .GT. 0)THEN
  745. SEGDES MPSC
  746. DO I1 = 1, NSCA
  747. MELVA1 = MCHAMS.IELVAL(I1)
  748. SEGDES MELVA1
  749. ENDDO
  750. SEGDES MCHAMS
  751. SEGSUP SCALPA
  752. ENDIF
  753. C
  754. C**** Destruction du MELNTI correspondance local/global
  755. C
  756. SEGSUP MLENT1
  757. C
  758. 9999 CONTINUE
  759. C
  760. RETURN
  761. END
  762.  
  763.  
  764.  
  765.  
  766.  
  767.  
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  

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