Sources Esope | Cast3M

pente1
C PENTE1    SOURCE    CB215821  20/11/25    13:35:36     10792          
      SUBROUTINE PENTE1(ICEN,IFAC,IFACEL,INORM,IOP2,IOP3,IMCHAM,ICHPO,
     &     ICHCL,ICHGRA,IMCALP)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PENTE1
C
C DESCRIPTION       :  Cette subroutine est appellée par la subroutine
C                      PENT (calcul du gradient d'un CHPOINT 2D de type
C                      CENTRE)
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C AUTEUR (Modif.)   :  R. MOREL, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C
C APPELES (Outils)  : LICHT, KRIPAD, ERREUR
C
C APPELES (Calcul)  : PENTE2, PENTE3
C
C
C************************************************************************
C
C ENTREES  : ICEN    : pointeur de MELEME  'CENTRE'
C
C            IFAC    : pointeur de MELEME  'FACE'
C
C            IFACEL  : pointeur de MELEME  'FACEL'
C
C            INORM   : pointeur des CHPOINT de normales aux faces
C
C            IOP2    : INTEGER:
C                          1         2
C                      'EULESCAL','EULEVECT'
C
C                      IOP2 = 1 -> symetrique d'un scalaire au bord
C                      IOP2 = 2 -> symetrique d'un vecteur au bord
C
C            IOP3    : INTEGER;
C                      IOP3 = 1 -> no limiteur
C                      IOP3 = 2 -> limiteur
C
C            IMCHAM  : pointeur d'un object de type MCHAML qui contient
C                      les elements de matrice mijx, mijx
C
C            ICHPO   : CHPOINT 'CENTRE' dont on veut calcular le gradient
C                      (NC composantes, NC &lt; 9)
C
C            ICHCL   : CHPOINT de conditions limites (optionel)
C
C
C SORTIES:   ICHGRA  : CHPOINT 'CENTRE' qui contient les gradients
C                      (2 ou 3  * NC composantes)
C                      Nom de le composantes:
C                      'P1DX', 'P1DY',('P1DZ'), 'P2DX', 'P2DY',('P2DZ')
C
C            IMCALP  : CHPOINT 'CENTRE' qui contient les limiteurs
C                      (NC composantes)
C                      Nom de le composantes:
C                      'P1', 'P2', ...
C                      Dans le cas I0P3 = 1 -> IMCALP = 0
C                                  IOP3 = 3 -> Le composantes sont
C                                               eguals
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE : Cree le 4-6-1998
C
C HISTORIQUE : Modifie pour adaptation 3D le 20-10-1998
C              Modifie pour reconstruction quadratique exacte
C              le 25-04-2000 (A. BECCANTINI)
C
C              Modif 10.070.1: on calcule un limiteur egual à 1 dans
C                              le cas 'NOLIMITE' (IOP3=1)
C
C
C************************************************************************
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHPOI
-INC SMCHAML
-INC SMELEME
-INC SMLENTI
C
      POINTEUR MPOMAX.MPOVAL, MPOMIN.MPOVAL, MPOALP.MPOVAL,
     &         MPOVCL.MPOVAL, MPOCHP.MPOVAL, MPOGRA.MPOVAL
      POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLEFAC.MLENTI
      POINTEUR MELEFL.MELEME
C
      INTEGER ICEN, IFACEL, IOP2, IOP3, IMCHAM, ICHPO, ICHCL, ICHGRA
     &     ,IMCALP, NCEN, NTOT,INORM, IFAC ,NCOMP, NC
     &     ,N, I1, I2, NFAC, IGEOM, JG
C
      LOGICAL LOGVEC
      CHARACTER*(LOCOMP) NOMCOM(27),NOMMCH(9)
      CHARACTER*8 TYPE
C
      DATA NOMCOM  /'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'/
      DATA NOMMCH  /'P1  ',
     &     'P2  ',
     &     'P3  ',
     &     'P4  ',
     &     'P5  ',
     &     'P6  ',
     &     'P7  ',
     &     'P8  ',
     &     'P9  '/
C
C**************************************
C**** PARTIE DU CALCUL DU GRADIENT ****
C**************************************
C
C
C**** Nombre total de points
C
      NTOT = nbpts
C
C**** Conditions limites
C
      IF (ICHCL .GT. 0) THEN
         TYPE=' '
         CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM)
C
C******* En LICHT
C        SEGACT*MOD MPOVCL
C
         CALL KRIPAD(IGEOM,MLENCL)
C
C******* En KRIPAD
C        SEGACT IGEOM, MLENCL
C
         MELEME = IGEOM
      ELSE
         JG = NTOT
         SEGINI MLENCL
         DO I1 = 1 , JG
            MLENCL.LECT(I1)=0
         ENDDO
         MPOVCL = -1
      ENDIF
C
C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
C
      CALL KRIPAD(ICEN,MLECEN)
C
C**** En KRIPAD
C     SEGACT ICEN
C     SEGINI MLECEN
C
      MELEME = ICEN
      NCEN = MELEME.NUM(/2)
C
C**** Le MLENTI avec la numerotation global/local des points FACE
C
      CALL KRIPAD(IFAC,MLEFAC)
C
C**** En KRIPAD
C     SEGACT IFAC
C     SEGINI MLEFAC
C
      MELEME = IFAC
