Télécharger primi1.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIMI1 SOURCE CB215821 19/07/31 21:16:38 10277
  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. CALL ACTOBJ(MTYPR,IPGAS,1)
  247. IF(IERR .NE. 0)GOTO 9999
  248. ENDIF
  249. C
  250. C**** Ordre des polynoms pour les cv_i
  251. C
  252. MTYPI = 'MOT '
  253. MTYPR = ' '
  254. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
  255. & MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
  256. IF(MTYPR .NE. 'ENTIER ')THEN
  257. C
  258. C******* Message d'erreur standard
  259. C -301 0 %m1:40
  260. C
  261. MOTERR(1:40) = 'TAB1 . NORD = ??? '
  262. WRITE(IOIMP,*) MOTERR(1:40)
  263. C
  264. C******* Message d'erreur standard
  265. C 21 2
  266. C Données incompatibles
  267. C
  268. CALL ERREUR(21)
  269. GOTO 9999
  270. ENDIF
  271. NORDP1 = NORD + 1
  272. C
  273. C**** Nom de l'espece qui n'est pas dans les equations d'Euler
  274. C
  275. MTYPI = 'MOT '
  276. MTYPR = ' '
  277. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI,
  278. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  279. IF(MTYPR .NE. 'MOT ')THEN
  280. C
  281. C******* Message d'erreur standard
  282. C -301 0 %m1:40
  283. C
  284. MOTERR(1:40) = 'TAB1 . ESPNEULE = ??? '
  285. WRITE(IOIMP,*) MOTERR(1:40)
  286. C
  287. C******* Message d'erreur standard
  288. C 21 2
  289. C Données incompatibles
  290. C
  291. CALL ERREUR(21)
  292. GOTO 9999
  293. ENDIF
  294. C
  295. C**** Les especes qui sont dans les Equations d'Euler
  296. C
  297. MTYPR = ' '
  298. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
  299. IF(MTYPR .EQ. ' ')THEN
  300. NESP = 0
  301. IROY = 0
  302. JGN = 4
  303. JGM = 1
  304. C
  305. C******* JGN,JGM en MLMOT2:
  306. C CHARACTER*(JGN) MOTS(JGM)
  307. C
  308. SEGINI MLMOT2
  309. MLMOT2.MOTS(1) = CHARR(1:4)
  310. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  311. C
  312. C******* Message d'erreur standard
  313. C -301 0 %m1:40
  314. C
  315. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  316. WRITE(IOIMP,*) MOTERR(1:40)
  317. C
  318. C******* Message d'erreur standard
  319. C 21 2
  320. C Données incompatibles
  321. C
  322. CALL ERREUR(21)
  323. GOTO 9999
  324. ELSE
  325. SEGACT MLMOT1
  326. NESP = MLMOT1.MOTS(/2)
  327. JGN = 4
  328. JGM = NESP + 1
  329. SEGINI MLMOT2
  330. DO I1 = 1, NESP
  331. MLMOT2.MOTS(I1) = MLMOT1.MOTS(I1)
  332. ENDDO
  333. MLMOT2.MOTS(NESP+1)=CHARR(1:4)
  334. SEGDES MLMOT1
  335. ENDIF
  336. C
  337. C**** Les scalaires passifs qui sont dans les Equations d'Euler
  338. C
  339. MTYPR = ' '
  340. CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMOSC)
  341. IF(MTYPR .EQ. ' ')THEN
  342. NSCA = 0
  343. IROSCA = 0
  344. ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
  345. C
  346. C******* Message d'erreur standard
  347. C -301 0 %m1:40
  348. C
  349. MOTERR(1:40) = 'TAB1 . SCALPASS = ??? '
  350. WRITE(IOIMP,*) MOTERR(1:40)
  351. C
  352. C******* Message d'erreur standard
  353. C 21 2
  354. C Données incompatibles
  355. C
  356. CALL ERREUR(21)
  357. GOTO 9999
  358. ELSE
  359. SEGACT MLMOSC
  360. NSCA = MLMOSC.MOTS(/2)
  361. SEGDES MLMOSC
  362. ENDIF
  363. C
  364. C**** On rempli les segment PROPHY
  365. C Ordre: IPGAS . 'ESPEULE' + IPGAS . 'ESPNEULE'
  366. C On controlle aussi la compatibilite des
  367. C donnes de la table
  368. C
  369. SEGINI PROPHY
  370. C
  371. C**** N.B. MOT1 est un CHARACTER*(4)
  372. C
  373. DO I1 = 1, NESP+1
  374. MOT1(1) = MLMOT2.MOTS(I1)
  375. C
  376. C******* CALL ACMF(...) ne marche pas parce que on a
  377. C des blanches dans nos composantes
  378. C
  379. MTYPI = 'MOT '
  380. MTYPR = ' '
  381. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  382. & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
  383. C
  384. C******* En IESP a la table IPGAS.MOT1(1)
  385. C
  386. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
  387.  
  388. C
  389. C********** Message d'erreur standard
  390. C -301 0 %m1:40
  391. C
  392. MOTERR = ' '
  393. MOTERR(1:7) = 'TAB1 . '
  394. MOTERR(8:11) = MOT1(1)
  395. MOTERR(13:17) = '= ???'
  396. WRITE(IOIMP,*) MOTERR(1:40)
  397. C
  398. C********** Message d'erreur standard
  399. C 21 2
  400. C Données incompatibles
  401. C
  402. CALL ERREUR(21)
  403. GOTO 9999
  404. ENDIF
  405. C
  406. C******* R
  407. C
  408. MTYPI = 'MOT '
  409. MTYPR = ' '
  410. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'R' , LOGII,IRETI,
  411. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  412. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  413. C
  414. C********** Message d'erreur standard
  415. C -301 0 %m1:40
  416. C
  417. MOTERR = ' '
  418. MOTERR(1:7) = 'TAB1 . '
  419. MOTERR(8:11) = MOT1(1)
  420. MOTERR(13:23) = ' . R = ??? '
  421. WRITE(IOIMP,*) MOTERR(1:40)
  422. C
  423. C********** Message d'erreur standard
  424. C 21 2
  425. C Données incompatibles
  426. C
  427. CALL ERREUR(21)
  428. GOTO 9999
  429. ENDIF
  430. PROPHY.R(I1)=XVALR
  431. C
  432. C******* H0K
  433. C
  434. MTYPI = 'MOT '
  435. MTYPR = ' '
  436. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
  437. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  438. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  439.  
  440. C
  441. C********** Message d'erreur standard
  442. C -301 0 %m1:40
  443. C
  444. MOTERR = ' '
  445. MOTERR(1:7) = 'TAB1 . '
  446. MOTERR(8:11) = MOT1(1)
  447. MOTERR(13:25) = ' . H0K = ??? '
  448. WRITE(IOIMP,*) MOTERR(1:40)
  449. C
  450. C********** Message d'erreur standard
  451. C 21 2
  452. C Données incompatibles
  453. C
  454. CALL ERREUR(21)
  455. GOTO 9999
  456. ENDIF
  457. PROPHY.H0K(I1)=XVALR
  458. C
  459. C******* A
  460. C
  461. MTYPI = 'MOT '
  462. MTYPR = ' '
  463. CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
  464. & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
  465. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
  466.  
  467. C
  468. C********** Message d'erreur standard
  469. C -301 0 %m1:40
  470. C
  471. MOTERR = ' '
  472. MOTERR(1:7) = 'TAB1 . '
  473. MOTERR(8:11) = MOT1(1)
  474. MOTERR(13:23) = ' . A = ??? '
  475. WRITE(IOIMP,*) MOTERR(1:40)
  476. C
  477. C********** Message d'erreur standard
  478. C 21 2
  479. C Données incompatibles
  480. C
  481. CALL ERREUR(21)
  482. GOTO 9999
  483. ENDIF
  484. MLREEL = IRETR
  485. SEGACT MLREEL
  486. NORD1 = MLREEL.PROG(/1)
  487. IF(NORD1 .NE. NORDP1)THEN
  488. C
  489. C********** Message d'erreur standard
  490. C -301 0 %m1:40
  491. C
  492. MOTERR = ' '
  493. MOTERR(1:10) = 'DIME(TAB1.'
  494. MOTERR(11:14) = MOT1(1)
  495. MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
  496. WRITE(IOIMP,*) MOTERR(1:40)
  497. C
  498. C********** Message d'erreur standard
  499. C 21 2
  500. C Données incompatibles
  501. C
  502. CALL ERREUR(21)
  503. GOTO 9999
  504. ENDIF
  505.  
  506. C
  507. C******* Dans le calcul, c'est plus utile ACV dans la forme
  508. C ACV(exponente,espece)
  509. C
  510. DO I2 = 1, NORDP1
  511. PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
  512. ENDDO
  513. SEGDES MLREEL
  514. ENDDO
  515. SEGSUP MLMOT2
  516. C
  517. C**** La table IPGAS donc a ete controllee et PROPHY est rempli
  518. C
  519. C
  520. C**** Lecture du CHPOINT CHPO1 (masse volumique totale)
  521. C
  522. ICOND = 1
  523. CALL QUETYP(MTYPR,ICOND,IRETOU)
  524. IF(IERR .NE. 0)GOTO 9999
  525. IF(MTYPR .NE. 'CHPOINT ')THEN
  526. C
  527. C******* Message d'erreur standard
  528. C 37 2
  529. C On ne trouve pas d'objet de type %m1:8
  530. C
  531. MOTERR(1:8) = 'CHPOINT '
  532. CALL ERREUR(37)
  533. GOTO 9999
  534. ELSE
  535. ICOND = 1
  536. CALL LIROBJ(MTYPR,IRO,ICOND,IRETOU)
  537. CALL ACTOBJ(MTYPR,IRO,1)
  538. IF(IERR .NE. 0)GOTO 9999
  539. ENDIF
  540. C
  541. C**** On cherche le pointeur de son maillage et on l'impose sur les
  542. C autres CHPOINTs
  543. C
  544. MCHPOI = IRO
  545. SEGACT MCHPOI
  546. MSOUPO = MCHPOI.IPCHP(1)
  547. SEGACT MSOUPO
  548. ICEN = MSOUPO.IGEOC
  549. SEGDES MSOUPO
  550. SEGDES MCHPOI
  551. C
  552. C**** Control du CHPOINT: QUEPOI
  553. C
  554. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  555. C N.B. Le CHPOINT peut changer de structure pour
  556. C avoir SPG = ICEN!!!!
  557. C INDIC = 0 -> on ne fait que verifier le support geometrique
  558. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  559. C
  560. C NBCOMP > 0 -> numero des composantes
  561. C
  562. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  563. C
  564. INDIC = 1
  565. NBCOMP = 1
  566. MOT1(1) = 'SCAL'
  567. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT1)
  568. IF(IERR .NE. 0)THEN
  569. IERR0 = IERR
  570.  
  571. C
  572. C******** Message d'erreur standard
  573. C -301 0 %m1:40
  574. C
  575. MOTERR = 'CHPO1 = ??? '
  576. WRITE(IOIMP,*) MOTERR(1:40)
  577.  
  578. GOTO 9999
  579. ENDIF
  580. C
  581. C**** Lecture du CHPOINT CHPO2( debits)
  582. C
  583. ICOND = 1
  584. CALL QUETYP(MTYPR,ICOND,IRETOU)
  585. IF(IERR .NE. 0)GOTO 9999
  586. IF(MTYPR .NE. 'CHPOINT ')THEN
  587. C
  588. C******* Message d'erreur standard
  589. C 37 2
  590. C On ne trouve pas d'objet de type %m1:8
  591. C
  592. MOTERR(1:8) = 'CHPOINT '
  593. CALL ERREUR(37)
  594. GOTO 9999
  595. ELSE
  596. ICOND = 1
  597. CALL LIROBJ(MTYPR,IROVIT,ICOND,IRETOU)
  598. CALL ACTOBJ(MTYPR,IROVIT,1)
  599. IF(IERR .NE. 0)GOTO 9999
  600. ENDIF
  601. C
  602. C**** Control du CHPOINT
  603. C
  604. C
  605. CERR2
  606. C
  607. JGN = 4
  608. JGM = IDIM
  609. SEGINI MLMOTS
  610. MLMOTS.MOTS(1) = 'UX '
  611. MLMOTS.MOTS(2) = 'UY '
  612. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  613. C
  614. C**** On controlle l'ordre de composantes de IROVIT
  615. C
  616. CALL QUEPO1(IROVIT, ICEN, MLMOTS)
  617. IF(IERR .NE. 0)THEN
  618. IERR0 = IERR
  619.  
  620. C
  621. C******** Message d'erreur standard
  622. C -301 0 %m1:40
  623. C
  624. MOTERR = 'CHPO2 = ??? '
  625. WRITE(IOIMP,*) MOTERR(1:40)
  626.  
  627. GOTO 9999
  628. ENDIF
  629. C
  630. C**** Lecture du CHPOINT CHPO3 (energie volumique)
  631. C
  632. ICOND = 1
  633. CALL QUETYP(MTYPR,ICOND,IRETOU)
  634. IF(IERR .NE. 0)GOTO 9999
  635. IF(MTYPR .NE. 'CHPOINT ')THEN
  636. C
  637. C******* Message d'erreur standard
  638. C 37 2
  639. C On ne trouve pas d'objet de type %m1:8
  640. C
  641. MOTERR(1:8) = 'CHPOINT '
  642. CALL ERREUR(37)
  643. GOTO 9999
  644. ELSE
  645. ICOND = 1
  646. CALL LIROBJ(MTYPR,IROET,ICOND,IRETOU)
  647. CALL ACTOBJ(MTYPR,IROET,1)
  648. IF(IERR .NE. 0)GOTO 9999
  649. ENDIF
  650. C
  651. C**** Control du CHPOINT
  652. C
  653. INDIC = 1
  654. NBCOMP = 1
  655. MOT1(1) = 'SCAL'
  656. CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT1)
  657. IF(IERR .NE. 0)THEN
  658. IERR0 = IERR
  659.  
  660. C
  661. C******** Message d'erreur standard
  662. C -301 0 %m1:40
  663. C
  664. MOTERR = 'CHPO3 = ??? '
  665. WRITE(IOIMP,*) MOTERR(1:40)
  666.  
  667. GOTO 9999
  668. ENDIF
  669. C
  670. C**** Lecture du CHPOINT CHPO4(masses volumiques des especes "splittees")
  671. C
  672. CERR1 IF(NESP .GT. 1)THEN: erreur: NESP = 0 dans le cas monoespece
  673. C NESP > 0 dans le cas multiespece
  674. IF(NESP .GE. 1)THEN
  675. ICOND = 1
  676. CALL QUETYP(MTYPR,ICOND,IRETOU)
  677. IF(IERR .NE. 0)GOTO 9999
  678. IF(MTYPR .NE. 'CHPOINT ')THEN
  679. C
  680. C******* Message d'erreur standard
  681. C 37 2
  682. C On ne trouve pas d'objet de type %m1:8
  683. C
  684. MOTERR(1:8) = 'CHPOINT '
  685. CALL ERREUR(37)
  686. GOTO 9999
  687. ELSE
  688. ICOND = 1
  689. CALL LIROBJ(MTYPR,IROY,ICOND,IRETOU)
  690. CALL ACTOBJ(MTYPR,IROY,1)
  691. IF(IERR .NE. 0)GOTO 9999
  692. ENDIF
  693. C
  694. C**** Control du CHPOINT
  695. C
  696. CALL QUEPO1(IROY , ICEN , MLMOT1)
  697. IF(IERR .NE. 0)THEN
  698.  
  699. C
  700. C******* Message d'erreur standard
  701. C -301 0 %m1:40
  702. C
  703. MOTERR = 'CHPO4 = ??? '
  704. WRITE(IOIMP,*) MOTERR(1:40)
  705. C
  706. C******* Message d'erreur standard
  707. C 21 2
  708. C Données incompatibles
  709. C
  710. CALL ERREUR(21)
  711. GOTO 9999
  712. ENDIF
  713. ENDIF
  714. C
  715. C**** Lecture du CHPOINT CHPO5 (scalaires passifs * densité)
  716. C
  717. IF(NSCA .GE. 1)THEN
  718. ICOND = 1
  719. CALL QUETYP(MTYPR,ICOND,IRETOU)
  720. IF(IERR .NE. 0)GOTO 9999
  721. IF(MTYPR .NE. 'CHPOINT ')THEN
  722. C
  723. C******* Message d'erreur standard
  724. C 37 2
  725. C On ne trouve pas d'objet de type %m1:8
  726. C
  727. MOTERR(1:8) = 'CHPOINT '
  728. CALL ERREUR(37)
  729. GOTO 9999
  730. ELSE
  731. ICOND = 1
  732. CALL LIROBJ(MTYPR,IROSCA,ICOND,IRETOU)
  733. CALL ACTOBJ(MTYPR,IROSCA,1)
  734. IF(IERR .NE. 0)GOTO 9999
  735. ENDIF
  736. C
  737. C**** Control du CHPOINT
  738. C
  739. CALL QUEPO1(IROSCA , ICEN , MLMOSC)
  740. IF(IERR .NE. 0)THEN
  741.  
  742. C
  743. C******* Message d'erreur standard
  744. C -301 0 %m1:40
  745. C
  746. MOTERR = 'CHPO5 = ??? '
  747. WRITE(IOIMP,*) MOTERR(1:40)
  748. C
  749. C******* Message d'erreur standard
  750. C 21 2
  751. C Données incompatibles
  752. C
  753. CALL ERREUR(21)
  754. GOTO 9999
  755. ENDIF
  756. ENDIF
  757. C
  758. C**** Lecture du CHPOINT CHPO6(temperature de tentative, optionelle)
  759. C
  760. ICOND = 0
  761. MTYPR = 'CHPOINT '
  762. CALL LIROBJ(MTYPR,IT,ICOND,IRETOU)
  763. IF(IERR .NE. 0)GOTO 9999
  764. IF(IRETOU .EQ. 1)THEN
  765. CALL ACTOBJ(MTYPR,IT,1)
  766. C
  767. C****** Control du CHPOINT
  768. C
  769. INDIC = 1
  770. NBCOMP = 1
  771. MOT1(1) = 'SCAL'
  772. CALL QUEPOI(IT, ICEN, INDIC, NBCOMP, MOT1)
  773. IF(IERR .NE. 0)THEN
  774. IERR0 = IERR
  775.  
  776. C
  777. C*********** Message d'erreur standard
  778. C -301 0 %m1:40
  779. C
  780. MOTERR = 'CHPO6 = ??? '
  781. WRITE(IOIMP,*) MOTERR(1:40)
  782.  
  783. GOTO 9999
  784. ENDIF
  785. LOGTEM = .TRUE.
  786. ELSE
  787. IT = 0
  788. LOGTEM = .FALSE.
  789. ENDIF
  790. C
  791. C*** Option TRICHE (optionelle et secrete)
  792. C
  793. ICOND = 0
  794. CALL LIRCHA(NOMTRI,ICOND,IRETOU)
  795. IF(IERR .NE. 0)GOTO 9999
  796. IF(IRETOU .NE. 0)THEN
  797. IF(NOMTRI .EQ. 'TRICHE')THEN
  798. LOGTRI = .TRUE.
  799. ELSE
  800. LOGTRI = .FALSE.
  801. CALL ECRCHA(NOMTRI)
  802. ENDIF
  803. ELSE
  804. LOGTRI = .FALSE.
  805. ENDIF
  806. C
  807. C**** Calcul des sorties.
  808. C
  809. C Jusque a la NESP = nombre d'especes qui apparessent
  810. C dans les equations d'Euler
  811. C
  812. C Maintenant NESP = nombre total d'espece
  813. C
  814. NESP = NESP + 1
  815. CALL PRIMI2(NESP,NORDP1,NSCA,PROPHY,
  816. & ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
  817. & IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
  818. & LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
  819. & VALER,VAL1,VAL2)
  820. C
  821. IF(LOGAN)THEN
  822. C
  823. C******* Message d'erreur standard
  824. C 5 3
  825. C Erreur anormale.contactez votre support
  826. C
  827. CALL ERREUR(5)
  828. GOTO 9999
  829. ELSE
  830. IF(LOGIPG)THEN
  831. C
  832. C********** CV(T) < 0
  833. C
  834. C
  835. C********** Message d'erreur standard
  836. C -301 0 %m1:40
  837. C
  838. MOTERR(1:40) = 'cv(T) < 0 ? R < 0 ? '
  839. WRITE(IOIMP,*) MOTERR(1:40)
  840. MOTERR(1:40) = 'TAB1 = ??? '
  841. WRITE(IOIMP,*) MOTERR(1:40)
  842. C
  843. C********** Message d'erreur standard
  844. C 21 2
  845. C Données incompatibles
  846. C
  847. CALL ERREUR(21)
  848. IF(LOGTRI)THEN
  849. IERR = 0
  850. ELSE
  851. GOTO 9999
  852. ENDIF
  853. ENDIF
  854. IF(LOGNC)THEN
  855. C
  856. C********** Newton - Raphson ne converge pas !!!
  857. C
  858. C
  859. C********** Message d'erreur standard
  860. C -301 0 %m1:40
  861. C
  862. MOTERR(1:40) = 'Newton - Raphson '
  863. WRITE(IOIMP,*) MOTERR(1:40)
  864. C
  865. C********** Message d'erreur standard
  866. C 460 2
  867. C Pas de convergence dans les itérations internes
  868. C
  869. CALL ERREUR(460)
  870. IF(LOGTRI)THEN
  871. IERR = 0
  872. ELSE
  873. GOTO 9999
  874. ENDIF
  875. ENDIF
  876. IF(LOGNEG)THEN
  877. C
  878. C******* Pression (energie thermique) ou densité negative
  879. C
  880. C
  881. C******* Message d'erreur standard
  882. C 41 2
  883. C %m1:8 = %r1 inférieur à %r2
  884. C
  885. MESCEL = MESERR(1)
  886. MOTERR(1:8) = MESCEL(1:8)
  887. REAERR(1) = REAL(VALER(1))
  888. REAERR(2) = 0.0
  889. CALL ERREUR(41)
  890. IF(LOGTRI)THEN
  891. * IERR = 0
  892. ELSE
  893. GOTO 9999
  894. ENDIF
  895. ENDIF
  896. IF(LOGBOR)THEN
  897. C
  898. C******* GAMMA !\in GAMMIN, GAMMAX
  899. C ou Y !\in YMIN,YMAX
  900. C
  901. C******* Message d'erreur standard
  902. C 42 2
  903. C %m1:8 = %r1 non compris entre %r2 et %r3
  904. C
  905. MESCEL = MESERR(2)
  906. MOTERR(1:8) = MESCEL(1:8)
  907. REAERR(1) = REAL(VALER(2))
  908. REAERR(2) = REAL(VAL1)
  909. REAERR(3) = REAL(VAL2)
  910. CALL ERREUR(42)
  911. IF(LOGTRI)THEN
  912. * IERR = 0
  913. ELSE
  914. GOTO 9999
  915. ENDIF
  916. ENDIF
  917.  
  918. C******* Ecriture du CHPOINT contenant les "gamma".
  919. CALL ACTOBJ('CHPOINT ',IGAM,1)
  920. CALL ECROBJ('CHPOINT ',IGAM)
  921.  
  922. C******* Ecriture du CHPOINT contenant les scalaires passifs.
  923. IF(ISCA .NE. 0) THEN
  924. CALL ACTOBJ('CHPOINT ',ISCA,1)
  925. CALL ECROBJ('CHPOINT ',ISCA)
  926. ENDIF
  927.  
  928. C******* Ecriture du CHPOINT contenant Y.
  929. IF(IY .NE. 0) THEN
  930. CALL ACTOBJ('CHPOINT ',IY,1)
  931. CALL ECROBJ('CHPOINT ',IY)
  932. ENDIF
  933.  
  934. C******* Ecriture du CHPOINT contenant la temperature.
  935. CALL ACTOBJ('CHPOINT',ITEMP,1)
  936. CALL ECROBJ('CHPOINT',ITEMP)
  937. C
  938. C******* Ecriture du CHPOINT contenant la pression.
  939. CALL ACTOBJ('CHPOINT',IPRES,1)
  940. CALL ECROBJ('CHPOINT',IPRES)
  941.  
  942. C******* Ecriture du CHPOINT contenant la vitesse.
  943. CALL ACTOBJ('CHPOINT',IVIT,1)
  944. CALL ECROBJ('CHPOINT',IVIT)
  945. ENDIF
  946.  
  947. SEGSUP PROPHY
  948. SEGSUP MLMOTS
  949. C
  950. 9999 CONTINUE
  951. END
  952.  
  953.  
  954.  

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