C ELCONT    SOURCE    CHAT      05/01/12    23:29:58     5004           
      SUBROUTINE ELCONT(MFACEL,MFACEP,MCONT,MCCEN)
C
C***********************************************************************
C NOM         : ELCONT
C DESCRIPTION : Construit les MELEME contenant les faces dont les éléments
C               1 et 3 de FACEL sont égaux (faces du contour).
C LANGAGE     : ESOPE
C AUTEUR      : Régis MOREL (CEA/DRN/DMT/SEMT/LTMF)
C
C***********************************************************************
C APPELES          : -
C APPELES (E/S)    : -
C APPELES (BLAS)   : -
C APPELES (CALCUL) : -
C***********************************************************************
C SYNTAXE GIBIANE    : -
C
C ENTREES            : MFACEL (type MELEME) : maillage de points
C                                             centre-face-centre
C
C                      MFACEP (type MELEME)  : maillage des points
C                                             sommets des faces
C
C ENTREES/SORTIES    : -
C SORTIES            : MCONT  (type MELEME) : maillage des faces du
C                                             contour .
C                                             Le dernier noeud contient
C                                             le centre de face
C
C                      MCCEN  (type MELEME) : maillage des centres de
C                                             ces faces.
C
C CODE RETOUR (IRET) : -
C***********************************************************************
C VERSION    : v1, 23/04/99, version initiale
C HISTORIQUE : v1, 23/04/99, création
C HISTORIQUE : v1, 07/04/2000 Ajout commentaire et petites modifs
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMELEME
      POINTEUR MCONT.MELEME
      POINTEUR MCCEN.MELEME
      POINTEUR MFACEL.MELEME
      POINTEUR MFACEP.MELEME
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
C     
      INTEGER NCONT,I,NBF,ITOT,JTOT,NCD,NCG,J,K,NFACE1,NFACE2
     &        ,ICONT, NBELEM, NBFACP, NBNN, NBREF, NBSOUS         
C     
C On commence par parcourir FACEL pour savoir combien d'éléments
C il y aura dans MCCEN
C     
      SEGACT MFACEL
      IF (MFACEL.LISOUS(/1).NE.0) THEN
         MOTERR(1:40) = 'Problème de connectvité FACEL           '     
         WRITE(IOIMP,*) MOTERR(1:40)         
         CALL ERREUR(5)
         GOTO 9999
      ENDIF
      NCONT=0
      NBF = MFACEL.NUM(/2)
      DO 10 I = 1,NBF
         NCG = MFACEL.NUM(1,I)
         NCD = MFACEL.NUM(3,I)
         IF (NCG.EQ.NCD) NCONT=NCONT+1
 10   CONTINUE
C     
C On crée le MELEME MCCEN (centres de faces sur les bords)
C     
      NBELEM = NCONT
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGINI MCCEN
      ICONT=0
      DO 20  I = 1,NBF
         NCG = MFACEL.NUM(1,I)
         NCD = MFACEL.NUM(3,I)
         IF (NCG.EQ.NCD) THEN
            ICONT=ICONT+1
            MCCEN.NUM(1,ICONT)= MFACEL.NUM(2,I)
         ENDIF
 20   CONTINUE
      SEGDES MCCEN
C
CAB: A mon avis, la creation de MCEN est inutile;
C    En plus, on pouvais le créer dans la boucle suivant!
C
C     
C On va maintenant boucler sur chaque sous-reference de MFACEP
C On suppose ici que MFACEP et MFACEL soient ordonnées dans la meme facon!
C     
      SEGACT MFACEP
      NBSOUS = MFACEP.LISOUS(/1)
      IF (NBSOUS.EQ.0) THEN
         NBNN = MFACEP.NUM(/1)
         NBELEM = NCONT
         NBREF=0
         SEGINI MCONT
         MCONT.ITYPEL=MFACEP.ITYPEL
         ICONT=0
         DO 21 I=1,NBF
            NCG = MFACEL.NUM(1,I)
            NCD = MFACEL.NUM(3,I)
            NFACE1 = MFACEL.NUM(2,I)
            NFACE2 = MFACEP.NUM(NBNN,I)
            IF(NFACE2 .NE. NFACE1)THEN
               MOTERR(1:40) = 'Problème de connectivité FACEL ou FACEP.'
               WRITE(IOIMP,*) MOTERR(1:40)         
               CALL ERREUR(5)
               GOTO 9999
            ENDIF
            IF (NCG.EQ.NCD) THEN
               ICONT=ICONT+1
               DO 22 J=1,NBNN
                  MCONT.NUM(J,ICONT)= MFACEP.NUM(J,I)
 22            CONTINUE 
            ENDIF
 21      CONTINUE
         SEGDES MCONT
      ELSE
         NBNN=0
         NBELEM=0
         NBREF=0
C
C******* NBFACP = NBSOUS de MFACEP
C        N.B. On peut avoir NBSOUS de FACEP != NBSOUS de MCONT
C        Mais pour l'instant on impose NBSOUS de MCONT = NBSOUS de FACEP 
C
         NBFACP=NBSOUS
         SEGINI MCONT
         ITOT=0
         JTOT=0
         DO 30 K=1,NBFACP
            IPT1 = MFACEP.LISOUS(K)
            SEGACT IPT1
C     
C On compte le nombre d'éléments du contour dans cette sous-référence
C On le stocke dans NCONT
C     
            NBF = IPT1.NUM(/2)
            NBNN = IPT1.NUM(/1)
            NCONT=0
            DO 40 I = 1,NBF         
               ITOT=ITOT+1
               NCG = MFACEL.NUM(1,ITOT)
               NCD = MFACEL.NUM(3,ITOT)
               IF (NCG.EQ.NCD) NCONT=NCONT+1
 40         CONTINUE
C     
C Maintenant, si NCONT > 0, on peut créer la sousreference correspondante de MCONT
C     
            IF(NCONT .GT. 0)THEN
               NBELEM=NCONT
               NBNN = IPT1.NUM(/1)
               NBREF=0
               SEGINI IPT2
               MCONT.LISOUS(K)=IPT2
               IPT2.ITYPEL = IPT1.ITYPEL
               ICONT=0
               DO 50 I = 1,NBF         
                  JTOT=JTOT+1
                  NCG = MFACEL.NUM(1,JTOT)
                  NCD = MFACEL.NUM(3,JTOT)
                  NFACE1 = MFACEL.NUM(2,JTOT)
                  NFACE2 = MFACEP.NUM(NBNN,JTOT)
                  IF(NFACE2 .NE. NFACE1)THEN
                     MOTERR(1:40) =
     $                    'Problème de connectivité FACEL ou FACEP.'
                     WRITE(IOIMP,*) MOTERR(1:40)         
                     CALL ERREUR(5)
                     GOTO 9999
                  ENDIF
                  IF (NCG.EQ.NCD) THEN
                     ICONT=ICONT+1
                     DO 60 J=1,NBNN
                        IPT2.NUM(J,ICONT)=IPT1.NUM(J,I)
 60                  CONTINUE
                  ENDIF
 50            CONTINUE
            ELSE
C
C**************** Le maillage elementare n'a pas elts de bord!
C
               NBSOUS = NBSOUS - 1
               SEGADJ MCONT
            ENDIF
            SEGDES IPT2
            SEGDES IPT1                 
 30      CONTINUE
         SEGDES MCONT
      ENDIF  
      SEGDES MFACEP
      SEGDES MFACEL
 9999 RETURN
      END