C
C**** Si on traite un champ vectoriel avec l'option EULEVECT
C     Les composantes doivent etre 2 (3): 'UX' 'UY' ('UZ)
C
      MCHPO1 = ICHPO
      SEGACT MCHPO1
      MSOUP1 = MCHPO1.IPCHP(1)
      SEGACT MSOUP1
      IF (IOP2.EQ.2) THEN
         NCOMP = MSOUP1.NOCOMP(/2)
         IF (IDIM.EQ.2) THEN
            LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX  ').AND.
     &             (MSOUP1.NOCOMP(2).EQ.'UY  ').AND.
     &             (NCOMP  .EQ.2)
         ELSE
            LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX  ').AND.
     &             (MSOUP1.NOCOMP(2).EQ.'UY  ').AND.
     &             (MSOUP1.NOCOMP(3).EQ.'UZ  ').AND.
     &             (NCOMP  .EQ. 3)
         ENDIF
         IF (.NOT.LOGVEC) THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
            MOTERR(1:40) = 'PENT EULEVECT                           '
            WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
      ENDIF
C
C**** Le MPOVAL du CHPOINT
C
      MPOCHP = MSOUP1.IPOVAL
      SEGACT MPOCHP
      NCOMP = MPOCHP.VPOCHA(/2)
C
C**** Le CHPOINT ICHGRA
C
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.MOCHDE = 'Gradient                                    '
      ICHGRA = MCHPO2
C
      NC = IDIM * NCOMP
      SEGINI MSOUP2
C
C     Nom de ses composantes
C
      MCHPO2.IPCHP(1) = MSOUP2
C
      DO  I1 = 1, NCOMP
         DO  I2 = 1, IDIM
            MSOUP2.NOCOMP((I1-1)*IDIM+I2) = NOMCOM((I1-1)*3+I2)
         ENDDO
      ENDDO
      MSOUP2.IGEOC = ICEN
C
      N = NCEN
      SEGINI MPOGRA
      MSOUP2.IPOVAL = MPOGRA
C
C**** Les MPOVAL MPOMAX, MPOMIN, (maximum et minimum dans le stencil),
C     utilises pour le calcul du limiteur  mais calcules dans PENTE2.
C
      SEGINI, MPOMAX = MPOCHP
      SEGINI, MPOMIN = MPOCHP
C
C**** Segments déjà activés
C
C     MPOVCL
C     MLENCL
C     MLECEN
C     MLEFAC
C     MPOCHP
C     MPOGRA
C     MPOMIN
C     MPOMAX
C
      CALL PENTE2(IOP2,INORM,
     &     MLECEN,MLEFAC,MLENCL,IMCHAM,
     &     NCOMP,MPOCHP,MPOVCL,MPOGRA,
     &     MPOMIN,MPOMAX)
C
      IF(IERR .NE. 0)GOTO 9999
C
C
C****************************
C**** Calcul du limiteur ****
C****************************
C
C
C**** Limiteur
C
C
C**** Le MPOVAL du limiteur
C
C     MPOCHP = MPOVAL du CHPOINT dont on veux calculer le gradient
C
      SEGINI, MPOALP = MPOCHP
C
C**** Le MSOUPO du limiteur
C
      SEGINI, MSOUP2 = MSOUP1
      DO I1 = 1, NCOMP
         MSOUP2.NOCOMP(I1) = NOMMCH(I1)
      ENDDO
      MSOUP2.IPOVAL = MPOALP
C
C*****Le MCHPOINT du limiteur
C
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.MOCHDE = 'Limiteur du gradient                         '
      MCHPO2.IPCHP(1) = MSOUP2
      IMCALP = MCHPO2
C
C******* Le MELEME FACEL
C
      MELEFL = IFACEL
      SEGACT MELEFL
      NFAC = MELEFL.NUM(/2)
C
C********** Initialisation du limiteur a 1.0
C
      DO I2 = 1, NCOMP
         DO I1 = 1, NCEN
            MPOALP.VPOCHA(I1,I2) = 1.0D0
         ENDDO
      ENDDO
C
      IF(IOP3 .EQ. 2)THEN
C
C******* Calcul de limiteur Barth-Jespersen
C
C
C******* Dans les cas quadrati, on est obligé de redefinir
C        MPOMAX et MPOMIN
C
         IF(IOP2 .EQ. 5)THEN
            DO I2 = 1, NCOMP
               DO I1 = 1, NCEN
                  MPOMIN.VPOCHA(I1,I2) = MPOCHP.VPOCHA(I1,I2)
               ENDDO
            ENDDO
            CALL PENTE5(NFAC,NCOMP,MELEFL,MPOCHP,MLECEN,MPOVCL,MLENCL,
     &           MPOMIN,MPOMAX)
         ENDIF
         CALL PENTE3(NFAC,MELEFL,MLECEN,NCOMP,MPOCHP,
     &        MPOGRA,MPOMIN,MPOMAX,MPOALP)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Desactivations et destruction de segments
C
      SEGSUP MLECEN
      SEGSUP MLEFAC
      SEGSUP MLENCL
      SEGSUP MPOMAX
      SEGSUP MPOMIN
C
 9999 CONTINUE
      END