C @(#)tsaint.for	19.1 (ESO-DMD) 02/25/03 13:33:25
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 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence 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) 1992 European Southern Observatory & Copernicus Astron. Center
C.IDENT     tsaint.for
C.AUTHOR    Alex Schwarzenberg-Czerny, Copernicus Astron. Center, Warsaw
C.KEYWORD   MIDAS, time analysis, INTERPOL/TIME

C.LANGUAGE  FORTRAN 77
C.PURPOSE   Interpolate an unevensampled series using its covariance function
C           Reference:  ApJ 385, 404
C.RETURNS   None
C.ENVIRON   TSA context
C.VERSION   0.0               June 1992
C 
C 021031	last modif
C 
C-----------------------------------------------------------------------------
C
C
      INCLUDE 'MID_REL_INCL:TSA_DEF.INC'
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
C
      CHARACTER*60     INAME1         !  NAME OF 1ST OBSERVATION TABLE
      CHARACTER*60     INAME2         !  NAME OF 2ND (OUTPUT) TABLE
      CHARACTER*3      CFUNC          !  TYPE OF ACF
      DOUBLE PRECISION PARM(12)       !  PARAMETERS OF ACF
      DOUBLE PRECISION ACFLIN,ACFPOL,ACFPOW,ACFEXP,
     $                 ACFLOG,ACFIPO
      EXTERNAL         ACFLIN,ACFPOL,ACFPOW,ACFEXP,
     $                 ACFLOG,ACFIPO
      DOUBLE PRECISION TSADELUR0,TSADELUR1,TSADELUR2,TSADELUR3,
     $                 TSADELUR4,TSADELUR5,TSADELUR6,TSADELUR7,
     $                 TSADELUR8,TSADELUR9
      EXTERNAL         TSADELUR0,TSADELUR1,TSADELUR2,TSADELUR3,
     $                 TSADELUR4,TSADELUR5,TSADELUR6,TSADELUR7,
     $                 TSADELUR8,TSADELUR9
C
      INTEGER           NOBS1, NOBS2, ISIZE, ASIZE
      INTEGER           MODE,  IACTS, KUN,   KNUL
      INTEGER           TID1,  TID2,  ITIME, IDAT, IVAR
      INTEGER           NCOL,  ICOL,  NROW,  ISOR
      INTEGER           LFIELD,TTYP,  DTYP,  VTYP
      INTEGER           ICOBS, INU,   ICT
C 
      INTEGER*8         POBS1T,POBS1D,POBS1V
      INTEGER*8         POBS2T,POBS2D,POBS2V
      INTEGER*8         PCOBS,PNU,PCT
C 
      DOUBLE PRECISION  AVER,VAR
      CHARACTER*10 FORM
      CHARACTER*80 TEXT
C
      INCLUDE 'MID_REL_INCL:TSA_DAT.INC'
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
C
C   Get parameters
C
      CALL STSPRO ('tsaint')
      CALL STKRDC ('IN_A',  1,1,60,IACTS,INAME1,KUN,KNUL,ISTAT)
      CALL STKRDC ('OUT_A',  1,1,60,IACTS,INAME2,KUN,KNUL,ISTAT)
      CALL STKRDC ('CFUNC',  1,1, 3,IACTS,CFUNC, KUN,KNUL,ISTAT)
      CALL STKRDD ('INPUTD',   1,12,IACTS,PARM,  KUN,KNUL,ISTAT)
C
C   Map input data
C
      CALL TBTOPN (INAME1,F_I_MODE,TID1,ISTAT)
      CALL TBIGET (TID1,NCOL,NOBS1,ISOR,ICOL,NROW,ISTAT)
      CALL TBLSER (TID1,'TIME' ,ITIME,ISTAT)
      IF (ITIME.LT.0) THEN
        CALL STETER(5,'Column :TIME not found in 1st table')
      ENDIF
      CALL TBLSER (TID1,'VALUE',IDAT ,ISTAT)
      IF (IDAT.LT.0) THEN
        CALL STETER(6,'Column :VALUE not found in 1st table')
      ENDIF
      CALL TBLSER (TID1,'VAR'  ,IVAR, ISTAT)
      IF (IVAR.LT.0) THEN
        CALL STETER(7,'Column :VAR not found in 1st table')
      ENDIF
      CALL TBFGET (TID1,ITIME,FORM,LFIELD,TTYP,ISTAT)
      CALL TBFGET (TID1,IDAT, FORM,LFIELD,DTYP,ISTAT)
      CALL TBFGET (TID1,IVAR, FORM,LFIELD,VTYP,ISTAT)
      CALL TBDGET (TID1,ISTORE,ISTAT)
      IF (ISTORE.NE.F_TRANS) THEN
        TEXT='Input table '//INAME1//' stored not transposed'
        CALL STETER(1,TEXT)
      ENDIF
      IF (TTYP.NE.D_R8_FORMAT.OR.DTYP.NE.D_R8_FORMAT.OR.
     $     VTYP.NE.D_R8_FORMAT) THEN
        CALL STETER(2,
     $    'Column(s) in 1st table must be in DOUBLE PRECISION')
      ENDIF
      CALL TBCMAP (TID1,ITIME,POBS1T,ISTAT)
      CALL TBCMAP (TID1,IDAT, POBS1D,ISTAT)
      CALL TBCMAP (TID1,IVAR, POBS1V,ISTAT)
