1 : C ELIMIN4 SOURCE FANDEUR 13/01/02 21:15:05 7653
2 :
3 : ************************************************************************
4 : * NOM : ELIMIN4
5 : * DESCRIPTION : Supprime les doublons dans un LISTMOTS
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 : * LMOTSS = UNIQ LMOTSE ('NOCA') ;
16 : ************************************************************************
17 :
18 : SUBROUTINE ELIMIN4(IPLMOT,INOCA)
19 :
20 : IMPLICIT INTEGER(I-N)
21 : IMPLICIT REAL*8(A-H,O-Z)
22 :
23 : -INC SMLMOTS
24 :
25 : CHARACTER*26 minusc,MAJUSC
26 : DATA minusc / 'abcdefghijklmnopqrstuvwxyz' /
27 : DATA MAJUSC / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
28 :
29 : MLMOT1 = IPLMOT
30 : SEGINI,MLMOTS=MLMOT1
31 :
32 : NN = MOTS(/2)
33 : JGN = MOTS(/1)
34 :
35 : c Passage en MAJUSCULES si la recherche est insensible a la casse
36 : IF (INOCA.NE.0) THEN
37 : DO I = 1, NN
38 : DO J = 1, JGN
39 : ICAR = INDEX(minusc,MOTS(I)(J:J))
40 : IF (ICAR.NE.0) MOTS(I)(J:J) = MAJUSC(ICAR:ICAR)
41 : ENDDO
42 : ENDDO
43 : ENDIF
44 :
45 : c Recherche de doublons
46 : IF (NN.GT.1) THEN
47 : JGM = 1
48 : DO 10 I = 2, NN
49 : DO J = 1, JGM
50 : IF (MOTS(I).EQ.MOTS(J)) GOTO 10
51 : ENDDO
52 : JGM = JGM + 1
53 : MOTS(JGM) = MOTS(I)
54 : 10 CONTINUE
55 : IF (JGM.NE.NN) SEGADJ,MLMOTS
56 : ENDIF
57 :
58 : SEGDES,MLMOTS
59 : IPLMOT = MLMOTS
60 :
61 : RETURN
62 : END
63 :
64 :
© Cast3M 2003 - All rights reserved.
Disclaimer