Télécharger pre111.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE111 SOURCE PV 09/03/12 21:30:31 6325
  2. SUBROUTINE PRE111(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IGAMC,
  3. & IROF,IVITF,IPF,IGAMF,
  4. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : PRE111
  10. C
  11. C DESCRIPTION : Voir PRE11
  12. C
  13. C Cas Deux Dimensions
  14. C
  15. C Une Espece
  16. C
  17. C 1er ordre en espace, 1re ordre en temps
  18. C
  19. C Creations des objets MCHAML IROF, IVITF, IPF,
  20. C IGAMF
  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 IGAMC : CHPOINT "CENTRE" contenat le "Gamma" du gaz
  63. C
  64. C
  65. C SORTIES
  66. C
  67. C
  68. C IROF : MCHAML defini sur le MELEME de pointeur IFACEL,
  69. C contenant la masse volumique RHO
  70. C
  71. C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL,
  72. C contenant la vitesse UN, UT dans le repaire local
  73. C (n,t) et defini sur le MELEME de pointeur IFACE,
  74. C contenant les cosinus directeurs du repere local
  75. C
  76. C IPF : MCHAML defini sur le MELEME de pointeur IFACEL,
  77. C contenant la pression P
  78. C
  79. C IGAMF : MCHAML defini sur le MELEME de pointeur IFACEL,
  80. C contenant le "gamma" du gaz
  81. C
  82. C LOGAN : anomalie detectee (changement de la convention dans
  83. C la table domaine)
  84. C
  85. C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité
  86. C negative a été detectée -> en interactif le
  87. C programme s'arrete en GIBIANE
  88. C (erreur stocké en MESERR et VALER)
  89. C
  90. C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte
  91. C dehor 1 et 3 (sa valeur stockée en MESERR et VALER;
  92. C en VAL1 et en VAL2 on stocke 1.0 et 3.0)
  93. C
  94. C MESERR
  95. C VALER
  96. C VAL1,
  97. C VAL2 : pour les messages d'erreur
  98. C
  99. C************************************************************************
  100. C
  101. C HISTORIQUE (Anomalies et modifications éventuelles)
  102. C
  103. C HISTORIQUE : Créée le 11.6.98.
  104. C
  105. C************************************************************************
  106. C
  107. C
  108. C ATTENTION: Cet programme marche que si le MAILLAGE est convex;
  109. C si non il faut changer l'argoritme de calcul de
  110. C l'orientation des normales aux faces.
  111. C
  112. C
  113. C************************************************************************
  114. C
  115. C**** Variables de COOPTIO
  116. C
  117. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  118. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  119. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  120. C & ,IECHO, IIMPI, IOSPI
  121. C & ,IDIM
  122. CC & ,MCOORD
  123. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  124. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  125. C & ,NORINC,NORVAL,NORIND,NORVAD
  126. C & ,NUCROU, IPSAUV
  127. C
  128. C**** Les variables
  129. C
  130. IMPLICIT INTEGER(I-N)
  131. INTEGER ICEN, IFACE, IFACEL, IROC, IVITC, IPC ,IGAMC, INORM
  132. & , IROF, IVITF, IPF, IGAMF
  133. & , IGEOM, NFAC
  134. & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
  135. & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1
  136. REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, DXG, DYG
  137. & , CNX, CNY, CTX, CTY, ORIENT
  138. & , ROG, PG, GAMG, UXG, UYG, UNG, UTG
  139. & , ROD, PD, GAMD, UXD, UYD, UND, UTD
  140. CHARACTER*(40) MESERR
  141. CHARACTER*(8) TYPE
  142. LOGICAL LOGAN,LOGNEG, LOGBOR
  143. C
  144. C**** Les Includes
  145. C
  146. -INC SMCOORD
  147. -INC CCOPTIO
  148. -INC SMCHPOI
  149. POINTEUR MPROC.MPOVAL, MPVITC.MPOVAL, MPPC.MPOVAL,
  150. & MPGAMC.MPOVAL, MPNORM.MPOVAL
  151. -INC SMCHAML
  152. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  153. & MELT1X.MELVAL, MELT1Y.MELVAL
  154. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  155. POINTEUR MELRO.MELVAL, MELP.MELVAL,
  156. & MELGAM.MELVAL
  157. -INC SMLENTI
  158. -INC SMELEME
  159. C
  160. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  161. C
  162. C LOGNEG = .FALSE.
  163. C LOGBOR = .FALSE.
  164. C MESERR = ' '
  165. C MOTERR(1:40) = MESERR(1:40)
  166. C VALER = 0.0D0
  167. C VAL1 = 0.0D0
  168. C VAL2 = 0.0D0
  169. C
  170. C
  171. C**** KRIPAD pour la correspondance global/local de centre
  172. C
  173. CALL KRIPAD(ICEN,MLENT1)
  174. C
  175. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  176. C
  177. C Si i est le numero global d'un noeud de ICEN,
  178. C MLENT1.LECT(i) contient sa position, i.e.
  179. C
  180. C I = numero global du noeud centre
  181. C MLENT1.LECT(i) = numero local du noeud centre
  182. C
  183. C MLENT1 déjà activé, i.e.
  184. C
  185. C SEGACT MLENT1
  186. C
  187. C**** Activation de CHPOINTs
  188. C
  189. C densité
  190. C vitesse
  191. C pression
  192. C gamma
  193. C cosinus directeurs des normales aux surface
  194. C
  195. CALL LICHT(IROC ,MPROC ,TYPE,IGEOM)
  196. CALL LICHT(IVITC,MPVITC,TYPE,IGEOM)
  197. CALL LICHT(IPC ,MPPC ,TYPE,IGEOM)
  198. CALL LICHT(IGAMC,MPGAMC,TYPE,IGEOM)
  199. CALL LICHT(INORM,MPNORM,TYPE,IGEOM)
  200. C
  201. C**** MPOVA1 - MPOVA5 sont déjà activés i.e.:
  202. C
  203. C SEGACT MPROC
  204. C SEGACT MPVITC
  205. C SEGACT MPPC
  206. C SEGACT MPGAMC
  207. C SEGACT MPNORM
  208. C
  209. C**** Le MELEME FACEL
  210. C
  211. IPT1 = IFACEL
  212. IPT2 = IFACE
  213. SEGACT IPT1
  214. SEGACT IPT2
  215. NFAC = IPT1.NUM(/2)
  216. C
  217. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  218. C
  219. C i.e.:
  220. C
  221. C vitesse + cosinus directors du repere local
  222. C densité
  223. C pression
  224. C gamma
  225. C
  226. C**** Cosinus directors du repere local et vitesse
  227. C
  228. C Les cosinus directeurs
  229. C
  230. N1 = 2
  231. N3 = 6
  232. L1 = 28
  233. SEGINI MCHEL1
  234. IVITF = MCHEL1
  235. MCHEL1.TITCHE = 'U '
  236. MCHEL1.IMACHE(1) = IFACE
  237. MCHEL1.IMACHE(2) = IFACEL
  238. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  239. MCHEL1.CONCHE(2) = ' U in (n,t) '
  240. C
  241. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  242. C
  243. MCHEL1.INFCHE(1,1) = 2
  244. MCHEL1.INFCHE(1,3) = NIFOUR
  245. MCHEL1.INFCHE(1,4) = 0
  246. MCHEL1.INFCHE(1,5) = 0
  247. MCHEL1.INFCHE(1,6) = 0
  248. MCHEL1.IFOCHE = IFOUR
  249. C
  250. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  251. C
  252. MCHEL1.INFCHE(2,1) = 1
  253. MCHEL1.INFCHE(2,3) = NIFOUR
  254. MCHEL1.INFCHE(2,4) = 0
  255. MCHEL1.INFCHE(2,5) = 0
  256. MCHEL1.INFCHE(2,6) = 0
  257. C
  258. C**** Le cosinus directeurs
  259. C
  260. N1PTEL = 1
  261. N1EL = NFAC
  262. N2PTEL = 0
  263. N2EL = 0
  264. C
  265. C**** MCHAML a N2 composantes:
  266. C
  267. C cosinus directeurs du repere local (n,t1)
  268. C
  269. C IDIM = 2 -> 4 composantes
  270. C
  271. N2 = 4
  272. SEGINI MCHAM1
  273. MCHEL1.ICHAML(1) = MCHAM1
  274. MCHAM1.NOMCHE(1) = 'NX '
  275. MCHAM1.NOMCHE(2) = 'NY '
  276. MCHAM1.NOMCHE(3) = 'TX '
  277. MCHAM1.NOMCHE(4) = 'TY '
  278. MCHAM1.TYPCHE(1) = 'REAL*8 '
  279. MCHAM1.TYPCHE(2) = 'REAL*8 '
  280. MCHAM1.TYPCHE(3) = 'REAL*8 '
  281. MCHAM1.TYPCHE(4) = 'REAL*8 '
  282. SEGINI MELVNX
  283. SEGINI MELVNY
  284. SEGINI MELT1X
  285. SEGINI MELT1Y
  286. MCHAM1.IELVAL(1) = MELVNX
  287. MCHAM1.IELVAL(2) = MELVNY
  288. MCHAM1.IELVAL(3) = MELT1X
  289. MCHAM1.IELVAL(4) = MELT1Y
  290. SEGDES MCHAM1
  291. C
  292. C**** Vitesse
  293. C
  294. N1EL = NFAC
  295. N1PTEL = 3
  296. N2EL = 0
  297. N2PTEL = 0
  298. C
  299. C**** MCHAML a N2 composantes:
  300. C
  301. C IDIM = 2 -> 2 composantes
  302. C
  303. N2 = 2
  304. SEGINI MCHAM1
  305. MCHEL1.ICHAML(2) = MCHAM1
  306. SEGDES MCHEL1
  307. MCHAM1.NOMCHE(1) = 'UN '
  308. MCHAM1.NOMCHE(2) = 'UT '
  309. MCHAM1.TYPCHE(1) = 'REAL*8 '
  310. MCHAM1.TYPCHE(2) = 'REAL*8 '
  311. SEGINI MELVUN
  312. SEGINI MELVUT
  313. MCHAM1.IELVAL(1) = MELVUN
  314. MCHAM1.IELVAL(2) = MELVUT
  315. SEGDES MCHAM1
  316. C
  317. C**** Densite
  318. C
  319. N1 = 1
  320. N3 = 6
  321. L1 = 15
  322. SEGINI MCHEL2
  323. IROF = MCHEL2
  324. MCHEL2.IMACHE(1) = IFACEL
  325. MCHEL2.TITCHE = 'RO '
  326. MCHEL2.CONCHE(1) = ' '
  327. C
  328. C**** Valeurs independente du repére, i.e.
  329. C
  330. MCHEL2.INFCHE(1,1) = 0
  331. MCHEL2.INFCHE(1,3) = NIFOUR
  332. MCHEL2.INFCHE(1,4) = 0
  333. MCHEL2.INFCHE(1,5) = 0
  334. MCHEL2.INFCHE(1,6) = 0
  335. MCHEL2.IFOCHE = IFOUR
  336. N2 = 1
  337. SEGINI MCHAM1
  338. MCHEL2.ICHAML(1) = MCHAM1
  339. SEGDES MCHEL2
  340. MCHAM1.NOMCHE(1) = 'SCAL '
  341. MCHAM1.TYPCHE(1) = 'REAL*8 '
  342. SEGINI MELRO
  343. MCHAM1.IELVAL(1) = MELRO
  344. SEGDES MCHAM1
  345. C
  346. C**** Pression
  347. C
  348. MCHEL1 = IROF
  349. SEGINI, MCHEL2 = MCHEL1
  350. IPF = MCHEL2
  351. MCHEL2.TITCHE = 'P '
  352. C
  353. C**** MCHAM1 = MCHAML de la densite
  354. C
  355. SEGINI, MCHAM2 = MCHAM1
  356. MCHEL2.ICHAML(1) = MCHAM2
  357. SEGDES MCHEL2
  358. SEGINI MELP
  359. MCHAM2.IELVAL(1) = MELP
  360. SEGDES MCHAM2
  361. C
  362. C**** Gamma
  363. C
  364. MCHEL1 = IROF
  365. SEGINI, MCHEL2 = MCHEL1
  366. IGAMF = MCHEL2
  367. MCHEL2.TITCHE = 'GAMMA '
  368. C
  369. C**** MCHAM1 = MCHAML de la densite
  370. C
  371. SEGINI, MCHAM2 = MCHAM1
  372. MCHEL2.ICHAML(1) = MCHAM2
  373. SEGDES MCHEL2
  374. SEGINI MELGAM
  375. MCHAM2.IELVAL(1) = MELGAM
  376. SEGDES MCHAM2
  377. C
  378. C**** Recapitulatif: les MELVALs et les MPOVALs actives
  379. C
  380. C MELVNX, MELVNY
  381. C MELT1X, MELT1Y
  382. C
  383. C MELVUN, MELVUT -> vitesse
  384. C
  385. C MELRO -> densite
  386. C
  387. C MELP -> pression
  388. C
  389. C MELGAM -> gamma
  390. C
  391. C MPROC -> densite
  392. C
  393. C MPVITC -> vitesse
  394. C
  395. C MPPC -> pression
  396. C
  397. C MPGAMC -> gamma
  398. C
  399. C MPNORM -> normales aux faces
  400. C
  401. C**** Boucle sur le faces
  402. C
  403. DO NLCF = 1, NFAC
  404. C
  405. C******* NLCF = numero local du centre de face
  406. C NGCF = numero global du centre de face
  407. C NGCEG = numero global du centre ELT "gauche"
  408. C NLCEG = numero local du centre ELT "gauche"
  409. C NGCED = numero global du centre ELT "droite"
  410. C NLCED = numero local du centre ELT "droite"
  411. C
  412. NGCEG = IPT1.NUM(1,NLCF)
  413. NGCF = IPT1.NUM(2,NLCF)
  414. NGCED = IPT1.NUM(3,NLCF)
  415. NLCEG = MLENT1.LECT(NGCEG)
  416. NLCED = MLENT1.LECT(NGCED)
  417. C
  418. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  419. C
  420. NGCF1 = IPT2.NUM(1,NLCF)
  421. IF( NGCF1 .NE. NGCF) THEN
  422. LOGAN = .TRUE.
  423. MESERR(1:40) = 'PRET, subroutine pre111.eso '
  424. GOTO 9999
  425. ENDIF
  426. C
  427. C******* Cosinus directeurs des NORMALES aux faces
  428. C
  429. C On impose que les normales sont direct "Gauche" -> "Centre"
  430. C
  431. XG = XCOOR((NGCEG-1)*(IDIM+1)+1)
  432. YG = XCOOR((NGCEG-1)*(IDIM+1)+2)
  433. XC = XCOOR((NGCF-1)*(IDIM+1)+1)
  434. YC = XCOOR((NGCF-1)*(IDIM+1)+2)
  435. DXG = XC - XG
  436. DYG = YC - YG
  437.  
  438. C
  439. C******* On calcule le sign du pruduit scalare
  440. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  441. C
  442. CNX = MPNORM.VPOCHA(NLCF,1)
  443. CNY = MPNORM.VPOCHA(NLCF,2)
  444. ORIENT = CNX * DXG + CNY * DYG
  445. ORIENT = SIGN(1.0D0,ORIENT)
  446. IF(ORIENT .NE. 1.0D0)THEN
  447. LOGAN = .TRUE.
  448. MESERR(1:30)=
  449. & 'PRET , subroutine pre111.eso. '
  450. GOTO 9999
  451. ENDIF
  452. CNX = CNX * ORIENT
  453. CNY = CNY * ORIENT
  454. C
  455. C********** Cosinus directeurs de tangent 2D
  456. C
  457. CTX = -1.0D0 * CNY
  458. CTY = CNX
  459. C
  460. C
  461. C******* Les autres MELVALs
  462. C
  463. C
  464. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  465. C GAMMA \in (1,3)
  466. C Si non il faut le faire, en utlisant LOGBOR,
  467. C LOGNEG, VALER, VAL1, VAL2
  468. C
  469. C
  470. C
  471. C******* NGCEG = NGCED -> Mur
  472. C
  473. IF( NGCEG .EQ. NGCED)THEN
  474. ROG = MPROC.VPOCHA(NLCEG , 1)
  475. PG = MPPC.VPOCHA(NLCEG, 1)
  476. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  477. UXG = MPVITC.VPOCHA(NLCEG , 1)
  478. UYG = MPVITC.VPOCHA(NLCEG , 2)
  479. UNG = UXG * CNX + UYG * CNY
  480. UTG = UXG * CTX + UYG * CTY
  481. C
  482. C********** Son etat droite
  483. C
  484. ROD = ROG
  485. PD = PG
  486. GAMD = GAMG
  487. UND = -1.0D0 * UNG
  488. UTD = UTG
  489. C
  490. C************* Fin cas mur
  491. C
  492. ELSE
  493. C
  494. C************* Etat gauche
  495. C
  496. ROG = MPROC.VPOCHA(NLCEG, 1)
  497. PG = MPPC.VPOCHA(NLCEG, 1)
  498. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  499. UXG = MPVITC.VPOCHA(NLCEG , 1)
  500. UYG = MPVITC.VPOCHA(NLCEG , 2)
  501. UNG = UXG * CNX + UYG * CNY
  502. UTG = UXG * CTX + UYG * CTY
  503. C
  504. C********** Etat gauche
  505. C
  506. ROD = MPROC.VPOCHA(NLCED,1)
  507. PD = MPPC.VPOCHA(NLCED,1)
  508. GAMD = MPGAMC.VPOCHA(NLCED,1)
  509. C
  510. C************* On suppose qu'on a déjà controlle ROG, PG > 0
  511. C Si non il faut le faire!!!
  512. C
  513. UXD = MPVITC.VPOCHA(NLCED,1)
  514. UYD = MPVITC.VPOCHA(NLCED,2)
  515. UND = UXD * CNX + UYD * CNY
  516. UTD = UXD * CTX + UYD * CTY
  517. ENDIF
  518. C
  519. C************* Les MELVALs
  520. C
  521. MELRO.VELCHE(1,NLCF) = ROG
  522. MELRO.VELCHE(3,NLCF) = ROD
  523. MELP.VELCHE(1,NLCF) = PG
  524. MELP.VELCHE(3,NLCF) = PD
  525. MELGAM.VELCHE(1,NLCF) = GAMG
  526. MELGAM.VELCHE(3,NLCF) = GAMD
  527. MELVUN.VELCHE(1,NLCF) = UNG
  528. MELVUN.VELCHE(3,NLCF) = UND
  529. MELVUT.VELCHE(1,NLCF) = UTG
  530. MELVUT.VELCHE(3,NLCF) = UTD
  531. MELVNX.VELCHE(1,NLCF) = CNX
  532. MELVNY.VELCHE(1,NLCF) = CNY
  533. MELT1X.VELCHE(1,NLCF) = CTX
  534. MELT1Y.VELCHE(1,NLCF) = CTY
  535. ENDDO
  536. C
  537. C**** Desactivation des SEGMENTs
  538. C
  539. SEGDES IPT1
  540. SEGDES IPT2
  541. C
  542. SEGDES MPROC
  543. SEGDES MPVITC
  544. SEGDES MPPC
  545. SEGDES MPGAMC
  546. SEGDES MPNORM
  547. C
  548. SEGDES MELRO
  549. SEGDES MELP
  550. SEGDES MELGAM
  551. SEGDES MELVUN
  552. SEGDES MELVUT
  553. SEGDES MELVNX
  554. SEGDES MELVNY
  555. SEGDES MELT1X
  556. SEGDES MELT1Y
  557. C
  558. C**** Destruction du MELNTI correspondance local/global
  559. C
  560. SEGSUP MLENT1
  561. C
  562. 9999 CONTINUE
  563. C
  564. RETURN
  565. END
  566.  
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  

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