Télécharger primi1.eso

Retour à la liste

Numérotation des lignes :

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

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