Esope source files

   1 : C ELIMIN3   SOURCE    FANDEUR   13/01/02    21:15:04     7653           
   2 : 
   3 : ************************************************************************
   4 : * NOM         : ELIMIN3
   5 : * DESCRIPTION : Supprime les doublons dans un LISTREEL
   6 : ************************************************************************
   7 : * HISTORIQUE : 22/05/2012 : JCARDO : Creation de la subroutine
   8 : * HISTORIQUE : 21/12/2012 : OF : Adaptation a UNIQue
   9 : ************************************************************************
  10 : * Priere de PRENDRE LE TEMPS DE COMPLETER LES COMMENTAIRES
  11 : * en cas de modification de ce sous-programme afin de faciliter
  12 : * la maintenance !
  13 : ************************************************************************
  14 : * SYNTAXE (GIBIANE)
  15 : *        LREELS = UNIQ LREELE (FLOT1) ;
  16 : ************************************************************************
  17 : 
  18 :       SUBROUTINE ELIMIN3(IPLREE,ICRIT,RCRIT)
  19 : 
  20 :       IMPLICIT INTEGER(I-N)
  21 :       IMPLICIT REAL*8(A-H,O-Z)
  22 : 
  23 : -INC SMLREEL
  24 : 
  25 :       MLREE1 = IPLREE
  26 :       SEGINI,MLREEL=MLREE1
  27 : 
  28 :       NN = PROG(/1)
  29 : 
  30 : c Recherche des doublons (a la precision pres)
  31 :       IF (NN.GT.1) THEN
  32 :         JG = 1
  33 :         IF (ICRIT.EQ.0) THEN
  34 :           DO 10 I = 2, NN
  35 :             R_ZI = PROG(I)
  36 :             R_ZA = ABS(R_ZI)
  37 :             DO J = 1, JG
  38 :               R_ZJ = PROG(J)
  39 :               XCRIT = RCRIT * MAX(R_ZA, ABS(R_ZJ))
  40 :               IF (ABS(R_ZI-R_ZJ).LT.XCRIT) GOTO 10
  41 :             ENDDO
  42 :             JG = JG + 1
  43 :             PROG(JG) = R_ZI
  44 :  10       CONTINUE
  45 :         ELSE
  46 :           DO 11 I = 2, NN
  47 :             R_ZI = PROG(I)
  48 :             DO J = 1, JG
  49 :               IF (ABS(R_ZI-PROG(J)).LT.RCRIT) GOTO 11
  50 :             ENDDO
  51 :             JG = JG + 1
  52 :             PROG(JG) = R_ZI
  53 :  11       CONTINUE
  54 :         ENDIF
  55 :         IF (JG.NE.NN) SEGADJ,MLREEL
  56 :       ENDIF
  57 : 
  58 :       SEGDES,MLREEL
  59 :       IPLREE = MLREEL
  60 : 
  61 :       RETURN
  62 :       END
  63 : 
  64 :