1 : C LIRMOT SOURCE PV 14/02/20 21:15:01 7973 2 : C CE PROGRAMME PERMET DE SIMULER UN SOUS-TYPAGE AU NIVEAU DES MOTS 3 : C 4 : SUBROUTINE LIRMOT(MOTCLE,MOTDI ,IVAL,ICOND) 5 : C MOTCLE TABLEAU DES MOTS CLES POSSIBLES 6 : C MOTDIM DIMENSION DE MOTCLE 7 : C IVAL POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC 8 : C ICOND LECTURE IMPERATIVE OU NON 9 : IMPLICIT INTEGER(I-N) 10 : CHARACTER*(*) MOTCLE(*) 11 : CHARACTER*500 MOT 12 : EXTERNAL LONG 13 : -INC CCOPTIO 14 : motdim=abs(motdi) 15 : IVAL=0 16 : ICONDO=ICOND 17 : LMOT=LEN(MOTCLE(1)) 17 : CALL LIRCHA(MOT(1:LMOT),ICONDO,IRETOU) 18 : IF (IERR.NE.0) RETURN 19 : IF (IRETOU.EQ.0) RETURN 20 : DO 1 I=1,MOTDIM 21 : IF (MOT(1:LMOT).EQ.MOTCLE(I)) GOTO 2 22 : 1 CONTINUE 23 : if (motdi.gt.0) goto 3 24 : LLU=LONG(MOT(1:LMOT)) 25 : ITROUV=0 26 : DO 5 I=1,MOTDIM 27 : IF (MOT(1:LLU).NE.MOTCLE(I)(1:MIN(LLU,LMOT))) GOTO 5 28 : ITROUV=ITROUV+1 29 : IV=I 30 : 5 CONTINUE 31 : I=IV 32 : IF (ITROUV.EQ.1) GOTO 2 33 : 34 : IF (MOT(1:2).NE.'? ') GOTO 3 35 : WRITE (IOIMP,100) (MOTCLE(I),I=1,MOTDIM) 36 : 100 FORMAT(/,' LISTE DES MOTS RECONNUS',/,(1H ,10A8)) 36 : 3 CALL REFUS 37 : I=0 38 : MOTERR(1:8)=MOT(1:8) 39 : IF (ICOND.EQ.1) THEN 39 : CALL ERREUR(7) 40 : if (mot(1:2).ne.'? ')WRITE(IOIMP,110) (MOTCLE(I),I=1,MOTDIM) 41 : 110 FORMAT(10(1H ,A8)) 42 : ENDIF 43 : 2 CONTINUE 44 : IVAL=I 45 : RETURN 46 : END 47 : 48 : 49 : 50 : 51 :
© Cast3M 2003 - All rights reserved.
Disclaimer