C @(#)tdlist2.for	17.1.1.1 (ES0-DMD) 01/25/02 17:47:15
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 12:00 - 11 JUL 1988
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C  900219  KB, throw out SX calls...
C  910130  MP  replace TBFSET by another stuff
C.IDENTIFICATION:    TDLIST2.FOR
C
C.KEYWORDS:          TABLE, APPLICATIONS
C
C.ENVIRONMENT:      MIDAS
C
C.PURPOSE
C
C  GET TABLE ENTRIES WITH INTRINSIC FORMAT
C  MODIFIED VERSION OF TDLIS1
C
C------------------------------------------------------------------
       SUBROUTINE TDLIS2(TABLE,NCOL,ICOL,IROW,CVAL,IHEAD,HEADER,STATUS)
C
C       List information from table.
C       Format is defined according to data type
C
       IMPLICIT        NONE
       INTEGER    TABLE           ! IN : table ident
       INTEGER    NCOL            ! IN : number of columns
       INTEGER    ICOL(NCOL)      ! IN : column index
       INTEGER    IROW            ! IN : row number
       CHARACTER*(*) CVAL         ! OUT: row values
       LOGICAL    IHEAD           ! IN : header flag
       CHARACTER*(*) HEADER       ! OUT: table header
       INTEGER    STATUS          ! OUT: status
C
       INTEGER          LIMIT
       PARAMETER       (LIMIT=30)
       LOGICAL          NULL(LIMIT)
C       LOGICAL          SELECT
       INTEGER          COL(LIMIT), ILAST
       INTEGER          I, NCOL1, I1, I2, II, ISTAT, ERNORM
       INTEGER          TYPE,LENGTH
       CHARACTER*128    LINE
       CHARACTER*72     ERRMSG
       CHARACTER*18     LABCOL
       CHARACTER*8      FORM
C
       INCLUDE          'MID_INCLUDE:TABLES.INC/NOLIST'
       INCLUDE          'MID_INCLUDE:TABLED.INC/NOLIST'
C
       DATA             ERRMSG/' *** Format conversion error ***'/
C
C ... DEFINE FORMAT AND HEADERS
C
       ERNORM = 0
       DO 10 I = 1, NCOL
           COL(I+1) = ICOL(I)
10     CONTINUE
       COL(1) = 0
       NCOL1 = NCOL+1
C
       IF (IHEAD) THEN
         HEADER    = ' Seq.no.'
         ILAST  = 0
C         CALL TBFSET(TABLE,NCOL1,COL,IFIRST,ILAST,STATUS)
C
C ... SET UP LABELS
C
         DO 20 I = 1, NCOL1
           CALL TBFGET(TABLE,COL(I),FORM,LENGTH,TYPE,STATUS)
           CALL TBLGET(TABLE,COL(I),LABCOL,STATUS)
           I1 = ILAST + 1
           I2 = ILAST + LENGTH + 1
           ILAST = I2
           IF (LABCOL.EQ.' ') THEN
             LABCOL = ' Column #'
             WRITE(LABCOL(10:12),9000) ICOL(I)
             II = 12
           ELSE IF (COL(I).EQ.0) THEN
             II = 9
           ELSE
             II = INDEX(LABCOL,' ') - 1 
           ENDIF
           IF (I2-I1+1.GE.II) THEN
             I1 = I1+(I2-I1+1-II)/2
             I2 = I1 + II - 1
             HEADER(I1:I2) = LABCOL(1:II)
           ELSE
              HEADER(I1:I1) = '#'
              WRITE(HEADER(I1+1:I1+3),9000) ICOL(I)
           ENDIF
20       CONTINUE
       ENDIF
C
C ... LIST ROW
C
C       CALL TBSGET(TABLE,I,SELECT,STATUS)
C       IF (SELECT) THEN
       CALL TBRRDC(TABLE,IROW,NCOL1,COL,LINE,NULL,ISTAT)
       IF (ISTAT.NE.ERNORM) CALL STTPUT(ERRMSG,ISTAT)
       CVAL = LINE
       RETURN
9000   FORMAT(I3)
       END