/* wrtprs.f -- translated by f2c (version 19980913).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

/* Table of constant values */

static integer c__1 = 1;

/* Subroutine */ int wrtprs_(integer *idlist, integer *n, char *del, char *
	quote, ftnlen del_len, ftnlen quote_len)
{
    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_cmp(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    char line[16000];
    integer myid, last;
    char temp[16000];
    integer i__;
    extern /* Subroutine */ int clgai_(integer *, char *, integer *, integer *
	    , ftnlen);
    integer width, dummy;
    logical empty;
    integer nrows;
    extern /* Subroutine */ int clq2id_(integer *, integer *), clncmp_(
	    integer *, integer *), clpval_(integer *, integer *, char *, 
	    integer *, ftnlen);
    extern integer lastnb_(char *, ftnlen);
    extern /* Subroutine */ int setchr_(char *, integer *, char *, ftnlen, 
	    ftnlen);
    logical doquot;
    char subrow[16000];
    extern /* Subroutine */ int nspwln_(char *, ftnlen);
    integer thstyp, get, num, row, put;


/* $ Abstract */

/*     Write out the current row of the current selection set preserving */
/*     components in separate rows. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     None. */

/* $ Keywords */

/*     INSPEKT */

/* $ Declarations */
/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     IDLIST     I   List of column ids for use in this report. */
/*     N          I   Number of columns to be output. */
/*     DEL        I   Character used to delimit colums. */
/*     QUOTE      I   Character used to quote strings. */

/* $ Detailed_Input */

/*     IDLIST     is the list of column idcodes that are used to */
/*                for the various subrows of this row of the matching */
/*                query. */

/*     N          The number of columns in IDLIST */

/*     DEL        Delimiter to use between columns.  You can use a space */
/*                but it kind of defeats the purpose of this routine. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Files */

/*     None. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This is simply a formatter.  Each component appears in an output */
/*     row by itself. */

/* $ Examples */

/*     Nope. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

/*     W.L. Taber      (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 27-MAR--2003 (WLT) */


/* -& */
/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */


/*     This file contains the parameter LNGSIZ which specifies the */
/*     longest character string that can be declared in all of the */
/*     FORTRAN environments supported by the SPICE system. */


/*     In this case we are going to print out a sub-row at a time */
/*     Each new component of a column will appear in a subsequent */
/*     row.  If there is no component with the specified index, */
/*     we will leave a blank in that spot. */

/*     Determine how many sub-rows are required for this matching */
/*     row of  the query. */

    nrows = 0;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	clncmp_(&idlist[i__], &num);
	nrows = max(nrows,num);
    }

/*     Now form each sub-row. */

    i__1 = nrows;
    for (row = 1; row <= i__1; ++row) {

/*        This subrow starts out empty. */

	s_copy(subrow, " ", (ftnlen)16000, (ftnlen)1);
	put = 1;

/*        Keep track of whether we put any real data into this line. */

	empty = TRUE_;
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {

/*           Fetch the number of components of the next column to */
/*           see if we are going to leave a blank or not. */

	    clncmp_(&idlist[i__], &num);

/*           Also determine which type of column we are dealing with so */
/*           we can determine whether or not to quote it. */

	    clq2id_(&idlist[i__], &myid);
	    clgai_(&myid, "TYPE", &dummy, &thstyp, (ftnlen)4);
	    doquot = thstyp != 3 && thstyp != 2;
	    if (num >= row) {
		clpval_(&idlist[i__], &row, line, &width, (ftnlen)16000);
		if (s_cmp(line, "<null>", (ftnlen)16000, (ftnlen)6) == 0 || 
			s_cmp(line, "<absent>", (ftnlen)16000, (ftnlen)8) == 
			0) {
		    doquot = TRUE_;
		}
		last = lastnb_(line, (ftnlen)16000);

/*              An empty string is allowed for non-null character */
/*              coumns, but not for any others. */

		if (thstyp == 1 && row > 1) {
		    clpval_(&idlist[i__], &c__1, temp, &width, (ftnlen)16000);
		    if (s_cmp(temp, "<null>", (ftnlen)16000, (ftnlen)6) != 0 
			    && s_cmp(temp, "<absent>", (ftnlen)16000, (ftnlen)
			    8) != 0) {
			empty = FALSE_;
		    }
		} else {
		    empty = empty && s_cmp(line, " ", (ftnlen)16000, (ftnlen)
			    1) == 0;
		}
	    } else {
		s_copy(line, " ", (ftnlen)16000, (ftnlen)1);
		last = 1;
	    }
	    if (doquot) {
		setchr_(quote, &put, subrow, (ftnlen)1, (ftnlen)16000);
	    }
	    i__3 = last;
	    for (get = 1; get <= i__3; ++get) {
		setchr_(line + (get - 1), &put, subrow, (ftnlen)1, (ftnlen)
			16000);
		if (doquot && *(unsigned char *)&line[get - 1] == *(unsigned 
			char *)quote) {
		    setchr_(quote, &put, subrow, (ftnlen)1, (ftnlen)16000);
		}
	    }
	    if (doquot) {
		setchr_(quote, &put, subrow, (ftnlen)1, (ftnlen)16000);
	    }
	    if (i__ != *n) {
		setchr_(del, &put, subrow, (ftnlen)1, (ftnlen)16000);
	    }
	}

/*        Ship this subrow out if it is non-empty. */

	if (! empty) {
	    nspwln_(subrow, (ftnlen)16000);
	}

/*        Get the next one (if there is one ) */

    }
    return 0;
} /* wrtprs_ */

