path: root/noao/astcat/src/agetcat/atfcat.x

include <ctotok.h>
include <ctype.h>
include <evvexpr.h>
include <imhdr.h>
include <pkg/cq.h>
include <pkg/skywcs.h>
include "../../lib/astrom.h"
include "../../lib/acatalog.h"

##############################################################################

# Create a small data structure to describe the field list. Decide whether
# this should be part of the main astrometry package structure later ...

define	FL_FLENGTH	12

define	FL_NEXPR	Memi[$1]	# The number of input expressions
define	FL_NFIELDS	Memi[$1+1]	# The number of output fields

# The field list decription
define	FL_FLIST	Memi[$1+2]	# The list of field expressions
define	FL_FRANGES	Memi[$1+3]	# The list of field ranges

# New quantities to be written in the header (could be a symbol table ...)
define	FL_FNAMES	Memi[$1+4]	# The list of field names
define	FL_FOFFSETS	Memi[$1+5]	# The list of field offsets
define	FL_FSIZES	Memi[$1+6]	# The list of field sizes
define	FL_FTYPES	Memi[$1+7]      # The list of field types
define	FL_FUNITS	Memi[$1+8]	# The list of field units
define	FL_FFMTS	Memi[$1+9]	# The list of field formats

# Useful constants
define	FL_MAX_NEXPR	20
define	FL_MAX_NFIELDS	100
define	FL_SZ_EXPR	SZ_LINE

##############################################################################

# AT_WIFILRECS -- Filter and write the output catalog.

procedure at_wifilrecs (fd, im, at, res, standard)

int	fd			#I the output file descriptor
pointer	im			#I the associated input image descriptor
pointer	at			#I the astrometry package descriptor
pointer	res			#I results descriptor
bool	standard		#I write a standard catalog header

double	raval, decval, oraval, odecval, iraval, idecval, xpval, ypval
pointer	sp, sexpr, sfield, record, raname, decname, sindex
pointer	flist, o, catcoo, outcoo, imcoo, mwim, ct
int	i, nlines, nrecs, rafield, decfield, xpfield, ypfield, xcfield, ycfield
pointer	at_flinit(), evvexpr(), locpr(), mw_sctran()
int	at_wfcathdr(), cq_rstati(), at_srtcat(), at_flnexpr(), cq_grecord()
int	cq_setrecord(), at_wcathdr(), at_mkrecord(), cq_gvald()
bool	streq()
extern	at_getop()

int	nchars

begin
	call smark (sp)
	call salloc (sexpr, FL_SZ_EXPR, TY_CHAR)
	call salloc (sfield, FL_SZ_EXPR, TY_CHAR)
	call salloc (record, SZ_LINE, TY_CHAR)
	call salloc (raname, FL_SZ_EXPR, TY_CHAR)
	call salloc (decname, FL_SZ_EXPR, TY_CHAR)

        # Initialize the catalog, output, and image coordinate systems.
	# and set up the image world to logical coordinate transformation.
	call at_cowcs (at, res, im, catcoo, outcoo, imcoo, mwim)
	if (imcoo != NULL)
	    ct = mw_sctran (mwim, "world", "logical", 03B)

	# Determine whether it is necessary to reformat.
	call at_stats (at, FIELDS, Memc[record], SZ_LINE)
	if (streq (Memc[record], "f[*]") && outcoo == NULL) {

	    # The field list is NULL.
	    flist = NULL

	    # Write the filtered catalog header.
	    if (standard)
	        nlines = at_wcathdr (fd, res)

	    # Coordinate fields are not modified.
	    rafield = 0
	    decfield = 0
	    xpfield = 0
	    ypfield = 0
	    xcfield = 0
	    ycfield = 0

	} else {

	    # Decode the output field list.
	    flist = at_flinit (at, res)

	    # Write the filtered catalog header.
	    if (standard)
	        nlines = at_wfcathdr (fd, at, res, flist)

	    # Get the offsets for the ra, dec, xp, yp, xc, and yc output fields.
	    call at_coofields (at, res, flist, Memc[raname], Memc[decname],
	        rafield, decfield, xpfield, ypfield, xcfield, ycfield)
	    if (outcoo == NULL) {
	        rafield = 0
	        decfield = 0
	    }
	    if (imcoo == NULL) {
	        xpfield = 0
	        ypfield = 0
	    }
	    xcfield = 0
	    ycfield = 0
	}

	# Compute the sort index.
	nrecs = cq_rstati (res, CQRNRECS)
	call malloc (sindex, nrecs, TY_INT)
	nrecs = at_srtcat (at, res, Memi[sindex], nrecs)

	# Get the selection expression and replace generic selection expression
	# field names with their catalog equivalents.
	call at_stats (at, FEXPR, Memc[sexpr], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[sexpr], i, Memc[sfield], FL_SZ_EXPR) == EOF)
	    Memc[sfield] = EOS

	# Loop over the sorted records. Note that any reference to
	# coordinates in the selection expression refers to the original
	# not the transformed coordinates. 

	o = NULL
	do i = 1, nrecs {

	    # Reject every record.
	    if (streq (Memc[sfield], "no"))
		next

	    # Evaluate the selection expression.
	    if (! streq (Memc[sfield], "yes")) {
	        if (cq_setrecord (res, Memi[sindex+i-1]) != Memi[sindex+i-1])
		    next
	        if (o != NULL)
		    call evvfree (o)
	        o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0)
		if (O_TYPE(o) != TY_BOOL)
		    next
		if (O_VALI(o) == NO)
		    next
	    }

	    # Write the record.
	    if (flist == NULL) {

		# Copy the record.
	        nchars = cq_grecord (res, Memc[record], SZ_LINE,
		    Memi[sindex+i-1])

	    } else {

		# Get the ra and dec fields.
		raval = INDEFD
		decval = INDEFD
		if (outcoo != NULL || imcoo != NULL) {
		    if (cq_gvald (res, Memi[sindex+i-1], Memc[raname],
		        raval) <= 0)
		        raval = INDEFD
		    if (cq_gvald (res, Memi[sindex+i-1], Memc[decname],
		        decval) <= 0)
		        decval = INDEFD
		}

		# Transform the catalog coordinates to the output coordinate
		#  system.
		oraval = INDEFD
		odecval = INDEFD
		if (outcoo != NULL && (rafield > 0 || decfield > 0)) {
		    if (! IS_INDEFD(raval) && ! IS_INDEFD(decval))
			call sk_ultran (catcoo, outcoo, raval, decval, oraval,
			    odecval, 1)
		}

		# Transform the catalog coordinates to the image coordinate
		# system and then to the image pixel coordinate system.
		xpval = INDEFD
		ypval = INDEFD
		if (imcoo != NULL && (xpfield > 0 || ypfield > 0)) {
		    if (! IS_INDEFD(raval) && ! IS_INDEFD(decval)) {
			call sk_ultran (catcoo, imcoo, raval, decval, iraval,
			    idecval, 1)
			call mw_c2trand (ct, iraval, idecval, xpval, ypval) 
			if (xpval < 0.5d0 || xpval > (IM_LEN(im,1)+0.5d0) ||
			    ypval < 0.5d0 || ypval > (IM_LEN(im,2)+0.5d0))
			    next
		    } else {
			xpval = INDEFD
			ypval = INDEFD
		    }
		}

		# Reformat the record.
		nchars = at_mkrecord (flist, res, Memc[record], SZ_LINE,
		    Memi[sindex+i-1], rafield, decfield, oraval, odecval,
		    xpfield, ypfield, xpval, ypval) 

	    }

	    # Write the new record.
            if (nchars > 0) {
	        call fprintf (fd, "%s")
	            call pargstr (Memc[record])
	    }
	}

	# Free the selection expression descriptor.
	if (o != NULL)
	    call evvfree (o)

	# Free the catalog, output, and image coordinate system descriptors.
	if (catcoo != NULL)
	    call sk_close (catcoo)
	if (outcoo != NULL)
	    call sk_close (outcoo)
	if (imcoo != NULL)
	    call sk_close (imcoo)
	if (mwim != NULL)
	    call mw_close (mwim)

	# Free output field list.
	if (flist != NULL)
	    call at_flfree (flist)

	# Free thesort index descriptor.
	call mfree (sindex, TY_INT)

	call sfree (sp)
end


# AT_WFILRECS -- Filter and write the output catalog.

procedure at_wfilrecs (fd, at, res, standard)

int	fd			#I the output file descriptor
pointer	at			#I the astrometry package descriptor
pointer	res			#I results descriptor
bool	standard		#I write a standard catalog header

double	raval, decval, oraval, odecval, iraval, idecval, xpval, ypval
pointer	sp, sexpr, sfield, record, raname, decname, sindex
pointer	flist, o, catcoo, outcoo, imcoo, mwim, ct
int	i, nlines, nrecs, rafield, decfield, xpfield, ypfield, xcfield, ycfield
pointer	at_flinit(), evvexpr(), locpr(), mw_sctran()
int	at_wfcathdr(), cq_rstati(), at_srtcat(), at_flnexpr(), cq_grecord()
int	cq_setrecord(), at_wcathdr(), at_mkrecord(), cq_gvald()
bool	streq()
extern	at_getop()

int	nchars

begin
	call smark (sp)
	call salloc (sexpr, FL_SZ_EXPR, TY_CHAR)
	call salloc (sfield, FL_SZ_EXPR, TY_CHAR)
	call salloc (record, SZ_LINE, TY_CHAR)
	call salloc (raname, FL_SZ_EXPR, TY_CHAR)
	call salloc (decname, FL_SZ_EXPR, TY_CHAR)

        # Initialize the catalog, output, and field  coordinate systems
	# and set up the image world to logical coordinate transformation.
	call at_cowcs (at, res, NULL, catcoo,  outcoo, imcoo, mwim)
	if (imcoo != NULL)
	    ct = mw_sctran (mwim, "world", "logical", 03B)

	# Determine whether it is necessary to reformat.
	call at_stats (at, FIELDS, Memc[record], SZ_LINE)
	if (streq (Memc[record], "f[*]") && outcoo == NULL) {

	    # The field list is NULL.
	    flist = NULL

	    # Write the filtered catalog header.
	    if (standard)
	        nlines = at_wcathdr (fd, res)

	    # Coordinate fields are not altered.
	    rafield = 0
	    decfield = 0
	    xpfield = 0
	    ypfield = 0
	    xcfield = 0
	    ycfield = 0

	} else {

	    # Decode the output field list.
	    flist = at_flinit (at, res)

	    # Write the filtered catalog header.
	    if (standard)
	        nlines = at_wfcathdr (fd, at, res, flist)

	    # Get the offsets for the ra, dec, xp, yp, xc, and yc output fields.
	    call at_coofields (at, res, flist, Memc[raname], Memc[decname],
	        rafield, decfield, xpfield, ypfield, xcfield, ycfield)
	    if (outcoo == NULL) {
	        rafield = 0
	        decfield = 0
	    }
	    if (imcoo == NULL) {
	        xpfield = 0
	        ypfield = 0
	    }
	    xcfield = 0
	    ycfield = 0
	}

	# Compute the sort index.
	nrecs = cq_rstati (res, CQRNRECS)
	call malloc (sindex, nrecs, TY_INT)
	nrecs = at_srtcat (at, res, Memi[sindex], nrecs)

	# Get the selection expression and replace generic selection expression
	# field names with their catalog equivalents.
	call at_stats (at, FEXPR, Memc[sexpr], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[sexpr], i, Memc[sfield], FL_SZ_EXPR) == EOF)
	    Memc[sfield] = EOS

	# Loop over the sorted records. Note that any reference to
	# coordinates in the selection expression refers to the original
	# not the transformed coordinates. 

	o = NULL
	do i = 1, nrecs {

	    # Reject every record.
	    if (streq (Memc[sfield], "no"))
		next

	    # Evaluate the selection expression.
	    if (! streq (Memc[sfield], "yes")) {
	        if (cq_setrecord (res, Memi[sindex+i-1]) != Memi[sindex+i-1])
		    next
	        if (o != NULL)
		    call evvfree (o)
	        o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0)
		if (O_TYPE(o) != TY_BOOL)
		    next
		if (O_VALI(o) == NO)
		    next
	    }

	    # Write the record.
	    if (flist == NULL) {

		# Copy the record.
	        nchars = cq_grecord (res, Memc[record], SZ_LINE,
		    Memi[sindex+i-1])

	    } else {

		# Get the ra and dec fields.
		raval = INDEFD
		decval = INDEFD
		if (outcoo != NULL || imcoo != NULL) {
		    if (cq_gvald (res, Memi[sindex+i-1], Memc[raname],
		        raval) <= 0)
		        raval = INDEFD
		    if (cq_gvald (res, Memi[sindex+i-1], Memc[decname],
		        decval) <= 0)
		        decval = INDEFD
		}

		# Transform the catalog coordinates to the output coordinate
		#  system.
		oraval = INDEFD
		odecval = INDEFD
		if (outcoo != NULL && (rafield > 0 || decfield > 0)) {
		    if (! IS_INDEFD(raval) && ! IS_INDEFD(decval))
			call sk_ultran (catcoo, outcoo, raval, decval, oraval,
			    odecval, 1)
		}

		# Transform the catalog coordinates to the image coordinate
		# system and then to the image pixel coordinate system.
		xpval = INDEFD
		ypval = INDEFD
		if (imcoo != NULL && (xpfield > 0 || ypfield > 0)) {
		    if (! IS_INDEFD(raval) && ! IS_INDEFD(decval)) {
			call sk_ultran (catcoo, imcoo, raval, decval, iraval,
			    idecval, 1)
			call mw_c2trand (ct, iraval, idecval, xpval, ypval) 
		    } else {
			xpval = INDEFD
			ypval = INDEFD
		    }
		}

		# Reformat the record.
		nchars = at_mkrecord (flist, res, Memc[record], SZ_LINE,
		    Memi[sindex+i-1], rafield, decfield, oraval, odecval,
		    xpfield, ypfield, xpval, ypval) 

	    }

	    # Write the new record.
            if (nchars > 0) {
	        call fprintf (fd, "%s")
	            call pargstr (Memc[record])
	    }
	}

	# Free the selection expression descriptor.
	if (o != NULL)
	    call evvfree (o)

	# Free the catalog, output, and field coordinate system descriptors.
	if (catcoo != NULL)
	    call sk_close (catcoo)
	if (outcoo != NULL)
	    call sk_close (outcoo)
	if (imcoo != NULL)
	    call sk_close (imcoo)
	if (mwim != NULL)
	    call mw_close (mwim)

	# Free output field list.
	if (flist != NULL)
	    call at_flfree (flist)

	# Free thesort index descriptor.
	call mfree (sindex, TY_INT)

	call sfree (sp)
end


# AT_FCATHDR -- Write the filtered catalog header

int procedure at_wfcathdr (fd, at, res, fl)

int	fd			#I the output file descriptor
pointer	at			#I the astrometry pacakge descriptor
pointer	res			#I the results descriptor descriptor
pointer	fl			#I the output field list descriptor

pointer	sp, catname, qpnames, qpvalues, qpunits, fname, fvalue, funits
int	i, nlines, nfields
int	cq_rstati(), at_wrdstr(), cq_hinfon()
char	cq_itype()
bool	streq(), strne()

begin
	nlines = 0

        # Allocate working space.
        call smark (sp)
        call salloc (catname, SZ_FNAME, TY_CHAR)
        call salloc (qpnames, SZ_LINE, TY_CHAR)
        call salloc (qpvalues, SZ_LINE, TY_CHAR)
        call salloc (qpunits, SZ_LINE, TY_CHAR)
        call salloc (fname, CQ_SZ_QPNAME, TY_CHAR)
        call salloc (fvalue, CQ_SZ_QPVALUE, TY_CHAR)
        call salloc (funits, CQ_SZ_QPUNITS, TY_CHAR)

        # Write the header banner.
        call fprintf (fd, "# BEGIN CATALOG HEADER\n")
        nlines = nlines + 1

        # Write the catalog database and id.
        call cq_rstats (res, CQRCATDB, Memc[catname], SZ_FNAME)
        call fprintf (fd, "# catdb %s\n")
            call pargstr (Memc[catname])
        nlines = nlines + 1
        call cq_rstats (res, CQRCATNAME, Memc[catname], SZ_FNAME)
        call fprintf (fd, "# catname %s\n")
            call pargstr (Memc[catname])
        nlines = nlines + 1

        # Write out the query parameter names, values, and units used
        # to generate the catalog.
        call cq_rstats (res, CQRQPNAMES, Memc[qpnames], SZ_LINE)
        call cq_rstats (res, CQRQPVALUES, Memc[qpvalues], SZ_LINE)
        call cq_rstats (res, CQRQPUNITS, Memc[qpunits], SZ_LINE)
        nfields = cq_rstati (res, CQRNQPARS)
        call fprintf (fd, "# nquery %d\n")
            call pargi (nfields)
        nlines = nlines + 1
        do i = 1, nfields {
            if (at_wrdstr (i, Memc[fname], CQ_SZ_QPNAME, Memc[qpnames]) != i)
                ;
            if (at_wrdstr (i, Memc[fvalue], CQ_SZ_QPVALUE, Memc[qpvalues]) != i)
                ;
            if (at_wrdstr (i, Memc[funits], CQ_SZ_QPUNITS, Memc[qpunits]) != i)
                ;
            call fprintf (fd, "#     %s %s %s\n")
                call pargstr (Memc[fname])
                call pargstr (Memc[fvalue])
                call pargstr (Memc[funits])
            nlines = nlines + 1
        }

        # Write out the results format type.
        if (at_wrdstr (cq_rstati(res, CQRTYPE), Memc[fvalue], CQ_SZ_QPVALUE,
            CQ_RTYPESTR) <= 0)
            call strcpy ("stext", Memc[fvalue], CQ_SZ_QPVALUE)
        call fprintf (fd, "# type %s\n")
            call pargstr (Memc[fvalue])
        nlines = nlines + 1

        # Write out the header parameters,
        nfields = cq_rstati (res, CQNHEADER)
        call fprintf (fd, "# nheader %d\n")
            call pargi (nfields)
        nlines = nlines + 1
        do i = 1, nfields {
            if (cq_hinfon (res, i, Memc[fname], CQ_SZ_QPNAME, Memc[fvalue],
                CQ_SZ_QPVALUE) != i)
                next
			
	     # Check for a changed coordinate system here
	     if (streq ("csystem", Memc[fname])) {
		call at_stats (at, FOSYSTEM, Memc[qpvalues], SZ_LINE)
		if (Memc[qpvalues] != EOS && strne (Memc[qpvalues],
		    Memc[fvalue]))
		    call strcpy (Memc[qpvalues], Memc[fvalue], CQ_SZ_QPVALUE)
	     }

            call fprintf (fd, "#     %s %s\n")
                call pargstr (Memc[fname])
                call pargstr (Memc[fvalue])
            nlines = nlines + 1
        }

	# Write out the field desription.
	nfields = FL_NFIELDS(fl)
        call fprintf (fd, "# nfields %d\n")
            call pargi (nfields)
	do i = 0, nfields - 1 {
            call fprintf (fd, "#     %s %d %d %c %s %s\n")
                call pargstr (Memc[FL_FNAMES(fl)+i*(CQ_SZ_QPNAME+1)])
                call pargi (Memi[FL_FOFFSETS(fl)+i])
                call pargi (Memi[FL_FSIZES(fl)+i])
                call pargc (cq_itype (Memi[FL_FTYPES(fl)+i]))
                call pargstr (Memc[FL_FUNITS(fl)+i*(CQ_SZ_QPUNITS+1)])
                call pargstr (Memc[FL_FFMTS(fl)+i*(CQ_SZ_QPFMTS+1)])
            nlines = nlines + 1
	}

        # Write the header trailer.
        call fprintf (fd, "# END CATALOG HEADER\n#\n")
        nlines = nlines + 1

	call sfree (sp)

	return (nlines)