C
C   Map input/output table
C
      CALL TBTOPN (INAME2,F_IO_MODE,TID2,ISTAT)
      CALL TBIGET (TID2,NCOL,NOBS2,ISOR,ICOL,NROW,ISTAT)
      CALL TBLSER (TID2,'TIME' ,ITIME,ISTAT)
      IF (ITIME.LT.0) THEN
        CALL STETER(8,'Column :TIME not found in 2nd table')
      ENDIF
      CALL TBLSER (TID2,'VALUE',IDAT ,ISTAT)
      IF (IDAT.LT.0) THEN
        CALL STETER(9,'Column :VALUE not found in 2nd table')
      ENDIF
      CALL TBLSER (TID2,'VAR'  ,IVAR, ISTAT)
      IF (IVAR.LT.0) THEN
        CALL STETER(10,'Column :VAR not found in 2nd table')
      ENDIF
      CALL TBFGET (TID2,ITIME,FORM,LFIELD,TTYP,ISTAT)
      CALL TBFGET (TID2,IDAT, FORM,LFIELD,DTYP,ISTAT)
      CALL TBFGET (TID2,IVAR, FORM,LFIELD,VTYP,ISTAT)
      CALL TBDGET (TID2,ISTORE,ISTAT)
      IF (ISTORE.NE.F_TRANS) THEN
        TEXT='Input table '//INAME2//' stored not transposed'
        CALL STETER(3,TEXT)
      ENDIF
      IF (TTYP.NE.D_R8_FORMAT.OR.DTYP.NE.D_R8_FORMAT.OR.
     $     VTYP.NE.D_R8_FORMAT) THEN
        CALL STETER(4,
     $    'Column(s) in 2nd table must be in DOUBLE PRECISION')
      ENDIF
      CALL TBCMAP (TID2,ITIME,POBS2T,ISTAT)
      CALL TBCMAP (TID2,IDAT, POBS2D,ISTAT)
      CALL TBCMAP (TID2,IVAR, POBS2V,ISTAT)
C
C   Create and map work tables  COBS,NU,CT
C
      ISIZE=(NOBS1+1)*(NOBS1+1)
      CALL STFCRE('ZZMIDAWORK',D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   ISIZE,ICOBS,ISTAT)
      CALL STFMAP(ICOBS,F_X_MODE,1,ISIZE,ASIZE,PCOBS,ISTAT)
      ISIZE=NOBS1+1
      CALL STFCRE('ZZMIDBWORK',D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   ISIZE,INU,  ISTAT)
      CALL STFMAP(INU,  F_X_MODE,1,ISIZE,ASIZE,PNU,ISTAT)
      ISIZE=NOBS1+1
      CALL STFCRE('ZZMIDCWORK',D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   ISIZE,ICT,  ISTAT)
      CALL STFMAP(ICT,  F_X_MODE,1,ISIZE,ASIZE,PCT,ISTAT)
C
C   Interpolate using covariance function
C
      MODE=2
      IF (LLE(CFUNC,'LIN').AND.LGE(CFUNC,'LIN')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    ACFLIN,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'POL').AND.LGE(CFUNC,'POL')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    ACFPOL,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'POW').AND.LGE(CFUNC,'POW')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    ACFPOW,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'EXP').AND.LGE(CFUNC,'EXP')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    ACFEXP,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'LOG').AND.LGE(CFUNC,'LOG')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    ACFLOG,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'IPO').AND.LGE(CFUNC,'IPO')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    ACFIPO,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR0').AND.LGE(CFUNC,'UR0')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR0,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR1').AND.LGE(CFUNC,'UR1')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR1,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR2').AND.LGE(CFUNC,'UR2')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR2,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR3').AND.LGE(CFUNC,'UR3')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR3,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR4').AND.LGE(CFUNC,'UR4')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR4,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR5').AND.LGE(CFUNC,'UR5')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR5,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR6').AND.LGE(CFUNC,'UR6')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR6,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR7').AND.LGE(CFUNC,'UR7')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR7,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR8').AND.LGE(CFUNC,'UR8')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR8,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSEIF (LLE(CFUNC,'UR9').AND.LGE(CFUNC,'UR9')) THEN
        CALL INTERPOL(
     $    MADRID(POBS1T),MADRID(POBS1D),MADRID(POBS1V),
     $    MADRID(POBS2T),MADRID(POBS2D),MADRID(POBS2V),
     $    TSADELUR9,PARM,NOBS1,NOBS2,MODE,AVER,VAR,
     $    MADRID(PCOBS),MADRID(PNU),MADRID(PCT))
      ELSE
        CALL STETER(5,'Wrong name for ACF type')
      ENDIF
      NCOL=3
      CALL TBIPUT (TID2,NCOL,NOBS2,ISTAT)
C
C   Wind-up
C
      CALL DSCUPT(TID2,TID2,' ',ISTAT)
      CALL STSEPI
C
      END
C
C
C
