C UNIQUE    SOURCE    FANDEUR   13/01/02    21:15:06     7653           

C=======================================================================
C=======================================================================
      SUBROUTINE UNIQUE

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

-INC CCOPTIO
-INC CCREEL

      SEGMENT MPILO
        INTEGER ITYOBJ(INOBJ)
        INTEGER IPEOBJ(INOBJ)
        INTEGER IPSOBJ(INOBJ)
      ENDSEGMENT

C**      PARAMETER (NCLE = 1, NTYP = 4)
      PARAMETER (NCLE = 1, NTYP = 3)

      CHARACTER*4 LICLE(NCLE)
      CHARACTER*8 LITYP(NTYP)

      CHARACTER*8 TYPI

      DATA LICLE / 'NOCA' /
C**      DATA LITYP / 'LISTENTI','LISTREEL','LISTMOTS','MAILLAGE' /
      DATA LITYP / 'LISTENTI','LISTREEL','LISTMOTS' /

C- Lecture des mots-cles et autres options
      INOCA = 0
 10   CONTINUE
        CALL LIRMOT(LICLE,NCLE,IRETOU,0)
        IF (IERR.NE.0) RETURN
        IF (IRETOU.EQ.0) GOTO 11
        INOCA = IRETOU
      GOTO 10

 11   CONTINUE
      CALL LIRREE(FLOT1,0,ICRIT)
      IF (IERR.NE.0) RETURN
      IF (ICRIT.NE.0) THEN
        RCRIT = FLOT1
      ELSE
        RCRIT = 10.D0 * XZPREC
      ENDIF
      RCRIT = ABS(RCRIT)

C- Lecture des objets a analyser
      INOBJ = 50
      SEGINI,MPILO
      NBOBJ = 0
 20   CONTINUE
        TYPI = '        '
        CALL QUETYP(TYPI,0,IRETOU)
        IF (IERR.NE.0) GOTO 900
        IF (IRETOU.EQ.0) GOTO 21
        CALL PLACE(LITYP,NTYP,IPLAC,TYPI)
        IF (IPLAC.EQ.0) THEN
C         ERREUR => "On ne veut pas d'objet de type %m1:8"
          MOTERR(1:8) = TYPI
          CALL ERREUR(39)
          GOTO 900
        ENDIF
        CALL LIROBJ(TYPI,IPOBJ,1,IRETOU)
        IF (IERR.NE.0) GOTO 900
        IF (NBOBJ.GE.INOBJ) THEN
          INOBJ = INOBJ + 50
          SEGADJ,MPILO
        ENDIF
        NBOBJ = NBOBJ + 1
        ITYOBJ(NBOBJ) = IPLAC
        IPEOBJ(NBOBJ) = IPOBJ
        IPSOBJ(NBOBJ) = IPOBJ
      GOTO 20
 21   CONTINUE
      IF (NBOBJ.EQ.0) THEN
        CALL ERREUR(533)
        GOTO 900
      ENDIF

C- Analyse des objets avec appel aux subroutines dediees
      DO I = 1, NBOBJ
        IPLAC = ITYOBJ(I)
        IPOBJ = IPSOBJ(I)
        IF (IPLAC.EQ.1) THEN
          CALL ELIMIN2(IPOBJ)
        ELSE IF (IPLAC.EQ.2) THEN
          CALL ELIMIN3(IPOBJ,ICRIT,RCRIT)
        ELSE IF (IPLAC.EQ.3) THEN
          CALL ELIMIN4(IPOBJ,INOCA)
C**        ELSE IF (IPLAC.EQ.4) THEN
C**          CALL UNIQMAI(IPOBJ)
        ELSE
          CALL ERREUR(5)
        ENDIF
        IPSOBJ(I) = IPOBJ
      ENDDO

C- Ecriture des objets resultats sans doublon
      DO I = NBOBJ, 1, -1
        TYPI  = LITYP(ITYOBJ(I))
        IPOBJ = IPSOBJ(I)
        CALL ECROBJ(TYPI,IPOBJ)
      ENDDO

 900  CONTINUE
      SEGSUP,MPILO

      RETURN
      END