Sources Esope | Cast3M

primi1
C PRIMI1    SOURCE    CB215821  20/11/25    13:36:55     10792          
      SUBROUTINE PRIMI1()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIMI1
C
C DESCRIPTION       :  Voir PRIMIT
C
C                      Calcul des variables primitives (et du "gamma")
C                      pour les gaz "thermally perfect" mono/multiespeces
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C
C APPELES (E/S)     : LIRENT, ACMO, LIROBJ, QUEPOI, ERREUR, ECROBJ
C
C APPELES (Calcul)  : PRIMI2
C
C
C************************************************************************
C
C
C PHRASE D'APPEL (GIBIANE) :
C
C 2) gaz "thermally" parfait mono/multi-especes (NESP > ou = 1)
C
C  RCHPO1 RCHPO2 RCHPO3 (RCHPO4) RCHPO5 = 'PRIM' MCLE1  TAB1
C                CHPO1 CHPO2 CHPO3 (CHPO4) (CHPO5) (MCLE2) ;
C
C
C ENTREES  :
C
C            MCLE1   : 'PERFMULT'  : mot clé
C
C
C            TAB1    : TABLE qui contient :
C                      * les noms des especes qui apparessent
C                        explicitement dans les equations d'Euler en
C                        TAB1 . 'ESPEULE' (LISTMOTS).
C                        Dans le cas monoespece TAB1 . 'ESPEULE'
C                        n'existe pas;
C                      * le nom de l'espece qui n'y est pas (mots), en
C                        TAB1 . 'ESPNEULE' (MOT).
C                      * le degre k des polynoms cv_i(T)
C                      * les CV du gas, supposes etre des polynoms du
C                        k-eme degre, i.e.
C                        CV_i = \sum_{j=0,k} A_{i,j} T^j (en J/Kg/K) ;
C                        Ils sont stokes, pour l'espece 'ESPI', dans la
C                        forme:
C                        TAB1 . 'ESPI' . 'A' = 'PROG' A_0, ..., A_k
C                      * Les constantes du gaz R_i; pour l'espece 'ESPI'
C                        TAB1 . 'ESPI' . 'R' (en J/Kg/K)
C                      * Les "energies de formation" a 0K, definies par
C                        e_{0,i} = h_{0,i} = h_{T_0,i} - {R_i * T_0 +
C                                  {\sum_{j=0,k} A_{i,j} / (j+1) T_0^(j+1)}};
C                        Elles sont stokes, pour l'espece 'ESPI', dans
C                        la forme
C                        TAB1 . 'ESPI' . 'H0K'
C                      * (éventuellement) les noms de scalaires passifs qu'on
C                        voudrait transporter en
C                         TAB1 . 'SCALPASS' (LISTMOTS)
C
C            CHPO1   : CHPOINT  contenant la masse volumique (en Kg/m^3)
C                      (une composante, 'SCAL').
C
C            CHPO2   : CHPOINT  contenant les dèbits (en m/s)
C                     (2 composantes en 2D, 'UX  ','UY  ');
C                     (3 composantes en 3D, 'UX  ','UY  ','UZ  ');
C
C            CHPO3   : CHPOINT  contenat l'énergie totale per
C                      unité de volume (RHO Et), (en J/m^3)
C                      (une composante, 'SCAL').
C
C           (CHPO4)  : CHPOINT  contenant la masse des especes qui sont
C                      explicitement "splitted" dans les equations
C                      d'Eulers (dont les noms sont dans
C                      TAB1 . 'ESPEULE');
C
C           (CHPO5)  : CHPOINT  contenant les scalaires passifs  qu'on transporte,
C                      multipliés par la masse volumique
C                      (si existe  TAB1 . 'SCALPASS');
C
C           (CHPO6)  : CHPOINT contenant la temperature de premier
C                      essai pour la methode de Newton-Raphson (en K);
C                      si il n'est pas donne' on prends T = 600K
C
C            i.e.  CHPO1, CHPO2, CHPO3, CHPO4 sont les variables
C                  conservatives des Equations d'Euler.
C
C            MCLE2   : Option personelle: pas dans la notice
C                      officielle!!!
C                      Mot clé, 'TRICHE' (s'il y a un erreur,
C                      les resultats ne sont pas
C                      des type ANNULLE et le programme
C                      ne s'arrete pas!!!)
C
C SORTIES  :
C
C            RCHPO1  : CHPOINT  contenant la vitesse
C
C            RCHPO2  : CHPOINT  contenant la pression du gaz;
C
C            RCHPO3  : CHPOINT  contenant la temperature du  gaz;
C
C           (RCHPO4) : CHPOINT  contenant les fractions
C                      massiques des differentes especes;
C
C           (RCHPO5) : CHPOINT  contenant les scalaire passifs;
C
C            RCHPO6  : CHPOINT  contenat les "gamma" du gaz
C
C            N.B.:-tous les CHPOINTs sont non-partitonees et
C                  ils ont le meme support geometrique;
C                  en sortie tous les CHPOINTs ont le support
C                  geometrique de RO
C                 -en sortie RCHPO4 et CHPO4 ont les composantes ordonnees
C                  dans le sens de TAB1 . 'ESPEULE'
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 14.12.98.
C
C               10.02.2000:
C               Correction d'un erreur informatique (voir ligne CERR1),
C               qui apparait dans le cas d'un gaz avec deux espèces
C
C               11.02.2000:
C               on ajout la possibilité de considérer des scalaires
C               passifs
C
C
C************************************************************************
C
C
C**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV, IROSCA, NSCA, ISCA
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
     &       , NESP,  ICEN, IRO, IROVIT, IROET, IROY, IT
     &       , IPGAS, IESP
     &       , IPRES, IVIT, ITEMP, IY, IGAM
     &       , I1, I2,  JGM, JGN,  NPOINT, NORD, NORDP1, NORD1
      REAL*8 VALER(2),VAL1,VAL2
      CHARACTER*(40) MESERR(2),MESCEL
      CHARACTER*(8) MTYPR
      CHARACTER*(6) NOMTRI
      CHARACTER*(4)  MOT1(1)
      LOGICAL LOGNEG, LOGBOR, LOGAN,  LOGTRI
     &        ,LOGTEM, LOGIPG, LOGNC
C
C**** Variables en ACCTAB
C
      INTEGER IVALI, IRETI,IVALR, IRETR
      REAL*8 XVALI, XVALR
      LOGICAL LOGII, LOGIR
      CHARACTER*(8) CHARR,MTYPI
C
C**** Segment des proprietes du gaz
C
      SEGMENT PROPHY
         REAL*8 ACV(NORD+1,NESP+1), R(NESP+1), H0K(NESP+1)
      ENDSEGMENT
C
C**** Les Includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
-INC SMLREEL
      POINTEUR MLMOSC.MLMOTS
C
C**** Initialisation des parametres d'erreur
C
      LOGAN   = .FALSE.
      LOGNEG  = .FALSE.
      LOGBOR  = .FALSE.
      LOGNC   = .FALSE.
      LOGIPG  = .FALSE.
      MESCEL  = '                                        '
      MESERR(1) = MESCEL
      MESERR(2) = MESCEL
      MOTERR(1:40) = MESCEL(1:40)
      VALER(1) = 0.0D0
      VALER(2) = 0.0D0
      VAL1 = 0.0D0
      VAL2 = 0.0D0
C
C**** Initialisation des variables en ACCTAB
C
      IVALI = 0
      IVALR = 0
      XVALI = 0.0D0
      XVALR = 0.0D0
      LOGII = .FALSE.
      LOGIR = .FALSE.
      IRETI = 0
      IRETR = 0
      CHARR = '        '
C
C**** Initialisation des MOT1(1) (noms des composantes)
C
      MOT1(1) = '    '
C
C**** N.B. On veut lire les objets sequentiellement.
C     Donc on utilise QUETYP pour controler que
C     le type de l'objet soit le bon.
C
C**** Lecture de la table des proprietes du gaz
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'TABLE   ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'TABLE   '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IPGAS,1)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Ordre des polynoms pour les cv_i
C
      MTYPI = 'MOT     '
      MTYPR = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
     &                     MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
      IF(MTYPR .NE. 'ENTIER  ')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . NORD = ???                       '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      NORDP1 = NORD + 1
C
C**** Nom de l'espece qui n'est pas dans les equations d'Euler
C
      MTYPI = 'MOT     '
      MTYPR = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI,
     &                     MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
      IF(MTYPR .NE. 'MOT     ')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . ESPNEULE = ???                   '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** Les especes qui sont dans les Equations d'Euler
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
      IF(MTYPR .EQ. '        ')THEN
         NESP = 0
         IROY = 0
         JGN = 4
         JGM =  1
C
C******* JGN,JGM en MLMOT2:
C        CHARACTER*(JGN) MOTS(JGM)
C
         SEGINI MLMOT2
         MLMOT2.MOTS(1) = CHARR(1:4)
      ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . ESPEULE = ???                    '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ELSE
         SEGACT MLMOT1
         NESP = MLMOT1.MOTS(/2)
         JGN = 4
         JGM =  NESP + 1
         SEGINI MLMOT2
         DO I1 = 1, NESP
            MLMOT2.MOTS(I1) = MLMOT1.MOTS(I1)
         ENDDO
         MLMOT2.MOTS(NESP+1)=CHARR(1:4)
         SEGDES MLMOT1
      ENDIF
C
C**** Les scalaires passifs qui sont dans les Equations d'Euler
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMOSC)
      IF(MTYPR .EQ. '        ')THEN
         NSCA = 0
         IROSCA = 0
      ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . SCALPASS = ???                   '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ELSE
         SEGACT MLMOSC
         NSCA = MLMOSC.MOTS(/2)
         SEGDES MLMOSC
      ENDIF
