C @(#)tsasca.for	10.3 (ES0-DMD) 7/9/96 10:07:28
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  @(#)tsasca.for	5.1 (ESO-IPG) 4/5/93 15:58:46
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT (c)  1992     European Southern Observatory and Warsaw Observatory
C.IDENT     tsasca.for
C.AUTHOR    Alex Schwarzenberg-Czerny, ESO and Warsawe Observatory
C.KEYWORD   MIDAS, time series, SCARGLE/TSA
C.LANGUAGE  FORTRAN 77
C.PURPOSE   Compute discrete or Scargle power spectra
C.VERSION   0.0               June 1992
C.RETURNS   None
C.ENVIRON   TSA context
C-----------------------------------------------------------------------------
C
C
      INCLUDE 'MID_REL_INCL:TSA_DEF.INC'
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
C
      REAL*8       START(2)             !  START FREQUENCY
      REAL*8       STEP(2)              !  STEP IN FREQUENCY
      INTEGER      LENGTH(2)            !  NUMBER OF FREQUENCIES
      CHARACTER*60 INAME                !  NAME OF INPUT TABLE
      CHARACTER*60 ONAME                !  NAME OF OUTPUT IMAGE
C
      LOGICAL      SCARGL
      INTEGER      IACTS,KUN,KNUL
      INTEGER      TID,ITIME,IVAL
      INTEGER      NCOL,ICOL,NROW,IROW,ISOR
      INTEGER      LFIELD,TTYP,VTYP
      INTEGER      PTIME,PVAL,PPER,IDPER,
     $   PCMS,IDCMS,PCPS,IDCPS,PCD,IDCD,PSD,IDSD,ASIZE
      CHARACTER*10 FORM
      CHARACTER*80 TEXT
C
      INCLUDE 'MID_REL_INCL:TSA_DAT.INC'
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
      DATA SCARGL/.TRUE./
C
C   Get parameters
C
      CALL STSPRO ('tsasca')
      CALL STKRDC ('IN_A',  1,1,60,IACTS,INAME    ,KUN,KNUL,ISTAT)
      CALL STKRDC ('OUT_A', 1,1,60,IACTS,ONAME    ,KUN,KNUL,ISTAT)
      CALL STKRDD ('STARTTSA',   1, 1,IACTS,START(1) ,KUN,KNUL,ISTAT)
      CALL STKRDD ('STEPTSA',    1, 1,IACTS,STEP(1)  ,KUN,KNUL,ISTAT)
      CALL STKRDI ('NSTEPS',  1, 1,IACTS,LENGTH(1),KUN,KNUL,ISTAT)
C
C   Map input data
C
      CALL TBTOPN (INAME,F_I_MODE,TID,ISTAT)
      CALL TBIGET (TID,NCOL,NROW,ISOR,ICOL,IROW,ISTAT)
      CALL TBLSER (TID,'TIME',ITIME,ISTAT)
      IF (ITIME.LT.0) THEN
        CALL STETER(3,'Column :TIME not found')
      ENDIF
      CALL TBLSER (TID,'VALUE',IVAL,ISTAT)
      IF (IVAL.LT.0) THEN
        CALL STETER(4,'Column :VALUE not found')
      ENDIF
      CALL TBFGET (TID,ITIME,FORM,LFIELD,TTYP,ISTAT)
      CALL TBFGET (TID,IVAL, FORM,LFIELD,VTYP,ISTAT)
      CALL TBDGET (TID,ISTORE,ISTAT)
      IF (ISTORE.NE.F_TRANS) THEN
        TEXT='Input table '//INAME//' stored not transposed'
        CALL STETER(2,TEXT)
      ENDIF
      IF (TTYP.NE.D_R8_FORMAT.OR.VTYP.NE.D_R8_FORMAT) THEN
        CALL STETER(1,
     $    'Data column(s) must be of DOUBLE PRECISION type')
      ENDIF
      CALL TBCMAP (TID,ITIME,PTIME,ISTAT)
      CALL TBCMAP (TID,IVAL, PVAL, ISTAT)
C
C   Map temporary tables CMS,CPS,CD,SD
C
      CALL STFCRE('ZZMIDCMS',D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   NROW,IDCMS, ISTAT)
      CALL STFMAP(IDCMS, F_X_MODE,1,NROW,ASIZE,PCMS, ISTAT)
C
      CALL STFCRE('ZZMIDCPS',D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   NROW,IDCPS, ISTAT)
      CALL STFMAP(IDCPS, F_X_MODE,1,NROW,ASIZE,PCPS, ISTAT)
C
      CALL STFCRE('ZZMIDCD', D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   NROW,IDCD,  ISTAT)
      CALL STFMAP(IDCD,  F_X_MODE,1,NROW,ASIZE,PCD,  ISTAT)
C
      CALL STFCRE('ZZMIDSD',D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,
     $   NROW,IDSD,ISTAT)
      CALL STFMAP(IDSD,  F_X_MODE,1,NROW,ASIZE,PSD,  ISTAT)
C
C   Map output data
C
      LENGTH(2)=2
      START(2)=0.
      STEP(2)=1.
      CALL STIPUT (ONAME,D_R8_FORMAT,F_IO_MODE,
     $    F_IMA_TYPE,2,LENGTH,
     $   START,STEP,ONAME,
     $   'AXIS: 1/TIME DATA: UNITLESS',PPER,IDPER,ISTAT)
C
C   Compute Scargle periodogramme
C
      CALL TIMDFT(MADRID(PTIME),MADRID(PVAL),NROW,
     $    MADRID(PPER),LENGTH(1),MADRID(PCMS),MADRID(PCPS),
     $    MADRID(PCD),MADRID(PSD),START(1),STEP(1),SCARGL)
C
C   Wind-up
C
      CALL DSCUPT(IDPER,IDPER,' ',ISTAT)
      CALL STSEPI
C
      END
C
C
C
C
C