C PRE71     SOURCE    BECC      11/05/18    21:15:29     6974           
       SUBROUTINE PRE71()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE71
C
C DESCRIPTION       :  Voir PRE7
C
C                      GFMP, stiffened gas.
C
C                      2me ordre en espace 
C     
C                      Creation of the MCHAMLs IPHIF, IROF, IVITF, IPF,
C                                              (IYF, IALF).
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C      
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C     
C************************************************************************
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Crée le 03.12.2010
C               
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
C
C**** Les variables
C
      INTEGER   ICOND,  IRETOU, MMODEL, ICELL
     &     , IDOMA, ICEN, IFACE, IFACEL, INORM
     &     , IPHI, IGRPHI, ILIPHI
     &     , IRN1, IGRRN1, ILIRN1
     &     , IVN1, IGRVN1, ILIVN1
     &     , IPN1, IGRPN1, ILIPN1
     &     , IYC, IGRYC, ILIMYC
     &     , IALC, IGRALC, ILIALC
     &     , IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF
     &     , NESP, I1, I2, ICEL, ICOM
C
      CHARACTER*(4)  NOMGRA(27),NOMLIM(9)
      CHARACTER*(8) MTYPR
C
C**** Les Includes
C
-INC CCOPTIO
      INTEGER JGM, JGN
-INC SMLMOTS
      POINTEUR MLMCOM.MLMOTS, MLMVIT.MLMOTS, MLMTEN.MLMOTS,
     &     MLMESP.MLMOTS
C
C**** Nom de composantes de gradients (HP. <= 9 composantes)
C
      DATA NOMGRA  /'P1DX','P1DY','P1DZ',
     &     'P2DX','P2DY','P2DZ',
     &     'P3DX','P3DY','P3DZ',
     &     'P4DX','P4DY','P4DZ',
     &     'P5DX','P5DY','P5DZ',
     &     'P6DX','P6DY','P6DZ',
     &     'P7DX','P7DY','P7DZ',
     &     'P8DX','P8DY','P8DZ',
     &     'P9DX','P9DY','P9DZ'/
C
      DATA NOMLIM  /'P1  ',
     &     'P2  ',
     &     'P3  ',
     &     'P4  ',
     &     'P5  ',
     &     'P6  ',
     &     'P7  ',
     &     'P8  ',
     &     'P9  '/
C
C**** Initialisation of some segment
C
      JGN=4
      JGM=1
      SEGINI MLMCOM
      JGN=4
      JGM=IDIM
      SEGINI MLMVIT
      JGN=4
      JGM=IDIM*IDIM
      SEGINI MLMTEN
C
C**** I need the LISTMOT of the species involved...
C
      MTYPR = 'LISTMOTS'
      CALL LIROBJ(MTYPR,MLMESP,ICOND,IRETOU)
      IF(IERR.NE.0)GOTO 9999
      SEGACT MLMESP
      NESP = MLMESP.MOTS(/2)
      SEGDES MLMESP
C
C**** Lecture de l'objet MODELE
C
      ICOND = 1
      MTYPR = 'MMODEL  '
      CALL LIROBJ(MTYPR, MMODEL, ICOND, IRETOU)
      IF(IERR.NE.0)GOTO 9999
      CALL LEKMOD(MMODEL, IDOMA, ICELL)
      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
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         CALL QUEPO1(INORM, IFACE, MLMVIT)
         IF(IERR.NE.0)GOTO 9999
      ELSE
