Sources Esope | Cast3M

elimin4
C ELIMIN4   SOURCE    SP204843  23/07/17    21:15:04     11710          
 
************************************************************************
* NOM         : ELIMIN4
* DESCRIPTION : Supprime les doublons dans un LISTMOTS
************************************************************************
* HISTORIQUE : 22/05/2012 : JCARDO : Creation de la subroutine
* HISTORIQUE : 21/12/2012 : OF : Adaptation a UNIQue
************************************************************************
* Priere de PRENDRE LE TEMPS DE COMPLETER LES COMMENTAIRES
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
* SYNTAXE (GIBIANE)
*        LMOTSS = UNIQ LMOTSE ('NOCA') ;
************************************************************************
 
      SUBROUTINE ELIMIN4(IPLMOT,INOCA)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC SMLMOTS
 
      CHARACTER*26 minusc,MAJUSC
      DATA minusc / 'abcdefghijklmnopqrstuvwxyz' /
      DATA MAJUSC / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
 
      MLMOT1 = IPLMOT
      SEGINI,MLMOTS=MLMOT1
 
      NN  = MOTS(/2)
      JGN = MOTS(/1)
 
c Passage en MAJUSCULES si la recherche est insensible a la casse
      IF (INOCA.NE.0) THEN
        DO I = 1, NN
          DO J = 1, JGN
            ICAR = INDEX(minusc,MOTS(I)(J:J))
            IF (ICAR.NE.0) MOTS(I)(J:J) = MAJUSC(ICAR:ICAR)
          ENDDO
        ENDDO
      ENDIF
 
c Recherche de doublons
      IF (NN.GT.1) THEN
        JGM = 1
        DO 10 I = 2, NN
          DO J = 1, JGM
            IF (MOTS(I).EQ.MOTS(J)) GOTO 10
          ENDDO
          JGM = JGM + 1
          MOTS(JGM) = MOTS(I)
 10     CONTINUE
        IF (JGM.NE.NN) SEGADJ,MLMOTS
      ENDIF
      IF (JGM.EQ.NN) THEN
        SEGSUP,MLMOTS
      ELSE
        SEGDES,MLMOTS
        IPLMOT = MLMOTS
      ENDIF
 
      RETURN
      END