SUBROUTINE CDTOUT (
*
*  inputs
*
     :                  TBNAME, COLNAM, UNIT, COLFMT, DTYPE, NCOL,
*
*  outputs
*
     :                  TP, COLIDN, NROWS, STATUS)
*
*  Module number:
*
*  Module name:
*
*  Keyphrase:
*  ----------
*  set up/acquire column identifiers and pointer to table descriptor of output
*  table
*
*  Description:
*  ------------
*  If the output table does not exist, this routine will initialize it,
*  define column names according to the input, and open it.  If the output
*  table does exist, this routine will open the table, check and find
*  identifiers for all columns, and define columns if they do not already
*  exist in the table.  It also gives the pointer to table descriptor and
*  number of rows already written in output table.
*
*  FORTRAN name: CDTOUT.FOR
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*       none
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       none
*  SDAS:
*       UTTACC, UTTOPN, UTPGTI, UTTINN, UTCDEF, UTTCRE, UTCFND, UTTCLO, UMSPUT
*  Others:
*       none
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       05-19-87     J.-C. HSU        design and coding
*     2       09-09-87     J.-C. HSU        new F77 interface
*-------------------------------------------------------------------------------
*
*== input:
*                                       --output table name
        CHARACTER*(*)   TBNAME,
*                                       --column name(s), unit(s), their
*                                       --format(s)
     :                  COLNAM(1), UNIT(1), COLFMT(1)
*                                       --number of columns, data types
        INTEGER         NCOL, DTYPE(1)
*
*== output:
*                                       --pointer to table descripter
        INTEGER         TP,
*                                       --column identifiers
     :                  COLIDN(1),
*                                       --number of rows already written in
*                                       --output table
     :                  NROWS,
*                                       --error status
     :                  STATUS
*
*== local:
*                                       --status
        INTEGER         STATOK,
*                                       --loop index
     :                  I
*                                       --error message
        CHARACTER*130   CONTXT, MESS
        LOGICAL         EXIST
*==========================begin iraf77.inc (without INTEGER*2)=================
*     Include file for the iraf77 FORTRAN interface to the IRAF VOS
*     Get IRAF common into main program
*
      LOGICAL MEMB(1)
      INTEGER MEMI(1)
      INTEGER MEML(1)
      REAL MEMR(1)
      DOUBLE PRECISION MEMD(1)
      COMPLEX MEMX(1)
      EQUIVALENCE (MEMB, MEMI, MEML, MEMR, MEMD, MEMX)
      COMMON /MEM/ MEMD
*
*     File I/O access modes
*
      INTEGER   RDONLY
      PARAMETER (RDONLY = 1)
      INTEGER   RDWRIT
      PARAMETER (RDWRIT = 2)
      INTEGER   WRONLY
      PARAMETER (WRONLY = 3)
      INTEGER   APPEND
      PARAMETER (APPEND = 4)
      INTEGER   NEWFIL
      PARAMETER (NEWFIL = 5)
      INTEGER   TMPFIL
      PARAMETER (TMPFIL = 6)
      INTEGER   NEWCPY
      PARAMETER (NEWCPY = 7)
      INTEGER   NEWIMG
      PARAMETER (NEWIMG = 5)
*
*     codes for data types
*
      INTEGER   TYBOOL
      PARAMETER (TYBOOL = 1)
      INTEGER   TYCHAR
      PARAMETER (TYCHAR = 2)
      INTEGER   TYSHOR
      PARAMETER (TYSHOR = 3)
      INTEGER   TYINT
      PARAMETER (TYINT = 4)
      INTEGER   TYLONG
      PARAMETER (TYLONG = 5)
      INTEGER   TYREAL
      PARAMETER (TYREAL = 6)
      INTEGER   TYDOUB
      PARAMETER (TYDOUB = 7)
      INTEGER   TYCPLX
      PARAMETER (TYCPLX = 8)
      INTEGER   TYUSHT
      PARAMETER (TYUSHT = 11)
      INTEGER   TYUBYT
      PARAMETER (TYUBYT = 12)
*
*     TYTEXT is a special code for the iraf77 interface; it is not in the VOS
*
      INTEGER TYTEXT
      PARAMETER (TYTEXT = 13)
*========================end iraf77.inc=========================================
*======================begin tblpar.inc=========================================
*--Lengths of character strings:
*
*       19  column name
*       19  units for a column
*       7   format for displaying a column
*
*--These may be set by UTPSET and/or read by UTPSTA:
*
*                                       Length of row (unit = size of real)
        INTEGER TBRLEN
        PARAMETER (TBRLEN = 1)
