C PENT      SOURCE    LEPOTIER  09/10/12    21:15:08     6527           
      SUBROUTINE PENT()
C************************************************************************
C     
C PROJET            :  CASTEM 2000
C     
C NOM               :  PENT (OPERATEUR GIBIANE)
C     
C DESCRIPTION       :  Calcul du gradient d'un CHPOINT 2D/3D de type CENTRE
C                      avec possible limitation LED ("Local extremum
C                      diminishing");
C
C                      Calcul du gradient d'un CHPOINT 2D/3D de type FACE
C                      avec la methode du diamant linaire exacte
C                      
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C     
C AUTEURS           :  A. BECCANTINI,  R. MOREL, C. LEPOTIER, DEN/DM2S
C     
C************************************************************************
C     
C**** Variables de COOPTIO
C     
      IMPLICIT INTEGER(I-N)
      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
     &     ,IOTER,   IOLEC,  IOIMP,   IOCAR,  IOACQ
     &     ,IOPER,   IOSGB,  IOGRA,   IOSAU,  IORES
     &     ,IECHO,   IIMPI,  IOSPI
     &     ,IDIM
     &     ,MCOORD      
     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
     &     ,NORINC,NORVAL,NORIND,NORVAD
     &     ,NUCROU, IPSAUV, IFICLE, IPREFI, IREFOR, ISAFOR
-INC CCOPTIO
C     
      INTEGER IDOMA, ICOND, IRET1, NBOPT1,NBOPT2,NBOPT3,IOP1,IOP2,IOP3 
     &     ,INEFMD,MMODEL
C
      PARAMETER(NBOPT1 = 3,NBOPT2 = 6,NBOPT3=2)
      CHARACTER*(8)  LISMC1(NBOPT1),LISMC2(NBOPT2),LISMC3(NBOPT3),MOT 
     &     ,TYPE
      DATA LISMC1 /'CENTRE  ','SOMMET  ','FACE    '/
      DATA LISMC2 /'EULESCAL','EULEVECT','DIAMANT','MPFA','DIAMAN2',
     &            'VFSYM'/
      DATA LISMC3 /'NOLIMITE','LIMITEUR'/
C
C**** Lecture de l'objet MODELE
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRET1)

      IF(IRET1.EQ.0.AND.TYPE.NE.'MMODEL')THEN
        WRITE(6,*)' On attend un objet MMODEL'
        RETURN
      ENDIF
      CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET1)
      IF(IERR.NE.0)GOTO 9999
      CALL LEKMOD(MMODEL,IDOMA,INEFMD)
      IF(IERR.NE.0)GOTO 9999
C     
C**** Les options
C
C     CENTRE, SOMMET ou FACE
C
      CALL LIRCHA(MOT,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
      CALL OPTLI(IOP1,LISMC1,MOT,NBOPT1)
      IF(IERR .NE. 0) GOTO 9999
      IF(IOP1 .EQ. 0) THEN
C     
C******* Message d'erreur standard
C        251 2
C        Tentative d'utilisation d'une option non implémentée
         
         CALL ERREUR(251)
         GOTO 9999
      ENDIF
C     
C**** Les differentes methodes (voir LISMC2)
C     
      CALL LIRCHA(MOT,1,IRET1)
      IF(IERR .NE. 0) GOTO 9999
      CALL OPTLI(IOP2,LISMC2,MOT,NBOPT2)
      IF(IOP2 .EQ. 0) THEN
C     
C******* Message d'erreur standard
C        251 2
C        Tentative d'utilisation d'une option non implémentée
         
         CALL ERREUR(251)
         GOTO 9999
      ENDIF
C
C
C**** Les cas 1-2 ('EULESCAL','EULEVECT') sont traités ensembles
C
      IF(IOP2.LE.2)THEN
C     
C**** Limiteur ou non
C     
         CALL LIRCHA(MOT,1,IRET1)
         IF(IERR .NE. 0) GOTO 9999
         CALL OPTLI(IOP3,LISMC3,MOT,NBOPT3)
         IF(IOP3 .EQ. 0) THEN
C     
C******* Message d'erreur standard
C        251 2
C        Tentative d'utilisation d'une option non implémentée
         
            CALL ERREUR(251)
            GOTO 9999
         ENDIF
C
C******* Pour l'instant les cas 1-5 sont donnent des gradients 
C        aux centres
C
         IF(IOP1 .NE. 1)THEN
C
C********** Message d'erreur standard
C           251 2
C           Tentative d'utilisation d'une option non implémentée
C         
            CALL ERREUR(251)
            GOTO 9999
         ENDIF
         CALL PENT15(IDOMA,IOP2,IOP3)
         IF(IERR.NE.0) GOTO 9999
      ELSEIF(IOP2.EQ.3)THEN
C
C******* Pour l'instant les cas 3 ('DIAMANT') donne un gradient aux
C        interfaces
C
         IF(IOP1 .NE. 3)THEN
C
C********** Message d'erreur standard
C           251 2
C           Tentative d'utilisation d'une option non implémentée
C         
            CALL ERREUR(251)
            GOTO 9999
         ENDIF
         CALL PENDIA(IDOMA)
         IF(IERR.NE.0) GOTO 9999
      ELSEIF(IOP2.EQ.4)THEN
C
C******* Le cas 4 ('NORVEGE') donne un gradient aux
C        interfaces
C
         IF(IOP1 .NE. 3)THEN
C
C********** Message d'erreur standard
C           251 2
C           Tentative d'utilisation d'une option non implémentée
C
            CALL ERREUR(251)
            GOTO 9999
         ENDIF
         CALL NORV(IDOMA)
         IF(IERR.NE.0) GOTO 9999
      ELSEIF(IOP2.EQ.5)THEN
C
C******* Le cas 5 ('DIAMAN2') donne un gradient aux
C        interfaces
C
         IF(IOP1 .NE. 3)THEN
C
C********** Message d'erreur standard
C           251 2
C           Tentative d'utilisation d'une option non implémentée
C
            CALL ERREUR(251)
            GOTO 9999
         ENDIF
         CALL PENDI2(IDOMA)
         IF(IERR.NE.0) GOTO 9999
      ELSEIF(IOP2.EQ.6)THEN
C
C******* Le cas 6 ('VFSYM') donne un gradient aux
C        SCHEMA PROPOSE PAR Christophe Le Potier 
C        Références : {C. Le Potier} 
c        \emph{Schema volumes finis pour des operateurs de diffusion
c        fortement anisotropes sur des maillages non structures}, 
C        C. R. Acad. Sci. Ser. I \textbf{340}, 2005, pp. 921--926. 
C        interfaces
C
         IF(IOP1 .NE. 3)THEN
C
C********** Message d'erreur standard
C           251 2
C           Tentative d'utilisation d'une option non implémentée
C
            CALL ERREUR(251)
            GOTO 9999
         ENDIF
         CALL VFSYM(IDOMA)
         IF(IERR.NE.0) GOTO 9999
      ENDIF
C     
 9999 RETURN
      END