C PRE31     SOURCE    FANDEUR   13/01/29    21:16:15     7683           
      SUBROUTINE PRE31()
C************************************************************************
C     
C PROJET            :  CASTEM 2000
C     
C NOM               :  PRE31
C     
C DESCRIPTION       :  Voir PRE3
C     
C                      Cas gaz "thermally perfect" mono/multi-especes
C     
C                      1er ordre en espace, 1er ordre en temps
C     
C                      Creations des object MCHAML IROF, IVITF, IPF, IYF
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 (Outils)  :  LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
C                      QUEPO1, ECROBJ
C     
C APPELES (Calcul)  :  PRE311 (2D), PRE312 (3D)
C     
C     
C************************************************************************
C     
C HISTORIQUE (Anomalies et modifications éventuelles)
C     
C HISTORIQUE :  Créée le 18.12.98.
C
C               06.02.00 transport des scalaires passifs
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, IFICLE, IPREFI
C     
C**** Les variables
C     
      IMPLICIT INTEGER(I-N)
      INTEGER   ICOND,  IRETOU, IERR0
     &     ,IDOMA, ICEN, IFACE, IFACEL, INORM, IROC, IVITC, IPC
     &     ,IYC, ISCAC, IROF, IVITF, IPF, IYF,  IPGAS, NESP, ISCAF
     &     ,NSCA, INEFMD
     &     ,MMODEL
      REAL*8 VALER, VAL1, VAL2
      CHARACTER*(8) MTYPR, TYPE
      CHARACTER*(40) MESERR
      LOGICAL LOGAN,LOGNEG, LOGBOR
C     
C**** Les Includes
C     
-INC CCOPTIO
      INTEGER JGM, JGN
-INC SMLMOTS
      POINTEUR MLMCOM.MLMOTS, MLMESP.MLMOTS, MLMSCA.MLMOTS
      POINTEUR MLMVIT.MLMOTS
C     
C**** Initialisation des parametres d'erreur
C     
      LOGAN = .FALSE.
      LOGNEG  = .FALSE.
      LOGBOR  = .FALSE.
      MESERR = '                                        '
      MOTERR(1:40) = MESERR(1:40)
      VALER = 0.0D0
      VAL1 = 0.0D0
      VAL2 = 0.0D0
C
C**** Lecture de l'objet MODELE
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRETOU)

      IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
        WRITE(6,*)' On attend un objet MMODEL'
        RETURN
      ENDIF
      CALL LIROBJ('MMODEL',MMODEL,ICOND,IRETOU)
      IF(IERR.NE.0)GOTO 9999
      CALL LEKMOD(MMODEL,IDOMA,INEFMD)
      IF(IERR.NE.0)GOTO 9999
C     
C**** Lecture du MELEME SPG des points CENTRE.
C     
C     
C     CALL LEKTAB(IDOMA,'CENTRE',IP)
C     
C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
C     il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
C     -> la correspondance global des noeuds saut!
C     
C     On peut utilizer ACCTAB ou ACMO
C     
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
      IF(IERR.NE.0)GOTO 9999
C     
C**** Lecture du MELEME 'FACE'
C     
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
      IF(IERR.NE.0)GOTO 9999
C     
C**** Lecture du MELEME 'FACEL'
C     
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
      IF(IERR.NE.0)GOTO 9999
C     
C**** Lecture du CHPOINT contenant les normales (tangentes)  aux faces
C     
      IF(IDIM .EQ. 2)THEN
C        Que les normales
         CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
         IF(IERR .NE. 0) GOTO 9999
         JGN = 4
         JGM = 2
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         CALL QUEPO1(INORM, IFACE, MLMVIT)
         SEGSUP MLMVIT
         IF(IERR.NE.0)GOTO 9999
      ELSE
         MTYPR = ' '
         CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
         IF (MTYPR .NE. 'CHPOINT ') THEN         
            CALL MATRAN(IDOMA,INORM)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
         JGN = 4
         JGM = 9
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         MLMVIT.MOTS(3) = 'UZ  '
         MLMVIT.MOTS(4) = 'RX  '
         MLMVIT.MOTS(5) = 'RY  '
         MLMVIT.MOTS(6) = 'RZ  '
         MLMVIT.MOTS(7) = 'MX  '
         MLMVIT.MOTS(8) = 'MY  '
         MLMVIT.MOTS(9) = 'MZ  '
         CALL QUEPO1(INORM, IFACE, MLMVIT)
         SEGSUP MLMVIT
         IF(IERR.NE.0)GOTO 9999
C     
      ENDIF
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)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF         
C     
C**** Les especes qui sont dans les Equations d'Euler
C     
      MTYPR = '        ' 
      CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP)
      IF(MTYPR .EQ. '        ')THEN
         NESP = 0
         IYC = 0
      ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
         MOTERR(1:40) = 'TAB2 . ESPEULE = ???                    '
         WRITE(IOIMP,*) MOTERR
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**** Les scalaires passifs
C     
      MTYPR = '        ' 
      CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMSCA)
      IF(MTYPR .EQ. '        ')THEN
         NSCA = 0
         ISCAC = 0
      ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
         MOTERR(1:40) = 'TAB2 . SCALPASS = ???                   '
         WRITE(IOIMP,*) MOTERR
