Télécharger pre111.eso

Retour à la liste

Numérotation des lignes :

pre111
  1. C PRE111 SOURCE CB215821 20/11/25 13:36:05 10792
  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.  
  148. -INC PPARAM
  149. -INC CCOPTIO
  150. -INC SMCHPOI
  151. POINTEUR MPROC.MPOVAL, MPVITC.MPOVAL, MPPC.MPOVAL,
  152. & MPGAMC.MPOVAL, MPNORM.MPOVAL
  153. -INC SMCHAML
  154. POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,
  155. & MELT1X.MELVAL, MELT1Y.MELVAL
  156. POINTEUR MELVUN.MELVAL, MELVUT.MELVAL
  157. POINTEUR MELRO.MELVAL, MELP.MELVAL,
  158. & MELGAM.MELVAL
  159. -INC SMLENTI
  160. -INC SMELEME
  161. C
  162. C**** Initialisation des parametres d'erreur déjà faite, i.e.
  163. C
  164. C LOGNEG = .FALSE.
  165. C LOGBOR = .FALSE.
  166. C MESERR = ' '
  167. C MOTERR(1:40) = MESERR(1:40)
  168. C VALER = 0.0D0
  169. C VAL1 = 0.0D0
  170. C VAL2 = 0.0D0
  171. C
  172. C
  173. C**** KRIPAD pour la correspondance global/local de centre
  174. C
  175. CALL KRIPAD(ICEN,MLENT1)
  176. C
  177. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  178. C
  179. C Si i est le numero global d'un noeud de ICEN,
  180. C MLENT1.LECT(i) contient sa position, i.e.
  181. C
  182. C I = numero global du noeud centre
  183. C MLENT1.LECT(i) = numero local du noeud centre
  184. C
  185. C MLENT1 déjà activé, i.e.
  186. C
  187. C SEGACT MLENT1
  188. C
  189. C**** Activation de CHPOINTs
  190. C
  191. C densité
  192. C vitesse
  193. C pression
  194. C gamma
  195. C cosinus directeurs des normales aux surface
  196. C
  197. CALL LICHT(IROC ,MPROC ,TYPE,IGEOM)
  198. CALL LICHT(IVITC,MPVITC,TYPE,IGEOM)
  199. CALL LICHT(IPC ,MPPC ,TYPE,IGEOM)
  200. CALL LICHT(IGAMC,MPGAMC,TYPE,IGEOM)
  201. CALL LICHT(INORM,MPNORM,TYPE,IGEOM)
  202. C
  203. C**** MPOVA1 - MPOVA5 sont déjà activés i.e.:
  204. C
  205. C SEGACT MPROC
  206. C SEGACT MPVITC
  207. C SEGACT MPPC
  208. C SEGACT MPGAMC
  209. C SEGACT MPNORM
  210. C
  211. C**** Le MELEME FACEL
  212. C
  213. IPT1 = IFACEL
  214. IPT2 = IFACE
  215. SEGACT IPT1
  216. SEGACT IPT2
  217. NFAC = IPT1.NUM(/2)
  218. C
  219. C**** Creation de MCHAMLs contenant les etats gauche et droite,
  220. C
  221. C i.e.:
  222. C
  223. C vitesse + cosinus directors du repere local
  224. C densité
  225. C pression
  226. C gamma
  227. C
  228. C**** Cosinus directors du repere local et vitesse
  229. C
  230. C Les cosinus directeurs
  231. C
  232. N1 = 2
  233. N3 = 6
  234. L1 = 28
  235. SEGINI MCHEL1
  236. IVITF = MCHEL1
  237. MCHEL1.TITCHE = 'U '
  238. MCHEL1.IMACHE(1) = IFACE
  239. MCHEL1.IMACHE(2) = IFACEL
  240. MCHEL1.CONCHE(1) = ' (n,t) in (x,y) '
  241. MCHEL1.CONCHE(2) = ' U in (n,t) '
  242. C
  243. C**** Valeurs des cosinus definies par respect au repair global, i.e.
  244. C
  245. MCHEL1.INFCHE(1,1) = 2
  246. MCHEL1.INFCHE(1,3) = NIFOUR
  247. MCHEL1.INFCHE(1,4) = 0
  248. MCHEL1.INFCHE(1,5) = 0
  249. MCHEL1.INFCHE(1,6) = 0
  250. MCHEL1.IFOCHE = IFOUR
  251. C
  252. C**** Valeurs de vitesse definies par respect au repair local, i.e.
  253. C
  254. MCHEL1.INFCHE(2,1) = 1
  255. MCHEL1.INFCHE(2,3) = NIFOUR
  256. MCHEL1.INFCHE(2,4) = 0
  257. MCHEL1.INFCHE(2,5) = 0
  258. MCHEL1.INFCHE(2,6) = 0
  259. C
  260. C**** Le cosinus directeurs
  261. C
  262. N1PTEL = 1
  263. N1EL = NFAC
  264. N2PTEL = 0
  265. N2EL = 0
  266. C
  267. C**** MCHAML a N2 composantes:
  268. C
  269. C cosinus directeurs du repere local (n,t1)
  270. C
  271. C IDIM = 2 -> 4 composantes
  272. C
  273. N2 = 4
  274. SEGINI MCHAM1
  275. MCHEL1.ICHAML(1) = MCHAM1
  276. MCHAM1.NOMCHE(1) = 'NX '
  277. MCHAM1.NOMCHE(2) = 'NY '
  278. MCHAM1.NOMCHE(3) = 'TX '
  279. MCHAM1.NOMCHE(4) = 'TY '
  280. MCHAM1.TYPCHE(1) = 'REAL*8 '
  281. MCHAM1.TYPCHE(2) = 'REAL*8 '
  282. MCHAM1.TYPCHE(3) = 'REAL*8 '
  283. MCHAM1.TYPCHE(4) = 'REAL*8 '
  284. SEGINI MELVNX
  285. SEGINI MELVNY
  286. SEGINI MELT1X
  287. SEGINI MELT1Y
  288. MCHAM1.IELVAL(1) = MELVNX
  289. MCHAM1.IELVAL(2) = MELVNY
  290. MCHAM1.IELVAL(3) = MELT1X
  291. MCHAM1.IELVAL(4) = MELT1Y
  292. SEGDES MCHAM1
  293. C
  294. C**** Vitesse
  295. C
  296. N1EL = NFAC
  297. N1PTEL = 3
  298. N2EL = 0
  299. N2PTEL = 0
  300. C
  301. C**** MCHAML a N2 composantes:
  302. C
  303. C IDIM = 2 -> 2 composantes
  304. C
  305. N2 = 2
  306. SEGINI MCHAM1
  307. MCHEL1.ICHAML(2) = MCHAM1
  308. SEGDES MCHEL1
  309. MCHAM1.NOMCHE(1) = 'UN '
  310. MCHAM1.NOMCHE(2) = 'UT '
  311. MCHAM1.TYPCHE(1) = 'REAL*8 '
  312. MCHAM1.TYPCHE(2) = 'REAL*8 '
  313. SEGINI MELVUN
  314. SEGINI MELVUT
  315. MCHAM1.IELVAL(1) = MELVUN
  316. MCHAM1.IELVAL(2) = MELVUT
  317. SEGDES MCHAM1
  318. C
  319. C**** Densite
  320. C
  321. N1 = 1
  322. N3 = 6
  323. L1 = 15
  324. SEGINI MCHEL2
  325. IROF = MCHEL2
  326. MCHEL2.IMACHE(1) = IFACEL
  327. MCHEL2.TITCHE = 'RO '
  328. MCHEL2.CONCHE(1) = ' '
  329. C
  330. C**** Valeurs independente du repére, i.e.
  331. C
  332. MCHEL2.INFCHE(1,1) = 0
  333. MCHEL2.INFCHE(1,3) = NIFOUR
  334. MCHEL2.INFCHE(1,4) = 0
  335. MCHEL2.INFCHE(1,5) = 0
  336. MCHEL2.INFCHE(1,6) = 0
  337. MCHEL2.IFOCHE = IFOUR
  338. N2 = 1
  339. SEGINI MCHAM1
  340. MCHEL2.ICHAML(1) = MCHAM1
  341. SEGDES MCHEL2
  342. MCHAM1.NOMCHE(1) = 'SCAL '
  343. MCHAM1.TYPCHE(1) = 'REAL*8 '
  344. SEGINI MELRO
  345. MCHAM1.IELVAL(1) = MELRO
  346. SEGDES MCHAM1
  347. C
  348. C**** Pression
  349. C
  350. MCHEL1 = IROF
  351. SEGINI, MCHEL2 = MCHEL1
  352. IPF = MCHEL2
  353. MCHEL2.TITCHE = 'P '
  354. C
  355. C**** MCHAM1 = MCHAML de la densite
  356. C
  357. SEGINI, MCHAM2 = MCHAM1
  358. MCHEL2.ICHAML(1) = MCHAM2
  359. SEGDES MCHEL2
  360. SEGINI MELP
  361. MCHAM2.IELVAL(1) = MELP
  362. SEGDES MCHAM2
  363. C
  364. C**** Gamma
  365. C
  366. MCHEL1 = IROF
  367. SEGINI, MCHEL2 = MCHEL1
  368. IGAMF = MCHEL2
  369. MCHEL2.TITCHE = 'GAMMA '
  370. C
  371. C**** MCHAM1 = MCHAML de la densite
  372. C
  373. SEGINI, MCHAM2 = MCHAM1
  374. MCHEL2.ICHAML(1) = MCHAM2
  375. SEGDES MCHEL2
  376. SEGINI MELGAM
  377. MCHAM2.IELVAL(1) = MELGAM
  378. SEGDES MCHAM2
  379. C
  380. C**** Recapitulatif: les MELVALs et les MPOVALs actives
  381. C
  382. C MELVNX, MELVNY
  383. C MELT1X, MELT1Y
  384. C
  385. C MELVUN, MELVUT -> vitesse
  386. C
  387. C MELRO -> densite
  388. C
  389. C MELP -> pression
  390. C
  391. C MELGAM -> gamma
  392. C
  393. C MPROC -> densite
  394. C
  395. C MPVITC -> vitesse
  396. C
  397. C MPPC -> pression
  398. C
  399. C MPGAMC -> gamma
  400. C
  401. C MPNORM -> normales aux faces
  402. C
  403. C**** Boucle sur le faces
  404. C
  405. DO NLCF = 1, NFAC
  406. C
  407. C******* NLCF = numero local du centre de face
  408. C NGCF = numero global du centre de face
  409. C NGCEG = numero global du centre ELT "gauche"
  410. C NLCEG = numero local du centre ELT "gauche"
  411. C NGCED = numero global du centre ELT "droite"
  412. C NLCED = numero local du centre ELT "droite"
  413. C
  414. NGCEG = IPT1.NUM(1,NLCF)
  415. NGCF = IPT1.NUM(2,NLCF)
  416. NGCED = IPT1.NUM(3,NLCF)
  417. NLCEG = MLENT1.LECT(NGCEG)
  418. NLCED = MLENT1.LECT(NGCED)
  419. C
  420. C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
  421. C
  422. NGCF1 = IPT2.NUM(1,NLCF)
  423. IF( NGCF1 .NE. NGCF) THEN
  424. LOGAN = .TRUE.
  425. MESERR(1:40) = 'PRET, subroutine pre111.eso '
  426. GOTO 9999
  427. ENDIF
  428. C
  429. C******* Cosinus directeurs des NORMALES aux faces
  430. C
  431. C On impose que les normales sont direct "Gauche" -> "Centre"
  432. C
  433. XG = XCOOR((NGCEG-1)*(IDIM+1)+1)
  434. YG = XCOOR((NGCEG-1)*(IDIM+1)+2)
  435. XC = XCOOR((NGCF-1)*(IDIM+1)+1)
  436. YC = XCOOR((NGCF-1)*(IDIM+1)+2)
  437. DXG = XC - XG
  438. DYG = YC - YG
  439.  
  440. C
  441. C******* On calcule le sign du pruduit scalare
  442. C (Normales de Castem) * (vecteur "gauche" -> "centre")
  443. C
  444. CNX = MPNORM.VPOCHA(NLCF,1)
  445. CNY = MPNORM.VPOCHA(NLCF,2)
  446. ORIENT = CNX * DXG + CNY * DYG
  447. ORIENT = SIGN(1.0D0,ORIENT)
  448. IF(ORIENT .NE. 1.0D0)THEN
  449. LOGAN = .TRUE.
  450. MESERR(1:30)=
  451. & 'PRET , subroutine pre111.eso. '
  452. GOTO 9999
  453. ENDIF
  454. CNX = CNX * ORIENT
  455. CNY = CNY * ORIENT
  456. C
  457. C********** Cosinus directeurs de tangent 2D
  458. C
  459. CTX = -1.0D0 * CNY
  460. CTY = CNX
  461. C
  462. C
  463. C******* Les autres MELVALs
  464. C
  465. C
  466. C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0
  467. C GAMMA \in (1,3)
  468. C Si non il faut le faire, en utlisant LOGBOR,
  469. C LOGNEG, VALER, VAL1, VAL2
  470. C
  471. C
  472. C
  473. C******* NGCEG = NGCED -> Mur
  474. C
  475. IF( NGCEG .EQ. NGCED)THEN
  476. ROG = MPROC.VPOCHA(NLCEG , 1)
  477. PG = MPPC.VPOCHA(NLCEG, 1)
  478. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  479. UXG = MPVITC.VPOCHA(NLCEG , 1)
  480. UYG = MPVITC.VPOCHA(NLCEG , 2)
  481. UNG = UXG * CNX + UYG * CNY
  482. UTG = UXG * CTX + UYG * CTY
  483. C
  484. C********** Son etat droite
  485. C
  486. ROD = ROG
  487. PD = PG
  488. GAMD = GAMG
  489. UND = -1.0D0 * UNG
  490. UTD = UTG
  491. C
  492. C************* Fin cas mur
  493. C
  494. ELSE
  495. C
  496. C************* Etat gauche
  497. C
  498. ROG = MPROC.VPOCHA(NLCEG, 1)
  499. PG = MPPC.VPOCHA(NLCEG, 1)
  500. GAMG = MPGAMC.VPOCHA(NLCEG, 1)
  501. UXG = MPVITC.VPOCHA(NLCEG , 1)
  502. UYG = MPVITC.VPOCHA(NLCEG , 2)
  503. UNG = UXG * CNX + UYG * CNY
  504. UTG = UXG * CTX + UYG * CTY
  505. C
  506. C********** Etat gauche
  507. C
  508. ROD = MPROC.VPOCHA(NLCED,1)
  509. PD = MPPC.VPOCHA(NLCED,1)
  510. GAMD = MPGAMC.VPOCHA(NLCED,1)
  511. C
  512. C************* On suppose qu'on a déjà controlle ROG, PG > 0
  513. C Si non il faut le faire!!!
  514. C
  515. UXD = MPVITC.VPOCHA(NLCED,1)
  516. UYD = MPVITC.VPOCHA(NLCED,2)
  517. UND = UXD * CNX + UYD * CNY
  518. UTD = UXD * CTX + UYD * CTY
  519. ENDIF
  520. C
  521. C************* Les MELVALs
  522. C
  523. MELRO.VELCHE(1,NLCF) = ROG
  524. MELRO.VELCHE(3,NLCF) = ROD
  525. MELP.VELCHE(1,NLCF) = PG
  526. MELP.VELCHE(3,NLCF) = PD
  527. MELGAM.VELCHE(1,NLCF) = GAMG
  528. MELGAM.VELCHE(3,NLCF) = GAMD
  529. MELVUN.VELCHE(1,NLCF) = UNG
  530. MELVUN.VELCHE(3,NLCF) = UND
  531. MELVUT.VELCHE(1,NLCF) = UTG
  532. MELVUT.VELCHE(3,NLCF) = UTD
  533. MELVNX.VELCHE(1,NLCF) = CNX
  534. MELVNY.VELCHE(1,NLCF) = CNY
  535. MELT1X.VELCHE(1,NLCF) = CTX
  536. MELT1Y.VELCHE(1,NLCF) = CTY
  537. ENDDO
  538. C
  539. C**** Desactivation des SEGMENTs
  540. C
  541. SEGDES IPT1
  542. SEGDES IPT2
  543. C
  544. SEGDES MPROC
  545. SEGDES MPVITC
  546. SEGDES MPPC
  547. SEGDES MPGAMC
  548. SEGDES MPNORM
  549. C
  550. SEGDES MELRO
  551. SEGDES MELP
  552. SEGDES MELGAM
  553. SEGDES MELVUN
  554. SEGDES MELVUT
  555. SEGDES MELVNX
  556. SEGDES MELVNY
  557. SEGDES MELT1X
  558. SEGDES MELT1Y
  559. C
  560. C**** Destruction du MELNTI correspondance local/global
  561. C
  562. SEGSUP MLENT1
  563. C
  564. 9999 CONTINUE
  565. C
  566. RETURN
  567. END
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578.  

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