C RLENCE    SOURCE    KK2000    14/04/10    21:15:37     8032
      SUBROUTINE RLENCE(MELCEN,MELTFA,MELFAC,MFACEL,MELEME)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  RLENCE
C
C DESCRIPTION       :  Cette subroutine est appellée par la subroutine
C                      GRADGE (calcul des coefficient pour le gradient
C                      d'un CHPOINT 'CENTRE')
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. Beccantini, SFME/LTMF
C
C************************************************************************
C
C
C APPELES (Outils)  :
C
C APPELES (Calcul)  :
C
C
C************************************************************************
C
C INPUT    :     ICEN   : 'CENTRE' points
C
C                IELTFA : Element-faces
C
C                IFAC   : 'FACE' points
C
C                IFACEL : Left center - face center -right center
C
C
C OUTPUT   :     MELEME  : stencil to compute gradient
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE : 04.07.2003
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

C
      INTEGER NBSOUS, NSOU, JG, NBNN, NBELEM, NBREF
     &     ,NGVOI,NLVOI,NCENG,NCEND, NCEN
     &     ,ISOUS, ICEN, IELEM, IVOI
C

-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMELEME
      POINTEUR MELCEN.MELEME,MELTFA.MELEME,MELFAC.MELEME,MFACEL.MELEME
      POINTEUR MLELTF.MLENTI, MLEFAC.MLENTI

C
      SEGACT MELCEN
      SEGACT MELTFA
      SEGACT MFACEL
C
      CALL KRIPAD(MELFAC,MLEFAC)
C     SEGINI MLEFAC
      SEGACT MELFAC
C
C     MELEME has the same structure than 'ELTFA'
C     Each element of MELEME has one point more than each element of
C     'ELTFA'
C
      NBSOUS=MELTFA.LISOUS(/1)
      NSOU=MAX(NBSOUS,1)
      JG=NSOU
      SEGINI MLENTI
      SEGINI MLELTF
C
C**** MLENTI contains the pointers of the elementary meshes
C     of ELTFA
C
      IF (NSOU.EQ.1)THEN
         MLENTI.LECT(1)=MELTFA
      ELSE
         DO ISOUS=1,NSOU,1
            IPT1=MELTFA.LISOUS(ISOUS)
            MLENTI.LECT(ISOUS)=IPT1
         ENDDO
      ENDIF
C
      ICEN=0
      DO ISOUS=1,NSOU,1
         IPT1=MLENTI.LECT(ISOUS)
         SEGACT IPT1
         NBNN=IPT1.NUM(/1)+1
         NBELEM=IPT1.NUM(/2)
         NBREF=0
         NBSOUS=0
         SEGINI IPT2
         MLELTF.LECT(ISOUS)=IPT2
C        POLY elts
         IPT2.ITYPEL=32
         DO IELEM=1,NBELEM,1
            ICEN=ICEN+1
            NCEN=MELCEN.NUM(1,ICEN)
            IPT2.NUM(NBNN,IELEM)=NCEN
            DO IVOI=1,NBNN-1,1
               NGVOI=IPT1.NUM(IVOI,IELEM)
               NLVOI=MLEFAC.LECT(NGVOI)
               NCENG=MFACEL.NUM(1,NLVOI)
               NCEND=MFACEL.NUM(3,NLVOI)
               IF(NCENG .EQ. NCEND)THEN
C
C**************** We are on the BC
C
                  IF(NCEND .NE. NCEN)THEN
                     WRITE(IOIMP,*) 'subroutine rlence.eso. 1'
                     CALL ERREUR(5)
                     GOTO 9999
                  ENDIF
                  IPT2.NUM(IVOI,IELEM)=NGVOI
               ELSEIF(NCENG .EQ. NCEN)THEN
                  IPT2.NUM(IVOI,IELEM)=NCEND
               ELSEIF(NCEND .EQ. NCEN)THEN
                  IPT2.NUM(IVOI,IELEM)=NCENG
               ELSE
                  WRITE(IOIMP,*) 'subroutine rlence.eso. 2'
                  CALL ERREUR(5)
                  GOTO 9999
               ENDIF
            ENDDO
         ENDDO
         SEGDES IPT1
         SEGDES IPT2
      ENDDO
C
      SEGDES MELCEN
      SEGDES MELTFA
      SEGDES MELFAC
      SEGDES MFACEL
      SEGSUP MLENTI
      SEGSUP MLEFAC
C
      IF(NSOU .EQ. 1)THEN
         MELEME=MLELTF.LECT(1)
      ELSE
         NBNN=0
         NBELEM=0
         NBSOUS=NSOU
         NBREF=0
         SEGINI MELEME
         DO ISOUS=1,NSOU,1
            MELEME.LISOUS(ISOUS)=MLELTF.LECT(ISOUS)
         ENDDO
         SEGDES MELEME
      ENDIF
C
      SEGSUP MLELTF
C
 9999 RETURN
      END