C @(#)tabsubs.for	17.1.1.1 (ES0-DMD) 01/25/02 17:40:36
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
      SUBROUTINE OPNTAB(TABLE,TID,NCOLS,NROWS,STAT)
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION:
C  subroutine OPNTAB            version 1.00	900720
C  K. Banse			ESO - Garching
C
C.KEYWORDS:
C  LUT/ITT tables
C
C.PURPOSE:
C  open LUT or ITT tables 
C
C.ALGORITHM:
C  use table interfaces 
C
C.INPUT/OUTPUT:
C  call as  OPNTAB(TABLE,TID,NCOLS,NROWS,STAT)
C  
C  input par:
C  TABLE:	char.exp.	table name
C 
C  output par:
C  TID:		I*4		id of table
C  NCOLS:	I*4		no. of rows
C  NROWS:	I*4		no. of columns
C  STAT:        I*4             return status
C	
C.VERSIONS
C  1.00		creation
C	
C---------------------------------------------------------
C
      IMPLICIT NONE
C      
      INTEGER      TID,NCOLS,NROWS,STAT
      INTEGER      N,EC,EL,ED
C      
      CHARACTER    TABLE*(*)
      CHARACTER    FILE*80
C 
      INCLUDE  'MID_INCLUDE:ST_DEF.INC'
      INCLUDE  'MID_INCLUDE:ST_DAT.INC'
C
C  first look for system table, then for own table in MID_WORK
      FILE(1:) = 'MID_SYSTAB: '
      FILE(12:) = TABLE
      CALL STECNT('GET',EC,EL,ED)
      CALL STECNT('PUT',1,0,0)
      CALL TBTOPN(FILE,F_I_MODE,TID,STAT)
      CALL STECNT('PUT',EC,EL,ED)
      IF (STAT.NE.0) THEN
         STAT = 0
         FILE(1:) = 'MID_WORK: '
         FILE(10:) = TABLE
         CALL TBTOPN(FILE,F_I_MODE,TID,STAT)
      ENDIF
C
C  get info about table
      CALL TBIGET(TID,NCOLS,NROWS,N,N,N,STAT)
C
      RETURN
      END

      SUBROUTINE BLDLUT(TABLE,RLUT,STAT)
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION:
C  subroutine BLDLUT            version 1.00	880927
C  K. Banse			ESO - Garching
C
C.KEYWORDS:
C  LUT/ITT tables
C
C.PURPOSE:
C  create + fill LUT tables for Image Display
C
C.ALGORITHM:
C  use table interfaces 
C
C.INPUT/OUTPUT:
C  call as  BLDTAB(TABLE,RLUT,STAT)
C  
C  input par:
C  TABLE:	char.exp.	table name
C  RLUT:	R*4 array	LUT table
C 
C  output par:
C  STAT:        I*4             return status
C	
C.VERSIONS
C  1.00		extracted from main programs
C	
C---------------------------------------------------------
C
      IMPLICIT NONE
C      
      INTEGER      STAT
      INTEGER      N
      INTEGER      TID,TCOLNM(3)
C      
      CHARACTER    TABLE*(*)
      CHARACTER    MYTAB*60
      CHARACTER    TABUNI*16,TABLAB(3)*16
C      
      REAL         RLUT(3,256)
C 
      INCLUDE  'MID_INCLUDE:ST_DEF.INC'
C
      DATA      TABUNI    /' '/
      DATA      TABLAB    /'RED ','GREEN ','BLUE '/
      DATA      TCOLNM    /1,2,3/
C      
      INCLUDE  'MID_INCLUDE:ST_DAT.INC'
C
C 
      STAT = 0
      MYTAB(1:) = ' '
C 
      MYTAB(1:) = TABLE(1:)
      N = INDEX(TABLE,' ') 
      IF (N.LE.0) THEN
         N = LEN(TABLE)
         IF (N.GT.56) GOTO 500                    !no space for appending type
      ENDIF
      MYTAB(N:) = '.lut'                          !append LUT type 
C 
500   CALL TBTINI(MYTAB,0,F_O_MODE,8,256,TID,STAT)     !8 columns, 256 rows
      DO 2000 N=1,3
         CALL TBCINI(TID,D_R4_FORMAT,1,'E12.5',TABUNI,
     +               TABLAB(N),TCOLNM(N),STAT)
2000  CONTINUE
C      
      DO 2100 N=1,256
         CALL TBRWRR(TID,N,3,TCOLNM,RLUT(1,N),STAT)
2100  CONTINUE
C
C  release table file properly
      CALL TBSINI(TID,STAT)
      CALL TBTCLO(TID,STAT)
C
      RETURN
      END

      SUBROUTINE BLDITT(TABLE,RITT,STAT)
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION:
C  subroutine BLDITT            version 1.00	880704
C  K. Banse			ESO - Garching
C
C.KEYWORDS:
C  LUT/ITT tables
C
C.PURPOSE:
C  create + fill ITT tables for Image Display
C
C.ALGORITHM:
C  use table interfaces 
C
C.INPUT/OUTPUT:
C  call as  BLDTAB(TABLE,RITT,STAT)
C  
C  input par:
C  TABLE:	char.exp.	table name
C  RITT:	R*4 array	ITT table
C 
C  output par:
C  STAT:        I*4             return status
C	
C.VERSIONS
C  1.00		extracted from main programs
C	
C---------------------------------------------------------
C
      IMPLICIT NONE
C      
      INTEGER      STAT
      INTEGER      N
      INTEGER      TID,TCOLNM(1)
C      
      CHARACTER    TABLE*(*)
      CHARACTER    MYTAB*60
      CHARACTER    TABUNI*16,TABLAB(1)*16
C      
      REAL         RITT(256)
C 
      INCLUDE  'MID_INCLUDE:ST_DEF.INC'
C
      DATA      TABUNI    /' '/
      DATA      TABLAB    /'ITT '/
      DATA      TCOLNM    /1/
C      
      INCLUDE  'MID_INCLUDE:ST_DAT.INC'
C
C 
      STAT = 0
      MYTAB(1:) = ' '
C 
      MYTAB(1:) = TABLE(1:)
      N = INDEX(TABLE,' ') 
      IF (N.LE.0) THEN
         N = LEN(TABLE)
         IF (N.GT.56) GOTO 500                    !no space for appending type
      ENDIF
      MYTAB(N:) = '.itt'                          !append ITT type 
C 
500   CALL TBTINI(MYTAB,0,F_O_MODE,4,256,TID,STAT)     !4 columns, 256 rows
      CALL TBCINI(TID,D_R4_FORMAT,1,'E12.5',TABUNI,
     +            TABLAB(1),TCOLNM(1),STAT)
C      
      DO 2100 N=1,256
         CALL TBRWRR(TID,N,1,TCOLNM,RITT(N),STAT)
2100  CONTINUE
C
C  release table file properly
      CALL TBSINI(TID,STAT)
      CALL TBTCLO(TID,STAT)
C
      RETURN
      END