Télécharger primme.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIMME SOURCE CB215821 19/07/31 21:16:39 10277
  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.  
  162. -INC PPARAM
  163. -INC CCOPTIO
  164. -INC SMCHPOI
  165. -INC SMLMOTS
  166. -INC SMLREEL
  167. POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  168. C
  169. C**** Initialisation des parametres d'erreur
  170. C
  171. LOGAN = .FALSE.
  172. LOGNEG = .FALSE.
  173. LOGBOR = .FALSE.
  174. MESCEL = ' '
  175. MESERR(1) = MESCEL
  176. MESERR(2) = MESCEL
  177. MOTERR(1:40) = MESCEL(1:40)
  178. VALER(1) = 0.0D0
  179. VALER(2) = 0.0D0
  180. VAL1 = 0.0D0
  181. VAL2 = 0.0D0
  182. C
  183. C**** Initialisation des variables en ACCTAB
  184. C
  185. IVALI = 0
  186. IVALR = 0
  187. XVALI = 0.0D0
  188. XVALR = 0.0D0
  189. LOGII = .FALSE.
  190. LOGIR = .FALSE.
  191. IRETI = 0
  192. IRETR = 0
  193. CHARR = ' '
  194. C
  195. C**** Initialisation des MOT1(1) (noms des composantes)
  196. C
  197. MOT1(1) = ' '
  198. C
  199. C**** N.B. On veut lire les objets sequentiellement.
  200. C Donc on utilise QUETYP pour controler que
  201. C le type de l'objet soit le bon.
  202. C
  203. C**** Lecture de la table des proprietes du gaz
  204. C
  205. ICOND = 1
  206. CALL QUETYP(MTYPR,ICOND,IRETOU)
  207. IF(IERR .NE. 0)GOTO 9999
  208. IF(MTYPR .NE. 'TABLE ')THEN
  209. C
  210. C******* Message d'erreur standard
  211. C 37 2
  212. C On ne trouve pas d'objet de type %m1:8
  213. C
  214. MOTERR(1:8) = 'TABLE '
  215. CALL ERREUR(37)
  216. GOTO 9999
  217. ELSE
  218. ICOND = 1
  219. CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
  220. CALL ACTOBJ(MTYPR,IPGAS,1)
  221. IF(IERR .NE. 0)GOTO 9999
  222. ENDIF
  223. C
  224. C**** Les CPs
  225. C
  226. MTYPR = ' '
  227. CALL ACMO(IPGAS,'CP',MTYPR,ICP)
  228. IF(MTYPR .NE. 'TABLE ')THEN
  229. C
  230. C******* Message d'erreur standard
  231. C -301 0 %m1:40
  232. C
  233. MOTERR(1:40) = 'TAB1 . CP = ??? '
  234. WRITE(IOIMP,*) MOTERR(1:40)
  235. C
  236. C******* Message d'erreur standard
  237. C 21 2
  238. C Données incompatibles
  239. C
  240. CALL ERREUR(21)
  241. GOTO 9999
  242. ENDIF
  243. C
  244. C**** Les CVs
  245. C
  246. MTYPR = ' '
  247. CALL ACMO(IPGAS,'CV',MTYPR,ICV)
  248. IF(MTYPR .NE. 'TABLE ')THEN
  249. C
  250. C******* Message d'erreur standard
  251. C -301 0 %m1:40
  252. C
  253. MOTERR(1:40) = 'TAB1 . CV = ??? '
  254. WRITE(IOIMP,*) MOTERR(1:40)
  255. C
  256. C******* Message d'erreur standard
  257. C 21 2
  258. C Données incompatibles
  259. C
  260. CALL ERREUR(21)
  261. GOTO 9999
  262. ENDIF
  263. C
  264. C**** Les especes qui sont dans les Equations d'Euler
  265. C
  266. MTYPR = ' '
  267. CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
  268. IF(MTYPR .NE. 'LISTMOTS')THEN
  269. C
  270. C******* Message d'erreur standard
  271. C -301 0 %m1:40
  272. C
  273. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  274. WRITE(IOIMP,*) MOTERR(1:40)
  275. C
  276. C******* Message d'erreur standard
  277. C 21 2
  278. C Données incompatibles
  279. C
  280. CALL ERREUR(21)
  281. GOTO 9999
  282. ENDIF
  283. C
  284. C**** Nom de l'espece qui n'est pas dans les equations d'Euler
  285. C
  286. MTYPI = 'MOT '
  287. MTYPR = ' '
  288. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
  289. & MTYPR,IVALR,XVALR ,CELLCH,LOGIR,IRETR)
  290. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MOT ')) THEN
  291. C
  292. C******* Message d'erreur standard
  293. C -301 0 %m1:40
  294. C
  295. MOTERR = 'TAB1 . ESPNEULE = ??? '
  296. WRITE(IOIMP,*) MOTERR(1:40)
  297. C
  298. C********** Message d'erreur standard
  299. C 21 2
  300. C Données incompatibles
  301. C
  302. CALL ERREUR(21)
  303. GOTO 9999
  304. ENDIF
  305. C
  306. C**** Control de compatibilite des donnes de la table
  307. C et creation des LISTREELs avec CP et CV
  308. C
  309. SEGACT MLMOT1
  310. NESP = MLMOT1.MOTS(/2)
  311. C
  312. C**** List de CP et CV
  313. C
  314. JG = NESP+1
  315. SEGINI MLRECP
  316. SEGINI MLRECV
  317. DO I1 = 1, NESP
  318. C
  319. C******* N.B. MOT1 est un CHARACTER*(4)
  320. C
  321. MOT1(1) = MLMOT1.MOTS(I1)
  322. C
  323. C******* CALL ACMF(ICP,NOMC,CP) ne marche pas parce que on a
  324. C des blanches dans nos composantes
  325. C
  326. MTYPI = 'MOT '
  327. MTYPR = ' '
  328. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  329. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  330. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  331. C
  332. C********** Message d'erreur standard
  333. C -301 0 %m1:40
  334. C
  335. MOTERR = 'TAB1 . CP , TAB1 . ESPEULE = ??? '
  336. WRITE(IOIMP,*) MOTERR(1:40)
  337. C
  338. C********** Message d'erreur standard
  339. C 21 2
  340. C Données incompatibles
  341. C
  342. CALL ERREUR(21)
  343. GOTO 9999
  344. ENDIF
  345. MLRECP.PROG(I1) = CP
  346. C
  347. MTYPI = 'MOT '
  348. MTYPR = ' '
  349. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
  350. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  351. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  352. C
  353. C********** Message d'erreur standard
  354. C -301 0 %m1:40
  355. C
  356. MOTERR = 'TAB1 . CV , TAB1 . ESPEULE = ??? '
  357. WRITE(IOIMP,*) MOTERR(1:40)
  358. C
  359. C********** Message d'erreur standard
  360. C 21 2
  361. C Données incompatibles
  362. C
  363. CALL ERREUR(21)
  364. GOTO 9999
  365. ENDIF
  366. MLRECV.PROG(I1) = CV
  367. ENDDO
  368. MTYPI = 'MOT '
  369. MTYPR = ' '
  370. CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  371. & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR)
  372. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  373. C
  374. C******* Message d'erreur standard
  375. C -301 0 %m1:40
  376. C
  377. MOTERR = 'TAB1 . CP , TAB1 . ESPNEULE = ??? '
  378. WRITE(IOIMP,*) MOTERR(1:40)
  379. C
  380. C********Message d'erreur standard
  381. C 21 2
  382. C Données incompatibles
  383. C
  384. CALL ERREUR(21)
  385. GOTO 9999
  386. ENDIF
  387. MLRECP.PROG(JG) = CP
  388. C
  389. MTYPI = 'MOT '
  390. MTYPR = ' '
  391. CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
  392. & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR)
  393. IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
  394. C
  395. C******* Message d'erreur standard
  396. C -301 0 %m1:40
  397. C
  398. MOTERR = 'TAB1 . CV , TAB1 . ESPNEULE = ??? '
  399. WRITE(IOIMP,*) MOTERR(1:40)
  400. C
  401. C******* Message d'erreur standard
  402. C 21 2
  403. C Données incompatibles
  404. C
  405. CALL ERREUR(21)
  406. GOTO 9999
  407. ENDIF
  408. MLRECV.PROG(JG) = CV
  409. C
  410. C**** Lecture du CHPOINT CHPO1 (masse volumique totale)
  411. C
  412. ICOND = 1
  413. CALL QUETYP(MTYPR,ICOND,IRETOU)
  414. IF(IERR .NE. 0)GOTO 9999
  415. IF(MTYPR .NE. 'CHPOINT ')THEN
  416. C
  417. C******* Message d'erreur standard
  418. C 37 2
  419. C On ne trouve pas d'objet de type %m1:8
  420. C
  421. MOTERR(1:8) = 'CHPOINT '
  422. CALL ERREUR(37)
  423. GOTO 9999
  424. ELSE
  425. ICOND = 1
  426. CALL LIROBJ(MTYPR,IRO,ICOND,IRETOU)
  427. CALL ACTOBJ(MTYPR,IRO,1)
  428. IF(IERR .NE. 0)GOTO 9999
  429. ENDIF
  430. C
  431. C**** On cherche le pointeur de son maillage et on l'impose sur les
  432. C autres CHPOINTs
  433. C
  434. MCHPOI = IRO
  435. SEGACT MCHPOI
  436. MSOUPO = MCHPOI.IPCHP(1)
  437. SEGACT MSOUPO
  438. ICEN = MSOUPO.IGEOC
  439. SEGDES MSOUPO
  440. SEGDES MCHPOI
  441. C
  442. C**** Control du CHPOINT: QUEPOI
  443. C
  444. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  445. C N.B. Le CHPOINT peut changer de structure pour
  446. C avoir SPG = ICEN!!!!
  447. C INDIC = 0 -> on ne fait que verifier le support geometrique
  448. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  449. C
  450. C NBCOMP > 0 -> numero des composantes
  451. C
  452. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  453. C
  454. INDIC = 1
  455. NBCOMP = 1
  456. MOT1(1) = 'SCAL'
  457. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT1)
  458. IF(IERR .NE. 0)THEN
  459. IERR0 = IERR
  460.  
  461. C
  462. C******** Message d'erreur standard
  463. C -301 0 %m1:40
  464. C
  465. MOTERR = 'CHPO1 '
  466. WRITE(IOIMP,*) MOTERR(1:40)
  467.  
  468. GOTO 9999
  469. ENDIF
  470. C
  471. C**** Lecture du CHPOINT CHPO2( debits)
  472. C
  473. ICOND = 1
  474. CALL QUETYP(MTYPR,ICOND,IRETOU)
  475. IF(IERR .NE. 0)GOTO 9999
  476. IF(MTYPR .NE. 'CHPOINT ')THEN
  477. C
  478. C******* Message d'erreur standard
  479. C 37 2
  480. C On ne trouve pas d'objet de type %m1:8
  481. C
  482. MOTERR(1:8) = 'CHPOINT '
  483. CALL ERREUR(37)
  484. GOTO 9999
  485. ELSE
  486. ICOND = 1
  487. CALL LIROBJ(MTYPR,IROVIT,ICOND,IRETOU)
  488. CALL ACTOBJ(MTYPR,IROVIT,1)
  489. IF(IERR .NE. 0)GOTO 9999
  490. ENDIF
  491. C
  492. C**** Control du CHPOINT
  493. C
  494. INDIC = 1
  495. NBCOMP = IDIM
  496. JGN = 4
  497. JGM = IDIM
  498. SEGINI MLMOT2
  499. MLMOT2.MOTS(1) = 'UX '
  500. MLMOT2.MOTS(2) = 'UY '
  501. IF(IDIM .EQ. 3) MLMOT2.MOTS(3) = 'UZ '
  502. CALL QUEPO1(IROVIT, ICEN, MLMOT2)
  503. IF(IERR .NE. 0)THEN
  504. IERR0 = IERR
  505.  
  506. C
  507. C******** Message d'erreur standard
  508. C -301 0 %m1:40
  509. C
  510. MOTERR = 'CHPO2 '
  511. WRITE(IOIMP,*) MOTERR(1:40)
  512.  
  513. GOTO 9999
  514. ENDIF
  515. C
  516. C**** Lecture du CHPOINT CHPO3(energie volumique)
  517. C
  518. ICOND = 1
  519. CALL QUETYP(MTYPR,ICOND,IRETOU)
  520. IF(IERR .NE. 0)GOTO 9999
  521. IF(MTYPR .NE. 'CHPOINT ')THEN
  522. C
  523. C******* Message d'erreur standard
  524. C 37 2
  525. C On ne trouve pas d'objet de type %m1:8
  526. C
  527. MOTERR(1:8) = 'CHPOINT '
  528. CALL ERREUR(37)
  529. GOTO 9999
  530. ELSE
  531. ICOND = 1
  532. CALL LIROBJ(MTYPR,IROET,ICOND,IRETOU)
  533. CALL ACTOBJ(MTYPR,IROET,1)
  534. IF(IERR .NE. 0)GOTO 9999
  535. ENDIF
  536. C
  537. C**** Control du CHPOINT
  538. C
  539. INDIC = 1
  540. NBCOMP = 1
  541. MOT1(1) = 'SCAL'
  542. CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT1)
  543. IF(IERR .NE. 0)THEN
  544. IERR0 = IERR
  545.  
  546. C
  547. C******** Message d'erreur standard
  548. C -301 0 %m1:40
  549. C
  550. MOTERR = 'CHPO3 '
  551. WRITE(IOIMP,*) MOTERR(1:40)
  552.  
  553. GOTO 9999
  554. ENDIF
  555. C
  556. C**** Lecture du CHPOINT CHPO4(masses volumiques des especes "splittees")
  557. C
  558. ICOND = 1
  559. CALL QUETYP(MTYPR,ICOND,IRETOU)
  560. IF(IERR .NE. 0)GOTO 9999
  561. IF(MTYPR .NE. 'CHPOINT ')THEN
  562. C
  563. C******* Message d'erreur standard
  564. C 37 2
  565. C On ne trouve pas d'objet de type %m1:8
  566. C
  567. MOTERR(1:8) = 'CHPOINT '
  568. CALL ERREUR(37)
  569. GOTO 9999
  570. ELSE
  571. ICOND = 1
  572. CALL LIROBJ(MTYPR,IROY,ICOND,IRETOU)
  573. CALL ACTOBJ(MTYPR,IROY,1)
  574. IF(IERR .NE. 0)GOTO 9999
  575. ENDIF
  576. C
  577. C**** Control du CHPOINT
  578. C
  579. CALL QUEPO1(IROY , ICEN , MLMOT1)
  580. IF(IERR .NE. 0)THEN
  581.  
  582. C
  583. C******* Message d'erreur standard
  584. C -301 0 %m1:40
  585. C
  586. MOTERR = 'CHPO4 = ??? '
  587. WRITE(IOIMP,*) MOTERR(1:40)
  588. C
  589. C******* Message d'erreur standard
  590. C 21 2
  591. C Données incompatibles
  592. C
  593. CALL ERREUR(21)
  594. GOTO 9999
  595. ENDIF
  596. C
  597. C******* Option TRICHE
  598. C
  599. ICOND = 0
  600. CALL LIRCHA(NOMTRI,ICOND,IRETOU)
  601. IF(IERR .NE. 0)GOTO 9999
  602. IF(IRETOU .EQ. 0)THEN
  603. LOGTRI = .FALSE.
  604. ELSEIF(NOMTRI .EQ. 'TRICHE')THEN
  605. LOGTRI = .TRUE.
  606. ELSE
  607. LOGTRI = .FALSE.
  608. CALL ECRCHA(NOMTRI)
  609. ENDIF
  610. C
  611. C**** Calcul des sorties.
  612. C
  613. C Jusque a la NESP = nombre d'especes qui apparessent
  614. C dans les equations d'Euler
  615. C
  616. C Maintenant NESP = nombre total d'espece
  617. C
  618. NESP = NESP + 1
  619. CALL PRMECA(NESP,
  620. & ICEN,IRO,IROVIT,IROET,IROY,MLRECP,MLRECV,
  621. & IVIT,IPRES,ITEMP,IY,IGAM,
  622. & LOGAN,LOGNEG,LOGBOR,MESERR,
  623. & VALER,VAL1,VAL2)
  624. C
  625. IF(LOGAN)THEN
  626. C
  627. C******* Message d'erreur standard
  628. C 5 3
  629. C Erreur anormale.contactez votre support
  630. C
  631. CALL ERREUR(5)
  632. GOTO 9999
  633. ELSE
  634. IF(LOGNEG)THEN
  635. C
  636. C******* Pression (energie thermique) ou densité negative
  637. C
  638. C
  639. C******* Message d'erreur standard
  640. C 41 2
  641. C %m1:8 = %r1 inférieur à %r2
  642. C
  643. MESCEL = MESERR(1)
  644. MOTERR(1:8) = MESCEL(1:8)
  645. REAERR(1) = REAL(VALER(1))
  646. REAERR(2) = 0.0
  647. CALL ERREUR(41)
  648. IF(LOGTRI)THEN
  649. * IERR = 0
  650. ELSE
  651. GOTO 9999
  652. ENDIF
  653. ENDIF
  654. IF(LOGBOR)THEN
  655. C
  656. C******* GAMMA !\in GAMMIN, GAMMAX
  657. C ou Y !\in YMIN,YMAX
  658. C
  659. C******* Message d'erreur standard
  660. C 42 2
  661. C %m1:8 = %r1 non compris entre %r2 et %r3
  662. C
  663. MESCEL = MESERR(2)
  664. MOTERR(1:8) = MESCEL(1:8)
  665. REAERR(1) = REAL(VALER(2))
  666. REAERR(2) = REAL(VAL1)
  667. REAERR(3) = REAL(VAL2)
  668. CALL ERREUR(42)
  669. IF(LOGTRI)THEN
  670. * IERR = 0
  671. ELSE
  672. GOTO 9999
  673. ENDIF
  674. ENDIF
  675.  
  676. CALL ACTOBJ('CHPOINT ',IGAM ,1)
  677. CALL ACTOBJ('CHPOINT ',IY ,1)
  678. CALL ACTOBJ('CHPOINT ',ITEMP,1)
  679. CALL ACTOBJ('CHPOINT ',IPRES,1)
  680. CALL ACTOBJ('CHPOINT ',IVIT ,1)
  681.  
  682. C******* Ecriture du CHPOINT contenant les "gamma".
  683. CALL ECROBJ('CHPOINT ',IGAM)
  684.  
  685. C******* Ecriture du CHPOINT contenant Y.
  686. CALL ECROBJ('CHPOINT ',IY)
  687.  
  688. C******* Ecriture du CHPOINT contenant la temperature.
  689. CALL ECROBJ('CHPOINT ',ITEMP)
  690.  
  691. C******* Ecriture du CHPOINT contenant la pression.
  692. CALL ECROBJ('CHPOINT ',IPRES)
  693.  
  694. C******* Ecriture du CHPOINT contenant la vitesse.
  695. CALL ECROBJ('CHPOINT ',IVIT)
  696.  
  697. ENDIF
  698.  
  699. SEGSUP MLRECV
  700. SEGSUP MLRECV
  701. SEGSUP MLMOT2
  702. SEGDES MLMOT1
  703.  
  704. 9999 CONTINUE
  705.  
  706. END
  707.  
  708.  
  709.  

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