Télécharger elimin4.eso

Retour à la liste

Numérotation des lignes :

  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.  
  65.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales