Télécharger lirmot.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRMOT SOURCE BP208322 17/10/24 21:15:01 9595
  2. C CE PROGRAMME PERMET DE SIMULER UN SOUS-TYPAGE AU NIVEAU DES MOTS
  3. C
  4. SUBROUTINE LIRMOT(MOTCLE,MOTDI ,IVAL,ICOND)
  5.  
  6. C MOTCLE TABLEAU DES MOTS CLES POSSIBLES
  7. C MOTDI +/-DIMENSION DE MOTCLE
  8. C si MOTDI<0, on souhaite utiliser des abreviations(#7969)
  9. C IVAL POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC
  10. C ICOND LECTURE IMPERATIVE (=1) OU NON (=0)
  11.  
  12. IMPLICIT INTEGER(I-N)
  13. CHARACTER*(*) MOTCLE(*)
  14. CHARACTER*500 MOT
  15. EXTERNAL LONG
  16.  
  17. -INC CCOPTIO
  18.  
  19. C MOTDIM DIMENSION DE MOTCLE
  20. motdim=abs(motdi)
  21. IVAL=0
  22. IV=0
  23.  
  24. c LECTURE D'UNE CHAINE DE LMOT CARACTERES
  25. ICONDO=ICOND
  26. LMOT=LEN(MOTCLE(1))
  27. CALL LIRCHA(MOT(1:LMOT),ICONDO,IRETOU)
  28. IF (IERR.NE.0) RETURN
  29. IF (IRETOU.EQ.0) RETURN
  30.  
  31. c RECHERCHE DE CE MOT DANS LA LISTE DES MOTS-CLES
  32. DO 1 I=1,MOTDIM
  33. IF (MOT(1:LMOT).EQ.MOTCLE(I)) GOTO 2
  34. 1 CONTINUE
  35. i=0
  36. if (motdi.gt.0) goto 4
  37.  
  38. c CAS ABBREVATION : RECHERCHE DE CE MOT DANS LA LISTE DES MOTS-CLES
  39. C ABBREGES A LA TAILLE DU MOT
  40. LLU=LONG(MOT(1:LMOT))
  41. ITROUV=0
  42. DO 5 I=1,MOTDIM
  43. IF (MOT(1:LLU).NE.MOTCLE(I)(1:MIN(LLU,LMOT))) GOTO 5
  44. ITROUV=ITROUV+1
  45. IV=I
  46. 5 CONTINUE
  47. I=IV
  48. IF (ITROUV.EQ.1) GOTO 2
  49. 4 CONTINUE
  50.  
  51. c MOT NON TROUVE DANS LA LISTE : ON TESTE SI IL S'AGIT DE "?"
  52. IF (MOT(1:2).NE.'? ') GOTO 3
  53.  
  54. c CAS "?" : ON ECRIT LA LISTE ET ON QUITTE
  55. WRITE (IOIMP,100) (MOTCLE(IM),IM=1,MOTDIM)
  56. 100 FORMAT(/,' LISTE DES MOTS RECONNUS',/,(1H ,10A8))
  57. CALL REFUS
  58. RETURN
  59.  
  60. c ECHEC : SI LECTURE OBLIGATOIRE, ON PRODUIT UNE ERREUR
  61. C ET DANS TOUS LES CAS, ON QUITTE
  62. 3 CALL REFUS
  63. MOTERR(1:8)=MOT(1:8)
  64. IF (ICOND.EQ.1) THEN
  65. CALL ERREUR(7)
  66. WRITE(IOIMP,110) (MOTCLE(I),I=1,MOTDIM)
  67. 110 FORMAT(10(1H ,A8))
  68. ENDIF
  69. RETURN
  70.  
  71. c SUCCES : ON RETOURNE L'INDICE DANS LA LISTE
  72. 2 CONTINUE
  73. IVAL=I
  74. RETURN
  75. END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  

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