C
C**** On rempli les segment PROPHY
C     Ordre: IPGAS . 'ESPEULE' + IPGAS . 'ESPNEULE'
C     On controlle aussi la compatibilite des
C     donnes de la table
C
      SEGINI PROPHY
C
C**** N.B. MOT1 est un CHARACTER*(4)
C
      DO I1 = 1, NESP+1
         MOT1(1) = MLMOT2.MOTS(I1)
C
C******* CALL ACMF(...)  ne marche pas parce que on a
C        des blanches dans nos composantes
C
         MTYPI = 'MOT     '
         MTYPR = '        '
         CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
     &                     MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
C
C******* En IESP a la table IPGAS.MOT1(1)
C
         IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE   ')) THEN
 
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR = '                                        '
            MOTERR(1:7) = 'TAB1 . '
            MOTERR(8:11) = MOT1(1)
            MOTERR(13:17) = '= ???'
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
C
C******* R
C
         MTYPI = 'MOT     '
         MTYPR = '        '
         CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'R' , LOGII,IRETI,
     &                    MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
         IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR = '                                        '
            MOTERR(1:7) = 'TAB1 . '
            MOTERR(8:11) = MOT1(1)
            MOTERR(13:23) = ' . R = ??? '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
         PROPHY.R(I1)=XVALR
