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

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