Download fimot2.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer