Télécharger pre31.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE31 SOURCE CB215821 19/07/31 21:16:23 10277
  2. SUBROUTINE PRE31()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE31
  8. C
  9. C DESCRIPTION : Voir PRE3
  10. C
  11. C Cas gaz "thermally perfect" mono/multi-especes
  12. C
  13. C 1er ordre en espace, 1er ordre en temps
  14. C
  15. C Creations des object MCHAML IROF, IVITF, IPF, IYF
  16. C
  17. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  18. C
  19. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  20. C
  21. C************************************************************************
  22. C
  23. C
  24. C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
  25. C QUEPO1, ECROBJ
  26. C
  27. C APPELES (Calcul) : PRE311 (2D), PRE312 (3D)
  28. C
  29. C
  30. C************************************************************************
  31. C
  32. C HISTORIQUE (Anomalies et modifications éventuelles)
  33. C
  34. C HISTORIQUE : Créée le 18.12.98.
  35. C
  36. C 06.02.00 transport des scalaires passifs
  37. C
  38. C************************************************************************
  39. C
  40. C
  41. C**** Variables de COOPTIO
  42. C
  43. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  44. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  45. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  46. C & ,IECHO, IIMPI, IOSPI
  47. C & ,IDIM
  48. C & ,MCOORD
  49. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  50. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  51. C & ,NORINC,NORVAL,NORIND,NORVAD
  52. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  53. C
  54. C**** Les variables
  55. C
  56. IMPLICIT INTEGER(I-N)
  57. INTEGER ICOND, IRETOU, IERR0
  58. & ,IDOMA, ICEN, IFACE, IFACEL, INORM, IROC, IVITC, IPC
  59. & ,IYC, ISCAC, IROF, IVITF, IPF, IYF, IPGAS, NESP, ISCAF
  60. & ,NSCA, INEFMD
  61. & ,MMODEL
  62. REAL*8 VALER, VAL1, VAL2
  63. CHARACTER*(8) MTYPR, TYPE
  64. CHARACTER*(40) MESERR
  65. LOGICAL LOGAN,LOGNEG, LOGBOR
  66. C
  67. C**** Les Includes
  68. C
  69. -INC CCOPTIO
  70. INTEGER JGM, JGN
  71. -INC SMLMOTS
  72. POINTEUR MLMCOM.MLMOTS, MLMESP.MLMOTS, MLMSCA.MLMOTS
  73. POINTEUR MLMVIT.MLMOTS
  74. C
  75. C**** Initialisation des parametres d'erreur
  76. C
  77. LOGAN = .FALSE.
  78. LOGNEG = .FALSE.
  79. LOGBOR = .FALSE.
  80. MESERR = ' '
  81. MOTERR(1:40) = MESERR(1:40)
  82. VALER = 0.0D0
  83. VAL1 = 0.0D0
  84. VAL2 = 0.0D0
  85. C
  86. C**** Lecture de l'objet MODELE
  87. C
  88. ICOND = 1
  89. CALL QUETYP(TYPE,ICOND,IRETOU)
  90. CALL LIROBJ('MMODEL ',MMODEL,ICOND,IRETOU)
  91. CALL ACTOBJ('MMODEL ',MMODEL,1)
  92. IF(IERR.NE.0)GOTO 9999
  93. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  94. IF(IERR.NE.0)GOTO 9999
  95. C
  96. C**** Lecture du MELEME SPG des points CENTRE.
  97. C
  98. C
  99. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  100. C
  101. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  102. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  103. C -> la correspondance global des noeuds saut!
  104. C
  105. C On peut utilizer ACCTAB ou ACMO
  106. C
  107. MTYPR = 'MAILLAGE'
  108. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  109. IF(IERR.NE.0)GOTO 9999
  110. C
  111. C**** Lecture du MELEME 'FACE'
  112. C
  113. MTYPR = 'MAILLAGE'
  114. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  115. IF(IERR.NE.0)GOTO 9999
  116. C
  117. C**** Lecture du MELEME 'FACEL'
  118. C
  119. MTYPR = 'MAILLAGE'
  120. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  121. IF(IERR.NE.0)GOTO 9999
  122. C
  123. C**** Lecture du CHPOINT contenant les normales (tangentes) aux faces
  124. C
  125. IF(IDIM .EQ. 2)THEN
  126. C Que les normales
  127. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  128. IF(IERR .NE. 0) GOTO 9999
  129. JGN = 4
  130. JGM = 2
  131. SEGINI MLMVIT
  132. MLMVIT.MOTS(1) = 'UX '
  133. MLMVIT.MOTS(2) = 'UY '
  134. CALL QUEPO1(INORM, IFACE, MLMVIT)
  135. SEGSUP MLMVIT
  136. IF(IERR.NE.0)GOTO 9999
  137. ELSE
  138. MTYPR = ' '
  139. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  140. IF (MTYPR .NE. 'CHPOINT ') THEN
  141. CALL MATRAN(IDOMA,INORM)
  142. IF(IERR .NE. 0) GOTO 9999
  143. ENDIF
  144. JGN = 4
  145. JGM = 9
  146. SEGINI MLMVIT
  147. MLMVIT.MOTS(1) = 'UX '
  148. MLMVIT.MOTS(2) = 'UY '
  149. MLMVIT.MOTS(3) = 'UZ '
  150. MLMVIT.MOTS(4) = 'RX '
  151. MLMVIT.MOTS(5) = 'RY '
  152. MLMVIT.MOTS(6) = 'RZ '
  153. MLMVIT.MOTS(7) = 'MX '
  154. MLMVIT.MOTS(8) = 'MY '
  155. MLMVIT.MOTS(9) = 'MZ '
  156. CALL QUEPO1(INORM, IFACE, MLMVIT)
  157. SEGSUP MLMVIT
  158. IF(IERR.NE.0)GOTO 9999
  159. C
  160. ENDIF
  161. C
  162. C**** Lecture de la table des proprietes du gaz
  163. C
  164. ICOND = 1
  165. CALL QUETYP(MTYPR,ICOND,IRETOU)
  166. IF(IERR .NE. 0)GOTO 9999
  167. IF(MTYPR .NE. 'TABLE ')THEN
  168. C
  169. C******* Message d'erreur standard
  170. C 37 2
  171. C On ne trouve pas d'objet de type %m1:8
  172. C
  173. MOTERR(1:8) = 'TABLE '
  174. CALL ERREUR(37)
  175. GOTO 9999
  176. ELSE
  177. ICOND = 1
  178. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  179. CALL ACTOBJ(MTYPR,IPGAS,1)
  180. IF(IERR .NE. 0)GOTO 9999
  181. ENDIF
  182. C
  183. C**** Les especes qui sont dans les Equations d'Euler
  184. C
  185. MTYPR = ' '
  186. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP)
  187. IF(MTYPR .EQ. ' ')THEN
  188. NESP = 0
  189. IYC = 0
  190. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  191. C
  192. C******* Message d'erreur standard
  193. C -301 0 %m1:40
  194. C
  195. MOTERR(1:40) = 'TAB2 . ESPEULE = ??? '
  196. WRITE(IOIMP,*) MOTERR
  197. C
  198. C******* Message d'erreur standard
  199. C 21 2
  200. C Données incompatibles
  201. C
  202. CALL ERREUR(21)
  203. GOTO 9999
  204. ELSE
  205. SEGACT MLMESP
  206. NESP = MLMESP.MOTS(/2)
  207. SEGDES MLMESP
  208. ENDIF
  209. C
  210. C**** Les scalaires passifs
  211. C
  212. MTYPR = ' '
  213. CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMSCA)
  214. IF(MTYPR .EQ. ' ')THEN
  215. NSCA = 0
  216. ISCAC = 0
  217. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  218. C
  219. C******* Message d'erreur standard
  220. C -301 0 %m1:40
  221. C
  222. MOTERR(1:40) = 'TAB2 . SCALPASS = ??? '
  223. WRITE(IOIMP,*) MOTERR
  224. C
  225. C******* Message d'erreur standard
  226. C 21 2
  227. C Données incompatibles
  228. C
  229. CALL ERREUR(21)
  230. GOTO 9999
  231. ELSE
  232. SEGACT MLMSCA
  233. NSCA = MLMSCA.MOTS(/2)
  234. SEGDES MLMSCA
  235. ENDIF
  236. C
  237. C**** Lecture du CHPOINT ROC
  238. C
  239. ICOND = 1
  240. CALL QUETYP(MTYPR,ICOND,IRETOU)
  241. IF(IERR .NE. 0)GOTO 9999
  242. IF(MTYPR .NE. 'CHPOINT ')THEN
  243. C
  244. C******* Message d'erreur standard
  245. C 37 2
  246. C On ne trouve pas d'objet de type %m1:8
  247. C
  248. MOTERR(1:8) = 'CHPOINT '
  249. CALL ERREUR(37)
  250. GOTO 9999
  251. ELSE
  252. ICOND = 1
  253. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  254. CALL ACTOBJ(MTYPR,IROC,1)
  255. IF (IERR.NE.0) GOTO 9999
  256. ENDIF
  257. C
  258. C**** Control du CHPOINT: QUEPO1
  259. C
  260. JGN=4
  261. JGM=1
  262. SEGINI MLMCOM
  263. MLMCOM.MOTS(1)='SCAL'
  264. CALL QUEPO1(IROC, ICEN, MLMCOM)
  265. SEGSUP MLMCOM
  266. IF(IERR .NE. 0)THEN
  267. IERR0 = IERR
  268.  
  269. C
  270. C******* Message d'erreur standard
  271. C -301 0 %m1:40
  272. C
  273. MOTERR(1:40) = 'CHPO1 = ??? '
  274. $
  275. WRITE(IOIMP,*) MOTERR
  276.  
  277. GOTO 9999
  278. ENDIF
  279. C
  280. C**** Lecture du CHPOINT VITC
  281. C
  282. ICOND = 1
  283. CALL QUETYP(MTYPR,ICOND,IRETOU)
  284. IF(IERR .NE. 0)GOTO 9999
  285. IF(MTYPR .NE. 'CHPOINT ')THEN
  286. C
  287. C******* Message d'erreur standard
  288. C 37 2
  289. C On ne trouve pas d'objet de type %m1:8
  290. C
  291. MOTERR(1:8) = 'CHPOINT '
  292. CALL ERREUR(37)
  293. GOTO 9999
  294. ELSE
  295. ICOND = 1
  296. CALL LIROBJ('CHPOINT',IVITC,ICOND,IRETOU)
  297. CALL ACTOBJ('CHPOINT',IVITC,1)
  298. IF (IERR.NE.0) GOTO 9999
  299. ENDIF
  300. C
  301. C**** Control du CHPOINT
  302. C
  303. JGN=4
  304. JGM=IDIM
  305. SEGINI MLMCOM
  306. MLMCOM.MOTS(1) = 'UX '
  307. MLMCOM.MOTS(2) = 'UY '
  308. IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ '
  309. CALL QUEPO1(IVITC, ICEN, MLMCOM)
  310. SEGSUP MLMCOM
  311. IF(IERR .NE. 0)THEN
  312. IERR0 = IERR
  313.  
  314. C
  315. C******* Message d'erreur standard
  316. C -301 0 %m1:40
  317. C
  318. MOTERR(1:40) = 'CHPO2 = ??? '
  319. $
  320. WRITE(IOIMP,*) MOTERR
  321.  
  322. GOTO 9999
  323. ENDIF
  324. C
  325. C**** Lecture du CHPOINT PC
  326. C
  327. ICOND = 1
  328. CALL QUETYP(MTYPR,ICOND,IRETOU)
  329. IF(IERR .NE. 0)GOTO 9999
  330. IF(MTYPR .NE. 'CHPOINT ')THEN
  331. C
  332. C******* Message d'erreur standard
  333. C 37 2
  334. C On ne trouve pas d'objet de type %m1:8
  335. C
  336. MOTERR(1:8) = 'CHPOINT '
  337. CALL ERREUR(37)
  338. GOTO 9999
  339. ELSE
  340. ICOND = 1
  341. CALL LIROBJ('CHPOINT',IPC,ICOND,IRETOU)
  342. CALL ACTOBJ('CHPOINT',IPC,1)
  343. IF (IERR.NE.0) GOTO 9999
  344. ENDIF
  345. C
  346. C**** Control du CHPOINT
  347. C
  348. JGN=4
  349. JGM=1
  350. SEGINI MLMCOM
  351. MLMCOM.MOTS(1)='SCAL'
  352. CALL QUEPO1(IPC, ICEN, MLMCOM)
  353. SEGSUP MLMCOM
  354. IF(IERR .NE. 0)THEN
  355. IERR0 = IERR
  356.  
  357. C
  358. C******* Message d'erreur standard
  359. C -301 0 %m1:40
  360. C
  361. MOTERR(1:40) = 'CHPO3 = ??? '
  362. $
  363. WRITE(IOIMP,*) MOTERR
  364.  
  365. GOTO 9999
  366. ENDIF
  367. C
  368. C**** Lecture du CHPOINT YC
  369. C
  370. IF(NESP .GT. 0)THEN
  371. ICOND = 1
  372. CALL QUETYP(MTYPR,ICOND,IRETOU)
  373. IF(IERR .NE. 0)GOTO 9999
  374. IF(MTYPR .NE. 'CHPOINT ')THEN
  375. C
  376. C******* Message d'erreur standard
  377. C 37 2
  378. C On ne trouve pas d'objet de type %m1:8
  379. C
  380. MOTERR(1:8) = 'CHPOINT '
  381. CALL ERREUR(37)
  382. GOTO 9999
  383. ELSE
  384. ICOND = 1
  385. CALL LIROBJ('CHPOINT',IYC,ICOND,IRETOU)
  386. CALL ACTOBJ('CHPOINT',IYC,1)
  387. IF (IERR.NE.0) GOTO 9999
  388. ENDIF
  389. C
  390. C**** Control du CHPOINT (on ne controlle que le maillage)
  391. C
  392. CALL QUEPO1(IYC, ICEN, MLMESP)
  393. IF(IERR .NE. 0)THEN
  394. IERR0 = IERR
  395.  
  396. C
  397. C******* Message d'erreur standard
  398. C -301 0 %m1:40
  399. C
  400. MOTERR(1:40) = 'CHPO4 = ??? '
  401. WRITE(IOIMP,*) MOTERR
  402.  
  403. GOTO 9999
  404. ENDIF
  405. ENDIF
  406. C
  407. C**** Lecture du CHPOINT ISCAC
  408. C
  409. IF(NSCA .GT. 0)THEN
  410. ICOND = 1
  411. CALL QUETYP(MTYPR,ICOND,IRETOU)
  412. IF(IERR .NE. 0)GOTO 9999
  413. IF(MTYPR .NE. 'CHPOINT ')THEN
  414. C
  415. C******* Message d'erreur standard
  416. C 37 2
  417. C On ne trouve pas d'objet de type %m1:8
  418. C
  419. MOTERR(1:8) = 'CHPOINT '
  420. CALL ERREUR(37)
  421. GOTO 9999
  422. ELSE
  423. ICOND = 1
  424. CALL LIROBJ('CHPOINT',ISCAC,ICOND,IRETOU)
  425. CALL ACTOBJ('CHPOINT',ISCAC,1)
  426. IF (IERR.NE.0) GOTO 9999
  427. ENDIF
  428. C
  429. C**** Control du CHPOINT (on ne controlle que le maillage)
  430. C
  431. CALL QUEPO1(ISCAC, ICEN, MLMSCA)
  432. IF(IERR .NE. 0)THEN
  433. IERR0 = IERR
  434.  
  435. C
  436. C******* Message d'erreur standard
  437. C -301 0 %m1:40
  438. C
  439. MOTERR(1:40) = 'CHPO5 = ??? '
  440. WRITE(IOIMP,*) MOTERR
  441.  
  442. GOTO 9999
  443. ENDIF
  444. ENDIF
  445. C
  446. C**** Centre -> Face
  447. C
  448. IF(IDIM .EQ. 2)THEN
  449. C
  450. C******* Deux Dimensions, Mono/Multi Especes, 1er ordre en espace, 1er ordre en
  451. C temps
  452. C
  453. CALL PRE311(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC,
  454. & IROF,IVITF,IPF,IYF,ISCAF,
  455. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  456. ELSE
  457. C
  458. C******* Trois Dimensions, Mono/Multi Especes, 1er ordre en espace,
  459. C 1er ordre en temps
  460. C
  461. C
  462. CALL PRE312(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC,
  463. & IROF,IVITF,IPF,IYF,ISCAF,
  464. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  465. ENDIF
  466. C
  467. C**** Messages d'erreur
  468. C
  469. IF(LOGAN)THEN
  470. C
  471. C******* Anomalie detectée
  472. C
  473. C
  474. C******* Message d'erreur standard
  475. C -301 0
  476. C %m1:40
  477. C
  478. MOTERR(1:40) = MESERR(1:40)
  479. WRITE(IOIMP,*) MOTERR
  480. C
  481. C******* Message d'erreur standard
  482. C 5 3
  483. C Erreur anormale.contactez votre support
  484. C
  485. CALL ERREUR(5)
  486. GOTO 9999
  487. C
  488. ELSEIF(LOGNEG)THEN
  489. C
  490. C******* Message d'erreur standard
  491. C 41 2
  492. C %m1:8 = %r1 inférieur à %r2
  493. C
  494. MOTERR(1:8) = MESERR(1:8)
  495. REAERR(1) = REAL(VALER)
  496. REAERR(2) = 0.0
  497. CALL ERREUR(41)
  498. GOTO 9999
  499. ELSEIF(LOGBOR)THEN
  500. C
  501. C******* Message d'erreur standard
  502. C 42 2
  503. C %m1:8 = %r1 non compris entre %r2 et %r3
  504. C
  505. MOTERR(1:8) = MESERR(1:8)
  506. REAERR(1) = REAL(VALER)
  507. REAERR(2) = REAL(VAL1)
  508. REAERR(3) = REAL(VAL2)
  509. CALL ERREUR(42)
  510. GOTO 9999
  511. ELSE
  512. C
  513. C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
  514. C
  515. MTYPR = 'MCHAML '
  516. IF(ISCAF .NE. 0) THEN
  517. CALL ACTOBJ(MTYPR,ISCAF,1)
  518. CALL ECROBJ(MTYPR,ISCAF)
  519. ENDIF
  520. IF(IYF .NE. 0) THEN
  521. CALL ACTOBJ(MTYPR,IYF,1)
  522. CALL ECROBJ(MTYPR,IYF)
  523. ENDIF
  524. CALL ACTOBJ(MTYPR,IPF,1)
  525. CALL ACTOBJ(MTYPR,IVITF,1)
  526. CALL ACTOBJ(MTYPR,IROF,1)
  527.  
  528. CALL ECROBJ(MTYPR,IPF)
  529. CALL ECROBJ(MTYPR,IVITF)
  530. CALL ECROBJ(MTYPR,IROF)
  531. ENDIF
  532. C
  533. 9999 CONTINUE
  534. END
  535.  
  536.  
  537.  

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