Télécharger la plaquette Cast3M


fr en

Télécharger crepe2.eso

Retour à la liste

Numérotation des lignes : 

crepe2

  1. C CREPE2    SOURCE    GOUNAND   07/07/30    21:15:11     5819
  2.       SUBROUTINE CREPE2(LNMOTS,LNINC,LNREP,
  3.      $     LISINC,LISREP,
  4.      $     KRINRE,
  5.      $     IMPR,IRET)
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM         : CREPE2
  10. C PROJET      : Noyau linéaire NLIN
  11. C DESCRIPTION : Deux tableaux de mots => un tableau d'entiers qui sont
  12. C               les indices des mots du premier tableau dans le deuxième
  13. C               tableau.
  14. C               On construit KRINRE, liste d'entier de repérage des
  15. C               chaines de caractères stockées dans LISINC, par rapport
  16. C               aux chaines de caractères (supposées sans doublons)
  17. C               de LISREP.
  18. C
  19. C       Exemple : LISINC = 'UN' 'PN' 'DN' 'TN' 'PN'
  20. C                 LISREP = 'UN' 'VN' 'PN' 'TN'
  21. C                 KRINRE =   1    3    0    4    3
  22. C
  23. C   Cette subroutine est identique à creper mais elle ne génère pas
  24. C   d'erreurs.
  25. C
  26. C
  27. C LANGAGE     : FORTRAN 77 (sauf E/S)
  28. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  29. C               mél : gounand@semt2.smts.cea.fr
  30. C***********************************************************************
  31. C APPELE PAR       : PRASEM
  32. C***********************************************************************
  33. C ENTREES            : LNMOTS, LNINC, LNREP, LISINC, LISREP
  34. C SORTIES            : KRINRE
  35. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  36. C***********************************************************************
  37. C VERSION    : v1, 05/10/99, version initiale
  38. C HISTORIQUE : v1, 05/10/99, création
  39. C HISTORIQUE :
  40. C HISTORIQUE :
  41. C***********************************************************************
  42. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  43. C en cas de modification de ce sous-programme afin de faciliter
  44. C la maintenance !
  45. C***********************************************************************
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49.       INTEGER LNMOTS,LNINC,LNREP
  50.       CHARACTER*(*) LISINC(LNINC)
  51.       CHARACTER*(*) LISREP(LNREP)
  52. *
  53.       INTEGER KRINRE(LNINC)
  54. *
  55.       INTEGER IMPR,IRET
  56. *
  57.       LOGICAL LFOUND
  58.       INTEGER IINC,IREP
  59. *
  60. * Executable statements
  61. *
  62.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans crepe2'
  63. *
  64.       DO 1 IINC=1,LNINC
  65.          LFOUND=.FALSE.
  66.          IREP=0
  67.  12      CONTINUE
  68.          IREP=IREP+1
  69.          IF (LISINC(IINC)(1:LNMOTS).EQ.LISREP(IREP)(1:LNMOTS)) THEN
  70.             LFOUND=.TRUE.
  71.          ELSE
  72.             IF (IREP.LT.LNREP) THEN
  73.                GOTO 12
  74.             ENDIF
  75.          ENDIF
  76.          IF (.NOT.LFOUND) THEN
  77.             KRINRE(IINC)=0
  78.          ELSE
  79.             KRINRE(IINC)=IREP
  80.          ENDIF
  81.  1    CONTINUE
  82. *
  83. * Normal termination
  84. *
  85.       IRET=0
  86.       RETURN
  87. *
  88. * Format handling
  89. *
  90. *
  91. * Error handling
  92. *
  93.  9999 CONTINUE
  94.       IRET=1
  95.       WRITE(IOIMP,*) 'An error was detected in subroutine crepe2'
  96.       RETURN
  97. *
  98. * End of subroutine CREPE2
  99. *
  100.       END
  101.  
  102.  
  103.  
  104.  
  105.  

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