C PREX1D    SOURCE    BP208322  16/11/18    21:20:07     9177           

C=======================================================================
C=                             P R E X 1 D                             =
C=                             -----------                             =
C=  Ce sousprogramme determine les "extremites" d'un maillage 1D.      =
C=  Il est l'image en 1D des sousprogrammes PRCONT (2D) et PRENVE (3D).=
C=  Il est appele par les operateurs FLUX et PRESSION.                 =
C=======================================================================

      SUBROUTINE PREX1D

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)


-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMELEME
-INC SMLENTI

C*    IF (IDIM.NE.1) THEN
C*      CALL ERREUR(xx)
C*      RETURN
C*    ENDIF

C= Travail sur un maillage avec des SEG2 et/ou des POI
C= C'est suffisant pour recuperer les points extremites
      CALL CHANLI
      IF (IERR.NE.0) RETURN
      CALL LIROBJ('MAILLAGE',ipmail,1,iOK)
      IF (IERR.NE.0) RETURN

C= On determine les composantes connexes du maillage
C= CCON cree un nouveau maillage, meme si ipmail est elementaire.
C= On peut donc detruire les maillages pointes dans ilect.
      CALL CCON1(ipmail,ilect)
      IF (IERR.NE.0) RETURN

C= On a alors au plus extremites = dimension de ilect * 2
      MLENT1=ilect
      SEGACT,MLENT1
      IG=MLENT1.LECT(/1)
      JG=2*IG
      SEGINI,MLENTI
      NBEXT=0
C= Recuperation des points extremites
C= On ordonne le maillage de SEG2.
C= Dans le cas ou la composante connexe retournee par CCON contient
C= plusieurs objets (normalement 2 de type POI1 et SEG2), les elements
C= POI1 sont en fait des noeuds inclus dans le maillage SEG2, qui ne
C= necessitent donc pas de traitement.
      DO i=1,IG
        IPT1=MLENT1.LECT(i)
        SEGACT,IPT1
        NSous=IPT1.LISOUS(/1)
        IF (NSous.NE.0) THEN
C*        MELEME=0
          DO j=1,NSous
            IPT2=IPT1.LISOUS(j)
            SEGACT,IPT2
            IF (IPT2.ITYPEL.EQ.2) MELEME=IPT2
            SEGDES,IPT2
          ENDDO
C*        IF (MELEME.EQ.0) --> ERREUR (a finir)
          SEGACT,MELEME
        ELSE
          MELEME=IPT1
        ENDIF
        IF (ITYPEL.EQ.1) THEN
          NBEXT=NBEXT+1
          LECT(NBEXT)=NUM(1,1)
        ELSE IF (ITYPEL.EQ.2) THEN
          CALL ORDON4(MELEME)
          SEGACT,MELEME
          NBEXT=NBEXT+1
          LECT(NBEXT)=NUM(1,1)
          NBEXT=NBEXT+1
          LECT(NBEXT)=NUM(2,NUM(/2))
        ENDIF
        SEGSUP,IPT1
      ENDDO

C= Initialisation du maillage de POI1 resultat
      NBNN=1
      NBELEM=NBEXT
      NBSOUS=0
      NBREF=0
      SEGINI,MELEME
C= Remplissage du maillage
      ITYPEL=1
      DO i=1,NBEXT
        NUM(1,i)=LECT(i)
        ICOLOR(i)=IDCOUL
      ENDDO
      SEGDES,MELEME
C= Ecriture du maillage resultat
      ipmail=MELEME
      CALL ECROBJ('MAILLAGE',ipmail)

C= Un peu de menage
      SEGSUP,MLENT1,MLENTI

      RETURN
      END