C     
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C     
         CALL ERREUR(21)
         GOTO 9999
      ELSE
         SEGACT MLMSCA
         NSCA = MLMSCA.MOTS(/2)
         SEGDES MLMSCA
      ENDIF
C
C**** Lecture du CHPOINT ROC
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,IROC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C     
C**** Control du CHPOINT: QUEPO1
C     
      JGN=4
      JGM=1
      SEGINI MLMCOM
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IROC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
         MOTERR(1:40) = 'CHPO1 = ???                             '
     $        
         WRITE(IOIMP,*) MOTERR         

         GOTO 9999
      ENDIF
C     
C**** Lecture du CHPOINT VITC
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('CHPOINT',IVITC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C     
C**** Control du CHPOINT
C     
      JGN=4
      JGM=IDIM
      SEGINI MLMCOM
      MLMCOM.MOTS(1) = 'UX  '
      MLMCOM.MOTS(2) = 'UY  '
      IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ  '
      CALL QUEPO1(IVITC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
         MOTERR(1:40) = 'CHPO2 = ???                             '
     $        
         WRITE(IOIMP,*) MOTERR         

         GOTO 9999
      ENDIF  
C     
C**** Lecture du CHPOINT PC
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('CHPOINT',IPC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C     
C**** Control du CHPOINT
C     
      JGN=4
      JGM=1
      SEGINI MLMCOM
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IPC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
         MOTERR(1:40) = 'CHPO3 = ???                             '
     $        
         WRITE(IOIMP,*) MOTERR

         GOTO 9999
      ENDIF 
C     
C**** Lecture du CHPOINT YC
C     
      IF(NESP .GT. 0)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('CHPOINT',IYC,ICOND,IRETOU)
            IF (IERR.NE.0) GOTO 9999
         ENDIF
C     
C**** Control du CHPOINT (on ne controlle que le maillage)
C     
         CALL QUEPO1(IYC, ICEN, MLMESP)
         IF(IERR .NE. 0)THEN
            IERR0 = IERR

C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
            MOTERR(1:40) = 'CHPO4 = ???                             '
            WRITE(IOIMP,*) MOTERR

            GOTO 9999
         ENDIF 
      ENDIF
C     
C**** Lecture du CHPOINT ISCAC
C     
      IF(NSCA .GT. 0)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('CHPOINT',ISCAC,ICOND,IRETOU)
            IF (IERR.NE.0) GOTO 9999
         ENDIF
C     
C**** Control du CHPOINT (on ne controlle que le maillage)
C     
         CALL QUEPO1(ISCAC, ICEN, MLMSCA)
         IF(IERR .NE. 0)THEN
            IERR0 = IERR

C     
C******* Message d'erreur standard
C        -301 0 %m1:40
C     
            MOTERR(1:40) = 'CHPO5 = ???                             '
            WRITE(IOIMP,*) MOTERR

            GOTO 9999
         ENDIF 
      ENDIF
C     
C**** Centre -> Face
C     
      IF(IDIM .EQ. 2)THEN
C     
C******* Deux Dimensions, Mono/Multi Especes, 1er ordre en espace, 1er ordre en
C        temps
C     
         CALL PRE311(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC,
     &        IROF,IVITF,IPF,IYF,ISCAF,
     &        LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
      ELSE
C     
C******* Trois Dimensions, Mono/Multi Especes, 1er ordre en espace,
C 1er ordre en temps
C     
C     
         CALL PRE312(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,ISCAC,
     &        IROF,IVITF,IPF,IYF,ISCAF,
     &        LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
      ENDIF
C     
C**** Messages d'erreur
C     
      IF(LOGAN)THEN
C     
C******* Anomalie detectée
C     
C     
C******* Message d'erreur standard
C        -301 0
C        %m1:40
C     
         MOTERR(1:40) =  MESERR(1:40)
         WRITE(IOIMP,*) MOTERR
C     
C******* Message d'erreur standard
C        5 3
C        Erreur anormale.contactez votre support
C     
         CALL ERREUR(5)
         GOTO 9999
C     
      ELSEIF(LOGNEG)THEN
C     
C******* Message d'erreur standard
C        41 2
C        %m1:8 = %r1 inférieur à %r2
C     
         MOTERR(1:8) = MESERR(1:8)
         REAERR(1) = REAL(VALER)
         REAERR(2) = 0.0
         CALL ERREUR(41)
         GOTO 9999
      ELSEIF(LOGBOR)THEN
C     
C******* Message d'erreur standard
C        42 2
C        %m1:8 = %r1 non compris entre %r2 et %r3
C     
         MOTERR(1:8) = MESERR(1:8)
         REAERR(1) = REAL(VALER)
         REAERR(2) = REAL(VAL1)
         REAERR(3) = REAL(VAL2)
         CALL ERREUR(42)
         GOTO 9999
      ELSE
C     
C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
C     
         MTYPR = 'MCHAML'
         IF(ISCAF .NE. 0) CALL ECROBJ(MTYPR,ISCAF)
         IF(IYF .NE. 0) CALL ECROBJ(MTYPR,IYF)
         CALL ECROBJ(MTYPR,IPF)
         CALL ECROBJ(MTYPR,IVITF)
         CALL ECROBJ(MTYPR,IROF)
      ENDIF  
C     
 9999 CONTINUE
C     
      RETURN
      END