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

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