1 : C LIRMO3 SOURCE CHAT 06/06/01 21:17:53 5450 2 : SUBROUTINE LIRMO3(MOTCLE,MOTDIM,IVAL,ICOND,ICOHCO) 3 : C MOTCLE TABLEAU DES MOTS CLES POSSIBLES 4 : C MOTDIM DIMENSION DE MOTCLE 5 : C IVAL POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC 6 : C ICOND LECTURE IMPERATIVE OU NON 7 : IMPLICIT INTEGER(I-N) 8 : DIMENSION ICOHCO(*) 9 : CHARACTER*(*) MOTCLE(*) 10 : CHARACTER*72 MOT 11 : CHARACTER*8 ITOMO 12 : -INC CCOPTIO 13 : -INC CCNOYAU 14 : -INC CCASSIS 15 : L=LEN(MOTCLE(1)) 16 : * WRITE(6,FMT='('' lirmo3 ico(1) '',i5)') icohco(1) 17 : IF(ICOHCO(1).EQ.-1) THEN 18 : DO 5198 I=1,MOTDIM 19 : IA=0 20 : DO 5199 J=1,L 21 : IA = IA + ICHAR(MOTCLE(I)(J:J)) 22 : 5199 CONTINUE 23 : ICOHCO(I) = IA 24 : 5198 CONTINUE 25 : ENDIF 26 : IVAL=0 27 : 28 : * 29 : ICONDO=ICOND 30 : * 31 : DO 36 K=1,100000 32 : ITOMO ='MOT ' 32 : CALL LIRABJ(ITOMO,IRAT,ICONDO,IRETOU) 33 : if(nbesc.ne.0) segact ipiloc 34 : IF (IERR.NE.0) RETURN 35 : * 36 : IF (IRETOU.EQ.0) GO TO 35 37 : JF=IPCHAR(IRAT+1)-1 38 : ID=IPCHAR(IRAT) 39 : MOT= ICHARA(ID:JF) 40 : * 41 : IA=0 42 : DO 65 I=1,L 43 : IA=IA + ICHAR(MOT(I:I)) 44 : 65 CONTINUE 45 : * 46 : DO 1 I=1,MOTDIM 47 : IF(IA.NE.ICOHCO(I)) GO TO 1 48 : IF (MOT(1:L).EQ.MOTCLE(I)) GOTO 2 49 : 1 CONTINUE 49 : 35 CALL NOUTRU 50 : if(nbesc.ne.0) segdes ipiloc 51 : 36 CONTINUE 52 : 2 CONTINUE 53 : IVAL=I 54 : RETURN 55 : END 56 : 57 : 58 :
© Cast3M 2003 - All rights reserved.
Disclaimer