C @(#)cattab.for	19.1 (ES0-DMD) 02/25/03 13:29:42
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
      SUBROUTINE CATINI(CATNAM,TID)
C++++
C.PURPOSE: Initialize the catalogue table
C.AUTHOR : Rein H. Warmels
C.VERSION: 200289  Creation
C----
      IMPLICIT     NONE
      CHARACTER*60 CATNAM
      INTEGER      TID
      INTEGER      NWCAT
      INTEGER      NCCAT
      INTEGER      NRCAT
      PARAMETER   (NWCAT=15)
      PARAMETER   (NCCAT=14)
      PARAMETER   (NRCAT=10000)
C
      INTEGER      I
      INTEGER      ISTAT
C
      CHARACTER*80 STRING
      CHARACTER*16 CATFOR(NCCAT)
      CHARACTER*16 CATUNI(NCCAT)
      CHARACTER*16 CATLAB(NCCAT)
      INTEGER      CATTYP(NCCAT)
      INTEGER      CATCOL(NRCAT)
      INCLUDE      'MID_INCLUDE:ST_DEF.INC'
C
      INCLUDE      'MID_INCLUDE:ST_DAT.INC'
      DATA         CATFOR/'I8',
     1                    'E12.4', 'E12.4', 'E12.4', 'E12.4',
     2                    'E12.4', 'E12.4', 'E12.4', 'E12.4',
     3                    'E12.4', 'E12.4', 'E12.4', 'E12.4',
     4                    'E12.4'/
      DATA         CATUNI/'     ',
     1                    '     ', '     ', '     ', '     ',
     2                    '     ', '     ', '     ', '     ',
     3                    '     ', '     ', '     ', '     ',
     4                    '     '/
      DATA         CATLAB/'GROUP',
     1                    'X    ', 'Y    ', 'INT   ', 'MAG1  ',
     2                    'MAG2 ', 'MAG3 ', 'BG    ', 'FLAG  ',
     3                    'SIGMA', 'BETA ', 'SAT   ', 'HEIGHT',
     4                    'THRESH'/
C
C *** create the catalogue table
      CALL TBTINI(CATNAM, 0, F_O_MODE, NWCAT, NRCAT, TID, ISTAT)
      IF (ISTAT.NE.0) THEN
         STRING = '*** FATAL: problems with creating the catalogue '//
     2            'table; try again ...'
         CALL STTPUT(STRING,ISTAT)
         CALL STSEPI
      ENDIF
 
      CATTYP(1) = D_I4_FORMAT
      CALL TBCINI(TID, CATTYP(1), 1, CATFOR(1), CATUNI(1),
     2                 CATLAB(1), CATCOL(1), ISTAT)
      DO 30 I = 2,NCCAT
         CATTYP(I) = D_R4_FORMAT
         CALL TBCINI(TID, CATTYP(I), 1, CATFOR(I), CATUNI(I),
     2                    CATLAB(I), CATCOL(I), ISTAT)
   30 CONTINUE

      RETURN
      END


      SUBROUTINE CATDRD(IDEN,INTG1,INTG2,INTG3,REAL4,REAL5,INTG6,INTG7,
     2                  INTG8,INTG9,REAL10,REAL11,REAL12,REAL13,
     3                  INTG14,INTG15)
C+++
C     INTG1:  numero oggetti trovati da quasar
C     INTG2:  finestre gia' determinate
C     INTG3:  puntatore dell'ultimo oggetto esaminato
C     REAL3:  raggio massimo tra gli nst raggi
C     REAL4:  raggio medio tra gli nst raggi
C     INTG5:  origine x assoluta (colonne) della window di lavoro di quasar
C     INTG6:  origine y assoluta (righe) della window
C     INTG7:  punti per linea della window
C     INTG8:  linee della window
C     REAL9:  sigma della moffattiana
C     REAL10: beta della moffattiana
C     INTG11: origine x del file
C     INTG12: origine y del file
C---
      IMPLICIT NONE
      INTEGER  IDEN
      INTEGER  INTG1,INTG2,INTG3
      REAL     REAL4,REAL5
      INTEGER  INTG6,INTG7,INTG8,INTG9
      REAL     REAL10,REAL11,REAL12,REAL13
      INTEGER  INTG14,INTG15
C
      INTEGER  IOUT(9)
      REAL     ROUT(6)
      INTEGER  IACT, KUN, KNUL, ISTAT
C
      INCLUDE      'MID_INCLUDE:ST_DEF.INC/NOLIST'
      INCLUDE      'MID_INCLUDE:ST_DAT.INC/NOLIST'
C     
      CALL STDRDR(IDEN,'CATPAR_R',1,6,IACT,ROUT,KUN,KNUL,ISTAT)
      REAL4  = ROUT(1)
      REAL5  = ROUT(2)
      REAL10 = ROUT(3)
      REAL11 = ROUT(4)
      REAL12 = ROUT(5)
      REAL13 = ROUT(6)
C
      CALL STDRDI(IDEN,'CATPAR_I',1,9,IACT,IOUT,KUN,KNUL,ISTAT)
      INTG1  =  IOUT(1)
      INTG2  =  IOUT(2)
      INTG3  =  IOUT(3)
      INTG6  =  IOUT(4)
      INTG7  =  IOUT(5)
      INTG8  =  IOUT(6)
      INTG9  =  IOUT(7)
      INTG14 =  IOUT(8)
      INTG15 =  IOUT(9)
    
      RETURN
      END


      SUBROUTINE CATDWR(IDEN,INTG1,INTG2,INTG3,REAL4,REAL5,INTG6,INTG7,
     2                  INTG8,INTG9,REAL10,REAL11,REAL12,REAL13,
     3                  INTG14,INTG15)
C+++
C     INTG1:  numero oggetti trovati da quasar
C     INTG2:  finestre gia' determinate
C     INTG3:  puntatore dell'ultimo oggetto esaminato
C     REAL3:  raggio massimo tra gli nst raggi
C     REAL4:  raggio medio tra gli nst raggi
C     INTG5:  origine x assoluta (colonne) della window di lavoro di quasar
C     INTG6:  origine y assoluta (righe) della window
C     INTG7:  punti per linea della window
C     INTG8:  linee della window
C     REAL9:  sigma della moffattiana
C     REAL10: beta della moffattiana
C     INTG11: origine x del file
C     INTG12: origine y del file
C---
      IMPLICIT NONE
      INTEGER  IDEN
      INTEGER  INTG1,INTG2,INTG3
      REAL     REAL4,REAL5
      INTEGER  INTG6,INTG7,INTG8,INTG9
      REAL     REAL10,REAL11,REAL12,REAL13
      INTEGER  INTG14,INTG15
C
      INTEGER  IOUT(9)
      REAL     ROUT(6)
      INTEGER  KUN, ISTAT
C
      INCLUDE      'MID_INCLUDE:ST_DEF.INC/NOLIST'
      INCLUDE      'MID_INCLUDE:ST_DAT.INC/NOLIST'
C     
      ROUT(1)  = REAL4
      ROUT(2)  = REAL5
      ROUT(3)  = REAL10
      ROUT(4)  = REAL11
      ROUT(5)  = REAL12
      ROUT(6)  = REAL13
      CALL STDWRR(IDEN,'CATPAR_R',ROUT,1,6,KUN,ISTAT)
C
      IOUT(1)  = INTG1
      IOUT(2)  = INTG2
      IOUT(3)  = INTG3
      IOUT(4)  = INTG6
      IOUT(5)  = INTG7
      IOUT(6)  = INTG8
      IOUT(7)  = INTG9
      IOUT(8)  = INTG14
      IOUT(9)  = INTG15
      CALL STDWRI(IDEN,'CATPAR_I',IOUT,1,9,KUN,ISTAT)
C    
      RETURN
      END


      SUBROUTINE CATTRD(TID,IROW,IDENT,REAL1,REAL2,REAL3,REAL4,
     2                  REAL5,REAL6,REAL7,REAL8,REAL9,REAL10,REAL11,
     3                  REAL12,REAL13)
C+++
C---
      IMPLICIT      NONE
      INTEGER       TID
      INTEGER       IROW
      INTEGER       IDENT
      REAL          REAL1,REAL2,REAL3,REAL4,REAL5,REAL6,REAL7,
     2              REAL8,REAL9,REAL10,REAL11,REAL12,REAL13
C
      INTEGER       REACOL(13)
      INTEGER       IDNCOL(1)
      INTEGER       ISTAT
      REAL          ROUT(13)
      LOGICAL       KUNIDN
      LOGICAL       KUNREA(13)

      DATA          IDNCOL/1/
      DATA          REACOL/2,3,4,5,6,7,8,9,10,11,12,13,14/
C
      CALL TBRRDI(TID,IROW,1,IDNCOL,IDENT,KUNIDN,ISTAT)
      CALL TBRRDR(TID,IROW,13,REACOL,ROUT,KUNREA,ISTAT)
      REAL1    = ROUT(1)
      REAL2    = ROUT(2)
      REAL3    = ROUT(3)
      REAL4    = ROUT(4)
      REAL5    = ROUT(5)
      REAL6    = ROUT(6)
      REAL7    = ROUT(7)
      REAL8    = ROUT(8)
      REAL9    = ROUT(9)
      REAL10   = ROUT(10)
      REAL11   = ROUT(11)
      REAL12   = ROUT(12)
      REAL13   = ROUT(13)

      RETURN
      END


      SUBROUTINE CATTWR(TID,IROW,IDENT,REAL1,REAL2,REAL3,REAL4,
     2                  REAL5,REAL6,REAL7,REAL8,REAL9,REAL10,
     3                  REAL11,REAL12,REAL13)
C+++
C---
      IMPLICIT      NONE
      INTEGER       TID
      INTEGER       IROW
      INTEGER       IDENT
      REAL          REAL1,REAL2,REAL3,REAL4,REAL5,REAL6,REAL7
      REAL          REAL8,REAL9,REAL10,REAL11,REAL12,REAL13
C
      INTEGER       IDNCOL(1)
      INTEGER       REACOL(13)
      INTEGER       ISTAT
      REAL          ROUT(13)
C
      DATA          IDNCOL/1/
      DATA          REACOL/2,3,4,5,6,7,8,9,10,11,12,13,14/
C
      ROUT(1)  = REAL1
      ROUT(2)  = REAL2
      ROUT(3)  = REAL3
      ROUT(4)  = REAL4
      ROUT(5)  = REAL5
      ROUT(6)  = REAL6
      ROUT(7)  = REAL7
      ROUT(8)  = REAL8
      ROUT(9)  = REAL9
      ROUT(10) = REAL10
      ROUT(11) = REAL11
      ROUT(12) = REAL12
      ROUT(13) = REAL13
      CALL TBRWRI(TID,IROW,1,IDNCOL,IDENT,ISTAT)
      CALL TBRWRR(TID,IROW,13,REACOL,ROUT,ISTAT)

      RETURN
      END
