Télécharger pridem.eso

Retour à la liste

pridem
C PRIDEM    SOURCE    CB215821  20/11/25    13:36:45     10792          
      SUBROUTINE PRIDEM()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIDEM
C
C DESCRIPTION       :  Voir PRIMIT
C
C                      RDEM approach for combustion.
C                      Computation of the primitive variables.
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C
C APPELES (Calcul)  : PRIDE1
C
C
C************************************************************************
C
C
C CALL (GIBIANE) :
C
C  RCHV1 RCHV2 RCHP1 RCHP2 RCHT1 RCHT2 = 'PRIM' 'DEM' TABPGAS
C        CHPAL1 CHPAL2 CHPARN1 CHPARN2 CHPAGN1 CHPAGN2
C        CHPARET1 CHPARET2 CHPTGUE1 CHPTGUE2 EPS ;
C
C
C ENTREES  :
C
C
C          TABPGAS   : TABLE which contains
C                      * 'SPECIES'
C                      * 'CHEM_COEF'
C                      * 'MASSFRA' initial and final mass fraction of
C                        the first appearing in 'SPECIES',
C                        final mass fractions of the species with
C                        positive coefficients in 'CHEM_COEF',
C                        initial mass fractions for the species with
C                        negative coefficients in 'CHEM_COEF'
C                      * 'RUNIV' = universal gas constant,
C                      * ESPi = table containing the properties of
C                        the species ESPi
C                      * 'TMAX' maximum temperature for cv expansion;
C                        for T>'TMAX', cv(T)=cv('TMAX')
C                      * ESPI . 'A'
C                        CV_i = \sum_{j=0,k} A_{i,j} T^j
C                      * ESPI . 'W' (Kg/mole)
C                      * ESPI . 'H0K'
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
C            CHPAL1  : CHPOINT which contains the volume fraction alpha_1
C                      of 1 (one component, 'SCAL').
C
C            CHPAL2  : CHPOINT which contains the volume fraction alpha_2
C                      of 2 (one component, 'SCAL').
C
C            CHPARN1 : CHPOINT which contains the alpha_1 * density  of 1
C                      (one component, 'SCAL').
C
C            CHPARN2 : CHPOINT which contains the alpha_2 * density  of 2
C                      (one component, 'SCAL').
C
C            CHPAGN1 : CHPOINT which contains the alpha_1 * momentom of 1
C                      (one component, 'SCAL').
C
C            CHPAGN2 : CHPOINT which contains the alpha_2 * momentom of 2
C                      (one component, 'SCAL').
C
C            CHPARET1: CHPOINT which contains the alpha_1 * total energy
C                      of 1 (one component, 'SCAL').
C
C            CHPARET2: CHPOINT which contains the alpha_2 * total energy
C                      of 2 (one component, 'SCAL').
C
C            CHPTGUE1: CHPOINT which contains the guess value
C                      for the temperature of 1 (one component, 'SCAL').
C
C            CHPTGUE2: CHPOINT which contains the guess value
C                      for the temperature of 2 (one component, 'SCAL').
C
C            K0      : FLOTTANT which contains the fundamental flame
C                      speed
C
C            EPS     : FLOTTANT such that if ALPHA_i < EPS, we can say
C                      that species i does not exists
C
C
C SORTIES  :
C
C            RCHV1   : CHPOINT which contains the speed of 1
C
C            RCHV2   : CHPOINT which contains the speed of 2
C
C            RCHP1   : CHPOINT which contains the pressure of 1
C
C            RCHP2   : CHPOINT which contains the pressure of 2
C
C            RCHT1   : CHPOINT which contains the temperature of 1
C
C            RCHT2   : CHPOINT which contains the temperature of 2
C
C
C************************************************************************
C
C HISTORIQUE :  Crée le 06.09.09.
C
C************************************************************************
C
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER ICOND, IRETOU, INDIC, NBCOMP
     &     , NESP,  NESP1, ICEN, IALP1, IALP2
     &     , IARN1, IARN2
     &     , IAGN1, IAGN2, IARET1, IARET2, ITG1, ITG2
     &     , IPGAS, IESP
     &     , IVN1, IVN2, IPN1, IPN2, IRN1, IRN2, ITN1, ITN2
     &     , I1, I2,  JGM, JGN, NORD, NORDP1, NORD1
      REAL*8 VALER(2),VAL1,VAL2, TMAX, RUNIV, EPS
      CHARACTER*(40) MESERR(2),MESCEL
      CHARACTER*(8) TYPE
      CHARACTER*(4)  MOT1(1)
      LOGICAL LOGNEG, LOGBOR, LOGAN, LOGNC, LOGIPG
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), W(NESP), H0K(NESP)
      ENDSEGMENT
