C FICH4 SOURCE GOUNAND 05/12/21 21:19:50 5281 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 CCOPTIO INTEGER LNMOTS,NBMOTS PARAMETER(LNMOTS=4) CHARACTER*(LNMOTS) MYLMOT(NBMOTS) CHARACTER*(*) MYMOT INTEGER INDMOT * INTEGER IMPR,IRET * INTEGER INBM INTEGER LNMOT2 LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fich4' 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 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