C
C******* H0K
C
         MTYPI = 'MOT     '
         MTYPR = '        '
         CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
     &                    MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
         IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
 
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR = '                                        '
            MOTERR(1:7) = 'TAB1 . '
            MOTERR(8:11) = MOT1(1)
            MOTERR(13:25) = ' . H0K = ??? '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
         PROPHY.H0K(I1)=XVALR
C
C******* A
C
         MTYPI = 'MOT     '
         MTYPR = '        '
         CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
     &                    MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
         IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
 
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR = '                                        '
            MOTERR(1:7) = 'TAB1 . '
            MOTERR(8:11) = MOT1(1)
            MOTERR(13:23) = ' . A = ??? '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
         MLREEL = IRETR
         SEGACT MLREEL
         NORD1 = MLREEL.PROG(/1)
         IF(NORD1 .NE. NORDP1)THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR = '                                        '
            MOTERR(1:10) = 'DIME(TAB1.'
            MOTERR(11:14) = MOT1(1)
            MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
 
C
C******* Dans le calcul, c'est plus utile ACV dans la forme
C        ACV(exponente,espece)
C
         DO I2 = 1, NORDP1
            PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
         ENDDO
         SEGDES MLREEL
      ENDDO
      SEGSUP MLMOT2
C
C**** La table IPGAS donc a ete controllee et PROPHY est rempli
C
C
C**** Lecture du CHPOINT CHPO1 (masse volumique totale)
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IRO,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IRO,1)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** On cherche le pointeur de son maillage et on l'impose sur les
C     autres CHPOINTs
C
      MCHPOI = IRO
      SEGACT MCHPOI
      MSOUPO = MCHPOI.IPCHP(1)
      SEGACT MSOUPO
      ICEN = MSOUPO.IGEOC
      SEGDES MSOUPO
      SEGDES MCHPOI
C
C**** Control du CHPOINT: QUEPOI
C
C     INDIC = 1   -> on impose le pointeur du support geometrique (ICEN)
C                   N.B. Le CHPOINT peut changer de structure pour
C                        avoir SPG = ICEN!!!!
C     INDIC = 0   -> on ne fait que verifier le support geometrique
C                   (ICEN). Si le SPG sont differents INDIC = -4 en sortie
C
C     NBCOMP > 0 -> numero des composantes
C
C     MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT CHPO2( debits)
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IROVIT,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IROVIT,1)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
C
CERR2
C
      JGN = 4
      JGM = IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'UX  '
      MLMOTS.MOTS(2) = 'UY  '
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ  '
C
C**** On controlle l'ordre de composantes de IROVIT
C
      CALL QUEPO1(IROVIT, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'CHPO2 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT CHPO3 (energie volumique)
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IROET,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IROET,1)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'CHPO3 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT CHPO4(masses volumiques des especes "splittees")
C
CERR1 IF(NESP .GT. 1)THEN: erreur: NESP = 0 dans le cas monoespece
C                                  NESP > 0 dans le cas multiespece
      IF(NESP .GE. 1)THEN
         ICOND = 1
         CALL QUETYP(MTYPR,ICOND,IRETOU)
         IF(IERR .NE. 0)GOTO 9999
         IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
            MOTERR(1:8) = 'CHPOINT '
            CALL ERREUR(37)
            GOTO 9999
         ELSE
            ICOND = 1
            CALL LIROBJ(MTYPR,IROY,ICOND,IRETOU)
            CALL ACTOBJ(MTYPR,IROY,1)
            IF(IERR .NE. 0)GOTO 9999
         ENDIF
C
C**** Control du CHPOINT
C
         CALL QUEPO1(IROY , ICEN , MLMOT1)
         IF(IERR .NE. 0)THEN
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
            MOTERR = 'CHPO4 = ???                             '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
      ENDIF
C
C**** Lecture du CHPOINT CHPO5 (scalaires passifs * densité)
C
      IF(NSCA .GE. 1)THEN
         ICOND = 1
         CALL QUETYP(MTYPR,ICOND,IRETOU)
         IF(IERR .NE. 0)GOTO 9999
         IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
            MOTERR(1:8) = 'CHPOINT '
            CALL ERREUR(37)
            GOTO 9999
         ELSE
            ICOND = 1
            CALL LIROBJ(MTYPR,IROSCA,ICOND,IRETOU)
            CALL ACTOBJ(MTYPR,IROSCA,1)
            IF(IERR .NE. 0)GOTO 9999
         ENDIF
C
C**** Control du CHPOINT
C
         CALL QUEPO1(IROSCA , ICEN , MLMOSC)
         IF(IERR .NE. 0)THEN
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
            MOTERR = 'CHPO5 = ???                             '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
      ENDIF
C
C**** Lecture du CHPOINT CHPO6(temperature de tentative, optionelle)
C
      ICOND = 0
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IT,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(IRETOU .EQ. 1)THEN
        CALL ACTOBJ(MTYPR,IT,1)
C
C****** Control du CHPOINT
C
         INDIC = 1
         NBCOMP = 1
         MOT1(1) = 'SCAL'
         CALL QUEPOI(IT, ICEN, INDIC, NBCOMP, MOT1)
         IF(IERR .NE. 0)THEN
            IERR0 = IERR
 
C
C*********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR = 'CHPO6 = ???                             '
            WRITE(IOIMP,*) MOTERR(1:40)
 
            GOTO 9999
         ENDIF
         LOGTEM = .TRUE.
      ELSE
         IT = 0
         LOGTEM = .FALSE.
      ENDIF
