C FIMOT2 SOURCE GOUNAND 06/04/06 17:53:37 5371 $ INDMOT, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : FIMOT2 C DESCRIPTION : Cherche le mot MYMOT dans la liste de mots MYLMOT. C Si on le trouve, on renvoie son indice dans la liste C sinon on renvoie 0 C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELE PAR : PRASEM C*********************************************************************** C ENTREES : MYMOT(CH*), MYLMOT(seg. MLMOTS) C SORTIES : INDMOT C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 07/03/06, version initiale C HISTORIQUE : v1, 07/03/06, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO CHARACTER*(*) MYLMOT(*) CHARACTER*(*) MYMOT INTEGER INDMOT * INTEGER IMPR,IRET * INTEGER MLMETA INTEGER INBM INTEGER LNMOTS,LNMOT2,NBMOTS LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fimot2' LNMOTS=LEN(MYLMOT(1)) LNMOT2=LEN(MYMOT) IF (LNMOT2.NE.LNMOTS) THEN WRITE(IOIMP,*) 'Le mot n''a pas la même longueur' WRITE(IOIMP,*) 'que ceux de la liste...' WRITE(IOIMP,*) 'LNMOT2=',LNMOT2,' LNMOTS=',LNMOTS GOTO 9999 ENDIF INBM=0 LFOUND=.FALSE. 1 CONTINUE IF (.NOT.LFOUND.AND.INBM.LT.NBMOTS) THEN INBM=INBM+1 LFOUND=MYMOT.EQ.MYLMOT(INBM) GOTO 1 ENDIF IF (.NOT.LFOUND) THEN INDMOT=0 ELSE INDMOT=INBM ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine fimot2' RETURN * * End of subroutine FIMOT2 * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales