Télécharger la plaquette Cast3M


fr en

Télécharger creper.eso

Retour à la liste

Numérotation des lignes : 

creper

  1. C CREPER    SOURCE    CB215821  20/11/25    13:23:21     10792          
  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.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45.       INTEGER LNMOTS,LNINC,LNREP
  46.       CHARACTER*(*) LISINC(LNINC)
  47.       CHARACTER*(*) LISREP(LNREP)
  48. *
  49.       INTEGER KRINRE(LNINC)
  50. *
  51.       INTEGER IMPR,IRET
  52. *
  53.       LOGICAL LFOUND
  54.       INTEGER IINC,IREP
  55.  
  56. C     En attendant que tout soit bien au point avec LOCOMP
  57. C     Je recopie dans des chaines de longueur LOCOMP
  58.       CHARACTER*(LOCOMP)   CHINC,CHREP
  59. *
  60. * Executable statements
  61. *
  62.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entree dans creper'
  63. *
  64.       DO 1 IINC=1,LNINC
  65.          LFOUND=.FALSE.
  66.          IREP=0
  67.  12      CONTINUE
  68.          IREP=IREP+1
  69.          CHINC=LISINC(IINC)
  70.          CHREP=LISREP(IREP)
  71.          IF (CHINC.EQ.CHREP) THEN
  72.             LFOUND=.TRUE.
  73.          ELSE
  74.             IF(IREP.LT.LNREP) GOTO 12
  75.          ENDIF
  76.          IF (.NOT.LFOUND) THEN
  77.             WRITE(IOIMP,*) 'Un element de LISINC n''est pas dans LISREP'
  78.             GOTO 9999
  79.          ELSE
  80.             KRINRE(IINC)=IREP
  81.          ENDIF
  82.  1    CONTINUE
  83. *
  84. * Normal termination
  85. *
  86.       IRET=0
  87.       RETURN
  88. *
  89. * Format handling
  90. *
  91. *
  92. * Error handling
  93. *
  94.  9999 CONTINUE
  95.       IRET=1
  96.       WRITE(IOIMP,*) 'An error was detected in subroutine creper'
  97.       RETURN
  98. *
  99. * End of subroutine CREPER
  100. *
  101.       END
  102.  
  103.  
  104.  
  105.  
  106.  

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