end


# AT_SRTCAT -- Sort the catalog on the user specified field.

int procedure at_srtcat (at, res, sindex, max_nrecs)

pointer	at			#I the astrometry package descriptor
pointer	res			#I results descriptor
int	sindex[ARB]		#O the output sort index 
int	max_nrecs		#I the maximum number of records

double	dval
pointer	sp, sexpr, sfield, sname, sval, darray, carray, o
int	i, ip, nrecs, stype, snum, nchars, sz_carray
pointer	evvexpr(), locpr()
int	ctotok(), cq_fnumber(), cq_ftype(), cq_fname(), ctoi(), cq_gvald()
int	cq_gvalc(), gstrcpy(), cq_setrecord(), at_flnexpr(), at_stati()
bool	streq()
extern	at_getop()

begin
	call smark (sp)
	call salloc (sexpr, FL_SZ_EXPR, TY_CHAR)
	call salloc (sfield, FL_SZ_EXPR, TY_CHAR)
	call salloc (sname, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (sval, SZ_LINE, TY_CHAR)

	# Get the sort expression.
	call at_stats (at, FSORT, Memc[sexpr], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[sexpr], i, Memc[sfield], FL_SZ_EXPR) == EOF)
	    Memc[sfield] = EOS

	# Return initialized index array if the sort expression is undefined.
	if (Memc[sfield] == EOS) {
	    do i = 1, max_nrecs
	        sindex[i] = i
	    call sfree (sp)
	    return (max_nrecs)
	}

	# Determine the type of sort. If sfield and sname are identical
	# sort expression is a field, otherwise it is an expression which
	# must be evaluated.
	ip = 1
	if (ctotok (Memc[sfield], ip, Memc[sname], CQ_SZ_QPNAME) ==
	    TOK_IDENTIFIER)
	    ;

	# Initialize the sort index array.
	do i = 1, max_nrecs
	    sindex[i] = i

	# The sort expression is a simple field. 
	if (streq (Memc[sfield], Memc[sname])) {

	    if (cq_fnumber (res, Memc[sfield]) > 0) {    # Catalog field name
	        stype = cq_ftype (res, Memc[sfield])
	    } else if (Memc[sfield] == 'f') {            # Generic f# name
		ip = 2
		if (ctoi (Memc[sfield], ip, snum) <= 0)
		    stype = INDEFI
		else if (cq_fname (res, snum, Memc[sname], CQ_SZ_FNAME) <= 0)
		    stype = INDEFI
		else
	            stype = cq_ftype (res, Memc[sname])
	    } else {                                     # Unknown name.
		stype = INDEFI
	    }

	    # Do the sort.
	    if (IS_INDEFI(stype)) {		# Field is undecodable.
		nrecs = max_nrecs

	    } else if (stype == TY_CHAR) {      # Character sort.
		sz_carray = 10 * SZ_LINE
		call malloc (carray, sz_carray, TY_CHAR)  
		ip = 1
		do i = 1, max_nrecs {
		    nchars = cq_gvalc (res, i, Memc[sname], Memc[sval],
		        SZ_LINE) 
		    if (nchars > sz_carray - ip + 1) {
			sz_carray = sz_carray + 10 * SZ_LINE
			call realloc (carray, sz_carray, TY_CHAR)
		    }
		    sindex[i] = ip
		    ip = ip + gstrcpy (Memc[sval], Memc[carray+ip-1], nchars)
		    Memc[carray+ip-1] = EOS
		    ip = ip + 1
		}
		call at_ssquick (Memc[carray], sindex, sindex, max_nrecs)
		call mfree (carray, TY_CHAR)
		nrecs = max_nrecs

	    } else {                            # Numeric sort.
		call malloc (darray, max_nrecs, TY_DOUBLE)
		do i = 1, max_nrecs {
		    nchars = cq_gvald (res, i, Memc[sname], dval) 
		    if (nchars <= 0)
			Memd[darray+i-1] = INDEFD
		    else
			Memd[darray+i-1] = dval
		}
		call at_qsortd (Memd[darray], sindex, sindex, max_nrecs)
		call mfree (darray, TY_DOUBLE)
		nrecs = max_nrecs
	    }

	# The sort field is an expression which must be evaluated.
	} else {

	    # Determine the data type of the output from the first record.
	    if (cq_setrecord (res, 1) != 1)
		;
	    o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0)
	    stype = O_TYPE(o)
	    call evvfree (o)

	    if (stype == 0)                  # Expression cannot be decoded.
		nrecs = max_nrecs
	    else if (stype == TY_CHAR || stype == TY_BOOL) {
		sz_carray = 10 * SZ_LINE
		call malloc (carray, sz_carray, TY_CHAR)  
		ip = 1
		do i = 1, max_nrecs {
	            if (cq_setrecord (res, i) != i)
			break
	    	    o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0)
		    if (O_LEN(o) > sz_carray - ip + 1) {
			sz_carray = sz_carray + 10 * SZ_LINE
			call realloc (carray, sz_carray, TY_CHAR)
		    }
		    sindex[i] = ip
		    ip = ip + gstrcpy (O_VALC(o), Memc[carray+ip-1], O_LEN(o))
		    Memc[carray+ip-1] = EOS
		    ip = ip + 1
	    	    call evvfree (o)
		}

		call at_ssquick (Memc[carray], sindex, sindex, max_nrecs)
		call mfree (carray, TY_CHAR)
		nrecs = max_nrecs
	    } else {
		call malloc (darray, max_nrecs, TY_DOUBLE)
		do i = 1, max_nrecs {
	            if (cq_setrecord (res, i) != i)
			break
	    	    o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0)
		    switch (O_TYPE(o)) {
		    case TY_SHORT:
			dval = O_VALS(o)
		    case TY_INT:
			dval = O_VALI(o)
		    case TY_LONG:
			dval = O_VALL(o)
		    case TY_REAL:
			dval = O_VALR(o)
		    case TY_DOUBLE:
		        dval = O_VALD(o)
		    default:
			dval = INDEFD
		    }
		    Memd[darray+i-1] = dval
	    	    call evvfree (o)
		}
		call at_qsortd (Memd[darray], sindex, sindex, max_nrecs)
		call mfree (darray, TY_DOUBLE)
		nrecs = max_nrecs
	    }

	}

	# Flip the index array if the sense of the sort is reversed.
	if (at_stati (at, FREVERSE) == YES) {
	    do i = 1, nrecs / 2 {
		ip = sindex[i]
		sindex[i] = sindex[nrecs-i+1]
		sindex[nrecs-i+1] = ip
	    }
	}

	call sfree (sp)

	return (nrecs)
end


# AT_COWCS -- Initialize the catalog and output coordinate system
# descriptors.

