C @(#)cattab.for 17.1.1.1 (ES0-DMD) 01/25/02 17:17: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 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