C FIMVF1    SOURCE    CHAT      05/01/13    00:01:02     5004           
      SUBROUTINE FIMVF1
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  FIMVF1
C
C DESCRIPTION       :  Subroutine appellée par FIMPVF
C
C                      Modelisation 2D/3D des equations d'Euler
C                      Gravité
C
C                      Calcul du flux/residu
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C*** SYNTAXE
C
C  Discrétisation en VF "cell-centered" des équations d'Euler pour
C  un gaz parfait polytropique
C  Inconnues: densités, quantité de mouvement, énergie totale par
C  unité de volumes (variables conservatives)
C  Gravité
C
C  RESU    = 'FIMP' 'VF' 'GRAVMONO'
C            MOT1 LMOTC CHPRN CHPGN CHGRA ;
C
C  MOT1    : MOT, 'RESI', 'JACOCONS'
C
C  LMOTC   : LISTMOTS, noms des variables conservatives
C
C  CHPRN   : densité  (SPG = 'CENTRE', une seule
C           composante, 'SCAL')
C
C  CHPGN   : qdm (SPG = meme que CHPRN,
C           composantes: 'UX', 'UY', ('UZ'))
C
C  CHPGRA  : gravité (SPG = meme que CHPRN, 
C           composantes: 'UX', 'UY', ('UZ'))
C
C
C SORTIES
C
C  RESU  : residu ou matrice jacobienne
C 
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMLMOTS
-INC SMCHPOI
C
      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
     &        ,IECHO,   IIMPI,  IOSPI
     &        ,IDIM,    IFICLE, IPREFI     
     &        ,MCOORD
     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
     &        ,NORINC,NORVAL,NORIND,NORVAD
     &        ,NUCROU, IPSAUV
C
      INTEGER NBOPT, IMET, IRET, IRO, ICEN, INDIC, NBCOMP
     &     , IROVIT, JGN, JGM, IGRAV, ILIINC, IJAC, IRES
C
      PARAMETER (NBOPT=2)
      CHARACTER*8 LOPT(NBOPT)
      CHARACTER*4 MOT(1)
C      
      DATA LOPT/'RESI    ','JACOCONS'/
C
C**** IMET = 1 -> residuu
C     IMET = 2 -> jacobienne
C
      CALL LIRMOT(LOPT,NBOPT,IMET,1)
      IF(IERR.NE.0)GOTO 9999
C
C**** Noms de variables conservatives
C
      CALL LIROBJ('LISTMOTS',ILIINC,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      MLMOTS = ILIINC
      SEGACT MLMOTS
      NBCOMP = MLMOTS.MOTS(/2)
      SEGDES MLMOTS
      IF(NBCOMP .NE. (IDIM+2))THEN
         MOTERR(1:40) = 'LISTINCO = ???'
         WRITE(IOIMP,*) MOTERR
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** Densité
C
      CALL LIROBJ('CHPOINT',IRO,1,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** On cherche le pointeur de son maillage et on l'impose sur les
C     autres CHPOINT
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
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C      
C**** Lecture du CHPOINT DEBIT.
C
      CALL LIROBJ('CHPOINT',IROVIT,1,IRET)
      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  '
      CALL QUEPO1(IROVIT, ICEN, MLMOTS)
      IF(IERR .NE. 0) GOTO 9999
C
C      
C**** Lecture du CHPOINT GRAVITE.
C
      CALL LIROBJ('CHPOINT',IGRAV,1,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT
C     
      CALL QUEPO1(IGRAV, ICEN, MLMOTS)
      IF(IERR .NE. 0) GOTO 9999
      SEGSUP MLMOTS
C
C**** Results
C
      IF(IMET.EQ.1)THEN
C
C******* On calcule le residu
C
         IJAC=0
         CALL FIMVF2(ILIINC,ICEN,IRO,IROVIT,IGRAV,IRES)
      ELSE
         IRES=0
         CALL FIMVF3(ILIINC,ICEN,IGRAV,IJAC)
      ENDIF
C
      IF(IRES .NE. 0) CALL ECROBJ('CHPOINT ',IRES)
      IF(IJAC .NE. 0) CALL ECROBJ('MATRIK  ',IJAC)
C      
 9999 CONTINUE
      RETURN
      END