Télécharger creper.eso

Retour à la liste

Numérotation des lignes :

  1. C CREPER SOURCE CHAT 05/01/12 22:29:40 5004
  2. SUBROUTINE CREPER(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 : CREPER
  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' 'TN' 'PN'
  20. C LISREP = 'UN' 'VN' 'PN' 'TN' 'KN'
  21. C KRINRE = 1 3 4 3
  22. C
  23. C LANGAGE : FORTRAN 77 (sauf E/S)
  24. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  25. C mél : gounand@semt2.smts.cea.fr
  26. C***********************************************************************
  27. C APPELE PAR : PRASEM
  28. C***********************************************************************
  29. C ENTREES : LNMOTS, LNINC, LNREP, LISINC, LISREP
  30. C SORTIES : KRINRE
  31. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32. C***********************************************************************
  33. C VERSION : v1, 05/10/99, version initiale
  34. C HISTORIQUE : v1, 05/10/99, création
  35. C HISTORIQUE :
  36. C HISTORIQUE :
  37. C***********************************************************************
  38. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  39. C en cas de modification de ce sous-programme afin de faciliter
  40. C la maintenance !
  41. C***********************************************************************
  42. -INC CCOPTIO
  43. INTEGER LNMOTS,LNINC,LNREP
  44. CHARACTER*(*) LISINC(LNINC)
  45. CHARACTER*(*) LISREP(LNREP)
  46. *
  47. INTEGER KRINRE(LNINC)
  48. *
  49. INTEGER IMPR,IRET
  50. *
  51. LOGICAL LFOUND
  52. INTEGER IINC,IREP
  53. *
  54. * Executable statements
  55. *
  56. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans creper'
  57. *
  58. DO 1 IINC=1,LNINC
  59. LFOUND=.FALSE.
  60. IREP=0
  61. 12 CONTINUE
  62. IREP=IREP+1
  63. IF (LISINC(IINC)(1:LNMOTS).EQ.LISREP(IREP)(1:LNMOTS)) THEN
  64. LFOUND=.TRUE.
  65. ELSE
  66. IF (IREP.LT.LNREP) THEN
  67. GOTO 12
  68. ENDIF
  69. ENDIF
  70. IF (.NOT.LFOUND) THEN
  71. WRITE(IOIMP,*) 'Un élément de LISINC n''est pas dans LISREP'
  72. GOTO 9999
  73. ELSE
  74. KRINRE(IINC)=IREP
  75. ENDIF
  76. 1 CONTINUE
  77. *
  78. * Normal termination
  79. *
  80. IRET=0
  81. RETURN
  82. *
  83. * Format handling
  84. *
  85. *
  86. * Error handling
  87. *
  88. 9999 CONTINUE
  89. IRET=1
  90. WRITE(IOIMP,*) 'An error was detected in subroutine creper'
  91. RETURN
  92. *
  93. * End of subroutine CREPER
  94. *
  95. END
  96.  
  97.  
  98.  
  99.  

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