*                                       Increase row length
        INTEGER TBIRLN
        PARAMETER (TBIRLN = 2)
*                                       Number of rows to allocate
        INTEGER TBALLR
        PARAMETER (TBALLR = 3)
*                                       Increase alloc num of rows
        INTEGER TBIALR
        PARAMETER (TBIALR = 4)
*                                       Which type of table? (row or column)
        INTEGER TBWTYP
        PARAMETER (TBWTYP = 5)
*                                       Maximum number of user parameters
        INTEGER TBMXPR
        PARAMETER (TBMXPR = 6)
*                                       Maximum number of columns
        INTEGER TBMXCL
        PARAMETER (TBMXCL = 7)
*                                       type = row-ordered table
        INTEGER TBTYPR
        PARAMETER (TBTYPR = 11)
*                                       type = column-ordered table
        INTEGER TBTYPC
        PARAMETER (TBTYPC = 12)
*
*--These may be read by UTPSTA but may not be set:
*
*                                       Number of rows written to
        INTEGER TBNROW
        PARAMETER (TBNROW = 21)
*                                       Number of columns defined
        INTEGER TBNCOL
        PARAMETER (TBNCOL = 22)
*                                       Amount of row used (unit=size of real)
        INTEGER TBRUSD
        PARAMETER (TBRUSD = 23)
*                                       Number of user parameters
        INTEGER TBNPAR
        PARAMETER (TBNPAR = 24)
*==========================end tblpar.inc=======================================
*=========================begin hsp.inc=========================================
*                                       --status return code
        INTEGER         OK, ERRNUM(20)
        INTEGER         DEST, PRIO
        DATA OK /0/
        DATA ERRNUM /701, 702, 703, 704, 705, 706, 707, 708, 709, 710,
     :               711, 712, 713, 714, 715, 716, 717, 718, 719, 720/
*                                       --message destination and priority
        DATA DEST, PRIO /1, 0/
*=========================end hsp.inc===========================================
*------------------------------------------------------------------------------
*
*  check if the table exists
*
        CALL UTTACC (TBNAME,     EXIST, STATOK)
*
*  if table already exists, open it, get number of existing rows
*
        IF (EXIST) THEN
            CALL UTTOPN (TBNAME, RDWRIT,     TP, STATUS)
*
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot open existing table ' // TBNAME
                GO TO 999
            END IF
*
            CALL UTPGTI (TP, TBNROW,     NROWS, STATUS)
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot get number of rows of table ' // TBNAME
            GO TO 999
        END IF
*
*  check column names, get their identifiers, and if nonexistent, create them
*
            CALL UTCFND (TP, COLNAM, NCOL,    COLIDN, STATOK)
*
            IF (STATOK .NE. OK) THEN
                DO 10 I = 1, NCOL
                    IF (COLIDN(I) .LE. 0) THEN
                        CALL UTCDEF (TP, COLNAM(I), UNIT(I), COLFMT(I),
     :                               DTYPE(I), 1,    COLIDN(I), STATUS)
                        IF (STATUS .NE. OK) THEN
                            CONTXT = 'cannot create column '// COLNAM(I)
                            CALL UTTCLO (TP, STATOK)
                            GO TO 999
                        END IF
                    END IF
   10           CONTINUE
            END IF
*
*  if table does not exist, initialize it, define all columns and open it
*
        ELSE
            CALL UTTINN (TBNAME,    TP, STATUS)
*
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot initialize table ' // TBNAME
                GO TO 999
            END IF
*
            CALL UTCDEF (TP, COLNAM, UNIT, COLFMT, DTYPE, 
     :                   NCOL,    COLIDN, STATUS)
*
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot define column(s)'
                CALL UTTCLO (TP,     STATOK)
                GO TO 999
            END IF
*
            CALL UTTCRE (TP,     STATUS)
*
            IF (STATUS .NE. OK) THEN
                CONTXT = 'cannot open table ' // TBNAME
                CALL UTTCLO (TP, STATOK)
                GO TO 999
            END IF
*
            NROWS = 0
*
        END IF
*
        STATUS = OK
        GO TO 1000
*
*  write error message
*
  999   MESS = 'CDTOUT: ' // CONTXT
        CALL UMSPUT (MESS, DEST, PRIO,     STATOK)
*
 1000   RETURN
        END