C LECTUR    SOURCE    CHAT      05/01/13    01:14:30     5004
C     FABRIQUE UN OBJET DE TYPE LISTENTI (LISTE D'ENTIERS)
C
      SUBROUTINE LECTUR
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
      CHARACTER*4 MOTC(2),MOTF(2)
      DATA MOTC/'PAS ','*   '/
      DATA MOTF/'NPAS','    '/
C
      JG=0
      IP=0
      IBEGIN=0
      SEGINI MLENTI
 999  CONTINUE
      CALL LIRENT(IPP,IBEGIN,IRETOU)
      IF(IRETOU.EQ.0) GO TO 30
C
C     LECTURE D'UN ENTIER
C
 1    CONTINUE
      IP=IPP
      JG=LECT(/1)+1
      SEGADJ MLENTI
      LECT(JG)=IP
      GO TO 999
C
 30   CONTINUE
      CALL LIRMOT(MOTC,2,IRET,0)
      IF(IRET.EQ.0) GO TO 20
      IF (IRET.EQ.2) GOTO 50
C
C     LECTURE DU MOT "PAS "
C
      CALL LIRENT(IPAS,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL LIRENT(IQ,0,IRETOU)
      IF(IRETOU.EQ.1)GOTO 10
      CALL LIRMOT(MOTF(1),1,INPA,1)
C
C     LECTURE DE NPAS
C
      CALL LIRENT(NP,1,IRETOU)
      IF(IERR.NE.0)RETURN
      NP=MAX(0,NP)
      KIP=IP
      KIPAS=IPAS
      JG0=JG
      JG=JG+NP
      SEGADJ MLENTI
      DO 11 IJ=1,NP
        LECT(JG0+IJ)=IJ*KIPAS+KIP
 11   CONTINUE
C
C ON DOIT LIRE UN ENTIER OU RIEN
C
      CALL LIRENT(IPP,0,IRETOU)
      IF(IRETOU.EQ.1) GOTO 1
      GOTO 20
C
C  VOIR SI IQ EST SUIVI PAR "*   "
C
  10  CONTINUE
      CALL LIRENT(IQ2,0,IRETX)
      IF (IRETX.EQ.1) GOTO 60
      CALL LIRMOT(MOTC(2),1,IRF,0)
      IF (IRF.EQ.0) GOTO 60
      NFOIS=IQ
      CALL LIRENT(IQ,1,IRETOU)
      IF (IERR.NE.0) RETURN
  60  CONTINUE
      IA=IQ-IP
      IF(IA*IPAS) 6,7,8
   6  CONTINUE
      CALL ERREUR(36)
C     IQ ET IP SONT DE SIGNE CONTRAIRE
      RETURN
   7  CONTINUE
      IF(IPAS.NE.0) THEN
         if( ipas.eq.1) go to 99
        CALL ERREUR(21)
C       IQ ET IP SONT IDENTIQUES
        RETURN
      ENDIF
   8  CONTINUE
      IF(IPAS.NE.0)IA=MOD(IA,IPAS)
      IF(IA.NE.0) THEN
        CALL ERREUR(21)
C       IQ-IP N EST PAS DIVISIBLE PAR IPAS
        RETURN
      ENDIF
      IF(IPAS.EQ.0)JQ=2
      IF(IPAS.NE.0)JQ=ABS((IQ-IP)/IPAS)+1
      JA=IP+IPAS
      JG1=LECT(/1)-1
      JG=JG1+JQ
      SEGADJ MLENTI
      DO 9 IA=2,JQ
        LECT(JG1+IA)=JA
        JA=JA+IPAS
   9  CONTINUE
  99  continue
      IPP=IQ2
      IP=IQ
      IF (IRF.EQ.1) GOTO 65
      IF (IRETX.EQ.1) GOTO 1
      GO TO 999
  50  CONTINUE
C
C   ON A LU "*   "
C
      IMAX=LECT(/1)
      NFOIS=LECT(IMAX)
      CALL LIRENT(IP,1,IRETOU)
      IF (IERR.NE.0) RETURN
      LECT(IMAX)=IP
  65  CONTINUE
      IF (NFOIS.LE.0) GOTO 6
      NF=NFOIS-1
      IF (NF.EQ.0) GOTO 51
      JG1=LECT(/1)
      JG=JG1+NF
      SEGADJ MLENTI
      DO 52 I=1,NF
        LECT(JG1+I)=IP
  52  CONTINUE
  51  CONTINUE
      GOTO 999
C
  20  CONTINUE
      CALL ECROBJ('LISTENTI',MLENTI)
      SEGDES MLENTI
      RETURN
      END