Télécharger lirmot.eso

Retour à la liste

Numérotation des lignes :

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

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