C      Les normales et les tangentes
         MTYPR = ' '
         CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
         IF (MTYPR .NE. 'CHPOINT ') THEN         
            CALL MATRAN(IDOMA,INORM)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
         MLMTEN.MOTS(1) = 'UX  '
         MLMTEN.MOTS(2) = 'UY  '
         MLMTEN.MOTS(3) = 'UZ  '
         MLMTEN.MOTS(4) = 'RX  '
         MLMTEN.MOTS(5) = 'RY  '
         MLMTEN.MOTS(6) = 'RZ  '
         MLMTEN.MOTS(7) = 'MX  '
         MLMTEN.MOTS(8) = 'MY  '
         MLMTEN.MOTS(9) = 'MZ  '
         CALL QUEPO1(INORM, IFACE, MLMTEN)
         IF(IERR.NE.0)GOTO 9999
      ENDIF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C**** Lecture du CHPOINT phi = ial1  ****C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C**** IPHI
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IPHI,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMCOM*MOD
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IPHI, ICEN, MLMCOM)
      SEGDES MLMCOM
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT IGRPHI
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IGRPHI,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMVIT*MOD
      MLMVIT.MOTS(1)=NOMGRA(1)
      MLMVIT.MOTS(2)=NOMGRA(2)
      IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
      CALL QUEPO1(IGRPHI, ICEN, MLMVIT)
      SEGDES MLMVIT
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT ILIPHI
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,ILIPHI,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMCOM*MOD
      MLMCOM.MOTS(1)= NOMLIM(1)
      CALL QUEPO1(ILIPHI, ICEN, MLMCOM)
      SEGDES MLMCOM
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C**** Lecture des CHPOINTs rho       ****C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C**** RN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IRN1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMCOM*MOD
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IRN1, ICEN, MLMCOM)
      SEGDES MLMCOM
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT IGRRN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IGRRN1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMVIT*MOD
      MLMVIT.MOTS(1)=NOMGRA(1)
      MLMVIT.MOTS(2)=NOMGRA(2)
      IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
      CALL QUEPO1(IGRRN1, ICEN, MLMVIT)
      SEGDES MLMVIT
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT ILIRN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,ILIRN1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMCOM*MOD
      MLMCOM.MOTS(1)= NOMLIM(1)
      CALL QUEPO1(ILIRN1, ICEN, MLMCOM)
      SEGDES MLMCOM
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C**** Lecture des CHPOINTs vitesse   ****C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C**** VN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IVN1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMVIT*MOD
      MLMVIT.MOTS(1)='UX  '
      MLMVIT.MOTS(2)='UY  '
      IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ  '
      CALL QUEPO1(IVN1, ICEN, MLMVIT)
      SEGDES MLMVIT
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT IGRVN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IGRVN1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMTEN*MOD
      IF (IDIM .EQ. 2)THEN
         MLMTEN.MOTS(1)=NOMGRA(1)
         MLMTEN.MOTS(2)=NOMGRA(2)
         MLMTEN.MOTS(3)=NOMGRA(4)
         MLMTEN.MOTS(4)=NOMGRA(5)
      ELSEIF(IDIM .EQ. 3) THEN
         MLMTEN.MOTS(1)=NOMGRA(1)
         MLMTEN.MOTS(2)=NOMGRA(2)
         MLMTEN.MOTS(3)=NOMGRA(3)
         MLMTEN.MOTS(4)=NOMGRA(4)
         MLMTEN.MOTS(5)=NOMGRA(5)
         MLMTEN.MOTS(6)=NOMGRA(6)
         MLMTEN.MOTS(7)=NOMGRA(7)
         MLMTEN.MOTS(8)=NOMGRA(8)
         MLMTEN.MOTS(9)=NOMGRA(9)
      ENDIF
      CALL QUEPO1(IGRVN1, ICEN, MLMTEN)
      SEGDES MLMTEN
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C
C      
C**** Lecture du CHPOINT ILIVN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,ILIVN1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMVIT*MOD
      MLMVIT.MOTS(1)=NOMLIM(1)
      MLMVIT.MOTS(2)=NOMLIM(2)
      IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMLIM(3)
      CALL QUEPO1(ILIVN1, ICEN, MLMVIT)
      SEGDES MLMVIT
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C**** Lecture des CHPOINTs P         ****C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C**** PN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IPN1,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMCOM*MOD
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IPN1, ICEN, MLMCOM)
      SEGDES MLMCOM
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT IGRPN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,IGRPN1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMVIT*MOD
      MLMVIT.MOTS(1)=NOMGRA(1)
      MLMVIT.MOTS(2)=NOMGRA(2)
      IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
      CALL QUEPO1(IGRPN1, ICEN, MLMVIT)
      SEGDES MLMVIT
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C      
C**** Lecture du CHPOINT ILIPN1
C
      ICOND = 1
      MTYPR = 'CHPOINT '
      CALL LIROBJ(MTYPR,ILIPN1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C     Control du CHPOINT: QUEPO1
      SEGACT MLMCOM*MOD
      MLMCOM.MOTS(1)= NOMLIM(1)
      CALL QUEPO1(ILIPN1, ICEN, MLMCOM)
      SEGDES MLMCOM
      IF(IERR .NE. 0)THEN
         GOTO 9999
      ENDIF
C
C**** Mass fractions and alpha
C
      IF (NESP .GE. 1) THEN
C
C****    Mass fractions
C
         ICOND = 1
         MTYPR = 'CHPOINT '
         CALL LIROBJ(MTYPR,IYC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
C
C****    Control du CHPOINT
C     
         CALL QUEPO1(IYC, ICEN, MLMESP)
         IF(IERR .NE. 0) GOTO 9999
C      
C****    Lecture du CHPOINT GRADYC
C
         MTYPR = 'CHPOINT '
         ICOND = 1
         CALL LIROBJ(MTYPR,IGRYC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
C
C****    Control du CHPOINT: QUEPOI
C      
         JGN=4
         JGM=IDIM*NESP
         SEGINI MLMCOM
C        NESP < 10
         IF(NESP .GE. 10)THEN
            WRITE(IOIMP,*) 'NESP >= 10!'
C     
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C     
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
C
         ICEL = 0
         DO I1 =  1, NESP, 1
            DO I2 = 1, IDIM
               ICEL = ICEL + 1
               ICOM = 3 * (I1 -1) + I2
               MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
            ENDDO
         ENDDO
         CALL QUEPO1(IGRYC, ICEN, MLMCOM)
         IF(IERR .NE. 0) GOTO 9999
         SEGSUP MLMCOM
C      
C****    Lecture du CHPOINT ILIMYC
C
         MTYPR = 'CHPOINT '
         ICOND = 1
         CALL LIROBJ(MTYPR,ILIMYC,ICOND,IRETOU)
         IF(IERR .NE. 0) GOTO 9999
C
C****    Control du CHPOINT: QUEPOI
C      
         JGN = 4
         JGM = NESP
         SEGINI MLMCOM
         DO I1 = 1, NESP, 1
            MLMCOM.MOTS(I1)=NOMLIM(I1)
         ENDDO
         CALL QUEPO1(ILIMYC, ICEN, MLMCOM)
         IF(IERR .NE. 0) GOTO 9999
         SEGSUP MLMCOM
C
C******* ALPHA
C
         ICOND = 1
         MTYPR = 'CHPOINT '
         CALL LIROBJ(MTYPR,IALC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
C
C****    Control du CHPOINT
C     
         CALL QUEPO1(IALC, ICEN, MLMESP)
         IF(IERR .NE. 0) GOTO 9999
C      
C****    Lecture du CHPOINT GRADYC
C
         MTYPR = 'CHPOINT '
         ICOND = 1
         CALL LIROBJ(MTYPR,IGRALC,ICOND,IRETOU)
         IF (IERR.NE.0) GOTO 9999
C
C****    Control du CHPOINT: QUEPOI
C      
         JGN=4
         JGM=IDIM*NESP
         SEGINI MLMCOM
C        NESP < 10
         IF(NESP .GE. 10)THEN
            WRITE(IOIMP,*) 'NESP >= 10!'
C     
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C     
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
C
         ICEL = 0
         DO I1 =  1, NESP, 1
            DO I2 = 1, IDIM
               ICEL = ICEL + 1
               ICOM = 3 * (I1 -1) + I2
               MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
            ENDDO
         ENDDO
         CALL QUEPO1(IGRALC, ICEN, MLMCOM)
         SEGSUP MLMCOM
         IF(IERR .NE. 0) GOTO 9999
C      
C****    Lecture du CHPOINT ILIALC
C
         MTYPR = 'CHPOINT '
         ICOND = 1
         CALL LIROBJ(MTYPR,ILIALC,ICOND,IRETOU)
         IF(IERR .NE. 0) GOTO 9999
C
C****    Control du CHPOINT: QUEPOI
C      
         JGN = 4
         JGM = NESP
         SEGINI MLMCOM
         DO I1 = 1, NESP, 1
            MLMCOM.MOTS(I1)=NOMLIM(I1)
         ENDDO
         CALL QUEPO1(ILIALC, ICEN, MLMCOM)
         IF(IERR .NE. 0) GOTO 9999
         SEGSUP MLMCOM
C
      ELSE
         IYC = 0
         IGRYC = 0
         ILIMYC = 0
         IALC = 0
         IGRALC = 0
         ILIALC = 0
      ENDIF
C
C      write(*,*) 'Fin qui'
C      write(*,*) IPHI, IGRPHI, ILIPHI
C      write(*,*) IRN1, IGRRN1, ILIRN1
C      write(*,*) IVN1, IGRVN1, ILIVN1
C      write(*,*) IPN1, IGRPN1, ILIPN1
C      write(*,*) IYC, IGRYC, ILIMYC
C      write(*,*) IALC, IGRALC, ILIALC
C      write(*,*) 'Fin qui'
C      goto 9999
C
      IF(IDIM .EQ. 2)THEN
C
C******* Deux Dimensions, 2-eme ordre en espace, 2-eme ordre en
C        temps
C
         CALL PRE711(NESP,MLMESP,
     &        ICEN,IFACE,IFACEL,INORM,
     &        IPHI, IGRPHI, ILIPHI,
     &        IRN1, IGRRN1, ILIRN1,
     &        IVN1, IGRVN1, ILIVN1,
     &        IPN1, IGRPN1, ILIPN1,
     &        IYC, IGRYC, ILIMYC,
     &        IALC, IGRALC, ILIALC,
     &        IPHIF, IRN1F, IVN1F, IPN1F, IYF, IALF)
         IF(IERR .NE. 0) GOTO 9999
      ELSE
C
C******* Message d'erreur standard
C        251 2
C        Tentative d'utilisation d'une option non implémentée
C         
         CALL ERREUR(251)
C
      ENDIF
      SEGSUP MLMCOM
      SEGSUP MLMVIT
      SEGSUP MLMTEN
C
C**** Ecriture de
C     IPHIF, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F
C
      MTYPR = 'MCHAML  '
C      write(*,*) nesp
      IF (NESP .GE. 1) THEN
         CALL ECROBJ(MTYPR,IALF)
         CALL ECROBJ(MTYPR,IYF)
      ENDIF
      CALL ECROBJ(MTYPR,IPN1F)
      CALL ECROBJ(MTYPR,IVN1F)
      CALL ECROBJ(MTYPR,IRN1F)
      CALL ECROBJ(MTYPR,IPHIF)
C
 9999 CONTINUE
C
      RETURN
      END