Télécharger lirmot.eso

Retour à la liste

Numérotation des lignes :

lirmot
  1. C LIRMOT SOURCE CB215821 23/07/12 21:15:08 11704
  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. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8.  
  9. C MOTCLE TABLEAU DES MOTS CLES POSSIBLES
  10. C MOTDI +/-DIMENSION DE MOTCLE
  11. C si MOTDI<0, on souhaite utiliser des abreviations(#7969)
  12. C IVAL POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC
  13. C ICOND LECTURE IMPERATIVE (=1) OU NON (=0)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18. CHARACTER*(*) MOTCLE(*)
  19. CHARACTER*(LOCHAI) MOT,MOTTOT
  20.  
  21. EXTERNAL LONG
  22.  
  23. MOT = ' '
  24. MOTTOT = ' '
  25.  
  26. C MOTDIM DIMENSION DE MOTCLE
  27. motdim=abs(motdi)
  28. IVAL=0
  29. IV=0
  30.  
  31. c LECTURE D'UNE CHAINE DE LMOT CARACTERES
  32. ICONDO=ICOND
  33. LMOT=LEN(MOTCLE(1))
  34. CALL LIRCHA(MOTTOT,ICONDO,IRETOU)
  35. IF(IERR .NE.0) RETURN
  36. IF(IRETOU.EQ.0) RETURN
  37. MOT=MOTTOT(1:LMOT)
  38.  
  39. c RECHERCHE DE CE MOT DANS LA LISTE DES MOTS-CLES
  40. DO 1 I=1,MOTDIM
  41. IF(MOT(1:LMOT).EQ.MOTCLE(I)) GOTO 2
  42. 1 CONTINUE
  43. i=0
  44. IF(motdi.gt.0) goto 4
  45.  
  46. c CAS ABBREVATION : RECHERCHE DE CE MOT DANS LA LISTE DES MOTS-CLES
  47. C ABBREGES A LA TAILLE DU MOT
  48. LLU=LONG(MOT(1:LMOT))
  49. ITROUV=0
  50. DO 5 I=1,MOTDIM
  51. LLIS=LONG(MOTCLE(I))
  52. IF( MOT(1:MIN(LLU,LLIS)).NE.
  53. & MOTCLE(I)(1:MIN(LLU,LMOT,LLIS)))GOTO 5
  54. ITROUV=ITROUV + 1
  55. IV=I
  56. 5 CONTINUE
  57. I=IV
  58.  
  59. IF(ITROUV.EQ.1)THEN
  60. GOTO 2
  61.  
  62. ELSEIF(ITROUV.GT.1)THEN
  63. C Le mot n'est pas discriminant dans la liste : plusieurs mots de la liste commencent par MOT(1:LLU)
  64. C Je fais comme si j'avais lu '? '
  65. MOT='?'
  66. ENDIF
  67.  
  68. 4 CONTINUE
  69.  
  70. c MOT NON TROUVE DANS LA LISTE : ON TESTE SI IL S'AGIT DE "?"
  71. IF(MOT(1:2).NE.'? ') GOTO 3
  72.  
  73. c CAS "?" : ON ECRIT LA LISTE ET ON QUITTE
  74. WRITE (IOIMP,100) (MOTCLE(IM),IM=1,MOTDIM)
  75. 100 FORMAT(/,' LISTE DES MOTS RECONNUS :',/,(8(1H ,A)))
  76. RETURN
  77. RETURN
  78.  
  79. c ECHEC : SI LECTURE OBLIGATOIRE, ON PRODUIT UNE ERREUR
  80. C ET DANS TOUS LES CAS, ON QUITTE
  81. 3 CALL REFUS
  82. MOTERR = MOTTOT
  83. IF(ICOND.EQ.1)THEN
  84. CALL ERREUR(7)
  85. WRITE(IOIMP,110) (MOTCLE(I),I=1,MOTDIM)
  86. 110 FORMAT(8(1H ,A))
  87. ENDIF
  88. RETURN
  89.  
  90. c SUCCES : ON RETOURNE L'INDICE DANS LA LISTE
  91. 2 CONTINUE
  92. IVAL=I
  93. RETURN
  94. END
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  

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