C @(#)ctable.for	19.1 (ES0-DMD) 02/25/03 13:25:32
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.IDENTIFICATION
C  subroutine CTABLE         version 1.1       830916
C  A. Kruszewski             ESO Garching
C  modified                  version 1.2       870304
C  A. Kruszewski             Obs. de Geneve
C.PURPOSE
C  creates a table and writes parameters of detected objects into it
C.INPUT/OUTPUT
C  input parameters
C  NCOL        integer*4         number of table columns
C  NROW        integer*4         number of table rows
C  START       real*8 array      physical coordinates of (1,1) pixel
C  STEP        real*8 array      physical size of one pixel
C  NCAT        integer*4 array   integer parameters
C  PMTR        real*4 array      array holding classifiers
C  PRCT        real*4 array      catalog of objects profiles
C  NP          integer*4         dimension of catalog buffer
C  output parameters
C  IOF         integer*4         output table
C-----------------------------------------------------------------------
      SUBROUTINE CTABLE(IOF,NCOL,NROW,START,STEP, NCAT,
     &                  PMTR, PRCT, NP)
C
      IMPLICIT  NONE
      INCLUDE  'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER        IOF
      INTEGER        NCOL
      INTEGER        NROW
      DOUBLE PRECISION START(2)
      DOUBLE PRECISION STEP(2)
      INTEGER        NP
      INTEGER        NCAT(NIPAR,NP)
      REAL           PMTR(NRPAR,NP) 
      REAL           PRCT(0:MAXSUB,NP)
C
      REAL           PVAL(27+MAXSUB)
      INTEGER        ICOL(MAXSUB+27)
      INTEGER        IPRF, ISTAT
      INTEGER        K
      INTEGER        L
      INTEGER        MADRID(1)
      CHARACTER*16   LABEL(26), UNIT(26), LABELP, UNITP
C
      INCLUDE        'MID_INCLUDE:TABLES.INC'
      COMMON        /VMR/MADRID
      INCLUDE       'MID_INCLUDE:TABLED.INC'
C
      DATA LABEL/'IDENT','X','Y','MAG_CNV','MAG_AP_1','MAG_AP_2',
     &     'REL_GRAD','SIGMA_GR','BG','INT','RADIUS_1','RADIUS_2',
     &     'ELONG','POS_ANG','RAD_ISO','MAG_PET','RAD_PET','RAD_KRON',
     &     'ALPHA','MAG_ISO','CLASS','NR_OTH_OBJ','AR','SIGMA_X',
     &     'SIGMA_Y','SIGMA_MAG'/
      DATA UNIT/'NO_DIM','MICRON','MICRON','MAGNITUDE','MAGNITUDE',
     &      'MAGNITUDE','NO_DIM','NO_DIM','INSTR_UNITS','INSTR_UNITS',
     &      'PIXEL','PIXEL','NO_DIM','DEGREES','PIXEL','MAGNITUDE',
     &      'PIXEL','PIXEL','NO_DIM','MAGNITUDE','NO_DIM','PIXEL',
     &      'PIXEL','PIXEL','PIXEL','NO_DIM'/
C
      UNITP  = 'INSTR_UNITS'
      LABELP = 'PROFILE'
      DO 10 L = 1 , NCOL
          ICOL(L) = L
   10 CONTINUE
C
      DO 20 L = 1 , 26
          CALL TBCINI(IOF, D_R4_FORMAT, 1, 'E12.4', UNIT(L),
     &                LABEL(L), ICOL(L), ISTAT)
   20 CONTINUE
      IPRF = NCOL - 26
      IF (IPRF.GT.0) THEN
         DO 30 L = 27 , NCOL
            CALL TBCINI(IOF, D_R4_FORMAT, 1, 'E12.4', UNITP,
     &                  LABELP, ICOL(L), ISTAT)
   30    CONTINUE
      ENDIF
C
C ****** Write data into output table.
C
      DO 60 K = 1 , NROW
          DO 40 L = 1 , 26
              IF ( L .EQ. 1 ) THEN
                  PVAL(L) = FLOAT(K)
              ELSE IF ( L .EQ. 2 ) THEN
                  PVAL(L) = SNGL( START(1) +
     &                              STEP(1) * DBLE(PMTR(10,K)-1.0) )
              ELSE IF ( L .EQ. 3 ) THEN
                  PVAL(L) = SNGL( START(2) +
     &                              STEP(2) * DBLE(PMTR(11,K)-1.0) )
              ELSE IF ( L .EQ. 4 ) THEN
                  PVAL(L) = PMTR(12,K)
              ELSE IF ( L .EQ. 5 ) THEN
                  PVAL(L) = PMTR(13,K)
              ELSE IF ( L .EQ. 6 ) THEN
                  PVAL(L) = PMTR(20,K)
              ELSE IF ( L .EQ. 7 ) THEN
                  PVAL(L) = PMTR(3,K)
              ELSE IF ( L .EQ. 8 ) THEN
                  PVAL(L) = PMTR(4,K)
              ELSE IF ( L .EQ. 9 ) THEN
                  PVAL(L) = PMTR(1,K)
              ELSE IF ( L .EQ. 10 ) THEN
                  PVAL(L) = PMTR(2,K)
              ELSE IF ( L .EQ. 11 ) THEN
                  PVAL(L) = PMTR(6,K)
              ELSE IF ( L .EQ. 12 ) THEN
                  PVAL(L) = PMTR(7,K)
              ELSE IF ( L .EQ. 13 ) THEN
                  PVAL(L) = PMTR(8,K)
              ELSE IF ( L .EQ. 14 ) THEN
                  PVAL(L) = PMTR(9,K)
              ELSE IF ( L .EQ. 23 ) THEN
                  PVAL(L) = FLOAT( NCAT(5,K) )
              ELSE IF ( L .EQ. 20 ) THEN
                  PVAL(L) = PMTR(5,K)
              ELSE IF ( L .EQ. 22 ) THEN
                  PVAL(L) = FLOAT( NCAT(3,K) )
              ELSE IF ( L .EQ. 24 ) THEN
                  PVAL(L) = PMTR(22,K)
              ELSE IF ( L .EQ. 25 ) THEN
                  PVAL(L) = PMTR(23,K)
              ELSE IF ( L .EQ. 26 ) THEN
                  PVAL(L) = PMTR(24,K)
              ELSE
                  PVAL(L) = PMTR(L,K)
              ENDIF
   40     CONTINUE
          DO 50 L = 27 , NCOL
              PVAL(L) = PRCT(L-27,K)
   50     CONTINUE
          CALL TBRWRR( IOF , K , NCOL , ICOL , PVAL , ISTAT )
   60 CONTINUE
      CALL TBSINI( IOF , ISTAT )
C
      RETURN
C
      END
C
