C @(#)setselect.for	17.1.1.1 (ES0-DMD) 01/25/02 17:14:44
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) 1989 European Southern Observatory,
C                                    all rights reserved
C.IDENTIFICATION: SETSELECT
C.PURPOSE:        set select flag in pcat for selected entries
C                 part of ESOLV image retrieval software
C.AUTHOR:         J. Edwin Huizinga
C.LANGUAGE:       F77+ESOext 
C.KEYWORDS:       ESOLV, table, select
C.ALGORITHM: 
C.INPUT/OUTPUT:   N/I/1/1 number of entries selected
C                 INPUTI/I/1/N eso-identifiers
C.VERSION:        890707 JEH creation
C----------------------------------------------------------------------
      PROGRAM SETSELECT
C
C This program is part of the package to copy files from optical disk to
C working directory provided by ESO-LV project. 
C It selects wanted entries in PCAT which will be used in FROMOD.FOR.
C Input from FROMOD.PRG via INPUTI, N.
C
C declarations:
C
      IMPLICIT NONE
      INTEGER     MADRID
      INTEGER     TID,IST,IAV,UNIT
      INTEGER     NCOL,NROW,NSC,ACOL,AROW
      INTEGER     I,ROW,ENTRY,WANTED(20),NWANT
      INTEGER     IFATAL,KUN
C
      CHARACTER   TEXT*80,TABLE*12
C
      LOGICAL     NOP
C
      INCLUDE     'MID_INCLUDE:ST_DEF.INC/NOLIST'
      COMMON      /VMR/MADRID(1)
      INCLUDE     'MID_INCLUDE:ST_DAT.INC/NOLIST'
C
C init MIDAS monitor, get PCAT and NWANT, WANTED eso identifier:
C 
      CALL STSPRO('SETSELECT')
      CALL STKRDC('P1',1,1,12,IAV,TABLE,UNIT,NOP,IST)
      CALL STKRDI('N',1,1,IAV,NWANT,UNIT,NOP,IST)
      IF (NWANT.EQ.0) THEN
         WRITE(TEXT,10) '*** FATAL: No selected entries'
 10      FORMAT(A)
         CALL STTPUT(TEXT,IST)
         IFATAL = 1
         CALL STKWRI('FATAL',IFATAL,1,1,KUN,IST)
         CALL STSEPI
      ENDIF
      CALL STKRDI('INPUTI',1,NWANT,IAV,WANTED,UNIT,NOP,IST)
      CALL TBTOPN(TABLE,F_IO_MODE,TID,IST)
      IF (IST.NE.0) THEN
         WRITE(TEXT,20) TABLE
 20      FORMAT('*** FATAL: Problems opening table ',A)
         CALL STTPUT(TEXT,IST)
         IFATAL = 1
         CALL STKWRI('FATAL',IFATAL,1,1,KUN,IST)
         CALL STSEPI
      ENDIF
      CALL TBIGET(TID,NCOL,NROW,NSC,ACOL,AROW,IST)
C
C initialize by setting all selects to false
C
      DO ROW=1, NROW
         CALL TBSPUT(TID,ROW,0,IST)
      ENDDO
C
C find row numbers in PCAT and set select to true:
C
      DO I=1, NWANT
         CALL TBESRR(TID,1,1.*WANTED(I),0,1,ENTRY,IST)
         IF (ENTRY.EQ.-1) THEN
            WRITE(TEXT,30) 'Entry not found in PCAT: ',WANTED(I)
 30         FORMAT(A,I8)
            CALL STTPUT(TEXT,IST)
         ELSE
            CALL TBSPUT(TID,ENTRY,1,IST)
         ENDIF
      ENDDO
C
C finish MIDAS and close PCAT:
C
      CALL TBTCLO(TID,IST)
      CALL STSEPI
C
C finito:
C
      END