Télécharger la plaquette Cast3M


fr en

Télécharger cuniq.eso

Retour à la liste

Numérotation des lignes : 

cuniq

  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36.       INTEGER LNMOTS,NBMOTS
  37.       CHARACTER*(*) LDOUBL(NBMOTS)
  38.       CHARACTER*(*) LMUNIQ(NBMOTS)
  39.       INTEGER NBUNIQ
  40. *
  41.       INTEGER IMPR,IRET
  42. *
  43.       INTEGER I,J
  44.       LOGICAL LFOUND
  45. *
  46. * Executable statements
  47. *
  48.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cuniq'
  49.       IF (NBMOTS.GT.0) THEN
  50.          NBUNIQ=1
  51.          LMUNIQ(1)(1:LNMOTS)=LDOUBL(1)(1:LNMOTS)
  52.          DO 1 I=2,NBMOTS
  53.             LFOUND=.FALSE.
  54.             J=0
  55.  12         CONTINUE
  56.             J=J+1
  57.             IF (LMUNIQ(J)(1:LNMOTS).EQ.LDOUBL(I)(1:LNMOTS)) THEN
  58.                LFOUND=.TRUE.
  59.             ELSE
  60.                IF (J.LT.NBUNIQ) THEN
  61.                   GOTO 12
  62.                ENDIF
  63.             ENDIF
  64.             IF (.NOT.LFOUND) THEN
  65.                NBUNIQ=NBUNIQ+1
  66.                LMUNIQ(NBUNIQ)(1:LNMOTS)=LDOUBL(I)(1:LNMOTS)
  67.             ENDIF
  68.  1       CONTINUE
  69.       ELSE
  70.          NBUNIQ=0
  71.       ENDIF
  72. *
  73. * Normal termination
  74. *
  75.       IRET=0
  76.       RETURN
  77. *
  78. * Format handling
  79. *
  80. *
  81. * Error handling
  82. *
  83.  9999 CONTINUE
  84.       IRET=1
  85.       WRITE(IOIMP,*) 'An error was detected in subroutine cuniq'
  86.       RETURN
  87. *
  88. * End of subroutine CUNIQ
  89. *
  90.       END
  91.  
  92.  
  93.  
  94.  
  95.  

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