C
C**** Les Includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
-INC SMLREEL
      POINTEUR MLMOSC.MLMOTS, MLMESP.MLMOTS
      POINTEUR MLRMFR.MLREEL, MLRCHE.MLREEL
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(TYPE,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(TYPE .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(TYPE,IPGAS,ICOND,IRETOU)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Ordre des polynoms pour les cv_i
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
     &                     TYPE,NORD,XVALR,CHARR,LOGIR,IESP)
      IF(TYPE .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**** 'TMAX'
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'TMAX',LOGII,IRETI,
     &                     TYPE,IVALR,XVALR,CHARR,LOGIR,IESP)
      IF(TYPE .NE. 'FLOTTANT')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . TMAX = ???                       '
         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
      TMAX = XVALR
C
C**** 'RUNIV'
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'RUNIV',LOGII,IRETI,
     &                     TYPE,IVALR,XVALR,CHARR,LOGIR,IESP)
      IF(TYPE .NE. 'FLOTTANT')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . RUNIV = ???                      '
         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
      RUNIV = XVALR
C
C**** Les especes
C
      TYPE = '        '
      CALL ACMO(IPGAS,'SPECIES',TYPE,MLMESP)
      IF(TYPE .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . SPECIES = ???                    '
         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 MLMESP
         NESP = MLMESP.MOTS(/2)
         SEGDES MLMESP
      ENDIF
C
C**** 'MASSFRA'
C
      TYPE = '        '
      CALL ACMO(IPGAS,'MASSFRA',TYPE,MLRMFR)
      IF(TYPE .NE. 'LISTREEL')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . MASSFRA  = ???                   '
         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 MLRMFR
         NESP1 = MLRMFR.PROG(/1)
         IF (NESP1 .NE. NESP) THEN
            MOTERR(1:40) = 'TAB1 . MASSFRA  = ???                   '
            WRITE(IOIMP,*) MOTERR(1:40)
            MOTERR(1:40) = 'TAB1 . SPECIES = ???                    '
            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
         SEGDES MLRMFR
      ENDIF
C
C**** 'CHEMCOEF'
C
      TYPE = '        '
      CALL ACMO(IPGAS,'CHEMCOEF',TYPE,MLRCHE)
      IF(TYPE .NE. 'LISTREEL')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         write(*,*) TYPE
         MOTERR(1:40) = 'TAB1 . CHEMCOEF = ???                   '
         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 MLRCHE
         NESP1 = MLRCHE.PROG(/1)
         IF (NESP1 .NE. NESP) THEN
            MOTERR(1:40) = 'TAB1 . CHEMCOEF = ???                   '
            WRITE(IOIMP,*) MOTERR(1:40)
            MOTERR(1:40) = 'TAB1 . SPECIES = ???                    '
            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
         SEGDES MLRCHE
      ENDIF
C
C**** On rempli les segment PROPHY
C     Ordre: IPGAS . 'SPECIES'
C
      SEGINI PROPHY
      SEGACT MLMESP
C
C**** N.B. MOT1 est un CHARACTER*(4)
C
      DO I1 = 1, NESP
         MOT1(1) = MLMESP.MOTS(I1)
C
C******* CALL ACMF(...)  ne marche pas parce que on a
C        des blanches dans nos composantes
C
         MTYPI = 'MOT     '
         TYPE = '        '
         CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
     &                     TYPE,IVALR,XVALR,CHARR,LOGIR,IESP)