procedure at_cowcs (at, res, im, catcoo, outcoo, imcoo, mwim)

pointer	at			#I the astrometry package descriptor
pointer	res			#I the catalog results descriptor
pointer	im			#I the associated image descriptor
pointer	catcoo			#O the output catalog system descriptor
pointer	outcoo			#O the output output system descriptor
pointer imcoo			#O the output image system descriptor
pointer	mwim			#O the output image mwcs descriptor

pointer	sp, csystem, cfield, fra, fdec, mw
int	i, catstat, outstat, imstat
int	cq_hinfo(), sk_decwcs(), strdic(), at_wrdstr(), sk_stati()
int	at_stati(), sk_decim()

begin
	call smark (sp)
	call salloc (csystem, SZ_LINE, TY_CHAR)
	call salloc (cfield, SZ_LINE, TY_CHAR)
	call salloc (fra, SZ_FNAME, TY_CHAR)
	call salloc (fdec, SZ_FNAME, TY_CHAR)

	# Get the catalog system.
	if (cq_hinfo (res, "csystem", Memc[csystem], SZ_LINE) <= 0)
	    call strcpy ("", Memc[csystem], SZ_LINE)

	# Open the catalog system.
        catstat = sk_decwcs (Memc[csystem], mw, catcoo, NULL)
        if (catstat == ERR || mw != NULL) {
            #call eprintf (
		#"Error: Cannot decode the catalog coordinate system\n")
            if (mw != NULL)
                call mw_close (mw)
	    call sk_close (catcoo)
	    catcoo = NULL
	    imcoo = NULL
	    outcoo = NULL
	    call sfree (sp)
	    return
	}


	# Get and set the ra catalog coordinate units.
	call at_stats (at, FIRA, Memc[fra], SZ_FNAME)
	call cq_funits (res, Memc[fra], Memc[cfield], SZ_LINE)
	i = strdic (Memc[cfield], Memc[cfield], SZ_LINE, SKY_LNG_UNITLIST) 
	if (i > 0)
	    call sk_seti (catcoo, S_NLNGUNITS, i)

	# Get and set the dec catalog coordinate units.
	call at_stats (at, FIDEC, Memc[fdec], SZ_FNAME)
	call cq_funits (res, Memc[fdec], Memc[cfield], SZ_LINE)
	i = strdic (Memc[cfield], Memc[cfield], SZ_LINE, SKY_LAT_UNITLIST) 
	if (i > 0)
	    call sk_seti (catcoo, S_NLATUNITS, i)

	# Open the output coordinate system if the output coordinate system is
	# different from the catalog coordinate system or the units are
	# different.
	call at_stats (at, FOSYSTEM, Memc[csystem], SZ_LINE)
	if (Memc[csystem] != EOS || at_stati(at,FORAUNITS) > 0 || at_stati(at,
	    FODECUNITS) > 0) {

	    if (Memc[csystem] == EOS)
                outstat = sk_decwcs (Memc[csystem], mw, outcoo, catcoo)
	    else
                outstat = sk_decwcs (Memc[csystem], mw, outcoo, NULL)

            if (outstat == ERR || mw != NULL) {
                #call eprintf (
		    #"Error: Cannot decode the output coordinate system\n")
                if (mw != NULL)
                    call mw_close (mw)
		call sk_close (outcoo)
	        outcoo = NULL
            } else {

		# Set the output catalog ra units.
		i = at_stati (at, FORAUNITS)
		if (i <= 0) {
		    Memc[cfield] = EOS
		} else if (at_wrdstr (i, Memc[cfield], SZ_LINE,
		    AT_RA_UNITS) <= 0) {
		    Memc[cfield] = EOS
		}
		if (Memc[cfield] == EOS) {
		    call sk_seti (outcoo, S_NLNGUNITS, sk_stati (catcoo,
		        S_NLNGUNITS))
		} else {
		    i = strdic (Memc[cfield], Memc[cfield], FL_SZ_EXPR,
		        SKY_LNG_UNITLIST)
		    if (i > 0)
		        call sk_seti (outcoo, S_NLNGUNITS, i)
		    else
		        call sk_seti (outcoo, S_NLNGUNITS, sk_stati(catcoo,
		            S_NLNGUNITS))
		}

		# Set the output catalog dec units.
		i = at_stati (at, FODECUNITS)
		if (i <= 0) {
		    Memc[cfield] = EOS
		} else if (at_wrdstr (i, Memc[cfield], SZ_LINE,
		    AT_DEC_UNITS) <= 0) {
		    Memc[cfield] = EOS
		}
		if (Memc[cfield] == EOS) {
		    call sk_seti (outcoo, S_NLATUNITS, sk_stati (catcoo,
		        S_NLATUNITS))
		} else {
		    i = strdic (Memc[cfield], Memc[cfield], SZ_LINE,
			SKY_LAT_UNITLIST)
		    if (i > 0)
		        call sk_seti (outcoo, S_NLATUNITS, i)
		    else
			call sk_seti (outcoo, S_NLATUNITS, sk_stati(catcoo,
			   S_NLATUNITS))
		}

	    }
	} else {
	    outcoo = NULL
	}

	# Open the image coordinate system.
	if (im == NULL) {
	    imcoo = NULL
	    mwim = NULL
	} else {
	    imstat = sk_decim (im, "logical", mwim, imcoo)
	    if (imstat == ERR || mwim == NULL) {
                if (mwim != NULL)
                    call mw_close (mwim)
		mwim = NULL
		call sk_close (outcoo)
	        outcoo = NULL
	    } else {
		call sk_seti (imcoo, S_NLNGUNITS, SKY_DEGREES)
		call sk_seti (imcoo, S_NLATUNITS, SKY_DEGREES)
	    }
	}

	call sfree (sp)
end


# AT_COOFIELDS -- Get the sequence number of the coordinate output fields.

procedure at_coofields (at, res, flist, raname, decname, rafield, decfield,
    xpfield, ypfield, xcfield, ycfield) 


pointer	at			#I the astrometry package descriptor
pointer	res			#I the output results descriptor
pointer	flist			#I the output field list descriptor
char	raname[ARB]		#O the catalog ra name
char	decname[ARB]		#O the catalog dec name
int	rafield			#O the output ra field no
int	decfield		#O the output dec field no
int	xpfield			#O the output xp field no
int	ypfield			#O the output yp field no
int	xcfield			#O the output xp field no
int	ycfield			#O the output yp field no

pointer	sp, xpname, ypname, str
int	i
int	at_flnexpr(), cq_fnumber()
bool	streq()

begin
	# Get working space.
	call smark (sp)
	call salloc (xpname, FL_SZ_EXPR, TY_CHAR)
	call salloc (ypname, FL_SZ_EXPR, TY_CHAR)
	call salloc (str, FL_SZ_EXPR, TY_CHAR)

	# Initialize.
	rafield = 0
	decfield = 0
	xpfield = 0
	ypfield = 0
	xcfield = 0
	ycfield = 0

	# Get the ra and dec field names.
	call at_stats (at, FIRA, Memc[str], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[str], i, raname, FL_SZ_EXPR) == EOF)
	    raname[1] = EOS
	call at_stats (at, FIDEC, Memc[str], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[str], i, decname, FL_SZ_EXPR) == EOF)
	    decname[1] = EOS

	# Get the predicted x and y field names.
	call at_stats (at, FIXP, Memc[str], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[str], i, Memc[xpname], FL_SZ_EXPR) == EOF)
	    Memc[xpname] = EOS
	call at_stats (at, FIYP, Memc[str], FL_SZ_EXPR)
	i = 1
	if (at_flnexpr (res, Memc[str], i, Memc[ypname], FL_SZ_EXPR) == EOF)
	    Memc[ypname] = EOS

	# Get the center x and y field names. Ignore this for now.

	# Check to see whether the field names are in the input catalog
	# and whether at least one of them is in the output catalog.
	if (cq_fnumber (res, raname) > 0 && cq_fnumber (res, decname) > 0) {
	    do i = 0, FL_NFIELDS(flist) - 1 {
		if (streq (raname, Memc[FL_FNAMES(flist)+i*
		    (CQ_SZ_QPNAME+1)])) {
		    rafield = i + 1
		} else if (streq (decname, Memc[FL_FNAMES(flist)+i*
		    (CQ_SZ_QPNAME+1)])) {
		    decfield = i + 1
		} else if (streq (Memc[xpname], Memc[FL_FNAMES(flist)+i*
		    (CQ_SZ_QPNAME+1)])) {
		    xpfield = i + 1
		} else if (streq (Memc[ypname], Memc[FL_FNAMES(flist)+i*
		    (CQ_SZ_QPNAME+1)])) {
		    ypfield = i + 1
		}
		#if (rafield > 0 && decfield > 0)
		    #break
	    }
	}

	call sfree (sp)
end


# AT_MKRECORD -- Format the output catalog record.

