Télécharger primme.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIMME SOURCE CHAT 06/03/29 21:30:28 5360
  2. SUBROUTINE PRIMME()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRIMME
  8. C
  9. C DESCRIPTION : Voir PRIMIT
  10. C
  11. C Calcul des variables primitives (et du "gamma")
  12. C pour les gaz "calorically perfect" 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) : QUETYP, ACMO, LIROBJ, QUEPOI, ERREUR, ECROBJ,
  22. C QUEPO1, ACCTAB, LIRCHA, ECRCHA
  23. C
  24. C APPELES (Calcul) : PRMECA
  25. C
  26. C
  27. C************************************************************************
  28. C
  29. C
  30. C PHRASE D'APPEL (GIBIANE) :
  31. C
  32. C 2) gaz parfait multi-especes (NESP > 1)
  33. C
  34. C RCHPO1 RCHPO2 RCHPO3 RCHPO4 RCHPO5 = 'PRIM' MCLE1 TAB1
  35. C CHPO1 CHPO2 CHPO3 CHPO4 (MCLE2) ;
  36. C
  37. C
  38. C ENTREES :
  39. C
  40. C MCLE1 : 'PERFMULT' : mot clé
  41. C
  42. C
  43. C TAB1 : TABLE qui contient :
  44. C * les noms des especes qui apparessent
  45. C explicitement dans les equations d'Euler en
  46. C TAB1 . 'ESPEULE' (list de mots);
  47. C * le nom de l'espece qui n'y est pas (mots);
  48. C * les CP et les CV du gas en
  49. C TAB1 . 'CP' (table)
  50. C TAB1 . 'CV' (table)
  51. C
  52. C CHPO1 : CHPOINT contenant la masse volumique
  53. C (une composante, 'SCAL').
  54. C
  55. C CHPO2 : CHPOINT contenant les dèbits
  56. C (2 composantes en 2D, 'UX ','UY ');
  57. C
  58. C CHPO3 : CHPOINT contenat l'énergie totale per
  59. C unité de volume (RHO Et),
  60. C (une composante, 'SCAL').
  61. C
  62. C CHPO4 : CHPOINT contenant la masse des especes qui
  63. C explicitement "splitted" dans les equations
  64. C d'Eulers (dont les noms sont dans
  65. C TAB1 . 'ESPEULE');
  66. C
  67. C i.e. CHPO1, CHPO2, CHPO3, CHPO4 sont les variables
  68. C conservatives des Equations d'Euler.
  69. C
  70. C MCLE2 : Option personelle: pas dans la notice
  71. C officielle!!!
  72. C Mot clé, 'TRICHE' (s'il y a un erreur,
  73. C les resultats ne sont pas
  74. C des type ANNULLE et le programme
  75. C ne s'arrete pas!!!)
  76. C
  77. C SORTIES :
  78. C
  79. C RCHPO1 : CHPOINT contenant la vitesse
  80. C
  81. C RCHPO2 : CHPOINT contenant la pression du gaz;
  82. C
  83. C RCHPO3 : CHPOINT contenant la temperature du gaz;
  84. C
  85. C RCHPO4 : CHPOINT contenant les fractions
  86. C massiques des differentes especes;
  87. C
  88. C RCHPO5 : CHPOINT contenat les "gamma" du gaz
  89. C
  90. C N.B.:-tous les CHPOINTs sont non-partitonees et
  91. C ils ont le meme support geometrique;
  92. C en sortie tous les CHPOINTs ont le support
  93. C geometrique de RO
  94. C -en sortie RCHPO5 a le composantes ordonnees
  95. C en tal sens:
  96. C TAB1 . 'ESPEULE' + TAB1 . 'ESPNEULE'
  97. C
  98. C************************************************************************
  99. C
  100. C HISTORIQUE (Anomalies et modifications éventuelles)
  101. C
  102. C HISTORIQUE : Créée le 12.1.98.
  103. C
  104. C Modifie le 30.7.98 pour ajouter le mot clee personelle
  105. C 'TRICHE'
  106. C
  107. C Modifie le 1.2.99 pour precedente use impropre de la
  108. C subroutine ACMM
  109. C
  110. C Modifie le 28.09.00 pour control sur le noms de composantes
  111. C (subroutine QUEPO1)
  112. C Variables de CCOPTIO en commentaire
  113. C Elimination de ERREUR(-301)
  114. C
  115. C************************************************************************
  116. C
  117. C
  118. C**** Variables de COOPTIO
  119. C
  120. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  121. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  122. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  123. C & ,IECHO, IIMPI, IOSPI
  124. C & ,IDIM
  125. C & ,MCOORD
  126. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  127. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  128. C & ,NORINC,NORVAL,NORIND,NORVAD
  129. C & ,NUCROU, IPSAUV
  130. C
  131. C**** Les variables
  132. C
  133. IMPLICIT INTEGER(I-N)
  134. INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
  135. & , NESP, ICEN, IRO, IROVIT, IROET, IROY
  136. & , IPGAS, ICP, ICV
  137. & , IPRES, IVIT, ITEMP, IY, IGAM
  138. & , I1, JG, JGM, JGN
  139. REAL*8 VALER(2),VAL1,VAL2,CP,CV
  140. CHARACTER*(40) MESERR(2),MESCEL
  141. CHARACTER*(8) MTYPR
  142. CHARACTER*(6) NOMTRI
  143. CHARACTER*(4) MOT1(3), CELLCH
  144. LOGICAL LOGNEG, LOGBOR, LOGAN, LOGTRI
  145. C
  146. C**** Variables en ACCTAB
  147. C
  148. INTEGER IVALI, IRETI,IVALR, IRETR
  149. REAL*8 XVALI,XVALR
  150. LOGICAL LOGII, LOGIR
  151. CHARACTER*(8) CHARR,MTYPI
  152. C
  153. C**** Segment pour ordoner les composantes
  154. C
  155. SEGMENT ORDO
  156. INTEGER IORDO(NC)
  157. ENDSEGMENT
  158. C
  159. C**** Les Includes
  160. C
  161. -INC CCOPTIO
  162. -INC SMCHPOI
  163. -INC SMLMOTS
  164. -INC SMLREEL
  165. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  166. C
  167. C**** Initialisation des parametres d'erreur
  168. C
  169. LOGAN = .FALSE.
  170. LOGNEG = .FALSE.
  171. LOGBOR = .FALSE.
  172. MESCEL = ' '
  173. MESERR(1) = MESCEL
  174. MESERR(2) = MESCEL
  175. MOTERR(1:40) = MESCEL(1:40)
  176. VALER(1) = 0.0D0
  177. VALER(2) = 0.0D0
  178. VAL1 = 0.0D0
  179. VAL2 = 0.0D0
  180. C
  181. C**** Initialisation des variables en ACCTAB
  182. C
  183. IVALI = 0
  184. IVALR = 0
  185. XVALI = 0.0D0
  186. XVALR = 0.0D0
  187. LOGII = .FALSE.
  188. LOGIR = .FALSE.
  189. IRETI = 0
  190. IRETR = 0
  191. CHARR = ' '
  192. C
  193. C**** Initialisation des MOT1(1) (noms des composantes)
  194. C
  195. MOT1(1) = ' '
  196. C
  197. C**** N.B. On veut lire les objets sequentiellement.
  198. C Donc on utilise QUETYP pour controler que
  199. C le type de l'objet soit le bon.
  200. C
  201. C**** Lecture de la table des proprietes du gaz
  202. C
  203. ICOND = 1
  204. CALL QUETYP(MTYPR,ICOND,IRETOU)
  205. IF(IERR .NE. 0)GOTO 9999
  206. IF(MTYPR .NE. 'TABLE ')THEN
  207. C
  208. C******* Message d'erreur standard
  209. C 37 2
  210. C On ne trouve pas d'objet de type %m1:8
  211. C
  212. MOTERR(1:8) = 'TABLE '
  213. CALL ERREUR(37)
  214. GOTO 9999
  215. ELSE
  216. ICOND = 1
  217. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  218. IF(IERR .NE. 0)GOTO 9999
  219. ENDIF
  220. C
  221. C**** Les CPs
  222. C
  223. MTYPR = ' '
  224. CALL ACMO(IPGAS,'CP',MTYPR,ICP)
  225. IF(MTYPR .NE. 'TABLE ')THEN
  226. C
  227. C******* Message d'erreur standard
  228. C -301 0 %m1:40
  229. C
  230. MOTERR(1:40) = 'TAB1 . CP = ??? '
  231. WRITE(IOIMP,*) MOTERR(1:40)
  232. C
  233. C******* Message d'erreur standard
  234. C 21 2
  235. C Données incompatibles
  236. C
  237. CALL ERREUR(21)
  238. GOTO 9999
  239. ENDIF
  240. C
  241. C**** Les CVs
  242. C
  243. MTYPR = ' '
  244. CALL ACMO(IPGAS,'CV',MTYPR,ICV)
  245. IF(MTYPR .NE. 'TABLE ')THEN
  246. C
  247. C******* Message d'erreur standard
  248. C -301 0 %m1:40
  249. C
  250. MOTERR(1:40) = 'TAB1 . CV = ??? '
  251. WRITE(IOIMP,*) MOTERR(1:40)
  252. C
  253. C******* Message d'erreur standard
  254. C 21 2
  255. C Données incompatibles
  256. C
  257. CALL ERREUR(21)
  258. GOTO 9999
  259. ENDIF
  260. C
  261. C**** Les especes qui sont dans les Equations d'Euler
  262. C
  263. MTYPR = ' '
  264. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
  265. IF(MTYPR .NE. 'LISTMOTS')THEN
  266. C
  267. C******* Message d'erreur standard
  268. C -301 0 %m1:40
  269. C
  270. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  271. WRITE(IOIMP,*) MOTERR(1:40)
  272. C
  273. C******* Message d'erreur standard
  274. C 21 2
  275. C Données incompatibles
  276. C
  277. CALL ERREUR(21)
  278. GOTO 9999
  279. ENDIF
  280. C
  281. C**** Nom de l'espece qui n'est pas dans les equations d'Euler
  282. C
  283. MTYPI = 'MOT '
  284. MTYPR = ' '
  285. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
  286. & MTYPR,IVALR,XVALR ,CELLCH,LOGIR,IRETR)
  287. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MOT ')) THEN
  288. C
  289. C******* Message d'erreur standard
  290. C -301 0 %m1:40
  291. C
  292. MOTERR = 'TAB1 . ESPNEULE = ??? '
  293. WRITE(IOIMP,*) MOTERR(1:40)
  294. C
  295. C********** Message d'erreur standard
  296. C 21 2
  297. C Données incompatibles
  298. C
  299. CALL ERREUR(21)
  300. GOTO 9999
  301. ENDIF
  302. C
  303. C**** Control de compatibilite des donnes de la table
  304. C et creation des LISTREELs avec CP et CV
  305. C
  306. SEGACT MLMOT1
  307. NESP = MLMOT1.MOTS(/2)
  308. C
  309. C**** List de CP et CV
  310. C
  311. JG = NESP+1
  312. SEGINI MLRECP
  313. SEGINI MLRECV
  314. DO I1 = 1, NESP
  315. C
  316. C******* N.B. MOT1 est un CHARACTER*(4)
  317. C
  318. MOT1(1) = MLMOT1.MOTS(I1)
  319. C
  320. C******* CALL ACMF(ICP,NOMC,CP) ne marche pas parce que on a
  321. C des blanches dans nos composantes
  322. C
  323. MTYPI = 'MOT '
  324. MTYPR = ' '
  325. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  326. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  327. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  328. C
  329. C********** Message d'erreur standard
  330. C -301 0 %m1:40
  331. C
  332. MOTERR = 'TAB1 . CP , TAB1 . ESPEULE = ??? '
  333. WRITE(IOIMP,*) MOTERR(1:40)
  334. C
  335. C********** Message d'erreur standard
  336. C 21 2
  337. C Données incompatibles
  338. C
  339. CALL ERREUR(21)
  340. GOTO 9999
  341. ENDIF
  342. MLRECP.PROG(I1) = CP
  343. C
  344. MTYPI = 'MOT '
  345. MTYPR = ' '
  346. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  347. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  348. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  349. C
  350. C********** Message d'erreur standard
  351. C -301 0 %m1:40
  352. C
  353. MOTERR = 'TAB1 . CV , TAB1 . ESPEULE = ??? '
  354. WRITE(IOIMP,*) MOTERR(1:40)
  355. C
  356. C********** Message d'erreur standard
  357. C 21 2
  358. C Données incompatibles
  359. C
  360. CALL ERREUR(21)
  361. GOTO 9999
  362. ENDIF
  363. MLRECV.PROG(I1) = CV
  364. ENDDO
  365. MTYPI = 'MOT '
  366. MTYPR = ' '
  367. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  368. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  369. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  370. C
  371. C******* Message d'erreur standard
  372. C -301 0 %m1:40
  373. C
  374. MOTERR = 'TAB1 . CP , TAB1 . ESPNEULE = ??? '
  375. WRITE(IOIMP,*) MOTERR(1:40)
  376. C
  377. C********Message d'erreur standard
  378. C 21 2
  379. C Données incompatibles
  380. C
  381. CALL ERREUR(21)
  382. GOTO 9999
  383. ENDIF
  384. MLRECP.PROG(JG) = CP
  385. C
  386. MTYPI = 'MOT '
  387. MTYPR = ' '
  388. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  389. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  390. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  391. C
  392. C******* Message d'erreur standard
  393. C -301 0 %m1:40
  394. C
  395. MOTERR = 'TAB1 . CV , TAB1 . ESPNEULE = ??? '
  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. MLRECV.PROG(JG) = CV
  406. C
  407. C**** Lecture du CHPOINT CHPO1 (masse volumique totale)
  408. C
  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(MTYPR,IRO,ICOND,IRETOU)
  424. IF(IERR .NE. 0)GOTO 9999
  425. ENDIF
  426. C
  427. C**** On cherche le pointeur de son maillage et on l'impose sur les
  428. C autres CHPOINTs
  429. C
  430. MCHPOI = IRO
  431. SEGACT MCHPOI
  432. MSOUPO = MCHPOI.IPCHP(1)
  433. SEGACT MSOUPO
  434. ICEN = MSOUPO.IGEOC
  435. SEGDES MSOUPO
  436. SEGDES MCHPOI
  437. C
  438. C**** Control du CHPOINT: QUEPOI
  439. C
  440. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  441. C N.B. Le CHPOINT peut changer de structure pour
  442. C avoir SPG = ICEN!!!!
  443. C INDIC = 0 -> on ne fait que verifier le support geometrique
  444. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  445. C
  446. C NBCOMP > 0 -> numero des composantes
  447. C
  448. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  449. C
  450. INDIC = 1
  451. NBCOMP = 1
  452. MOT1(1) = 'SCAL'
  453. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT1)
  454. IF(IERR .NE. 0)THEN
  455. IERR0 = IERR
  456.  
  457. C
  458. C******** Message d'erreur standard
  459. C -301 0 %m1:40
  460. C
  461. MOTERR = 'CHPO1 '
  462. WRITE(IOIMP,*) MOTERR(1:40)
  463.  
  464. GOTO 9999
  465. ENDIF
  466. C
  467. C**** Lecture du CHPOINT CHPO2( debits)
  468. C
  469. ICOND = 1
  470. CALL QUETYP(MTYPR,ICOND,IRETOU)
  471. IF(IERR .NE. 0)GOTO 9999
  472. IF(MTYPR .NE. 'CHPOINT ')THEN
  473. C
  474. C******* Message d'erreur standard
  475. C 37 2
  476. C On ne trouve pas d'objet de type %m1:8
  477. C
  478. MOTERR(1:8) = 'CHPOINT '
  479. CALL ERREUR(37)
  480. GOTO 9999
  481. ELSE
  482. ICOND = 1
  483. CALL LIROBJ(MTYPR,IROVIT,ICOND,IRETOU)
  484. IF(IERR .NE. 0)GOTO 9999
  485. ENDIF
  486. C
  487. C**** Control du CHPOINT
  488. C
  489. INDIC = 1
  490. NBCOMP = IDIM
  491. JGN = 4
  492. JGM = IDIM
  493. SEGINI MLMOT2
  494. MLMOT2.MOTS(1) = 'UX '
  495. MLMOT2.MOTS(2) = 'UY '
  496. IF(IDIM .EQ. 3) MLMOT2.MOTS(3) = 'UZ '
  497. CALL QUEPO1(IROVIT, ICEN, MLMOT2)
  498. IF(IERR .NE. 0)THEN
  499. IERR0 = IERR
  500.  
  501. C
  502. C******** Message d'erreur standard
  503. C -301 0 %m1:40
  504. C
  505. MOTERR = 'CHPO2 '
  506. WRITE(IOIMP,*) MOTERR(1:40)
  507.  
  508. GOTO 9999
  509. ENDIF
  510. C
  511. C**** Lecture du CHPOINT CHPO3(energie volumique)
  512. C
  513. ICOND = 1
  514. CALL QUETYP(MTYPR,ICOND,IRETOU)
  515. IF(IERR .NE. 0)GOTO 9999
  516. IF(MTYPR .NE. 'CHPOINT ')THEN
  517. C
  518. C******* Message d'erreur standard
  519. C 37 2
  520. C On ne trouve pas d'objet de type %m1:8
  521. C
  522. MOTERR(1:8) = 'CHPOINT '
  523. CALL ERREUR(37)
  524. GOTO 9999
  525. ELSE
  526. ICOND = 1
  527. CALL LIROBJ(MTYPR,IROET,ICOND,IRETOU)
  528. IF(IERR .NE. 0)GOTO 9999
  529. ENDIF
  530. C
  531. C**** Control du CHPOINT
  532. C
  533. INDIC = 1
  534. NBCOMP = 1
  535. MOT1(1) = 'SCAL'
  536. CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT1)
  537. IF(IERR .NE. 0)THEN
  538. IERR0 = IERR
  539.  
  540. C
  541. C******** Message d'erreur standard
  542. C -301 0 %m1:40
  543. C
  544. MOTERR = 'CHPO3 '
  545. WRITE(IOIMP,*) MOTERR(1:40)
  546.  
  547. GOTO 9999
  548. ENDIF
  549. C
  550. C**** Lecture du CHPOINT CHPO4(masses volumiques des especes "splittees")
  551. C
  552. ICOND = 1
  553. CALL QUETYP(MTYPR,ICOND,IRETOU)
  554. IF(IERR .NE. 0)GOTO 9999
  555. IF(MTYPR .NE. 'CHPOINT ')THEN
  556. C
  557. C******* Message d'erreur standard
  558. C 37 2
  559. C On ne trouve pas d'objet de type %m1:8
  560. C
  561. MOTERR(1:8) = 'CHPOINT '
  562. CALL ERREUR(37)
  563. GOTO 9999
  564. ELSE
  565. ICOND = 1
  566. CALL LIROBJ(MTYPR,IROY,ICOND,IRETOU)
  567. IF(IERR .NE. 0)GOTO 9999
  568. ENDIF
  569. C
  570. C**** Control du CHPOINT
  571. C
  572. CALL QUEPO1(IROY , ICEN , MLMOT1)
  573. IF(IERR .NE. 0)THEN
  574.  
  575. C
  576. C******* Message d'erreur standard
  577. C -301 0 %m1:40
  578. C
  579. MOTERR = 'CHPO4 = ??? '
  580. WRITE(IOIMP,*) MOTERR(1:40)
  581. C
  582. C******* Message d'erreur standard
  583. C 21 2
  584. C Données incompatibles
  585. C
  586. CALL ERREUR(21)
  587. GOTO 9999
  588. ENDIF
  589. C
  590. C******* Option TRICHE
  591. C
  592. ICOND = 0
  593. CALL LIRCHA(NOMTRI,ICOND,IRETOU)
  594. IF(IERR .NE. 0)GOTO 9999
  595. IF(IRETOU .EQ. 0)THEN
  596. LOGTRI = .FALSE.
  597. ELSEIF(NOMTRI .EQ. 'TRICHE')THEN
  598. LOGTRI = .TRUE.
  599. ELSE
  600. LOGTRI = .FALSE.
  601. CALL ECRCHA(NOMTRI)
  602. ENDIF
  603. C
  604. C**** Calcul des sorties.
  605. C
  606. C Jusque a la NESP = nombre d'especes qui apparessent
  607. C dans les equations d'Euler
  608. C
  609. C Maintenant NESP = nombre total d'espece
  610. C
  611. NESP = NESP + 1
  612. CALL PRMECA(NESP,
  613. & ICEN,IRO,IROVIT,IROET,IROY,MLRECP,MLRECV,
  614. & IVIT,IPRES,ITEMP,IY,IGAM,
  615. & LOGAN,LOGNEG,LOGBOR,MESERR,
  616. & VALER,VAL1,VAL2)
  617. C
  618. IF(LOGAN)THEN
  619. C
  620. C******* Message d'erreur standard
  621. C 5 3
  622. C Erreur anormale.contactez votre support
  623. C
  624. CALL ERREUR(5)
  625. GOTO 9999
  626. ELSE
  627. IF(LOGNEG)THEN
  628. C
  629. C******* Pression (energie thermique) ou densité negative
  630. C
  631. C
  632. C******* Message d'erreur standard
  633. C 41 2
  634. C %m1:8 = %r1 inférieur à %r2
  635. C
  636. MESCEL = MESERR(1)
  637. MOTERR(1:8) = MESCEL(1:8)
  638. REAERR(1) = REAL(VALER(1))
  639. REAERR(2) = 0.0
  640. CALL ERREUR(41)
  641. IF(LOGTRI)THEN
  642. * IERR = 0
  643. ELSE
  644. GOTO 9999
  645. ENDIF
  646. ENDIF
  647. IF(LOGBOR)THEN
  648. C
  649. C******* GAMMA !\in GAMMIN, GAMMAX
  650. C ou Y !\in YMIN,YMAX
  651. C
  652. C******* Message d'erreur standard
  653. C 42 2
  654. C %m1:8 = %r1 non compris entre %r2 et %r3
  655. C
  656. MESCEL = MESERR(2)
  657. MOTERR(1:8) = MESCEL(1:8)
  658. REAERR(1) = REAL(VALER(2))
  659. REAERR(2) = REAL(VAL1)
  660. REAERR(3) = REAL(VAL2)
  661. CALL ERREUR(42)
  662. IF(LOGTRI)THEN
  663. * IERR = 0
  664. ELSE
  665. GOTO 9999
  666. ENDIF
  667. ENDIF
  668. C
  669. C******* Ecriture du CHPOINT contenant les "gamma".
  670. C
  671. CALL ECROBJ('CHPOINT',IGAM)
  672. C
  673. C******* Ecriture du CHPOINT contenant Y.
  674. C
  675. CALL ECROBJ('CHPOINT',IY)
  676. C
  677. C******* Ecriture du CHPOINT contenant la temperature.
  678. C
  679. CALL ECROBJ('CHPOINT',ITEMP)
  680. C
  681. C******* Ecriture du CHPOINT contenant la pression.
  682. C
  683. CALL ECROBJ('CHPOINT',IPRES)
  684. C
  685. C******* Ecriture du CHPOINT contenant la vitesse.
  686. C
  687. CALL ECROBJ('CHPOINT',IVIT)
  688. C
  689. ENDIF
  690. C
  691. SEGSUP MLRECV
  692. SEGSUP MLRECV
  693. SEGSUP MLMOT2
  694. SEGDES MLMOT1
  695. C
  696. 9999 CONTINUE
  697. C
  698. RETURN
  699. END
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
  708.  
  709.  

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