Télécharger crepe2.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  47. INTEGER LNMOTS,LNINC,LNREP
  48. CHARACTER*(*) LISINC(LNINC)
  49. CHARACTER*(*) LISREP(LNREP)
  50. *
  51. INTEGER KRINRE(LNINC)
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. LOGICAL LFOUND
  56. INTEGER IINC,IREP
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans crepe2'
  61. *
  62. DO 1 IINC=1,LNINC
  63. LFOUND=.FALSE.
  64. IREP=0
  65. 12 CONTINUE
  66. IREP=IREP+1
  67. IF (LISINC(IINC)(1:LNMOTS).EQ.LISREP(IREP)(1:LNMOTS)) THEN
  68. LFOUND=.TRUE.
  69. ELSE
  70. IF (IREP.LT.LNREP) THEN
  71. GOTO 12
  72. ENDIF
  73. ENDIF
  74. IF (.NOT.LFOUND) THEN
  75. KRINRE(IINC)=0
  76. ELSE
  77. KRINRE(IINC)=IREP
  78. ENDIF
  79. 1 CONTINUE
  80. *
  81. * Normal termination
  82. *
  83. IRET=0
  84. RETURN
  85. *
  86. * Format handling
  87. *
  88. *
  89. * Error handling
  90. *
  91. 9999 CONTINUE
  92. IRET=1
  93. WRITE(IOIMP,*) 'An error was detected in subroutine crepe2'
  94. RETURN
  95. *
  96. * End of subroutine CREPE2
  97. *
  98. END
  99.  
  100.  
  101.  
  102.  
  103.  

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