int procedure at_mkrecord (flist, res, record, maxch, recno, rafield, decfield,
	raval, decval, xpfield, ypfield, xpval, ypval) 

pointer	flist				#I the output field list descriptor
pointer	res				#I the output results descriptor
char	record[ARB]			#O the output record
int	maxch				#I the maximum size of a record
int	recno				#I the current record number
int	rafield				#I the output ra field
int	decfield			#I the output dec field
double	raval				#I the input ra value
double	decval				#I the input dec value
int	xpfield				#I the output predicted x field
int	ypfield				#I the output predicted y field
double	xpval				#I the input predicted x value
double	ypval				#I the input predicted y value

pointer	sp, newval, eptr, rptr, o
int	i, j, k, op, findex, nchars
pointer	evvexpr(), locpr()
int	gstrcpy(), cq_rstati(), cq_gvalc(), strlen()
extern	at_getop()

begin
	call smark (sp)
	call salloc (newval, SZ_LINE, TY_CHAR)

	# Initialize.
	findex = 0
	op = 1
	record[op] = EOS
	o = NULL
	eptr = FL_FLIST(flist)
	rptr = FL_FRANGES(flist)

	# Loop over the expressions.
	do i = 1, FL_NEXPR(flist) {

	    # The output field is an expression.
	    if (IS_INDEFI(Memi[rptr])) {

		# Evaluate the expression.
		if (xpfield == (findex + 1)) {
		    call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		        findex * (CQ_SZ_QPFMTS + 1)])
			call pargd (xpval)
		} else if (ypfield == (findex + 1)) {
		    call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		        findex * (CQ_SZ_QPFMTS + 1)])
			call pargd (ypval)
		} else {

		    if (o != NULL)
		        call evvfree (o)
		    o = evvexpr (Memc[eptr], locpr (at_getop), res, 0, res, 0)

		    # Encode the expression in a string.
		    switch (O_TYPE(o)) {
		    case TY_CHAR:
		        call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		            findex * (CQ_SZ_QPFMTS + 1)])
			    call pargstr (O_VALC(o))
		    case TY_INT:
		        call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		            findex * (CQ_SZ_QPFMTS + 1)])
			    call pargi (O_VALI(o))
		    case TY_REAL:
		        call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		            findex * (CQ_SZ_QPFMTS + 1)])
			    call pargr (O_VALR(o))
		    case TY_DOUBLE:
		        call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		            findex * (CQ_SZ_QPFMTS + 1)])
			    call pargd (O_VALD(o))
		    default:
		        call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+
		            findex * (CQ_SZ_QPFMTS + 1)])
			    call pargstr (O_VALC(o))
		    }
		}

		# Copy the string to the output record.
		if (Memi[FL_FSIZES(flist)+findex] == 0) {
		    op = op + gstrcpy (" ", record[op], maxch - op + 1)
		    op = op + gstrcpy (Memc[newval], record[op], maxch - op + 1)
		    op = op + gstrcpy (" ", record[op], maxch - op + 1)
		} else {
		    nchars = min (Memi[FL_FSIZES(flist)+findex],
		        strlen (Memc[newval]))
		    do k = 1, Memi[FL_FSIZES(flist)+findex] - nchars - 1 {
			if (op > maxch)
			    break
			record[op] = ' '
			op = op + 1
		    }
		    op = op + gstrcpy (Memc[newval], record[op], min (nchars,
		        maxch - op + 1))
		    op = op + gstrcpy (" ", record[op], maxch - op + 1)
		}

		findex = findex + 1

	    # The field expression are input catalog columns.
	    } else if (Memi[rptr] >= 1 && Memi[rptr+1] <= cq_rstati (res,
		CQNFIELDS)) {

		# Loop over the fields in each range.
		do j = max (1, Memi[rptr]), min (Memi[rptr+1], cq_rstati(res,
		    CQNFIELDS)), Memi[rptr+2] {

		    # Encode the record values.
		    if (rafield == (findex + 1)) {
		        call sprintf (Memc[newval], SZ_LINE,
			    Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)])
			    call pargd (raval)
			nchars = strlen (Memc[newval])
		    } else if (decfield == (findex + 1)) {
		        call sprintf (Memc[newval], SZ_LINE,
			    Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)])
			    call pargd (decval)
			nchars = strlen (Memc[newval])
		    } else if (xpfield == (findex + 1)) {
		        call sprintf (Memc[newval], SZ_LINE,
			    Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)])
			    call pargd (xpval)
			nchars = strlen (Memc[newval])
		    } else if (ypfield == (findex + 1)) {
		        call sprintf (Memc[newval], SZ_LINE,
			    Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)])
			    call pargd (ypval)
			nchars = strlen (Memc[newval])
		    } else {
			nchars = cq_gvalc (res, recno, Memc[FL_FNAMES(flist)+
			    findex*(CQ_SZ_QPNAME+1)], Memc[newval], SZ_LINE)
		    }

		    # Copy the string to the output record.
		    if (Memi[FL_FSIZES(flist)+findex] == 0) {
			if ((j == 1) && (! IS_WHITE(Memc[newval])))
		            op = op + gstrcpy (" ", record[op], maxch - op + 1)
			else if (rafield == (findex + 1) || decfield ==
			    (findex + 1) || xpfield == (findex + 1) ||
			    ypfield == (findex + 1))
		            op = op + gstrcpy (" ", record[op], maxch - op + 1)
		        op = op + gstrcpy (Memc[newval], record[op],
			    maxch - op + 1)
			if (rafield == (findex + 1) || decfield ==
			    (findex + 1) || xpfield == (findex + 1) ||
			    ypfield == (findex + 1))
		            op = op + gstrcpy (" ", record[op], maxch - op + 1)
		    } else {
		        nchars = min (Memi[FL_FSIZES(flist)+findex], nchars)
		        do k = 1, Memi[FL_FSIZES(flist)+findex] - nchars - 1 {
			    if (op > maxch)
			        break
			    record[op] = ' '
			    op = op + 1
		        }
		        op = op + gstrcpy (Memc[newval], record[op],
			    min (nchars, maxch - op + 1))
		        op = op + gstrcpy (" ", record[op], maxch - op + 1)
		    }

		    findex = findex + 1
		}
	    }

	    # Increment the expression and ranges pointers.
	    eptr = eptr + FL_SZ_EXPR + 1
	    rptr = rptr + 3
	}
	if (o != NULL)
	    call evvfree (o)

	# Append a newline and EOS to the data.
	if (record[1] != EOS) {
	    record[op] = '\n'
	    record[op+1] = EOS
	}

	call sfree (sp)

	return (op - 1)
end


# AT_NFLIST -- Add new fields to the current output field list and optionally
# specify the field names, field types, field units, and field formats.

procedure at_nflist (at, nfields, nfnames, nftypes, nfunits, nformats, append)

pointer	at			#I the astrometry package descriptors
int	nfields			#I the number of new fields
char	nfnames[ARB]		#I the new field names list
char	nftypes[ARB]		#I the new field types list
char	nfunits[ARB]		#I the new field units list
char	nformats[ARB]		#I the new field formats list
bool	append			#I append the new fields

pointer	sp, str1, str2
int	i, op1, op2
int	gstrcpy(), strlen

begin
	call smark (sp)
	call salloc (str1, SZ_LINE, TY_CHAR)
	call salloc (str2, SZ_LINE, TY_CHAR)

	# Set the new output field expressions to INDEF and retrieve the
	# original user fields value.
	call at_stats (at, FIELDS, Memc[str1], SZ_LINE)
	op1 = strlen (Memc[str1])
	op2 = 0
	do i = 1, nfields {
	    if (i == 1) {
		op2 = op2 + gstrcpy ("INDEF", Memc[str2+op2], SZ_LINE - op2) 
	    } else {
		op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) 
		op2 = op2 + gstrcpy ("INDEF", Memc[str2+op2], SZ_LINE - op2) 
	    }
	}

	# Construct the new output fields string.
	if (append) {
	    op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1)
	    op1 = op1 + gstrcpy (Memc[str2], Memc[str1+op1], SZ_LINE - op1)
	    call at_sets (at, FIELDS, Memc[str1])
	} else {
	    op2 = op 2+ gstrcpy (",", Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2)
	    call at_sets (at, FIELDS, Memc[str2])
	}

	# Construct the new field names.
	call at_stats (at, FNAMES, Memc[str1], SZ_LINE)
	op1 = strlen (Memc[str1])
	op2 = 0
	if (append) {
	    op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1)
	    op1 = op1 + gstrcpy (nfnames, Memc[str1+op1], SZ_LINE - op1)
	    call at_sets (at, FNAMES, Memc[str1])
	} else {
	    op2 = op2 + gstrcpy (nfnames, Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2)
	    call at_sets (at, FNAMES, Memc[str2])
	}

	# Construct the new field types.
	call at_stats (at, FNTYPES, Memc[str1], SZ_LINE)
	op1 = strlen (Memc[str1])
	op2 = 0
	if (append) {
	    op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1)
	    op1 = op1 + gstrcpy (nftypes, Memc[str1+op1], SZ_LINE - op1)
	    call at_sets (at, FNTYPES, Memc[str1])
	} else {
	    op2 = op2 + gstrcpy (nftypes, Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2)
	    call at_sets (at, FNTYPES, Memc[str2])
	}

	# Construct the new field units.
	call at_stats (at, FNUNITS, Memc[str1], SZ_LINE)
	op1 = strlen (Memc[str1])
	op2 = 0
	if (append) {
	    op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1)
	    op1 = op1 + gstrcpy (nfunits, Memc[str1+op1], SZ_LINE - op1)
	    call at_sets (at, FNUNITS, Memc[str1])
	} else {
	    op2 = op2 + gstrcpy (nfunits, Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2)
	    call at_sets (at, FNUNITS, Memc[str2])
	}

	# Construct the new field units.
	call at_stats (at, FNFORMATS, Memc[str1], SZ_LINE)
	op1 = strlen (Memc[str1])
	op2 = 0
	if (append) {
	    op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1)
	    op1 = op1 + gstrcpy (nformats, Memc[str1+op1], SZ_LINE - op1)
	    call at_sets (at, FNFORMATS, Memc[str1])
	} else {
	    op2 = op2 + gstrcpy (nformats, Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2)
	    op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2)
	    call at_sets (at, FNFORMATS, Memc[str2])
	}

	call sfree (sp)
