C @(#)tintertbl.for	17.1.1.1 (ES0-DMD) 01/25/02 17:47:27
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.2  ESO-FORTRAN Conversion, AA  14:17 - 19 NOV 1989
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C
C.IDENTIFICATION:
C         PROGRAM TINTERTBL
C
C.PURPOSE
C
C Statistics and mathematical operations on tables. 
C Implements the commands:
C INTERPOLATE/TI, TT, IT, II
C REBIN/TI, TT, IT, II
C
C.KEYWORDS
C
C ARITHMETIC OPERATS, TABLES.
C
C.ALGORITHM
C
C USE TABLE INTERFACE ROUTINES
C
C-----------------------------------------------------------
C
      PROGRAM TINTER
      IMPLICIT NONE
      INTEGER     NCOM
      PARAMETER   (NCOM=2)
      INTEGER     I, KUN, KNUL, STAT
      CHARACTER*4 COMMAND,WS
      CHARACTER*4 COMTAB(NCOM)
      CHARACTER*70 LINE
C
      DATA COMTAB/'INTE','REBI'/
C
C ... GET INTO MIDAS
C
      CALL STSPRO('TINTETBL')
C
C ... GET COMMAND FORM ENVIRONMENT
C
      CALL STKRDC('MID$CMND',1,1,4,I,COMMAND,KUN,KNUL,STAT)
      CALL FORUPC(COMMAND,WS)      
      IF (WS.EQ.'PRIN') WS = 'READ'
C
C ... SELECT THE ACTION
C
      DO 10 I = 1, NCOM
         IF (WS.EQ.COMTAB(I)) GOTO 20
   10 CONTINUE
      CALL STKRDC('MID$CMND',1,11,2,I,WS,KUN,KNUL,STAT) 
      WRITE(LINE,2000) COMMAND,WS
2000  FORMAT('Error: command ',A,'/',A,' not found')
      CALL STTPUT(LINE,STAT)
      GOTO 3000
C
C ... EXECUTE ACTION
C
   20 GOTO (100,200),I
      CALL STTPUT('Warning: command not found',STAT)
      GOTO 3000
  100 CALL STKRDC('MID$CMND',1,11,2,I,WS,KUN,KNUL,STAT) ! INTERPOLATE
      CALL FORUPC(WS,WS)
      IF (WS(1:2).EQ.'II') THEN
         CALL TDINII
      ELSE IF (WS(1:2).EQ.'IT') THEN
         CALL TDINIT
      ELSE IF (WS(1:2).EQ.'TI') THEN
         CALL TDINTI
      ELSE 
         CALL TDINTT
      END IF
      GOTO 3000
  200 CALL STKRDC('MID$CMND',1,11,2,I,WS,KUN,KNUL,STAT) ! REBIN
      CALL FORUPC(WS,WS)
      IF (WS(1:2).EQ.'II') THEN
         CALL TDRBII
      ELSE IF (WS(1:2).EQ.'IT') THEN
         CALL TDRBIT
      ELSE IF (WS(1:2).EQ.'TI') THEN
         CALL TDRBTI
      ELSE 
         CALL TDRBTT
      END IF
      GOTO 3000
C
C ... EXIT FROM MIDAS
C
 3000 CALL STSEPI
      END
C