Sources Esope | Cast3M

gradi2
C GRADI2    SOURCE    CHAT      05/01/13    00:20:35     5004
      SUBROUTINE GRADI2(ICEN,ISOMM,IFACL0,IFACEP,ISGLI1,ISGLI2,
     &     INORM,ICHELM)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  GRADI2
C
C DESCRIPTION       :  Appelle par PENDI2
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI
C
C************************************************************************
C
C Inputs:
C
C ICEN   : MELEME CENTRE
C
C ISOMM  : MELEME SOMMET
C
C IFACL0 : MELEME FACEL (centre G + F + CENTRE D)
C
C IFACEP : MELEME FACEP (SOMMET belonging to a face + F)
C
C ISGLI1 : SPG of Dirichlet BC
C
C ISGLI2 : SPG of von Neumann BC
C
C INORM  : interfaces normales
C
C Output :
C
C ICHELM : MCHAML which contains coeff. to compute gradients
C
C
C
C**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI
C
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMELEME
C
      POINTEUR MLEPOI.MLENTI, MLECOE.MLENTI, MLECOF.MLENTI
     &     ,MLEPOF.MLENTI
C
      INTEGER ICEN,ISOMM,IFACL0,IFACEP,IFACE,IFACEL
     &       ,ICHELM,ISGLI1,ISGLI2,INORM
C     &       ,I1,I2,IELEM,JG,NBE,NBN,NBSOUS,NGF,NGF1
C
C
C**** FACE, FACEL, FACEP must have the same order, i.e.
C     the i-th point of FACE belongs also to the i-th element of
C     FACEP and to the i-th element of FACEL
C
      CALL RLEORD(IFACL0,IFACEP,IFACE,IFACEL)
      IF(IERR .NE. 0)GOTO 9999
C
C**** test RLEORD
C
C      MELEME= IFACEP
C      IPT1 = IFACEL
C      SEGACT MELEME
C      SEGACT IPT1
C      NBSOUS=MELEME.LISOUS(/1)
C      JG=MAX(1,NBSOUS)
C      SEGINI MLENTI
C      IF(NBSOUS.EQ.0)THEN
C         MLENTI.LECT(1)=IFACEP
C      ELSE
C         DO I1 = 1, NBSOUS, 1
C            MLENTI.LECT(I1)=MELEME.LISOUS(I1)
C         ENDDO
C      ENDIF
C      NBSOUS=JG
C      IELEM=0
C      DO I1 = 1, NBSOUS, 1
C         IPT2=MLENTI.LECT(I1)
C         SEGACT IPT2
C         NBN=IPT2.NUM(/1)
C         NBE=IPT2.NUM(/2)
C         DO I2 = 1, NBE, 1
C            IELEM=IELEM+1
C            NGF=IPT2.NUM(NBN,I2)
C            NGF1=IPT1.NUM(2,IELEM)
C            write(ioimp,*) ngf, ngf1
C         ENDDO
C      ENDDO
C
C**** Fin test
C
C
C**** N.B: IFACEL has the same order of face as IFACEP. At the end
C     we have to destroy IFACEL
C
C**** The neighbors of each points 'SOMMET'
C     Two cases:
C     - If the 'sommet' point is on the border, the 'FACE'
C       and the 'CENTRE' points are both neighbors
C     - If the 'sommet' point does not belongs to the border, the
C       'CENTRE' points are both neighbors
C
      CALL RLENSO(IFACEL,IFACEP,ISOMM,MLEPOI)
      IF(IERR.NE.0) GOTO 9999
C
C     RLENSO creates MLEPOI
C     MLEPOI : list of integers.
C     MLEPOI.LECT(I) is the pointer of the list of integers
C     MLENTI which contains the neighbors of the i-th sommet
C     point.
C
      CALL RLENCO(ISOMM,ICEN,ISGLI1,ISGLI2,INORM,MLEPOI,MLECOE)
      IF(IERR.NE.0) GOTO 9999
C
C     RLENCO creates MRECOE
C     MLECOE : list of integers.
C     MLECOE.LECT(I) is the pointer of the list of real
C     MLREEL which contains the coefficient of the i-th sommet
C     to compute its value as function of the values on
C     its neighbors.
C     Note that ISGLI1 is the support of the Dirichlet boundary
C     conditions; ISGLI2 is the support of the von Neumann boundary
C     conditions. Their intersection is 0 and their union is
C     the total boundary. This is checked in the subroutine
C     RLENCO
C
      CALL RLENCF(IFACEL,IFACEP,MLEPOF,MLECOF)
      IF(IERR.NE.0) GOTO 9999
C
C     RLENCF creates MLEPOF,MLECOF
C
C     MLEPOF : list of integers.
C     MLEPOF.LECT(I) is the pointer of the list of the neighbors
C     of the I-th FACE. Neighbors are 'CENTRE' points and
C     'VERTEX' points.
C
C     MLECOF : list of integers.
C     MLECOF.LECT(I) is the pointer of the matrix of real
C     which contains the coefficient of the i-th face
C     to compute its gradient as function of the values on
C     its neighbors.
C
      CALL RLENCT(IFACEL,ISOMM,MLEPOI,MLECOE,MLEPOF,MLECOF)
      IF(IERR.NE.0) GOTO 9999
C
C     RLENCT adjusts MLEPOF,MLECOF such that
C
C     MLEPOF : list of integers.
C     MLEPOF.LECT(I) is the pointer of the list of the neighbors
C     of the I-th FACE. Neighbors are just 'CENTRE' points and
C     'boundary conditions' points.
C
C     MLECOF : list of integers.
C     MLECOF.LECT(I) is the pointer of the matrix of real
C     which contains the coefficient of the i-th face
C     to compute its gradient as function of the values on
C     its neighbors.
C
C     N.B.: segments MLEPOI,MLECOE are destroyed into RLENCT
C
C
C**** Creation de MCHAML
C     MLECOE, MLEPOF -> MCHAML
C
      CALL RLEXC1(MLEPOF,MLECOF,ICHELM)
      IF(IERR.NE.0)GOTO 9999
C
C**** On detrui le IFACEL et IFAC ici crée
C
      MELEME=IFACEL
      SEGSUP MELEME
      MELEME=IFACE
      SEGSUP MELEME
C
 9999 CONTINUE
      RETURN
      END