Télécharger pent.eso

Retour à la liste

pent
C PENT      SOURCE    CB215821  23/01/25    21:15:29     11573          
      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
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
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'/
      SEGACT,MCOORD
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)
      CALL ACTOBJ('MMODEL  ',MMODEL,1)
      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
 
      SEGDES,MCOORD
      END
 
 

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