C LIRMOT    SOURCE    CB215821  23/07/12    21:15:08     11704          
C  CE PROGRAMME PERMET DE SIMULER UN SOUS-TYPAGE AU NIVEAU DES MOTS
C
      SUBROUTINE LIRMOT(MOTCLE,MOTDI ,IVAL,ICOND)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

C     MOTCLE TABLEAU DES MOTS CLES POSSIBLES
C     MOTDI  +/-DIMENSION DE MOTCLE
C            si MOTDI<0, on souhaite utiliser des abreviations(#7969)
C     IVAL   POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC
C     ICOND  LECTURE IMPERATIVE (=1) OU NON (=0)

-INC PPARAM
-INC CCOPTIO

      CHARACTER*(*) MOTCLE(*)
      CHARACTER*(LOCHAI) MOT,MOTTOT

      EXTERNAL LONG

      MOT    = ' '
      MOTTOT = ' '

C     MOTDIM DIMENSION DE MOTCLE
      motdim=abs(motdi)
      IVAL=0
      IV=0

c     LECTURE D'UNE CHAINE DE LMOT CARACTERES
      ICONDO=ICOND
      LMOT=LEN(MOTCLE(1))
      CALL LIRCHA(MOTTOT,ICONDO,IRETOU)
      IF(IERR  .NE.0) RETURN
      IF(IRETOU.EQ.0) RETURN
      MOT=MOTTOT(1:LMOT)

c     RECHERCHE DE CE MOT DANS LA LISTE DES MOTS-CLES
      DO 1 I=1,MOTDIM
        IF(MOT(1:LMOT).EQ.MOTCLE(I)) GOTO 2
   1  CONTINUE
      i=0
      IF(motdi.gt.0) goto 4

c     CAS ABBREVATION : RECHERCHE DE CE MOT DANS LA LISTE DES MOTS-CLES
C     ABBREGES A LA TAILLE DU MOT
      LLU=LONG(MOT(1:LMOT))
      ITROUV=0
      DO 5 I=1,MOTDIM
        LLIS=LONG(MOTCLE(I))
        IF(      MOT(1:MIN(LLU,LLIS)).NE.
     &     MOTCLE(I)(1:MIN(LLU,LMOT,LLIS)))GOTO 5
        ITROUV=ITROUV + 1
        IV=I
   5  CONTINUE
      I=IV

      IF(ITROUV.EQ.1)THEN
        GOTO 2

      ELSEIF(ITROUV.GT.1)THEN
C       Le mot n'est pas discriminant dans la liste : plusieurs mots de la liste commencent par MOT(1:LLU)
C       Je fais comme si j'avais lu '? '
        MOT='?'
      ENDIF

   4  CONTINUE

c     MOT NON TROUVE DANS LA LISTE : ON TESTE SI IL S'AGIT DE "?"
      IF(MOT(1:2).NE.'? ') GOTO 3

c     CAS "?" : ON ECRIT LA LISTE ET ON QUITTE
      WRITE (IOIMP,100) (MOTCLE(IM),IM=1,MOTDIM)
 100  FORMAT(/,' LISTE DES MOTS RECONNUS :',/,(8(1H ,A)))
      RETURN
      RETURN

c     ECHEC : SI LECTURE OBLIGATOIRE, ON PRODUIT UNE ERREUR
C     ET DANS TOUS LES CAS, ON QUITTE
   3  CALL REFUS
      MOTERR = MOTTOT
      IF(ICOND.EQ.1)THEN
       CALL ERREUR(7)
       WRITE(IOIMP,110) (MOTCLE(I),I=1,MOTDIM)
 110   FORMAT(8(1H ,A))
      ENDIF
      RETURN

c     SUCCES : ON RETOURNE L'INDICE DANS LA LISTE
   2  CONTINUE
      IVAL=I
      RETURN
      END