C FICH4 SOURCE CB215821 20/11/04 21:17:25 10766 SUBROUTINE FICH4(MYMOT,MYLMOT,NBMOTS,INDMOT,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : FICH4 C PROJET : Noyau linéaire NLIN C DESCRIPTION : Cherche le mot MYMOT dans le tableau de CHARACTER*4 C 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 : FILFAL C*********************************************************************** C ENTREES : * MYMOT (type CH*(*)) : mot à rechercher. C * MYLMOT (type CH*4) : liste de mots. C * NBMOTS (type ENTIER) : nombre de mots de MYLMOT C SORTIES : * INDMOT (type ENTIER) : indice de MYMOT dans C MYLMOT. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 13/04/2000, version initiale C HISTORIQUE : v1, 13/04/2000, 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 INTEGER NBMOTS CHARACTER*(*) MYLMOT(*),MYMOT INTEGER INDMOT * INTEGER IMPR,IRET * INTEGER INBM LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fich4' 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 WRITE(IOIMP,*) 'On n''a pas trouvé le mot ',MYMOT WRITE(IOIMP,*) 'dans la liste de mots.' WRITE(IOIMP,*) (MYLMOT(INBM),INBM=1,NBMOTS) GOTO 9999 ENDIF INDMOT=INBM * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine fich4' RETURN * * End of subroutine FICH4 * END