C UNIQUE    SOURCE    SP204843  26/07/30    21:15:10     12612          

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

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


-INC PPARAM
-INC CCOPTIO
-INC CCREEL

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

      PARAMETER (NCLE = 2, NTYP = 5)

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

      CHARACTER*8 TYPI

      DATA LICLE / 'NOCA','ORDO'/
      DATA LITYP / 'LISTENTI','LISTREEL','LISTMOTS','MAILLAGE',
     &             'LISTOBJE' /

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

 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)
        ELSE IF (IPLAC.EQ.4) THEN
          CALL UNIQMA(IPOBJ,NBDIF,iordre)
        ELSE IF (IPLAC.EQ.5) THEN
          CALL ELIMIN5(IPOBJ,ICRIT,RCRIT)
        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

 
 
 
