Télécharger cuniq.eso

Retour à la liste

Numérotation des lignes :

  1. C CUNIQ SOURCE GOUNAND 06/08/03 21:15:02 5513
  2. SUBROUTINE CUNIQ(LDOUBL,LNMOTS,NBMOTS,
  3. $ LMUNIQ,NBUNIQ,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : CUNIQ
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Un tableau de mots avec des doublons => un tableau de
  11. C mots sans doublons.
  12. C Algorithme en n^2 => pas de longs tableaux
  13. C
  14. C LANGAGE : Fortran 77 (sauf E/S)
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELE PAR : PRASEM
  19. C***********************************************************************
  20. C ENTREES : LDOUBL, LNMOTS, NBMOTS
  21. C SORTIES : LMUNIQ, NBUNIQ
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 30/09/99, version initiale
  25. C HISTORIQUE : v1, 30/09/99, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. INTEGER LNMOTS,NBMOTS
  35. CHARACTER*(*) LDOUBL(NBMOTS)
  36. CHARACTER*(*) LMUNIQ(NBMOTS)
  37. INTEGER NBUNIQ
  38. *
  39. INTEGER IMPR,IRET
  40. *
  41. INTEGER I,J
  42. LOGICAL LFOUND
  43. *
  44. * Executable statements
  45. *
  46. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cuniq'
  47. IF (NBMOTS.GT.0) THEN
  48. NBUNIQ=1
  49. LMUNIQ(1)(1:LNMOTS)=LDOUBL(1)(1:LNMOTS)
  50. DO 1 I=2,NBMOTS
  51. LFOUND=.FALSE.
  52. J=0
  53. 12 CONTINUE
  54. J=J+1
  55. IF (LMUNIQ(J)(1:LNMOTS).EQ.LDOUBL(I)(1:LNMOTS)) THEN
  56. LFOUND=.TRUE.
  57. ELSE
  58. IF (J.LT.NBUNIQ) THEN
  59. GOTO 12
  60. ENDIF
  61. ENDIF
  62. IF (.NOT.LFOUND) THEN
  63. NBUNIQ=NBUNIQ+1
  64. LMUNIQ(NBUNIQ)(1:LNMOTS)=LDOUBL(I)(1:LNMOTS)
  65. ENDIF
  66. 1 CONTINUE
  67. ELSE
  68. NBUNIQ=0
  69. ENDIF
  70. *
  71. * Normal termination
  72. *
  73. IRET=0
  74. RETURN
  75. *
  76. * Format handling
  77. *
  78. *
  79. * Error handling
  80. *
  81. 9999 CONTINUE
  82. IRET=1
  83. WRITE(IOIMP,*) 'An error was detected in subroutine cuniq'
  84. RETURN
  85. *
  86. * End of subroutine CUNIQ
  87. *
  88. END
  89.  
  90.  
  91.  
  92.  
  93.  

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