C
C******* En IESP a la table IPGAS.MOT1(1)
C
         IF((IERR .NE. 0) .OR. (TYPE .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******* W
C
         MTYPI = 'MOT     '
         TYPE = '        '
         CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'W' , LOGII,IRETI,
     &                    TYPE,IVALR, XVALR ,CHARR,LOGIR,IRETR)
         IF((IERR .NE. 0) .OR. (TYPE .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) = ' . W = ??? '
            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.W(I1)=XVALR
C
C******* H0K
C
         MTYPI = 'MOT     '
         TYPE = '        '
         CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
     &                    TYPE,IVALR, XVALR ,CHARR,LOGIR,IRETR)
         IF((IERR .NE. 0) .OR. (TYPE .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     '
         TYPE = '        '
         CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
     &                    TYPE,IVALR, XVALR ,CHARR,LOGIR,IRETR)
         IF((IERR .NE. 0) .OR. (TYPE .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
      SEGDES MLMESP
C
C**** La table IPGAS donc a ete controllee et PROPHY est rempli
C
C
C**** Lecture du CHPOINT ALPHA1
C
      TYPE='CHPOINT '
      ICOND = 1
      CALL LIROBJ(TYPE,IALP1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** On cherche le pointeur de son maillage et on l'impose sur les
C     autres CHPOINTs
C
      MCHPOI = IALP1
      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(IALP1, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IALP1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT ALPHA2
C
      TYPE='CHPOINT '
      ICOND = 1
      CALL LIROBJ(TYPE,IALP2,ICOND,IRETOU)
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IALP2, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IALP2 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IARN1
C
      ICOND = 1
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,IARN1,ICOND,IRETOU)
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IARN1, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IARN1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IARN2
C
      ICOND = 1
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,IARN2,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IARN2, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IARN2 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IAGN1 ( debits)
C
      TYPE='CHPOINT '
      ICOND = 1
      CALL LIROBJ(TYPE,IAGN1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT
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 IAGN1
C
      CALL QUEPO1(IAGN1, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'IAGN1    = ???                          '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IAGN2 ( debits)
C
      ICOND = 1
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,IAGN2,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT
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 IAGN2
C
      CALL QUEPO1(IAGN2, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'IAGN2    = ???                          '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IARET1
C
      ICOND = 1
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,IARET1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IARET1, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IARET1 = ???                            '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IARET2
C
      ICOND = 1
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,IARET2,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IARET2, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IARET2 = ???                            '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT Tguess ITG1
C
      ICOND = 1
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,ITG1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C****** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(ITG1, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'ITG1  = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT Tguess ITG2
C
      ICOND = 1
      TYPE='CHPOINT '
      CALL LIROBJ(TYPE,ITG2,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(ITG2, ICEN, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'ITG2  = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
         GOTO 9999
      ENDIF
C
      ICOND = 1
      CALL LIRREE(EPS, ICOND, IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Creation of the CHAMPOIN for the results
C
      TYPE = 'CHPOINT '
      CALL KRCHP1(TYPE, ICEN, IVN1, MLMOTS)
      CALL KRCHP1(TYPE, ICEN, IVN2, MLMOTS)
      SEGSUP MLMOTS
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL KRCHP1(TYPE, ICEN, IPN1, MLMOTS)
      CALL KRCHP1(TYPE, ICEN, IPN2, MLMOTS)
      CALL KRCHP1(TYPE, ICEN, IRN1, MLMOTS)
      CALL KRCHP1(TYPE, ICEN, IRN2, MLMOTS)
      CALL KRCHP1(TYPE, ICEN, ITN1, MLMOTS)
      CALL KRCHP1(TYPE, ICEN, ITN2, MLMOTS)
      SEGSUP MLMOTS
C
C**** Computation of the primitive variables
C
      CALL PRIDE1(NESP,NORD,TMAX,RUNIV,PROPHY,
     &     MLRCHE,MLRMFR,
     &     ICEN,IALP1,IALP2,IARN1,IARN2,IAGN1,IAGN2,IARET1,IARET2,
     &     ITG1,ITG2,IRN1,IRN2,
     &     IVN1,IVN2,IPN1,IPN2,ITN1,ITN2,
     &     EPS,
     &     LOGAN,LOGIPG,LOGNEG,LOGBOR,LOGNC,
     &     VALER,VAL1,VAL2)
C
      IF(IERR .NE. 0)THEN
         WRITE(IOIMP,*) 'subroutine pride1'
         GOTO 9999
      ENDIF
CCCC
CCCC**** Calcul des sorties.
CCCC
CCCC     Jusque a la NESP = nombre d'especes qui apparessent
CCCC     dans les equations d'Euler
CCCC
CCCC     Maintenant NESP = nombre total d'espece
CCCC
CCC      NESP = NESP + 1
CCC      CALL PRIMI2(NESP,NORDP1,NSCA,PROPHY,
CCC     &            ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
CCC     &            IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
CCC     &            LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
CCC     &            VALER,VAL1,VAL2)
CCCC
      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) < 0
C
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR(1:40) = 'cv(T) < 0 ?  R < 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)
C           IF(LOGTRI)THEN
C               IERR = 0
C            ELSE
            GOTO 9999
C            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)
            GOTO 9999
         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)
            GOTO 9999
         ENDIF
         IF(LOGBOR)THEN
C
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)
C           We artificially change the value of IERR in order to
C           continue the computation
            IERR = 0
            GOTO 9999
         ENDIF
      ENDIF
C
C*****Ecriture du CHPOINT contenant les "gamma".
C
      CALL ACTOBJ('CHPOINT ',ITN2,1)
      CALL ACTOBJ('CHPOINT ',ITN1,1)
      CALL ACTOBJ('CHPOINT ',IPN2,1)
      CALL ACTOBJ('CHPOINT ',IPN1,1)
      CALL ACTOBJ('CHPOINT ',IVN2,1)
      CALL ACTOBJ('CHPOINT ',IVN1,1)
      CALL ACTOBJ('CHPOINT ',IRN2,1)
      CALL ACTOBJ('CHPOINT ',IRN1,1)
 
      CALL ECROBJ('CHPOINT ',ITN2)
      CALL ECROBJ('CHPOINT ',ITN1)
      CALL ECROBJ('CHPOINT ',IPN2)
      CALL ECROBJ('CHPOINT ',IPN1)
      CALL ECROBJ('CHPOINT ',IVN2)
      CALL ECROBJ('CHPOINT ',IVN1)
      CALL ECROBJ('CHPOINT ',IRN2)
      CALL ECROBJ('CHPOINT ',IRN1)
 9999 CONTINUE
C
      RETURN
      END
 
 
 
 

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