C @(#)ccdhotpix.for	17.1.1.1 (ES0-DMD) 01/25/02 17:49:55
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 @(#)ccdhotpix.for	17.1.1.1 (ESO-SDAG) 01/25/02 17:49:55
       PROGRAM HOTPIX
C+++
C.IDENTIFICATION: ccdhottab.for
C.PURPOSE: Analayse the bad pixels table from FIND/PIXEL and construct the
C          hot pixel table
C.AUTHOR:  R.H Warmels, ESO-SDAG
C.VERSION: 940531   RHW Creation
C----
      IMPLICIT       NONE
C
      INTEGER        NCOL
      PARAMETER      (NCOL=3)
      INTEGER        NCOL1
      PARAMETER      (NCOL1=2)
      INTEGER        NROW
      PARAMETER      (NROW=100)
C ***
      INTEGER        ISTAT, IAC, IC, IR, IROUT
      INTEGER        COLUMNS(NCOL)
      INTEGER        KUN, KNUL
      INTEGER        MADRID(1)
      INTEGER        NRIN,NCIN,NACIN,NARIN,NSIN
      INTEGER        OUTCOL
      INTEGER        TIDIN,TIDOUT
      INTEGER        LFIELD,CTYPE
C ***
      REAL           CVAL1(NCOL), CVAL2(NCOL)
      REAL           EPS
      LOGICAL        NULL(NCOL)
C ***
      CHARACTER*60   INTAB,OUTTAB
      CHARACTER*16   CUNI,CLAB,CFRM
      CHARACTER*80   STRING
C ***
      INCLUDE        'MID_INCLUDE:TABLES.INC'
      COMMON         /VMR/MADRID
      INCLUDE        'MID_INCLUDE:TABLED.INC'
C ***
      DATA           COLUMNS/1,2,3/
      DATA           EPS/1.0e-12/
C----------------------------------------------------------------------------
      CALL STSPRO('HOTPIX')
C
C *** get the input
      CALL STKRDC('IN_A',1,1,60,IAC,INTAB,KUN,KNUL,ISTAT)
      CALL STKRDC('OUT_A',1,1,60,IAC,OUTTAB,KUN,KNUL,ISTAT)
C
C ***
      CALL TBTOPN(INTAB,F_I_MODE,TIDIN,ISTAT)
      IF (ISTAT.NE.0) THEN
         STRING = '*** FATAL: Error opening input table'
         CALL STTPUT(STRING,ISTAT)
         CALL STSEPI
      ENDIF
C
      CALL TBIGET(TIDIN,NCIN,NRIN,NSIN,NACIN,NARIN,ISTAT)
      IF (ISTAT.NE.0) THEN
         STRING = '*** FATAL: Problems with getting table info '//
     2            'of intermediate table'
         CALL STTPUT(STRING,ISTAT)
         CALL STSEPI
      ENDIF
      IF (NRIN.EQ.0) THEN
         STRING = '*** FATAL: There are no data in the input table'
         CALL STTPUT(STRING,ISTAT)
         CALL STSEPI
      ENDIF
C
C *** create the hot pixel table
      CALL TBTINI(OUTTAB,1,F_O_MODE,NCOL,NROW,TIDOUT,ISTAT)
      IF (ISTAT.NE.0) THEN
         STRING = '*** FATAL:  Problems with opening hot pixel table'
         CALL STTPUT(STRING,ISTAT)
         CALL STSEPI
      ENDIF
C
C *** Create the output table
      DO IC = 1, NCOL
          CALL TBFGET(TIDIN,IC,CFRM,LFIELD,CTYPE,ISTAT)
          CALL TBUGET(TIDIN,IC,CUNI,ISTAT)
          CALL TBLGET(TIDIN,IC,CLAB,ISTAT)
          CALL TBCINI(TIDOUT,CTYPE,1,CFRM,CUNI,CLAB,OUTCOL,ISTAT)    
      ENDDO
C
      CALL TBRRDR(TIDIN,1,NCOL,COLUMNS,CVAL1,NULL,ISTAT)
      CALL TBRWRR(TIDOUT,1,NCOL,COLUMNS,CVAL1,ISTAT)
      IROUT = 1
      DO IR = 2,NRIN
         CALL TBRRDR(TIDIN,IR,NCOL,COLUMNS,CVAL2,NULL,ISTAT)
         IF (ABS(CVAL2(1)-CVAL1(1)) .GT. EPS) THEN
            IROUT = IROUT + 1
            CALL TBRWRR(TIDOUT,IROUT,NCOL,COLUMNS,CVAL2,ISTAT)
            DO IC = 1,NCOL
               CVAL1(1) = CVAL2(1)
               CVAL1(2) = CVAL2(2)
               CVAL1(3) = CVAL2(3)
            ENDDO
         ENDIF
      ENDDO
C
C *** read the input and store first entry in output table
      CALL TBTCLO(TIDIN,ISTAT)
      CALL TBTCLO(TIDOUT,ISTAT)
      CALL STSEPI
      END