fimots
C FIMOTS SOURCE CB215821 20/11/04 21:17:26 10766 $ INDMOT, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : FIMOTS C PROJET : Noyau linéaire NLIN 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 erreur... 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, 12/08/99, version initiale C HISTORIQUE : v1, 12/08/99, 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 PPARAM -INC CCOPTIO -INC SMLMOTS POINTEUR MYLMOT.MLMOTS CHARACTER*(*) MYMOT INTEGER INDMOT * INTEGER IMPR,IRET * INTEGER MLMETA INTEGER INBM INTEGER NBMOTS LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fimots' CALL OOOETA(MYLMOT,MLMETA,IMOD) IF (MLMETA.NE.1) SEGACT MYLMOT INBM=0 LFOUND=.FALSE. 1 CONTINUE IF (.NOT.LFOUND.AND.INBM.LT.NBMOTS) THEN INBM=INBM+1 GOTO 1 ENDIF IF (.NOT.LFOUND) THEN WRITE(IOIMP,*) 'On n''a pas trouvé le mot ',MYMOT WRITE(IOIMP,*) 'dans la liste de mots ',MYLMOT GOTO 9999 ENDIF INDMOT=INBM IF (MLMETA.NE.1) SEGDES MYLMOT * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine fimots' RETURN * * End of subroutine FIMOTS * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales