Télécharger lirmot.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRMOT SOURCE PV 14/03/28 21:15:03 8015
  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. IV=0
  17. ICONDO=ICOND
  18. LMOT=LEN(MOTCLE(1))
  19. CALL LIRCHA(MOT(1:LMOT),ICONDO,IRETOU)
  20. IF (IERR.NE.0) RETURN
  21. IF (IRETOU.EQ.0) RETURN
  22. DO 1 I=1,MOTDIM
  23. IF (MOT(1:LMOT).EQ.MOTCLE(I)) GOTO 2
  24. 1 CONTINUE
  25. i=0
  26. if (motdi.gt.0) goto 4
  27. LLU=LONG(MOT(1:LMOT))
  28. ITROUV=0
  29. DO 5 I=1,MOTDIM
  30. IF (MOT(1:LLU).NE.MOTCLE(I)(1:MIN(LLU,LMOT))) GOTO 5
  31. ITROUV=ITROUV+1
  32. IV=I
  33. 5 CONTINUE
  34. I=IV
  35. IF (ITROUV.EQ.1) GOTO 2
  36. 4 CONTINUE
  37. IF (MOT(1:2).NE.'? ') GOTO 3
  38. WRITE (IOIMP,100) (MOTCLE(IM),IM=1,MOTDIM)
  39. 100 FORMAT(/,' LISTE DES MOTS RECONNUS',/,(1H ,10A8))
  40. 3 CALL REFUS
  41. if (motdi.gt.0) goto 2
  42. I=0
  43. MOTERR(1:8)=MOT(1:8)
  44. IF (ICOND.EQ.1) THEN
  45. CALL ERREUR(7)
  46. WRITE(IOIMP,110) (MOTCLE(I),I=1,MOTDIM)
  47. 110 FORMAT(10(1H ,A8))
  48. ENDIF
  49. 2 CONTINUE
  50. IVAL=I
  51. RETURN
  52. END
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  

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