Download fich4.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer