Télécharger la plaquette Cast3M


fr en

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