C @(#)dclist.for	17.1.1.1 (ES0-DMD) 01/25/02 17:57:37
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT     (c)   1989   European Southern Observatory
C.IDENT         dclist.for
C.LANGUAGE      VAX/VMS FORTRAN-77
C.AUTHOR        Preben Grosbol,  ESO/IPG
C.KEYWORDS      decoding, list of numbers
C.COMMENT       Routines for decoding and accessing list of numbers
C               given as a MIDAS 'list'.
C.VERSION       1.0    1989-Mar-11 : Creation,   PJG
C------------------------------------------------------------------------
      INTEGER FUNCTION  DEFLIST(LIST)
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.PURPOSE       decode string with MIDAS 'list' specification and initiate
C               internal list structure.
C.RETURN        status, 0: OK, -1:invalid list, 1: list too long
C------------------------------------------------------------------------
      PARAMETER   (MXLIST=64)
C
      INTEGER     LNO
      INTEGER     NOF(MXLIST),NOL(MXLIST)
C
      CHARACTER*(*)   LIST
      LOGICAL         LDIG
      INTEGER         L,N,LL
C
      COMMON /LIST/LNO,NOF,NOL
C
C     RESET LISTS
C
      LNO = -1
      DO 100, N = 1,MXLIST
         NOF(N) = -1
         NOL(N) = -1
  100 CONTINUE
      DEFLIST = 0
C
C     GET LENGTH OF STRING - ERROR IF NULL
C
      LL = INDEX(LIST,' ') - 1
      IF (LL.LT.1) THEN
         DEFLIST = -1
         RETURN
      ENDIF
C
C     CHECK SPECIAL CASE '*' I.E. ALL NUMBERS 1 TO 9999
C
      IF (LIST(1:1).EQ.'*') THEN
         IF (LL.GT.1) THEN
            DEFLIST = -1
            RETURN
         ENDIF
         NOF(1) = 1
         NOL(1) = 9999
         LNO = 1
         RETURN
      ENDIF
C
C     GO THROUGH LIST AND DECODE IT
C
      N = 0
      L = 1
      LDIG = .FALSE.
      DO 200, I = 1,LL
         IF (LIST(I:I).EQ.','.AND.LDIG) THEN
            IF (NOF(L).LT.0) NOF(L) = N
            IF (N.LT.NOF(L)) THEN
               NOL(L) = NOF(L)
            ELSE
               NOL(L) = N
            ENDIF
            L = L + 1
            IF (MXLIST.LT.L) THEN
               DEFLIST = 1
               LNO = 1
               RETURN
            ENDIF
         ELSE IF (LIST(I:I).EQ.'-'.AND.LDIG) THEN
            NOF(L) = N
         ELSE IF (LIST(I:I).EQ.'.') THEN
            IF (LIST(I-1:I-1).EQ.'.') GOTO 200
            IF (LIST(I+1:I+1).NE.'.'.OR..NOT.LDIG) THEN
               DEFLIST = -1
               RETURN
            ENDIF
            NOF(L) = N
         ELSE IF (LIST(I:I).LT.'0'.OR.'9'.LT.LIST(I:I)) THEN
               DEFLIST = -1
               RETURN
         ENDIF
C
C     CHECK IF NEXT CHARACTER IS A DIGIT
C
         LDIG = '0'.LE.LIST(I:I) .AND. LIST(I:I).LE.'9'
         IF (LDIG) THEN
            N = 10*N + ICHAR(LIST(I:I)) - ICHAR('0')
         ELSE
            N = 0
         ENDIF
  200 CONTINUE
C
C     CHECK IF SINGLE NO. IN RANGE
C
      IF (LDIG) THEN
         IF (NOF(L).LT.0) NOF(L) = N
         IF (N.LT.NOF(L)) THEN
            NOL(L) = NOF(L)
         ELSE
            NOL(L) = N
         ENDIF
      ELSE
         DEFLIST = -1
         RETURN
      ENDIF
C
C     NORMAL RETURN
C
      LNO = 1
      RETURN
      END
C-----------------------------------------------------------------------
      INTEGER FUNCTION GETLIST(NO)
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.PURPOSE       get next no. in list previously defined. The no. is
C               return through the parameter.
C.RETURN        status, 1:valid no., 0:no number return
C------------------------------------------------------------------------
      PARAMETER   (MXLIST=64)
C
      INTEGER     NO
C
      INTEGER     LNO
      INTEGER     NOF(MXLIST),NOL(MXLIST)
C
      COMMON /LIST/LNO,NOF,NOL
C
C     CHECK IF THERE ARE MORE NUMBERS IN LIST
C
      GETLIST = 0
      IF (LNO.LT.0) RETURN
      IF (NOF(LNO).LT.0) THEN
         LNO = -1
         RETURN
      ENDIF
C
C     GET NEXT NUMBER AND UPDATE LIST
C
      NO = NOF(LNO)
      NOF(LNO) = NOF(LNO) + 1
      IF (NOL(LNO).LT.NOF(LNO)) THEN
         NOF(LNO) = -1
         LNO = LNO + 1
         IF (MXLIST.LE.LNO) LNO = -1
      ENDIF
      GETLIST = 1
      RETURN
      END