Télécharger pre31.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE31 SOURCE FANDEUR 13/01/29 21:16:15 7683
  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.  
  91. IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  92. WRITE(6,*)' On attend un objet MMODEL'
  93. RETURN
  94. ENDIF
  95. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRETOU)
  96. IF(IERR.NE.0)GOTO 9999
  97. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  98. IF(IERR.NE.0)GOTO 9999
  99. C
  100. C**** Lecture du MELEME SPG des points CENTRE.
  101. C
  102. C
  103. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  104. C
  105. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  106. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  107. C -> la correspondance global des noeuds saut!
  108. C
  109. C On peut utilizer ACCTAB ou ACMO
  110. C
  111. MTYPR = 'MAILLAGE'
  112. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  113. IF(IERR.NE.0)GOTO 9999
  114. C
  115. C**** Lecture du MELEME 'FACE'
  116. C
  117. MTYPR = 'MAILLAGE'
  118. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  119. IF(IERR.NE.0)GOTO 9999
  120. C
  121. C**** Lecture du MELEME 'FACEL'
  122. C
  123. MTYPR = 'MAILLAGE'
  124. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  125. IF(IERR.NE.0)GOTO 9999
  126. C
  127. C**** Lecture du CHPOINT contenant les normales (tangentes) aux faces
  128. C
  129. IF(IDIM .EQ. 2)THEN
  130. C Que les normales
  131. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  132. IF(IERR .NE. 0) GOTO 9999
  133. JGN = 4
  134. JGM = 2
  135. SEGINI MLMVIT
  136. MLMVIT.MOTS(1) = 'UX '
  137. MLMVIT.MOTS(2) = 'UY '
  138. CALL QUEPO1(INORM, IFACE, MLMVIT)
  139. SEGSUP MLMVIT
  140. IF(IERR.NE.0)GOTO 9999
  141. ELSE
  142. MTYPR = ' '
  143. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  144. IF (MTYPR .NE. 'CHPOINT ') THEN
  145. CALL MATRAN(IDOMA,INORM)
  146. IF(IERR .NE. 0) GOTO 9999
  147. ENDIF
  148. JGN = 4
  149. JGM = 9
  150. SEGINI MLMVIT
  151. MLMVIT.MOTS(1) = 'UX '
  152. MLMVIT.MOTS(2) = 'UY '
  153. MLMVIT.MOTS(3) = 'UZ '
  154. MLMVIT.MOTS(4) = 'RX '
  155. MLMVIT.MOTS(5) = 'RY '
  156. MLMVIT.MOTS(6) = 'RZ '
  157. MLMVIT.MOTS(7) = 'MX '
  158. MLMVIT.MOTS(8) = 'MY '
  159. MLMVIT.MOTS(9) = 'MZ '
  160. CALL QUEPO1(INORM, IFACE, MLMVIT)
  161. SEGSUP MLMVIT
  162. IF(IERR.NE.0)GOTO 9999
  163. C
  164. ENDIF
  165. C
  166. C**** Lecture de la table des proprietes du gaz
  167. C
  168. ICOND = 1
  169. CALL QUETYP(MTYPR,ICOND,IRETOU)
  170. IF(IERR .NE. 0)GOTO 9999
  171. IF(MTYPR .NE. 'TABLE ')THEN
  172. C
  173. C******* Message d'erreur standard
  174. C 37 2
  175. C On ne trouve pas d'objet de type %m1:8
  176. C
  177. MOTERR(1:8) = 'TABLE '
  178. CALL ERREUR(37)
  179. GOTO 9999
  180. ELSE
  181. ICOND = 1
  182. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  183. IF(IERR .NE. 0)GOTO 9999
  184. ENDIF
  185. C
  186. C**** Les especes qui sont dans les Equations d'Euler
  187. C
  188. MTYPR = ' '
  189. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP)
  190. IF(MTYPR .EQ. ' ')THEN
  191. NESP = 0
  192. IYC = 0
  193. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  194. C
  195. C******* Message d'erreur standard
  196. C -301 0 %m1:40
  197. C
  198. MOTERR(1:40) = 'TAB2 . ESPEULE = ??? '
  199. WRITE(IOIMP,*) MOTERR
  200. C
  201. C******* Message d'erreur standard
  202. C 21 2
  203. C Données incompatibles
  204. C
  205. CALL ERREUR(21)
  206. GOTO 9999
  207. ELSE
  208. SEGACT MLMESP
  209. NESP = MLMESP.MOTS(/2)
  210. SEGDES MLMESP
  211. ENDIF
  212. C
  213. C**** Les scalaires passifs
  214. C
  215. MTYPR = ' '
  216. CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMSCA)
  217. IF(MTYPR .EQ. ' ')THEN
  218. NSCA = 0
  219. ISCAC = 0
  220. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  221. C
  222. C******* Message d'erreur standard
  223. C -301 0 %m1:40
  224. C
  225. MOTERR(1:40) = 'TAB2 . SCALPASS = ??? '
  226. WRITE(IOIMP,*) MOTERR
  227. C
  228. C******* Message d'erreur standard
  229. C 21 2
  230. C Données incompatibles
  231. C
  232. CALL ERREUR(21)
  233. GOTO 9999
  234. ELSE
  235. SEGACT MLMSCA
  236. NSCA = MLMSCA.MOTS(/2)
  237. SEGDES MLMSCA
  238. ENDIF
  239. C
  240. C**** Lecture du CHPOINT ROC
  241. C
  242. ICOND = 1
  243. CALL QUETYP(MTYPR,ICOND,IRETOU)
  244. IF(IERR .NE. 0)GOTO 9999
  245. IF(MTYPR .NE. 'CHPOINT ')THEN
  246. C
  247. C******* Message d'erreur standard
  248. C 37 2
  249. C On ne trouve pas d'objet de type %m1:8
  250. C
  251. MOTERR(1:8) = 'CHPOINT '
  252. CALL ERREUR(37)
  253. GOTO 9999
  254. ELSE
  255. ICOND = 1
  256. CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
  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. IF (IERR.NE.0) GOTO 9999
  300. ENDIF
  301. C
  302. C**** Control du CHPOINT
  303. C
  304. JGN=4
  305. JGM=IDIM
  306. SEGINI MLMCOM
  307. MLMCOM.MOTS(1) = 'UX '
  308. MLMCOM.MOTS(2) = 'UY '
  309. IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ '
  310. CALL QUEPO1(IVITC, ICEN, MLMCOM)
  311. SEGSUP MLMCOM
  312. IF(IERR .NE. 0)THEN
  313. IERR0 = IERR
  314.  
  315. C
  316. C******* Message d'erreur standard
  317. C -301 0 %m1:40
  318. C
  319. MOTERR(1:40) = 'CHPO2 = ??? '
  320. $
  321. WRITE(IOIMP,*) MOTERR
  322.  
  323. GOTO 9999
  324. ENDIF
  325. C
  326. C**** Lecture du CHPOINT PC
  327. C
  328. ICOND = 1
  329. CALL QUETYP(MTYPR,ICOND,IRETOU)
  330. IF(IERR .NE. 0)GOTO 9999
  331. IF(MTYPR .NE. 'CHPOINT ')THEN
  332. C
  333. C******* Message d'erreur standard
  334. C 37 2
  335. C On ne trouve pas d'objet de type %m1:8
  336. C
  337. MOTERR(1:8) = 'CHPOINT '
  338. CALL ERREUR(37)
  339. GOTO 9999
  340. ELSE
  341. ICOND = 1
  342. CALL LIROBJ('CHPOINT',IPC,ICOND,IRETOU)
  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. IF (IERR.NE.0) GOTO 9999
  387. ENDIF
  388. C
  389. C**** Control du CHPOINT (on ne controlle que le maillage)
  390. C
  391. CALL QUEPO1(IYC, ICEN, MLMESP)
  392. IF(IERR .NE. 0)THEN
  393. IERR0 = IERR
  394.  
  395. C
  396. C******* Message d'erreur standard
  397. C -301 0 %m1:40
  398. C
  399. MOTERR(1:40) = 'CHPO4 = ??? '
  400. WRITE(IOIMP,*) MOTERR
  401.  
  402. GOTO 9999
  403. ENDIF
  404. ENDIF
  405. C
  406. C**** Lecture du CHPOINT ISCAC
  407. C
  408. IF(NSCA .GT. 0)THEN
  409. ICOND = 1
  410. CALL QUETYP(MTYPR,ICOND,IRETOU)
  411. IF(IERR .NE. 0)GOTO 9999
  412. IF(MTYPR .NE. 'CHPOINT ')THEN
  413. C
  414. C******* Message d'erreur standard
  415. C 37 2
  416. C On ne trouve pas d'objet de type %m1:8
  417. C
  418. MOTERR(1:8) = 'CHPOINT '
  419. CALL ERREUR(37)
  420. GOTO 9999
  421. ELSE
  422. ICOND = 1
  423. CALL LIROBJ('CHPOINT',ISCAC,ICOND,IRETOU)
  424. IF (IERR.NE.0) GOTO 9999
  425. ENDIF
  426. C
  427. C**** Control du CHPOINT (on ne controlle que le maillage)
  428. C
  429. CALL QUEPO1(ISCAC, ICEN, MLMSCA)
  430. IF(IERR .NE. 0)THEN
  431. IERR0 = IERR
  432.  
  433. C
  434. C******* Message d'erreur standard
  435. C -301 0 %m1:40
  436. C
  437. MOTERR(1:40) = 'CHPO5 = ??? '
  438. WRITE(IOIMP,*) MOTERR
  439.  
  440. GOTO 9999
  441. ENDIF
  442. ENDIF
  443. C
  444. C**** Centre -> Face
  445. C
  446. IF(IDIM .EQ. 2)THEN
  447. C
  448. C******* Deux Dimensions, Mono/Multi Especes, 1er ordre en espace, 1er ordre en
  449. C temps
  450. C
  451. CALL PRE311(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC,
  452. & IROF,IVITF,IPF,IYF,ISCAF,
  453. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  454. ELSE
  455. C
  456. C******* Trois Dimensions, Mono/Multi Especes, 1er ordre en espace,
  457. C 1er ordre en temps
  458. C
  459. C
  460. CALL PRE312(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC,
  461. & IROF,IVITF,IPF,IYF,ISCAF,
  462. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  463. ENDIF
  464. C
  465. C**** Messages d'erreur
  466. C
  467. IF(LOGAN)THEN
  468. C
  469. C******* Anomalie detectée
  470. C
  471. C
  472. C******* Message d'erreur standard
  473. C -301 0
  474. C %m1:40
  475. C
  476. MOTERR(1:40) = MESERR(1:40)
  477. WRITE(IOIMP,*) MOTERR
  478. C
  479. C******* Message d'erreur standard
  480. C 5 3
  481. C Erreur anormale.contactez votre support
  482. C
  483. CALL ERREUR(5)
  484. GOTO 9999
  485. C
  486. ELSEIF(LOGNEG)THEN
  487. C
  488. C******* Message d'erreur standard
  489. C 41 2
  490. C %m1:8 = %r1 inférieur à %r2
  491. C
  492. MOTERR(1:8) = MESERR(1:8)
  493. REAERR(1) = REAL(VALER)
  494. REAERR(2) = 0.0
  495. CALL ERREUR(41)
  496. GOTO 9999
  497. ELSEIF(LOGBOR)THEN
  498. C
  499. C******* Message d'erreur standard
  500. C 42 2
  501. C %m1:8 = %r1 non compris entre %r2 et %r3
  502. C
  503. MOTERR(1:8) = MESERR(1:8)
  504. REAERR(1) = REAL(VALER)
  505. REAERR(2) = REAL(VAL1)
  506. REAERR(3) = REAL(VAL2)
  507. CALL ERREUR(42)
  508. GOTO 9999
  509. ELSE
  510. C
  511. C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
  512. C
  513. MTYPR = 'MCHAML'
  514. IF(ISCAF .NE. 0) CALL ECROBJ(MTYPR,ISCAF)
  515. IF(IYF .NE. 0) CALL ECROBJ(MTYPR,IYF)
  516. CALL ECROBJ(MTYPR,IPF)
  517. CALL ECROBJ(MTYPR,IVITF)
  518. CALL ECROBJ(MTYPR,IROF)
  519. ENDIF
  520. C
  521. 9999 CONTINUE
  522. C
  523. RETURN
  524. END
  525.  
  526.  
  527.  

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