Télécharger lirmo3.eso

Retour à la liste

Numérotation des lignes :

  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 '
  33. CALL LIRABJ(ITOMO,IRAT,ICONDO,IRETOU)
  34. if(nbesc.ne.0) segact ipiloc
  35. IF (IERR.NE.0) RETURN
  36. *
  37. IF (IRETOU.EQ.0) GO TO 35
  38. JF=IPCHAR(IRAT+1)-1
  39. ID=IPCHAR(IRAT)
  40. MOT= ICHARA(ID:JF)
  41. *
  42. IA=0
  43. DO 65 I=1,L
  44. IA=IA + ICHAR(MOT(I:I))
  45. 65 CONTINUE
  46. *
  47. DO 1 I=1,MOTDIM
  48. IF(IA.NE.ICOHCO(I)) GO TO 1
  49. IF (MOT(1:L).EQ.MOTCLE(I)) GOTO 2
  50. 1 CONTINUE
  51. 35 CALL NOUTRU
  52. if(nbesc.ne.0) segdes ipiloc
  53. 36 CONTINUE
  54. 2 CONTINUE
  55. IVAL=I
  56. RETURN
  57. END
  58.  
  59.  
  60.  
  61.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales