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