end


# AT_FLINIT -- Initialize the field list structure. This routines: 1)
# creates a list of fields, field ranges, and field expressions, 2) determines
# whether an output field is an input field or a field expression, and 3)
# assembles the information required to write a catalog header.


pointer procedure at_flinit (at, res)

pointer	at			#I the astrometry package descriptor
pointer	res			#I results descriptor

pointer	sp, fields
pointer	fl
int	nexpr, nfields
int	at_flelist(), at_flranges()

begin
	# Get some working space.
	call smark (sp)
	call salloc (fields, SZ_LINE, TY_CHAR)

	# Get the user field list.
	call at_stats (at, FIELDS, Memc[fields], SZ_LINE)

	# Allocate the field list descriptor.
	call calloc (fl, FL_FLENGTH, TY_STRUCT)

	# Create the field expression list.
	nexpr = at_flelist (res, Memc[fields], fl)
	if (nexpr > 0) {

	    # Determine which individual fields are to be output.
	    nfields = at_flranges (res, fl)

	    # Compile the new header info.
	    if (nfields > 0)
		call at_flflist (at, res, fl)
	}

	call sfree (sp)

	return (fl)
end


# AT_FLFREE -- Free the field list structure.

procedure at_flfree (fl)

pointer	fl			#I the field list descriptor

begin
	if (FL_FLIST(fl) != NULL)
	    call mfree (FL_FLIST(fl), TY_CHAR)
	if (FL_FRANGES(fl) != NULL)
	    call mfree (FL_FRANGES(fl), TY_STRUCT)

	if (FL_FNAMES(fl) != NULL)
	    call mfree (FL_FNAMES(fl), TY_CHAR)
	if (FL_FOFFSETS(fl) != NULL)
	    call mfree (FL_FOFFSETS(fl), TY_INT)
	if (FL_FSIZES(fl) != NULL)
	    call mfree (FL_FSIZES(fl), TY_INT)
	if (FL_FTYPES(fl) != NULL)
	    call mfree (FL_FTYPES(fl), TY_INT)
	if (FL_FUNITS(fl) != NULL)
	    call mfree (FL_FUNITS(fl), TY_CHAR)
	if (FL_FFMTS(fl) != NULL)
	    call mfree (FL_FFMTS(fl), TY_CHAR)

	call mfree (fl, TY_STRUCT)
end


# AT_FLELIST -- Create the expression list from the user field list.

int procedure at_flelist (res, fields, fl)

pointer	res			#I the results descriptor
char	fields[ARB]		#I the user field list
pointer	fl			#O the field list descriptor

int	i, ip, fp, nexpr
int	at_flnexpr()

begin
	# Allocate space for the expression list.
	call malloc (FL_FLIST(fl), FL_MAX_NEXPR * (FL_SZ_EXPR + 1), TY_CHAR)

	# Decode the user field list into a list of comma separated
	# expressions. Expressions may be field names (e.g. "ra" or "f2"),
	# field ranges (e.g. "f[*]" or "f[1-4]"), or field expressions
	# (e.g. "f2 - f3" or "mag2 - mag1").

	ip = 1
	fp = FL_FLIST(fl)
	nexpr = 0
	do i = 1, FL_MAX_NEXPR {
	    if (at_flnexpr (res, fields, ip, Memc[fp], FL_SZ_EXPR) == EOF)
		break
	    #call strlwr (Memc[fp])
	    fp = fp + FL_SZ_EXPR + 1
	    nexpr = nexpr + 1
	}
	call realloc (FL_FLIST(fl), nexpr * (FL_SZ_EXPR + 1), TY_CHAR)
	FL_NEXPR(fl) = nexpr

	return (nexpr)
end


# AT_FLNEXPR -- Get the next expression from an expression list.

int procedure at_flnexpr (res, exprlist, ip, expr, maxch)

pointer	res			#I pointer to the results descriptor
char    exprlist[ARB]           #I the input expression list
int     ip                      #I pointer into the expression list 
char    expr[ARB]               #O the output expression
int     maxch                   #I maximum length of the output expression

int     ep, op, token, fnum
int     ctotok(), strlen(), cq_fnumber(), ctoi(), cq_rstati(), cq_fname()

begin
        # Decode the column labels.
        op = 1
        while (exprlist[ip] != EOS) {

            token = ctotok (exprlist, ip, expr[op], maxch)
            if (expr[op] == EOS)
                next

            if ((token == TOK_PUNCTUATION) && (expr[op] == ',')) {
                if (op == 1)
                    next
                else
                    break
            }

	    # Replace generic identifiers with their catalog equivalents.
	    if (token == TOK_IDENTIFIER) {
	        fnum = cq_fnumber (res, expr[op])
		if (fnum <= 0 && expr[op] == 'f') {
		    ep = 2
		    if (ctoi (expr[op], ep, fnum) <= 0)
			fnum = 0
		    if (fnum < 1 || fnum > cq_rstati (res, CQRNRECS))
			fnum = 0
		    if (fnum > 0) {
			if (cq_fname (res, fnum, expr[op], maxch) != fnum)
			    ;
		    }
		}
	    }


            op = op + strlen (expr[op])
        }

        expr[op] = EOS
        if ((exprlist[ip] == EOS) && (op == 1))
            return (EOF)
        else
            return (op - 1)
end


# AT_FLNITEM -- Get the next expression from an expression list.

int procedure at_flnitem (itemlist, ip, item, maxch)

char    itemlist[ARB]           #I the input item list
int     ip                      #I pointer into the item list 
char    item[ARB]               #O the output item
int     maxch                   #I maximum length of the output item

int     op, token
int     ctotok(), strlen()

begin
        # Decode the column labels.
        op = 1
        while (itemlist[ip] != EOS) {

            token = ctotok (itemlist, ip, item[op], maxch)
            if (item[op] == EOS)
                next

            if ((token == TOK_PUNCTUATION) && (item[op] == ',')) {
                if (op == 1)
                    next
                else
                    break
            }

            op = op + strlen (item[op])
        }

        item[op] = EOS
        if ((itemlist[ip] == EOS) && (op == 1))
            return (EOF)
        else
            return (op - 1)
end


# AT_FLRANGES -- Get the field ranges for each output field. 

int procedure at_flranges (res, fl)

pointer	res			#I the results descriptor
pointer	fl			#I the field list descriptor

pointer	sp, fname, fptr, rptr
int	i, nin, nout, lindex, rindex, ip1, ip2, f1, f2
char	lbracket, rbracket
int	cq_rstati(), strldx(), ctoi(), ctotok(), cq_fnumber()
bool	streq()
data	lbracket /'['/, rbracket /']'/

