Esope source files

   1 : C FIMOTS    SOURCE    CHAT      05/01/13    00:00:46     5004           
   2 :       SUBROUTINE FIMOTS(MYMOT,MYLMOT,
   3 :      $     INDMOT,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : FIMOTS
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Cherche le mot MYMOT dans la liste de mots MYLMOT.
  11 : C               Si on le trouve, on renvoie son indice dans la liste
  12 : C               sinon erreur...
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELE PAR       : PRASEM
  18 : C***********************************************************************
  19 : C ENTREES            : MYMOT(CH*), MYLMOT(seg. MLMOTS)
  20 : C SORTIES            : INDMOT
  21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22 : C***********************************************************************
  23 : C VERSION    : v1, 12/08/99, version initiale
  24 : C HISTORIQUE : v1, 12/08/99, création
  25 : C HISTORIQUE :
  26 : C HISTORIQUE :
  27 : C***********************************************************************
  28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29 : C en cas de modification de ce sous-programme afin de faciliter
  30 : C la maintenance !
  31 : C***********************************************************************
  32 : -INC CCOPTIO
  33 : -INC SMLMOTS
  34 :       POINTEUR MYLMOT.MLMOTS
  35 :       CHARACTER*(*) MYMOT
  36 :       INTEGER INDMOT
  37 : *
  38 :       INTEGER IMPR,IRET
  39 : *
  40 :       INTEGER MLMETA
  41 :       INTEGER INBM
  42 :       INTEGER LNMOTS,LNMOT2,NBMOTS
  43 :       LOGICAL LFOUND
  44 : *     
  45 : * Executable statements
  46 : *
  47 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fimots'
  47 :       CALL OOOETA(MYLMOT,MLMETA)
  48 :       IF (MLMETA.NE.1) SEGACT MYLMOT
  49 :       LNMOTS=MYLMOT.MOTS(/1)
  50 :       LNMOT2=LEN(MYMOT)
  51 :       IF (LNMOT2.NE.LNMOTS) THEN
  52 :          WRITE(IOIMP,*) 'Le mot n''a pas la même longueur'
  53 :          WRITE(IOIMP,*) 'que ceux de la liste...'
  54 :          WRITE(IOIMP,*) 'LNMOT2=',LNMOT2,' LNMOTS=',LNMOTS
  55 :          GOTO 9999
  56 :       ENDIF
  57 :       NBMOTS=MYLMOT.MOTS(/2)
  58 :       INBM=0
  59 :       LFOUND=.FALSE.
  60 :  1    CONTINUE
  61 :       IF (.NOT.LFOUND.AND.INBM.LT.NBMOTS) THEN
  62 :          INBM=INBM+1
  63 :          LFOUND=MYMOT.EQ.MYLMOT.MOTS(INBM)
  64 :          GOTO 1
  65 :       ENDIF
  66 :       IF (.NOT.LFOUND) THEN
  67 :          WRITE(IOIMP,*) 'On n''a pas trouvé le mot ',MYMOT
  68 :          WRITE(IOIMP,*) 'dans la liste de mots ',MYLMOT
  69 :          GOTO 9999
  70 :       ENDIF
  71 :       INDMOT=INBM
  72 :       IF (MLMETA.NE.1) SEGDES MYLMOT
  73 : *
  74 : * Normal termination
  75 : *
  76 :       IRET=0
  77 :       RETURN
  78 : *
  79 : * Format handling
  80 : *
  81 : *
  82 : * Error handling
  83 : *
  84 :  9999 CONTINUE
  85 :       IRET=1
  86 :       WRITE(IOIMP,*) 'An error was detected in subroutine fimots'
  87 :       RETURN
  88 : *
  89 : * End of subroutine FIMOTS
  90 : *
  91 :       END
  92 : 
  93 :  
  94 :