Esope source files

   1 : C UNIQUE    SOURCE    FANDEUR   13/01/02    21:15:06     7653           
   2 : 
   3 : C=======================================================================
   4 : C=======================================================================
   5 :       SUBROUTINE UNIQUE
   6 : 
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8 (A-H,O-Z)
   9 : 
  10 : -INC CCOPTIO
  11 : -INC CCREEL
  12 : 
  13 :       SEGMENT MPILO
  14 :         INTEGER ITYOBJ(INOBJ)
  15 :         INTEGER IPEOBJ(INOBJ)
  16 :         INTEGER IPSOBJ(INOBJ)
  17 :       ENDSEGMENT
  18 : 
  19 : C**      PARAMETER (NCLE = 1, NTYP = 4)
  20 :       PARAMETER (NCLE = 1, NTYP = 3)
  21 : 
  22 :       CHARACTER*4 LICLE(NCLE)
  23 :       CHARACTER*8 LITYP(NTYP)
  24 : 
  25 :       CHARACTER*8 TYPI
  26 : 
  27 :       DATA LICLE / 'NOCA' /
  28 : C**      DATA LITYP / 'LISTENTI','LISTREEL','LISTMOTS','MAILLAGE' /
  29 :       DATA LITYP / 'LISTENTI','LISTREEL','LISTMOTS' /
  30 : 
  31 : C- Lecture des mots-cles et autres options
  32 :       INOCA = 0
  33 :  10   CONTINUE
  33 :         CALL LIRMOT(LICLE,NCLE,IRETOU,0)
  34 :         IF (IERR.NE.0) RETURN
  35 :         IF (IRETOU.EQ.0) GOTO 11
  36 :         INOCA = IRETOU
  37 :       GOTO 10
  38 : 
  39 :  11   CONTINUE
  39 :       CALL LIRREE(FLOT1,0,ICRIT)
  40 :       IF (IERR.NE.0) RETURN
  41 :       IF (ICRIT.NE.0) THEN
  42 :         RCRIT = FLOT1
  43 :       ELSE
  44 :         RCRIT = 10.D0 * XZPREC
  45 :       ENDIF
  46 :       RCRIT = ABS(RCRIT)
  47 : 
  48 : C- Lecture des objets a analyser
  49 :       INOBJ = 50
  50 :       SEGINI,MPILO
  51 :       NBOBJ = 0
  52 :  20   CONTINUE
  53 :         TYPI = '        '
  53 :         CALL QUETYP(TYPI,0,IRETOU)
  54 :         IF (IERR.NE.0) GOTO 900
  55 :         IF (IRETOU.EQ.0) GOTO 21
  55 :         CALL PLACE(LITYP,NTYP,IPLAC,TYPI)
  56 :         IF (IPLAC.EQ.0) THEN
  57 : C         ERREUR => "On ne veut pas d'objet de type %m1:8"
  58 :           MOTERR(1:8) = TYPI
  58 :           CALL ERREUR(39)
  59 :           GOTO 900
  60 :         ENDIF
  60 :         CALL LIROBJ(TYPI,IPOBJ,1,IRETOU)
  61 :         IF (IERR.NE.0) GOTO 900
  62 :         IF (NBOBJ.GE.INOBJ) THEN
  63 :           INOBJ = INOBJ + 50
  64 :           SEGADJ,MPILO
  65 :         ENDIF
  66 :         NBOBJ = NBOBJ + 1
  67 :         ITYOBJ(NBOBJ) = IPLAC
  68 :         IPEOBJ(NBOBJ) = IPOBJ
  69 :         IPSOBJ(NBOBJ) = IPOBJ
  70 :       GOTO 20
  71 :  21   CONTINUE
  72 :       IF (NBOBJ.EQ.0) THEN
  72 :         CALL ERREUR(533)
  73 :         GOTO 900
  74 :       ENDIF
  75 : 
  76 : C- Analyse des objets avec appel aux subroutines dediees
  77 :       DO I = 1, NBOBJ
  78 :         IPLAC = ITYOBJ(I)
  79 :         IPOBJ = IPSOBJ(I)
  80 :         IF (IPLAC.EQ.1) THEN
  80 :           CALL ELIMIN2(IPOBJ)
  81 :         ELSE IF (IPLAC.EQ.2) THEN
  81 :           CALL ELIMIN3(IPOBJ,ICRIT,RCRIT)
  82 :         ELSE IF (IPLAC.EQ.3) THEN
  82 :           CALL ELIMIN4(IPOBJ,INOCA)
  83 : C**        ELSE IF (IPLAC.EQ.4) THEN
  83 : C**          CALL UNIQMAI(IPOBJ)
  84 :         ELSE
  84 :           CALL ERREUR(5)
  85 :         ENDIF
  86 :         IPSOBJ(I) = IPOBJ
  87 :       ENDDO
  88 : 
  89 : C- Ecriture des objets resultats sans doublon
  90 :       DO I = NBOBJ, 1, -1
  91 :         TYPI  = LITYP(ITYOBJ(I))
  92 :         IPOBJ = IPSOBJ(I)
  92 :         CALL ECROBJ(TYPI,IPOBJ)
  93 :       ENDDO
  94 : 
  95 :  900  CONTINUE
  96 :       SEGSUP,MPILO
  97 : 
  98 :       RETURN
  99 :       END
 100 : 
 101 : 
 102 :