C
C*** Option TRICHE (optionelle et secrete)
C
      ICOND = 0
      CALL LIRCHA(NOMTRI,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(IRETOU .NE. 0)THEN
         IF(NOMTRI .EQ. 'TRICHE')THEN
            LOGTRI  = .TRUE.
         ELSE
            LOGTRI  = .FALSE.
            CALL ECRCHA(NOMTRI)
         ENDIF
      ELSE
         LOGTRI = .FALSE.
      ENDIF
C
C**** Calcul des sorties.
C
C     Jusque a la NESP = nombre d'especes qui apparessent
C     dans les equations d'Euler
C
C     Maintenant NESP = nombre total d'espece
C
      NESP = NESP + 1
      CALL PRIMI2(NESP,NORDP1,NSCA,PROPHY,
     &            ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
     &            IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
     &            LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
     &            VALER,VAL1,VAL2)
C
      IF(LOGAN)THEN
C
C******* Message d'erreur standard
C        5 3
C        Erreur anormale.contactez votre support
C
         CALL ERREUR(5)
         GOTO 9999
      ELSE
         IF(LOGIPG)THEN
C
C********** CV(T) &lt; 0
C
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR(1:40) = 'cv(T) &lt; 0 ?  R &lt; 0 ?                    '
            WRITE(IOIMP,*) MOTERR(1:40)
            MOTERR(1:40) = 'TAB1 = ???                              '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            IF(LOGTRI)THEN
               IERR = 0
            ELSE
               GOTO 9999
            ENDIF
         ENDIF
         IF(LOGNC)THEN
C
C********** Newton - Raphson ne converge pas !!!
C
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR(1:40) = 'Newton - Raphson                        '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           460 2
C           Pas de convergence dans les itérations internes
C
            CALL ERREUR(460)
            IF(LOGTRI)THEN
               IERR = 0
            ELSE
               GOTO 9999
            ENDIF
         ENDIF
         IF(LOGNEG)THEN
C
C******* Pression (energie thermique)  ou densité negative
C
C
C******* Message d'erreur standard
C        41 2
C        %m1:8 = %r1 inférieur à %r2
C
            MESCEL = MESERR(1)
            MOTERR(1:8) = MESCEL(1:8)
            REAERR(1) = REAL(VALER(1))
            REAERR(2) = 0.0
            CALL ERREUR(41)
            IF(LOGTRI)THEN
*               IERR = 0
            ELSE
               GOTO 9999
            ENDIF
         ENDIF
         IF(LOGBOR)THEN
C
C******* GAMMA !\in  GAMMIN, GAMMAX
C        ou Y !\in YMIN,YMAX
C
C******* Message d'erreur standard
C        42 2
C        %m1:8 = %r1 non compris entre %r2 et %r3
C
            MESCEL = MESERR(2)
            MOTERR(1:8) = MESCEL(1:8)
            REAERR(1) = REAL(VALER(2))
            REAERR(2) = REAL(VAL1)
            REAERR(3) = REAL(VAL2)
            CALL ERREUR(42)
            IF(LOGTRI)THEN
*               IERR = 0
            ELSE
               GOTO 9999
            ENDIF
         ENDIF
 
C******* Ecriture du CHPOINT contenant les "gamma".
         CALL ACTOBJ('CHPOINT ',IGAM,1)
         CALL ECROBJ('CHPOINT ',IGAM)
 
C******* Ecriture du CHPOINT contenant les scalaires passifs.
         IF(ISCA .NE. 0) THEN
           CALL ACTOBJ('CHPOINT ',ISCA,1)
           CALL ECROBJ('CHPOINT ',ISCA)
         ENDIF
 
C******* Ecriture du CHPOINT contenant Y.
         IF(IY .NE. 0) THEN
           CALL ACTOBJ('CHPOINT ',IY,1)
           CALL ECROBJ('CHPOINT ',IY)
         ENDIF
 
C******* Ecriture du CHPOINT contenant la temperature.
         CALL ACTOBJ('CHPOINT',ITEMP,1)
         CALL ECROBJ('CHPOINT',ITEMP)
C
C******* Ecriture du CHPOINT contenant la pression.
         CALL ACTOBJ('CHPOINT',IPRES,1)
         CALL ECROBJ('CHPOINT',IPRES)
 
C******* Ecriture du CHPOINT contenant la vitesse.
         CALL ACTOBJ('CHPOINT',IVIT,1)
         CALL ECROBJ('CHPOINT',IVIT)
      ENDIF
 
      SEGSUP PROPHY
      SEGSUP MLMOTS
C
 9999 CONTINUE
      END