Télécharger primi1.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIMI1 SOURCE CHAT 06/03/29 21:30:22 5360
  2. SUBROUTINE PRIMI1()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRIMI1
  8. C
  9. C DESCRIPTION : Voir PRIMIT
  10. C
  11. C Calcul des variables primitives (et du "gamma")
  12. C pour les gaz "thermally perfect" mono/multiespeces
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. C APPELES (E/S) : LIRENT, ACMO, LIROBJ, QUEPOI, ERREUR, ECROBJ
  22. C
  23. C APPELES (Calcul) : PRIMI2
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C
  29. C PHRASE D'APPEL (GIBIANE) :
  30. C
  31. C 2) gaz "thermally" parfait mono/multi-especes (NESP > ou = 1)
  32. C
  33. C RCHPO1 RCHPO2 RCHPO3 (RCHPO4) RCHPO5 = 'PRIM' MCLE1 TAB1
  34. C CHPO1 CHPO2 CHPO3 (CHPO4) (CHPO5) (MCLE2) ;
  35. C
  36. C
  37. C ENTREES :
  38. C
  39. C MCLE1 : 'PERFMULT' : mot clé
  40. C
  41. C
  42. C TAB1 : TABLE qui contient :
  43. C * les noms des especes qui apparessent
  44. C explicitement dans les equations d'Euler en
  45. C TAB1 . 'ESPEULE' (LISTMOTS).
  46. C Dans le cas monoespece TAB1 . 'ESPEULE'
  47. C n'existe pas;
  48. C * le nom de l'espece qui n'y est pas (mots), en
  49. C TAB1 . 'ESPNEULE' (MOT).
  50. C * le degre k des polynoms cv_i(T)
  51. C * les CV du gas, supposes etre des polynoms du
  52. C k-eme degre, i.e.
  53. C CV_i = \sum_{j=0,k} A_{i,j} T^j (en J/Kg/K) ;
  54. C Ils sont stokes, pour l'espece 'ESPI', dans la
  55. C forme:
  56. C TAB1 . 'ESPI' . 'A' = 'PROG' A_0, ..., A_k
  57. C * Les constantes du gaz R_i; pour l'espece 'ESPI'
  58. C TAB1 . 'ESPI' . 'R' (en J/Kg/K)
  59. C * Les "energies de formation" a 0K, definies par
  60. C e_{0,i} = h_{0,i} = h_{T_0,i} - {R_i * T_0 +
  61. C {\sum_{j=0,k} A_{i,j} / (j+1) T_0^(j+1)}};
  62. C Elles sont stokes, pour l'espece 'ESPI', dans
  63. C la forme
  64. C TAB1 . 'ESPI' . 'H0K'
  65. C * (éventuellement) les noms de scalaires passifs qu'on
  66. C voudrait transporter en
  67. C TAB1 . 'SCALPASS' (LISTMOTS)
  68. C
  69. C CHPO1 : CHPOINT contenant la masse volumique (en Kg/m^3)
  70. C (une composante, 'SCAL').
  71. C
  72. C CHPO2 : CHPOINT contenant les dèbits (en m/s)
  73. C (2 composantes en 2D, 'UX ','UY ');
  74. C (3 composantes en 3D, 'UX ','UY ','UZ ');
  75. C
  76. C CHPO3 : CHPOINT contenat l'énergie totale per
  77. C unité de volume (RHO Et), (en J/m^3)
  78. C (une composante, 'SCAL').
  79. C
  80. C (CHPO4) : CHPOINT contenant la masse des especes qui sont
  81. C explicitement "splitted" dans les equations
  82. C d'Eulers (dont les noms sont dans
  83. C TAB1 . 'ESPEULE');
  84. C
  85. C (CHPO5) : CHPOINT contenant les scalaires passifs qu'on transporte,
  86. C multipliés par la masse volumique
  87. C (si existe TAB1 . 'SCALPASS');
  88. C
  89. C (CHPO6) : CHPOINT contenant la temperature de premier
  90. C essai pour la methode de Newton-Raphson (en K);
  91. C si il n'est pas donne' on prends T = 600K
  92. C
  93. C i.e. CHPO1, CHPO2, CHPO3, CHPO4 sont les variables
  94. C conservatives des Equations d'Euler.
  95. C
  96. C MCLE2 : Option personelle: pas dans la notice
  97. C officielle!!!
  98. C Mot clé, 'TRICHE' (s'il y a un erreur,
  99. C les resultats ne sont pas
  100. C des type ANNULLE et le programme
  101. C ne s'arrete pas!!!)
  102. C
  103. C SORTIES :
  104. C
  105. C RCHPO1 : CHPOINT contenant la vitesse
  106. C
  107. C RCHPO2 : CHPOINT contenant la pression du gaz;
  108. C
  109. C RCHPO3 : CHPOINT contenant la temperature du gaz;
  110. C
  111. C (RCHPO4) : CHPOINT contenant les fractions
  112. C massiques des differentes especes;
  113. C
  114. C (RCHPO5) : CHPOINT contenant les scalaire passifs;
  115. C
  116. C RCHPO6 : CHPOINT contenat les "gamma" du gaz
  117. C
  118. C N.B.:-tous les CHPOINTs sont non-partitonees et
  119. C ils ont le meme support geometrique;
  120. C en sortie tous les CHPOINTs ont le support
  121. C geometrique de RO
  122. C -en sortie RCHPO4 et CHPO4 ont les composantes ordonnees
  123. C dans le sens de TAB1 . 'ESPEULE'
  124. C
  125. C************************************************************************
  126. C
  127. C HISTORIQUE (Anomalies et modifications éventuelles)
  128. C
  129. C HISTORIQUE : Créée le 14.12.98.
  130. C
  131. C 10.02.2000:
  132. C Correction d'un erreur informatique (voir ligne CERR1),
  133. C qui apparait dans le cas d'un gaz avec deux espèces
  134. C
  135. C 11.02.2000:
  136. C on ajout la possibilité de considérer des scalaires
  137. C passifs
  138. C
  139. C
  140. C************************************************************************
  141. C
  142. C
  143. C**** Variables de COOPTIO
  144. C
  145. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  146. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  147. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  148. C & ,IECHO, IIMPI, IOSPI
  149. C & ,IDIM
  150. C & ,MCOORD
  151. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  152. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  153. C & ,NORINC,NORVAL,NORIND,NORVAD
  154. C & ,NUCROU, IPSAUV, IROSCA, NSCA, ISCA
  155. C
  156. C**** Les variables
  157. C
  158. IMPLICIT INTEGER(I-N)
  159. INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
  160. & , NESP, ICEN, IRO, IROVIT, IROET, IROY, IT
  161. & , IPGAS, IESP
  162. & , IPRES, IVIT, ITEMP, IY, IGAM
  163. & , I1, I2, JGM, JGN, NPOINT, NORD, NORDP1, NORD1
  164. REAL*8 VALER(2),VAL1,VAL2
  165. CHARACTER*(40) MESERR(2),MESCEL
  166. CHARACTER*(8) MTYPR
  167. CHARACTER*(6) NOMTRI
  168. CHARACTER*(4) MOT1(1)
  169. LOGICAL LOGNEG, LOGBOR, LOGAN, LOGTRI
  170. & ,LOGTEM, LOGIPG, LOGNC
  171. C
  172. C**** Variables en ACCTAB
  173. C
  174. INTEGER IVALI, IRETI,IVALR, IRETR
  175. REAL*8 XVALI, XVALR
  176. LOGICAL LOGII, LOGIR
  177. CHARACTER*(8) CHARR,MTYPI
  178. C
  179. C**** Segment des proprietes du gaz
  180. C
  181. SEGMENT PROPHY
  182. REAL*8 ACV(NORD+1,NESP+1), R(NESP+1), H0K(NESP+1)
  183. ENDSEGMENT
  184. C
  185. C**** Les Includes
  186. C
  187. -INC CCOPTIO
  188. -INC SMCHPOI
  189. -INC SMLMOTS
  190. -INC SMLREEL
  191. POINTEUR MLMOSC.MLMOTS
  192. C
  193. C**** Initialisation des parametres d'erreur
  194. C
  195. LOGAN = .FALSE.
  196. LOGNEG = .FALSE.
  197. LOGBOR = .FALSE.
  198. LOGNC = .FALSE.
  199. LOGIPG = .FALSE.
  200. MESCEL = ' '
  201. MESERR(1) = MESCEL
  202. MESERR(2) = MESCEL
  203. MOTERR(1:40) = MESCEL(1:40)
  204. VALER(1) = 0.0D0
  205. VALER(2) = 0.0D0
  206. VAL1 = 0.0D0
  207. VAL2 = 0.0D0
  208. C
  209. C**** Initialisation des variables en ACCTAB
  210. C
  211. IVALI = 0
  212. IVALR = 0
  213. XVALI = 0.0D0
  214. XVALR = 0.0D0
  215. LOGII = .FALSE.
  216. LOGIR = .FALSE.
  217. IRETI = 0
  218. IRETR = 0
  219. CHARR = ' '
  220. C
  221. C**** Initialisation des MOT1(1) (noms des composantes)
  222. C
  223. MOT1(1) = ' '
  224. C
  225. C**** N.B. On veut lire les objets sequentiellement.
  226. C Donc on utilise QUETYP pour controler que
  227. C le type de l'objet soit le bon.
  228. C
  229. C**** Lecture de la table des proprietes du gaz
  230. C
  231. ICOND = 1
  232. CALL QUETYP(MTYPR,ICOND,IRETOU)
  233. IF(IERR .NE. 0)GOTO 9999
  234. IF(MTYPR .NE. 'TABLE ')THEN
  235. C
  236. C******* Message d'erreur standard
  237. C 37 2
  238. C On ne trouve pas d'objet de type %m1:8
  239. C
  240. MOTERR(1:8) = 'TABLE '
  241. CALL ERREUR(37)
  242. GOTO 9999
  243. ELSE
  244. ICOND = 1
  245. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  246. IF(IERR .NE. 0)GOTO 9999
  247. ENDIF
  248. C
  249. C**** Ordre des polynoms pour les cv_i
  250. C
  251. MTYPI = 'MOT '
  252. MTYPR = ' '
  253. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
  254. & MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
  255. IF(MTYPR .NE. 'ENTIER ')THEN
  256. C
  257. C******* Message d'erreur standard
  258. C -301 0 %m1:40
  259. C
  260. MOTERR(1:40) = 'TAB1 . NORD = ??? '
  261. WRITE(IOIMP,*) MOTERR(1:40)
  262. C
  263. C******* Message d'erreur standard
  264. C 21 2
  265. C Données incompatibles
  266. C
  267. CALL ERREUR(21)
  268. GOTO 9999
  269. ENDIF
  270. NORDP1 = NORD + 1
  271. C
  272. C**** Nom de l'espece qui n'est pas dans les equations d'Euler
  273. C
  274. MTYPI = 'MOT '
  275. MTYPR = ' '
  276. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI,
  277. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  278. IF(MTYPR .NE. 'MOT ')THEN
  279. C
  280. C******* Message d'erreur standard
  281. C -301 0 %m1:40
  282. C
  283. MOTERR(1:40) = 'TAB1 . ESPNEULE = ??? '
  284. WRITE(IOIMP,*) MOTERR(1:40)
  285. C
  286. C******* Message d'erreur standard
  287. C 21 2
  288. C Données incompatibles
  289. C
  290. CALL ERREUR(21)
  291. GOTO 9999
  292. ENDIF
  293. C
  294. C**** Les especes qui sont dans les Equations d'Euler
  295. C
  296. MTYPR = ' '
  297. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
  298. IF(MTYPR .EQ. ' ')THEN
  299. NESP = 0
  300. IROY = 0
  301. JGN = 4
  302. JGM = 1
  303. C
  304. C******* JGN,JGM en MLMOT2:
  305. C CHARACTER*(JGN) MOTS(JGM)
  306. C
  307. SEGINI MLMOT2
  308. MLMOT2.MOTS(1) = CHARR(1:4)
  309. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  310. C
  311. C******* Message d'erreur standard
  312. C -301 0 %m1:40
  313. C
  314. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  315. WRITE(IOIMP,*) MOTERR(1:40)
  316. C
  317. C******* Message d'erreur standard
  318. C 21 2
  319. C Données incompatibles
  320. C
  321. CALL ERREUR(21)
  322. GOTO 9999
  323. ELSE
  324. SEGACT MLMOT1
  325. NESP = MLMOT1.MOTS(/2)
  326. JGN = 4
  327. JGM = NESP + 1
  328. SEGINI MLMOT2
  329. DO I1 = 1, NESP
  330. MLMOT2.MOTS(I1) = MLMOT1.MOTS(I1)
  331. ENDDO
  332. MLMOT2.MOTS(NESP+1)=CHARR(1:4)
  333. SEGDES MLMOT1
  334. ENDIF
  335. C
  336. C**** Les scalaires passifs qui sont dans les Equations d'Euler
  337. C
  338. MTYPR = ' '
  339. CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMOSC)
  340. IF(MTYPR .EQ. ' ')THEN
  341. NSCA = 0
  342. IROSCA = 0
  343. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  344. C
  345. C******* Message d'erreur standard
  346. C -301 0 %m1:40
  347. C
  348. MOTERR(1:40) = 'TAB1 . SCALPASS = ??? '
  349. WRITE(IOIMP,*) MOTERR(1:40)
  350. C
  351. C******* Message d'erreur standard
  352. C 21 2
  353. C Données incompatibles
  354. C
  355. CALL ERREUR(21)
  356. GOTO 9999
  357. ELSE
  358. SEGACT MLMOSC
  359. NSCA = MLMOSC.MOTS(/2)
  360. SEGDES MLMOSC
  361. ENDIF
  362. C
  363. C**** On rempli les segment PROPHY
  364. C Ordre: IPGAS . 'ESPEULE' + IPGAS . 'ESPNEULE'
  365. C On controlle aussi la compatibilite des
  366. C donnes de la table
  367. C
  368. SEGINI PROPHY
  369. C
  370. C**** N.B. MOT1 est un CHARACTER*(4)
  371. C
  372. DO I1 = 1, NESP+1
  373. MOT1(1) = MLMOT2.MOTS(I1)
  374. C
  375. C******* CALL ACMF(...) ne marche pas parce que on a
  376. C des blanches dans nos composantes
  377. C
  378. MTYPI = 'MOT '
  379. MTYPR = ' '
  380. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  381. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  382. C
  383. C******* En IESP a la table IPGAS.MOT1(1)
  384. C
  385. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
  386.  
  387. C
  388. C********** Message d'erreur standard
  389. C -301 0 %m1:40
  390. C
  391. MOTERR = ' '
  392. MOTERR(1:7) = 'TAB1 . '
  393. MOTERR(8:11) = MOT1(1)
  394. MOTERR(13:17) = '= ???'
  395. WRITE(IOIMP,*) MOTERR(1:40)
  396. C
  397. C********** Message d'erreur standard
  398. C 21 2
  399. C Données incompatibles
  400. C
  401. CALL ERREUR(21)
  402. GOTO 9999
  403. ENDIF
  404. C
  405. C******* R
  406. C
  407. MTYPI = 'MOT '
  408. MTYPR = ' '
  409. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'R' , LOGII,IRETI,
  410. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  411. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  412. C
  413. C********** Message d'erreur standard
  414. C -301 0 %m1:40
  415. C
  416. MOTERR = ' '
  417. MOTERR(1:7) = 'TAB1 . '
  418. MOTERR(8:11) = MOT1(1)
  419. MOTERR(13:23) = ' . R = ??? '
  420. WRITE(IOIMP,*) MOTERR(1:40)
  421. C
  422. C********** Message d'erreur standard
  423. C 21 2
  424. C Données incompatibles
  425. C
  426. CALL ERREUR(21)
  427. GOTO 9999
  428. ENDIF
  429. PROPHY.R(I1)=XVALR
  430. C
  431. C******* H0K
  432. C
  433. MTYPI = 'MOT '
  434. MTYPR = ' '
  435. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
  436. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  437. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  438.  
  439. C
  440. C********** Message d'erreur standard
  441. C -301 0 %m1:40
  442. C
  443. MOTERR = ' '
  444. MOTERR(1:7) = 'TAB1 . '
  445. MOTERR(8:11) = MOT1(1)
  446. MOTERR(13:25) = ' . H0K = ??? '
  447. WRITE(IOIMP,*) MOTERR(1:40)
  448. C
  449. C********** Message d'erreur standard
  450. C 21 2
  451. C Données incompatibles
  452. C
  453. CALL ERREUR(21)
  454. GOTO 9999
  455. ENDIF
  456. PROPHY.H0K(I1)=XVALR
  457. C
  458. C******* A
  459. C
  460. MTYPI = 'MOT '
  461. MTYPR = ' '
  462. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
  463. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  464. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
  465.  
  466. C
  467. C********** Message d'erreur standard
  468. C -301 0 %m1:40
  469. C
  470. MOTERR = ' '
  471. MOTERR(1:7) = 'TAB1 . '
  472. MOTERR(8:11) = MOT1(1)
  473. MOTERR(13:23) = ' . A = ??? '
  474. WRITE(IOIMP,*) MOTERR(1:40)
  475. C
  476. C********** Message d'erreur standard
  477. C 21 2
  478. C Données incompatibles
  479. C
  480. CALL ERREUR(21)
  481. GOTO 9999
  482. ENDIF
  483. MLREEL = IRETR
  484. SEGACT MLREEL
  485. NORD1 = MLREEL.PROG(/1)
  486. IF(NORD1 .NE. NORDP1)THEN
  487. C
  488. C********** Message d'erreur standard
  489. C -301 0 %m1:40
  490. C
  491. MOTERR = ' '
  492. MOTERR(1:10) = 'DIME(TAB1.'
  493. MOTERR(11:14) = MOT1(1)
  494. MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
  495. WRITE(IOIMP,*) MOTERR(1:40)
  496. C
  497. C********** Message d'erreur standard
  498. C 21 2
  499. C Données incompatibles
  500. C
  501. CALL ERREUR(21)
  502. GOTO 9999
  503. ENDIF
  504.  
  505. C
  506. C******* Dans le calcul, c'est plus utile ACV dans la forme
  507. C ACV(exponente,espece)
  508. C
  509. DO I2 = 1, NORDP1
  510. PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
  511. ENDDO
  512. SEGDES MLREEL
  513. ENDDO
  514. SEGSUP MLMOT2
  515. C
  516. C**** La table IPGAS donc a ete controllee et PROPHY est rempli
  517. C
  518. C
  519. C**** Lecture du CHPOINT CHPO1 (masse volumique totale)
  520. C
  521. ICOND = 1
  522. CALL QUETYP(MTYPR,ICOND,IRETOU)
  523. IF(IERR .NE. 0)GOTO 9999
  524. IF(MTYPR .NE. 'CHPOINT ')THEN
  525. C
  526. C******* Message d'erreur standard
  527. C 37 2
  528. C On ne trouve pas d'objet de type %m1:8
  529. C
  530. MOTERR(1:8) = 'CHPOINT '
  531. CALL ERREUR(37)
  532. GOTO 9999
  533. ELSE
  534. ICOND = 1
  535. CALL LIROBJ(MTYPR,IRO,ICOND,IRETOU)
  536. IF(IERR .NE. 0)GOTO 9999
  537. ENDIF
  538. C
  539. C**** On cherche le pointeur de son maillage et on l'impose sur les
  540. C autres CHPOINTs
  541. C
  542. MCHPOI = IRO
  543. SEGACT MCHPOI
  544. MSOUPO = MCHPOI.IPCHP(1)
  545. SEGACT MSOUPO
  546. ICEN = MSOUPO.IGEOC
  547. SEGDES MSOUPO
  548. SEGDES MCHPOI
  549. C
  550. C**** Control du CHPOINT: QUEPOI
  551. C
  552. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  553. C N.B. Le CHPOINT peut changer de structure pour
  554. C avoir SPG = ICEN!!!!
  555. C INDIC = 0 -> on ne fait que verifier le support geometrique
  556. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  557. C
  558. C NBCOMP > 0 -> numero des composantes
  559. C
  560. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  561. C
  562. INDIC = 1
  563. NBCOMP = 1
  564. MOT1(1) = 'SCAL'
  565. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT1)
  566. IF(IERR .NE. 0)THEN
  567. IERR0 = IERR
  568.  
  569. C
  570. C******** Message d'erreur standard
  571. C -301 0 %m1:40
  572. C
  573. MOTERR = 'CHPO1 = ??? '
  574. WRITE(IOIMP,*) MOTERR(1:40)
  575.  
  576. GOTO 9999
  577. ENDIF
  578. C
  579. C**** Lecture du CHPOINT CHPO2( debits)
  580. C
  581. ICOND = 1
  582. CALL QUETYP(MTYPR,ICOND,IRETOU)
  583. IF(IERR .NE. 0)GOTO 9999
  584. IF(MTYPR .NE. 'CHPOINT ')THEN
  585. C
  586. C******* Message d'erreur standard
  587. C 37 2
  588. C On ne trouve pas d'objet de type %m1:8
  589. C
  590. MOTERR(1:8) = 'CHPOINT '
  591. CALL ERREUR(37)
  592. GOTO 9999
  593. ELSE
  594. ICOND = 1
  595. CALL LIROBJ(MTYPR,IROVIT,ICOND,IRETOU)
  596. IF(IERR .NE. 0)GOTO 9999
  597. ENDIF
  598. C
  599. C**** Control du CHPOINT
  600. C
  601. C
  602. CERR2
  603. C
  604. JGN = 4
  605. JGM = IDIM
  606. SEGINI MLMOTS
  607. MLMOTS.MOTS(1) = 'UX '
  608. MLMOTS.MOTS(2) = 'UY '
  609. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  610. C
  611. C**** On controlle l'ordre de composantes de IROVIT
  612. C
  613. CALL QUEPO1(IROVIT, ICEN, MLMOTS)
  614. IF(IERR .NE. 0)THEN
  615. IERR0 = IERR
  616.  
  617. C
  618. C******** Message d'erreur standard
  619. C -301 0 %m1:40
  620. C
  621. MOTERR = 'CHPO2 = ??? '
  622. WRITE(IOIMP,*) MOTERR(1:40)
  623.  
  624. GOTO 9999
  625. ENDIF
  626. C
  627. C**** Lecture du CHPOINT CHPO3 (energie volumique)
  628. C
  629. ICOND = 1
  630. CALL QUETYP(MTYPR,ICOND,IRETOU)
  631. IF(IERR .NE. 0)GOTO 9999
  632. IF(MTYPR .NE. 'CHPOINT ')THEN
  633. C
  634. C******* Message d'erreur standard
  635. C 37 2
  636. C On ne trouve pas d'objet de type %m1:8
  637. C
  638. MOTERR(1:8) = 'CHPOINT '
  639. CALL ERREUR(37)
  640. GOTO 9999
  641. ELSE
  642. ICOND = 1
  643. CALL LIROBJ(MTYPR,IROET,ICOND,IRETOU)
  644. IF(IERR .NE. 0)GOTO 9999
  645. ENDIF
  646. C
  647. C**** Control du CHPOINT
  648. C
  649. INDIC = 1
  650. NBCOMP = 1
  651. MOT1(1) = 'SCAL'
  652. CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT1)
  653. IF(IERR .NE. 0)THEN
  654. IERR0 = IERR
  655.  
  656. C
  657. C******** Message d'erreur standard
  658. C -301 0 %m1:40
  659. C
  660. MOTERR = 'CHPO3 = ??? '
  661. WRITE(IOIMP,*) MOTERR(1:40)
  662.  
  663. GOTO 9999
  664. ENDIF
  665. C
  666. C**** Lecture du CHPOINT CHPO4(masses volumiques des especes "splittees")
  667. C
  668. CERR1 IF(NESP .GT. 1)THEN: erreur: NESP = 0 dans le cas monoespece
  669. C NESP > 0 dans le cas multiespece
  670. IF(NESP .GE. 1)THEN
  671. ICOND = 1
  672. CALL QUETYP(MTYPR,ICOND,IRETOU)
  673. IF(IERR .NE. 0)GOTO 9999
  674. IF(MTYPR .NE. 'CHPOINT ')THEN
  675. C
  676. C******* Message d'erreur standard
  677. C 37 2
  678. C On ne trouve pas d'objet de type %m1:8
  679. C
  680. MOTERR(1:8) = 'CHPOINT '
  681. CALL ERREUR(37)
  682. GOTO 9999
  683. ELSE
  684. ICOND = 1
  685. CALL LIROBJ(MTYPR,IROY,ICOND,IRETOU)
  686. IF(IERR .NE. 0)GOTO 9999
  687. ENDIF
  688. C
  689. C**** Control du CHPOINT
  690. C
  691. CALL QUEPO1(IROY , ICEN , MLMOT1)
  692. IF(IERR .NE. 0)THEN
  693.  
  694. C
  695. C******* Message d'erreur standard
  696. C -301 0 %m1:40
  697. C
  698. MOTERR = 'CHPO4 = ??? '
  699. WRITE(IOIMP,*) MOTERR(1:40)
  700. C
  701. C******* Message d'erreur standard
  702. C 21 2
  703. C Données incompatibles
  704. C
  705. CALL ERREUR(21)
  706. GOTO 9999
  707. ENDIF
  708. ENDIF
  709. C
  710. C**** Lecture du CHPOINT CHPO5 (scalaires passifs * densité)
  711. C
  712. IF(NSCA .GE. 1)THEN
  713. ICOND = 1
  714. CALL QUETYP(MTYPR,ICOND,IRETOU)
  715. IF(IERR .NE. 0)GOTO 9999
  716. IF(MTYPR .NE. 'CHPOINT ')THEN
  717. C
  718. C******* Message d'erreur standard
  719. C 37 2
  720. C On ne trouve pas d'objet de type %m1:8
  721. C
  722. MOTERR(1:8) = 'CHPOINT '
  723. CALL ERREUR(37)
  724. GOTO 9999
  725. ELSE
  726. ICOND = 1
  727. CALL LIROBJ(MTYPR,IROSCA,ICOND,IRETOU)
  728. IF(IERR .NE. 0)GOTO 9999
  729. ENDIF
  730. C
  731. C**** Control du CHPOINT
  732. C
  733. CALL QUEPO1(IROSCA , ICEN , MLMOSC)
  734. IF(IERR .NE. 0)THEN
  735.  
  736. C
  737. C******* Message d'erreur standard
  738. C -301 0 %m1:40
  739. C
  740. MOTERR = 'CHPO5 = ??? '
  741. WRITE(IOIMP,*) MOTERR(1:40)
  742. C
  743. C******* Message d'erreur standard
  744. C 21 2
  745. C Données incompatibles
  746. C
  747. CALL ERREUR(21)
  748. GOTO 9999
  749. ENDIF
  750. ENDIF
  751. C
  752. C**** Lecture du CHPOINT CHPO6(temperature de tentative, optionelle)
  753. C
  754. ICOND = 0
  755. MTYPR = 'CHPOINT '
  756. CALL LIROBJ(MTYPR,IT,ICOND,IRETOU)
  757. IF(IERR .NE. 0)GOTO 9999
  758. IF(IRETOU .EQ. 1)THEN
  759. C
  760. C****** Control du CHPOINT
  761. C
  762. INDIC = 1
  763. NBCOMP = 1
  764. MOT1(1) = 'SCAL'
  765. CALL QUEPOI(IT, ICEN, INDIC, NBCOMP, MOT1)
  766. IF(IERR .NE. 0)THEN
  767. IERR0 = IERR
  768.  
  769. C
  770. C*********** Message d'erreur standard
  771. C -301 0 %m1:40
  772. C
  773. MOTERR = 'CHPO6 = ??? '
  774. WRITE(IOIMP,*) MOTERR(1:40)
  775.  
  776. GOTO 9999
  777. ENDIF
  778. LOGTEM = .TRUE.
  779. ELSE
  780. IT = 0
  781. LOGTEM = .FALSE.
  782. ENDIF
  783. C
  784. C*** Option TRICHE (optionelle et secrete)
  785. C
  786. ICOND = 0
  787. CALL LIRCHA(NOMTRI,ICOND,IRETOU)
  788. IF(IERR .NE. 0)GOTO 9999
  789. IF(IRETOU .NE. 0)THEN
  790. IF(NOMTRI .EQ. 'TRICHE')THEN
  791. LOGTRI = .TRUE.
  792. ELSE
  793. LOGTRI = .FALSE.
  794. CALL ECRCHA(NOMTRI)
  795. ENDIF
  796. ELSE
  797. LOGTRI = .FALSE.
  798. ENDIF
  799. C
  800. C**** Calcul des sorties.
  801. C
  802. C Jusque a la NESP = nombre d'especes qui apparessent
  803. C dans les equations d'Euler
  804. C
  805. C Maintenant NESP = nombre total d'espece
  806. C
  807. NESP = NESP + 1
  808. CALL PRIMI2(NESP,NORDP1,NSCA,PROPHY,
  809. & ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
  810. & IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
  811. & LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
  812. & VALER,VAL1,VAL2)
  813. C
  814. IF(LOGAN)THEN
  815. C
  816. C******* Message d'erreur standard
  817. C 5 3
  818. C Erreur anormale.contactez votre support
  819. C
  820. CALL ERREUR(5)
  821. GOTO 9999
  822. ELSE
  823. IF(LOGIPG)THEN
  824. C
  825. C********** CV(T) < 0
  826. C
  827. C
  828. C********** Message d'erreur standard
  829. C -301 0 %m1:40
  830. C
  831. MOTERR(1:40) = 'cv(T) < 0 ? R < 0 ? '
  832. WRITE(IOIMP,*) MOTERR(1:40)
  833. MOTERR(1:40) = 'TAB1 = ??? '
  834. WRITE(IOIMP,*) MOTERR(1:40)
  835. C
  836. C********** Message d'erreur standard
  837. C 21 2
  838. C Données incompatibles
  839. C
  840. CALL ERREUR(21)
  841. IF(LOGTRI)THEN
  842. IERR = 0
  843. ELSE
  844. GOTO 9999
  845. ENDIF
  846. ENDIF
  847. IF(LOGNC)THEN
  848. C
  849. C********** Newton - Raphson ne converge pas !!!
  850. C
  851. C
  852. C********** Message d'erreur standard
  853. C -301 0 %m1:40
  854. C
  855. MOTERR(1:40) = 'Newton - Raphson '
  856. WRITE(IOIMP,*) MOTERR(1:40)
  857. C
  858. C********** Message d'erreur standard
  859. C 460 2
  860. C Pas de convergence dans les itérations internes
  861. C
  862. CALL ERREUR(460)
  863. IF(LOGTRI)THEN
  864. IERR = 0
  865. ELSE
  866. GOTO 9999
  867. ENDIF
  868. ENDIF
  869. IF(LOGNEG)THEN
  870. C
  871. C******* Pression (energie thermique) ou densité negative
  872. C
  873. C
  874. C******* Message d'erreur standard
  875. C 41 2
  876. C %m1:8 = %r1 inférieur à %r2
  877. C
  878. MESCEL = MESERR(1)
  879. MOTERR(1:8) = MESCEL(1:8)
  880. REAERR(1) = REAL(VALER(1))
  881. REAERR(2) = 0.0
  882. CALL ERREUR(41)
  883. IF(LOGTRI)THEN
  884. * IERR = 0
  885. ELSE
  886. GOTO 9999
  887. ENDIF
  888. ENDIF
  889. IF(LOGBOR)THEN
  890. C
  891. C******* GAMMA !\in GAMMIN, GAMMAX
  892. C ou Y !\in YMIN,YMAX
  893. C
  894. C******* Message d'erreur standard
  895. C 42 2
  896. C %m1:8 = %r1 non compris entre %r2 et %r3
  897. C
  898. MESCEL = MESERR(2)
  899. MOTERR(1:8) = MESCEL(1:8)
  900. REAERR(1) = REAL(VALER(2))
  901. REAERR(2) = REAL(VAL1)
  902. REAERR(3) = REAL(VAL2)
  903. CALL ERREUR(42)
  904. IF(LOGTRI)THEN
  905. * IERR = 0
  906. ELSE
  907. GOTO 9999
  908. ENDIF
  909. ENDIF
  910. C
  911. C******* Ecriture du CHPOINT contenant les "gamma".
  912. C
  913. CALL ECROBJ('CHPOINT',IGAM)
  914. C
  915. C******* Ecriture du CHPOINT contenant les scalaires passifs.
  916. C
  917. IF(ISCA .NE. 0) CALL ECROBJ('CHPOINT',ISCA)
  918. C
  919. C******* Ecriture du CHPOINT contenant Y.
  920. C
  921. IF(IY .NE. 0) CALL ECROBJ('CHPOINT',IY)
  922. C
  923. C******* Ecriture du CHPOINT contenant la temperature.
  924. C
  925. CALL ECROBJ('CHPOINT',ITEMP)
  926. C
  927. C******* Ecriture du CHPOINT contenant la pression.
  928. C
  929. CALL ECROBJ('CHPOINT',IPRES)
  930. C
  931. C******* Ecriture du CHPOINT contenant la vitesse.
  932. C
  933. CALL ECROBJ('CHPOINT',IVIT)
  934. C
  935. ENDIF
  936. C
  937. SEGSUP PROPHY
  938. SEGSUP MLMOTS
  939. C
  940. 9999 CONTINUE
  941. C
  942. RETURN
  943. END
  944.  
  945.  
  946.  
  947.  
  948.  
  949.  
  950.  
  951.  
  952.  
  953.  
  954.  
  955.  

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