C @(#)tdfdecd.for	19.1 (ES0-DMD) 02/25/03 14:11:17
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: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  17:34 - 11 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C
C
C.IDENTIFICATION        TDFDECD.FOR
C.KEYWORDS           TABLE, APPLICATIONS
C.ENVIRONMENT  MIDAS
C.PURPOSE
C  DECODE EXTERNAL FORMAT LINE
C
C
C------------------------------------------------------------------
      SUBROUTINE TDFDEC(LINE,I1,I2,C,FORM,LABEL,UNIT,STATUS)
      IMPLICIT NONE
      CHARACTER*(*) LINE  !   IN : input format line
      INTEGER I1          !   OUT: start position
      INTEGER I2          !   OUT: end position
      CHARACTER*(*) C     !   OUT: type
      CHARACTER*8 FORM    !   OUT: format
      CHARACTER*16 LABEL  !   OUT: label
      CHARACTER*16 UNIT   !   OUT : unit 
      INTEGER STATUS      !   OUT : status
C
      INTEGER COUNT,START,I,IST,FIELD
      INTEGER FORSKP
      INTEGER LTOKEN(8)
C
      CHARACTER*1  CC
      CHARACTER*64 TOKEN(8)
      CHARACTER*1  SYMILL(9)
      CHARACTER*80 LINE1
       INCLUDE 'MID_INCLUDE:TABLES.INC/NOLIST'
       INCLUDE 'MID_INCLUDE:TABLED.INC/NOLIST'
      DATA SYMILL/')','(','+','-','*','/','.','#',':'/
C
      COUNT  = 0
      LABEL  = ' '
      UNIT   = ' '
      FORM   = ' '
      START  = FORSKP(' ',LINE(1:))
      IF (START.LE.0) THEN
          STATUS = ERRFMT
          RETURN
      END IF
      DO 10 I = 1,8
          CALL GENEXT(LINE,' ',START,TOKEN(I),LTOKEN(I))
          IF (LTOKEN(I).GT.0 .AND. (TOKEN(I) (1:1).NE.'!')) THEN
C
C ... TO BE REMOVED
C
C              CALL FORUPC(TOKEN(I),TOKEN(I))
              COUNT  = COUNT + 1
          ELSE
              GO TO 20
          END IF
   10 CONTINUE
   20 CONTINUE
      IF (COUNT.LE.3) THEN
          LINE1 = LINE
          CALL STTPUT('Wrong definition',IST)
          CALL STTPUT(LINE1,IST)
          STATUS = ERRFMT
          RETURN
      END IF
      FIELD  = LTOKEN(2)
      LINE1  = TOKEN(2)
C      READ(TOKEN(2) (1:LTOKEN(2)),9000) I1
      CALL ASCINT(LINE1, FIELD, I1)
      FIELD  = LTOKEN(3)
      LINE1  = TOKEN(3)
C      READ(TOKEN(3) (1:LTOKEN(3)),9000) I2
      CALL ASCINT(LINE1, FIELD, I2)
      IF (COUNT.GT.4) THEN
          DO 30 I = 5,COUNT
              CC     = TOKEN(I) (1:1)
              IF (CC.EQ.':' .OR. CC.EQ.'#') THEN
                  IF (CC.EQ.':') LABEL  = TOKEN(I) (2:LTOKEN(I))
              ELSE
                  IF (CC.EQ.'"') THEN
                      UNIT   = TOKEN(I) (2:LTOKEN(I)-1)
                  ELSE
                      FORM   = TOKEN(I)
                  END IF
              END IF
   30     CONTINUE
      END IF
      C      = TOKEN(4)
      DO 40 I = 1,9
          IF (INDEX(LABEL,SYMILL(I)).NE.0) THEN
              LINE1 = ' '
              LINE1 = ' Wrong label '//LABEL
              CALL STTPUT(LINE1,IST)
              STATUS = ERRPAR
          END IF
   40 CONTINUE
      RETURN
C100 FORMAT(I<FIELD>)
C 9000 FORMAT (I4)
      END

      SUBROUTINE ASCINT(A, N, I)
C
C      CONVERT ASCII STRING IN TO INTEGER
C
      IMPLICIT NONE
      CHARACTER*(*) A
      INTEGER       N
      INTEGER       I
C
      CHARACTER*1   T
      INTEGER       J, K
C
      I = 0
      DO 10 J = 1, N
        T = A(J:J)
        IF (T.GE.'0' .AND. T.LE.'9') THEN
          READ(T,100) K
          I = I*10 +  K
        ELSE
          RETURN
        ENDIF
10    CONTINUE
      RETURN
100   FORMAT(I1)
      END           