begin
	# Allocate working space.
	call smark (sp)
	call salloc (fname, FL_SZ_EXPR, TY_CHAR)

	# Allocate space for the ranges list.
	call calloc (FL_FRANGES(fl), 3 * FL_NEXPR(fl) + 1, TY_INT)

	# Initialize.
	nin = cq_rstati (res, CQNFIELDS)
	nout = 0

	# Loop over the expressions. Fields which cannot be decoded
	# have zero-valued range entries. Expression fields have INDEFI
	# valued range entries.
	fptr = FL_FLIST(fl)
	rptr = FL_FRANGES(fl)
	do i = 1, FL_NEXPR (fl) {

	    lindex = strldx (lbracket, Memc[fptr])
	    rindex = strldx (rbracket, Memc[fptr])
	    ip1 = 1
	    ip2 = lindex + 1

	    # Decode generic field ranges.
	    if (Memc[fptr] == 'f' && lindex == 2 && rindex > lindex) {

		# Find the range limits.
		if (Memc[fptr+lindex] == '*') {
		    f1 = 1
		    f2 = nin 
		} else {
		    if (ctoi (Memc[fptr], ip2, f1) <= 0)
			f1 = 0
		    else if (f1 < 1 || f1 > nin)
			f1 = 0
		    if (ctoi (Memc[fptr], ip2, f2) <= 0)
			f2 = 0
		    else
			f2 = -f2
		    if (f2 < 1 || f2 > nin)
			f2 = 0
		}

		# Valid range.
		if (f1 > 0 && f2 > f1) {
		    Memi[rptr] = f1
		    Memi[rptr+1] = f2
		    Memi[rptr+2] = 1
		    nout = nout + f2 - f1 + 1

		# Field cannot be decoded.
		} else {
		    Memi[rptr] = 0
		    Memi[rptr+1] = 0
		    Memi[rptr+2] = 0
		}

	    # Decode fields and expressions.
	    } else if (ctotok (Memc[fptr], ip1, Memc[fname], FL_SZ_EXPR) ==
	        TOK_IDENTIFIER) {

		# Find the field number.
		f1 = cq_fnumber (res, Memc[fptr])
		if (f1 <= 0 && streq (Memc[fptr], Memc[fname])) {
		    if (Memc[fptr] != 'f')
			f1 = 0
		    else {
		        f2 = 1
		        if (ctoi (Memc[fptr+1], f2, f1) <= 0)
			    f1 = 0
		        else if (f1 < 1 || f1 > nin)
			    f1 = 0
		    }
		}

		# Valid single field.
		if (f1 > 0) {
		    Memi[rptr] = f1
		    Memi[rptr+1] = f1
		    Memi[rptr+2] = 1
		    nout = nout + 1

		# Field is an expression.
		} else if (ctotok (Memc[fptr], ip1, Memc[fname],
		    FL_SZ_EXPR) != TOK_EOS) {
		    Memi[rptr] = INDEFI
		    Memi[rptr+1] = INDEFI
		    Memi[rptr+2] = INDEFI
		    nout = nout + 1

		# Field cannot be decoded.
		} else {
		    Memi[rptr] = 0
		    Memi[rptr+1] = 0
		    Memi[rptr+2] = 0
		}

	    # What's left over is an expression field.
	    } else {

		Memi[rptr] = INDEFI
		Memi[rptr+1] = INDEFI
		Memi[rptr+2] = INDEFI
		nout = nout + 1
	    }

	    fptr = fptr + FL_SZ_EXPR + 1
	    rptr = rptr + 3
	}

	# Store the field counts.
	FL_NFIELDS(fl) = nout

	call sfree (sp)

	return (nout)
end


# AT_FLFLIST -- Assemble the field header info for the new catalog.

procedure at_flflist (at, res, fl)

pointer	at			#I the astrometry package descriptor
pointer	res			#I the results descriptor
pointer	fl			#I the field list descriptor

pointer	sp, fnames, fntypes, fnunits, fnfmts, franame, fdecname, xpname
pointer	ypname, xcname, ycname, str, rptr
int	i, j, ip, nfields, fnp, ftp, fup, ffp, rtype, foffset, ival
int	cq_rstati(), ctotok(), at_dtype(), ctoi(), cq_finfon()
int	at_wrdstr(), at_stati(), at_flnitem()
bool	streq(), strne()

begin
	# Get the number of output fields.
	nfields = FL_NFIELDS(fl)
	if (nfields <= 0)
	    return

	# Get some working space.
	call smark (sp)
	call salloc (fnames, SZ_LINE, TY_CHAR)
	call salloc (fntypes, SZ_LINE, TY_CHAR)
	call salloc (fnunits, SZ_LINE, TY_CHAR)
	call salloc (fnfmts, SZ_LINE, TY_CHAR)
	call salloc (franame, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (fdecname, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (xpname, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (ypname, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (xcname, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (ycname, CQ_SZ_QPNAME, TY_CHAR)
	call salloc (str, SZ_FNAME, TY_CHAR)

	# Get the user parameters defining the names, types, units, and
	# formats of the new fields.
	call at_stats (at, FNAMES, Memc[fnames], SZ_LINE)
	call at_stats (at, FNTYPES, Memc[fntypes], SZ_LINE)
	call at_stats (at, FNUNITS, Memc[fnunits], SZ_LINE)
	call at_stats (at, FNFORMATS, Memc[fnfmts], SZ_LINE)
	fnp = 1
	ftp = 1
	fup = 1
	ffp = 1

	# Get the special coordinate field names.
	call at_stats (at, FIRA, Memc[franame], CQ_SZ_FNAME)
	call at_stats (at, FIDEC, Memc[fdecname], CQ_SZ_FNAME)
	call at_stats (at, FIXP, Memc[xpname], CQ_SZ_FNAME)
	call at_stats (at, FIYP, Memc[ypname], CQ_SZ_FNAME)
	call at_stats (at, FIXC, Memc[xcname], CQ_SZ_FNAME)
	call at_stats (at, FIYC, Memc[ycname], CQ_SZ_FNAME)

	# Allocate space for the header field names, offsets, sizes, data
	# types, units, and formats.
	call calloc (FL_FNAMES(fl), nfields * (CQ_SZ_QPNAME + 1), TY_CHAR)
	call calloc (FL_FOFFSETS(fl), nfields, TY_INT)
	call calloc (FL_FSIZES(fl), nfields, TY_INT)
	call calloc (FL_FTYPES(fl), nfields, TY_INT)
	call calloc (FL_FUNITS(fl), nfields * (CQ_SZ_QPUNITS + 1), TY_CHAR)
	call calloc (FL_FFMTS(fl), nfields * (CQ_SZ_QPFMTS + 1), TY_CHAR)

	# Get the output type. This is the same as the input type.
	rtype = cq_rstati (res, CQRTYPE)

	# Loop over the ranges list.
	nfields = 0
	foffset = 1
	rptr = FL_FRANGES(fl)
	do i = 1, FL_NEXPR(fl) {

	    # Skip non-decodable fields.
	    if (Memi[rptr] == 0) {
		rptr = rptr + 3
		next
	    }

	    # The field is an input catalog field.
	    if (! IS_INDEFI (Memi[rptr])) {

		do j = Memi[rptr], Memi[rptr+1] {

		    # Get the field name, the field offset, size, data type,
		    # units and default format.
		    if (cq_finfon (res, j, Memc[FL_FNAMES(fl)+nfields*
		        (CQ_SZ_QPNAME+1)], CQ_SZ_QPNAME, Memi[FL_FOFFSETS(fl)+
			nfields], Memi[FL_FSIZES(fl)+nfields],
			Memi[FL_FTYPES(fl)+nfields],
			Memc[FL_FUNITS(fl)+nfields*(CQ_SZ_QPUNITS+1)],
			CQ_SZ_QPUNITS, Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) != j)
			;

		    # Correct the field offset and field size.
		    switch (rtype) {
		    case CQ_STEXT:
			Memi[FL_FOFFSETS(fl)+nfields] = nfields + 1
			Memi[FL_FSIZES(fl)+nfields] = 0
		    case CQ_BTEXT:
			Memi[FL_FOFFSETS(fl)+nfields] = foffset
			foffset = foffset + Memi[FL_FSIZES(fl)+nfields]
		    default:
			call error (0, "Unknown output catalog type")
			;
		    }

		    # Correct for coordinate units and format transform here.
		    if (streq (Memc[franame], Memc[FL_FNAMES(fl)+
		        nfields*(CQ_SZ_QPNAME+1)])) {
			ival = at_stati (at, FORAUNITS)
			if (ival <= 0)
			    Memc[str] = EOS
			else if (at_wrdstr (ival, Memc[str], SZ_FNAME,
			    AT_RA_UNITS) <= 0)
			    Memc[str] = EOS
			if (Memc[str] != EOS && strne (Memc[str],
			    Memc[FL_FUNITS(fl)+nfields*(CQ_SZ_QPUNITS+1)]))
			    call strcpy (Memc[str], Memc[FL_FUNITS(fl)+
			        nfields*(CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS)
			call at_stats (at, FORAFORMAT, Memc[str], SZ_FNAME)
			if (Memc[str] != EOS && strne (Memc[str],
			    Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)]))
			    call strcpy (Memc[str], Memc[FL_FFMTS(fl)+
			        nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    }
		    if (streq (Memc[fdecname], Memc[FL_FNAMES(fl)+
		        nfields*(CQ_SZ_QPNAME+1)])) {
			ival = at_stati (at, FODECUNITS)
			if (ival <= 0)
			    Memc[str] = EOS
			else if (at_wrdstr (ival, Memc[str], SZ_FNAME,
			    AT_DEC_UNITS) <= 0)
			    Memc[str] = EOS
			if (Memc[str] != EOS && strne (Memc[str],
			    Memc[FL_FUNITS(fl)+nfields*(CQ_SZ_QPUNITS+1)]))
			    call strcpy (Memc[str], Memc[FL_FUNITS(fl)+
			        nfields*(CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS)
			call at_stats (at, FODECFORMAT, Memc[str], SZ_FNAME)
			if (Memc[str] != EOS && strne (Memc[str],
			    Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)]))
			    call strcpy (Memc[str], Memc[FL_FFMTS(fl)+
			        nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    }

		    # Correct for pixel coordinate formats here.
		    if (streq (Memc[xpname], Memc[FL_FNAMES(fl)+
		        nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[xcname],
			Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) {
			call at_stats (at, FOXFORMAT, Memc[str], SZ_FNAME)
			if (Memc[str] != EOS && strne (Memc[str],
			    Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)]))
			    call strcpy (Memc[str], Memc[FL_FFMTS(fl)+
			        nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    }
		    if (streq (Memc[ypname], Memc[FL_FNAMES(fl)+
		        nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[ycname],
			Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) {
			call at_stats (at, FOYFORMAT, Memc[str], SZ_FNAME)
			if (Memc[str] != EOS && strne (Memc[str],
			    Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)]))
			    call strcpy (Memc[str], Memc[FL_FFMTS(fl)+
			        nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    }


		    nfields = nfields + 1
		}

	    # This field is a new field.
	    } else {

		# Get the field names. The default is f#.
		ip = 1
		if (at_flnitem (Memc[fnames], fnp, Memc[FL_FNAMES(fl)+
		    nfields*(CQ_SZ_QPNAME+1)], CQ_SZ_QPNAME) == EOF) {
		    call sprintf (Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)],
		        CQ_SZ_QPNAME, "f%d")
			call pargi (nfields + 1)
		} else if (ctotok (Memc[FL_FNAMES(fl)+nfields*
		    (CQ_SZ_QPNAME+1)], ip, Memc[FL_FNAMES(fl)+nfields*
		    (CQ_SZ_QPNAME+1)],  CQ_SZ_QPNAME) != TOK_IDENTIFIER) {
		    call sprintf (Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)],
		        CQ_SZ_QPNAME, "f%d")
			call pargi (nfields + 1)
		}

		# Get the data types. The default for now is type real.
		ip = 1
		if (at_flnitem (Memc[fntypes], ftp, Memc[str],
		    SZ_FNAME) == EOF) {
		    Memi[FL_FTYPES(fl)+nfields] = TY_REAL
		} else if (ctotok (Memc[str], ip, Memc[str], SZ_FNAME) !=
		    TOK_IDENTIFIER) {
		    Memi[FL_FTYPES(fl)+nfields] = TY_REAL
		} else {
		    #call strlwr (Memc[str])
		    #Memi[FL_FTYPES(fl)+nfields] = cq_dtype(Memc[str])
		    Memi[FL_FTYPES(fl)+nfields] = at_dtype(Memc[str])
		}

		# Get the data units. The default is INDEF.
		ip = 1
		if (at_flnitem (Memc[fnunits], fup, Memc[FL_FUNITS(fl)+
		    nfields*(CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) == EOF) {
		    call strcpy ("INDEF", Memc[FL_FUNITS(fl)+nfields*
		        (CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS)
		} else if (ctotok (Memc[FL_FUNITS(fl)+nfields*
		    (CQ_SZ_QPUNITS+1)], ip, Memc[FL_FUNITS(fl)+nfields*
		    (CQ_SZ_QPUNITS+1)],  CQ_SZ_QPUNITS) != TOK_IDENTIFIER) {
		    call strcpy ("INDEF", Memc[FL_FUNITS(fl)+nfields*
		        (CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS)
		}

		# Get the data formats. The default is %10s, %10d, and %10g
		# for character, integer, and floating data points respectively.
		ip = 1
		if (at_flnitem (Memc[fnfmts], ffp, Memc[FL_FFMTS(fl)+nfields*
		    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) == EOF) {
		    switch (Memi[FL_FTYPES(fl)+nfields]) {
		    case TY_CHAR:
			call strcpy ("%10s", Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    case TY_SHORT, TY_INT, TY_LONG:
			call strcpy ("%10d", Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    case TY_REAL, TY_DOUBLE:
			call strcpy ("%10g", Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    }
		} else if (Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)] != '%') {
		    switch (Memi[FL_FTYPES(fl)+nfields*(CQ_SZ_QPFMTS+1)]) {
		    case TY_CHAR:
			call strcpy ("%10s", Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    case TY_SHORT, TY_INT, TY_LONG:
			call strcpy ("%10d", Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    case TY_REAL, TY_DOUBLE:
			call strcpy ("%10g", Memc[FL_FFMTS(fl)+nfields*
			    (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		    }
		}

		# Correct for pixel coordinate formats here.
		if (streq (Memc[xpname], Memc[FL_FNAMES(fl)+
		    nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[xcname],
		    Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) {
		    call at_stats (at, FOXFORMAT, Memc[str], SZ_FNAME)
		    if (Memc[str] != EOS && strne (Memc[str],
		        Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)]))
			call strcpy (Memc[str], Memc[FL_FFMTS(fl)+
			    nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		}
		if (streq (Memc[ypname], Memc[FL_FNAMES(fl)+
		    nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[ycname],
		    Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) {
		    call at_stats (at, FOYFORMAT, Memc[str], SZ_FNAME)
		    if (Memc[str] != EOS && strne (Memc[str],
			Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)]))
			call strcpy (Memc[str], Memc[FL_FFMTS(fl)+
			    nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS)
		}

		# Get the field width.
		ip = 2
		if (ctoi (Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)], ip,
		    ival) <= 0)
		    ival = 10
		else if (ival <= 0 || IS_INDEFI(ival))
		    ival = 10

		# Get the field offset and field size. Note the extra
		# character added to the width ...
		switch (rtype) {
		case CQ_STEXT:
		    Memi[FL_FOFFSETS(fl)+nfields] = nfields + 1
		    Memi[FL_FSIZES(fl)+nfields] = 0
		case CQ_BTEXT:
		    Memi[FL_FOFFSETS(fl)+nfields] = foffset
		    Memi[FL_FSIZES(fl)+nfields] = ival + 1
		    foffset = foffset + Memi[FL_FSIZES(fl)+nfields]
		default:
		    call error (0, "Unknown output catalog type")
		}

		nfields = nfields + 1

	    }

	    rptr = rptr + 3
	}

	call sfree (sp)
end


# AT_GETOP -- Fetch an operand from the data structure.

procedure at_getop (res, operand, o)

pointer res                     #I pointer to the data structure
char    operand[ARB]            #I name of operand to be returned
pointer o                       #I pointer to output operand

pointer	sp, fvalue
int	fieldno, nchars
int	cq_fnumber(), cq_ftype(), cq_gvald(), cq_gvali(), cq_gvalc()
int	cq_rstati()

begin
	fieldno = cq_fnumber (res, operand)
	if (fieldno <= 0)
	    call error (0, "Illegal operand in expression")

	switch (cq_ftype (res, operand)) {

	case TY_CHAR:
	    call smark (sp)
	    call salloc (fvalue, SZ_LINE, TY_CHAR)
	    nchars = cq_gvalc (res, cq_rstati(res, CQRECPTR), operand,
	        Memc[fvalue], SZ_LINE) 
	    if (nchars <= 0) {
		call strcpy ("INDEF", Memc[fvalue], 5)
		nchars = 5
	    }
	    O_TYPE(o) = TY_CHAR
	    O_LEN(o) = nchars
	    O_FLAGS(o) = O_FREEVAL
	    call malloc (O_VALP(o), nchars, TY_CHAR)
	    call strcpy (Memc[fvalue], O_VALC(o), nchars)
	    call sfree (sp)

	case TY_SHORT, TY_INT, TY_LONG:
	    O_TYPE(o) = TY_INT
	    O_LEN(o) = 0
	    O_FLAGS(o) = 0
	    nchars = cq_gvali (res, cq_rstati (res, CQRECPTR), operand,
	        O_VALI(o)) 

	case TY_REAL, TY_DOUBLE:
	    O_TYPE(o) = TY_DOUBLE
	    O_LEN(o) = 0
	    O_FLAGS(o) = 0
	    nchars = cq_gvald (res, cq_rstati(res, CQRECPTR), operand,
	        O_VALD(o)) 

	default:
	    call smark (sp)
	    call salloc (fvalue, SZ_LINE, TY_CHAR)
	    nchars = cq_gvalc (res, cq_rstati(res, CQRECPTR), operand,
	        Memc[fvalue], SZ_LINE) 
	    if (nchars <= 0) {
		call strcpy ("INDEF", Memc[fvalue], 5)
		nchars = 5
	    }
	    O_TYPE(o) = TY_CHAR
	    O_LEN(o) = nchars
	    O_FLAGS(o) = O_FREEVAL
	    call malloc (O_VALP(o), nchars, TY_CHAR)
	    call strcpy (Memc[fvalue], O_VALC(o), nchars)
	    call sfree (sp)
	}
end