Ejemplo n.º 1
0
/* $Procedure      CKWSS ( CK write segment summary ) */
/* Subroutine */ int ckwss_(integer *unit, char *segid, integer *segins, 
	integer *segfrm, integer *segtyp, integer *segrts, doublereal *segbtm,
	 doublereal *segetm, ftnlen segid_len)
{
    /* Initialized data */

    static char cktyp[80*6] = "Discrete Pointing                            "
	    "                                   " "Continuous Pointing: Const"
	    "ant Angular Velocity                                  " "Continu"
	    "ous Pointing: Linear Interpolation                              "
	    "         " "Continuous Pointing: Chebyshev, Variable Interval Le"
	    "ngth                        " "Continuous Pointing: MEX/Rosetta "
	    "Polynomial Interpolation                       " "Continuous Poi"
	    "nting: ESOC/DDID Piecewise Interpolation                        "
	    "  ";
    static char pvstat[40*2] = "Pointing Only                           " 
	    "Pointing and Angular Velocity           ";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    static integer sclk;
    extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
    static doublereal beget;
    static char frame[32];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    static doublereal endet;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    static char lines[80*11];
    static logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, 
	    ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, 
	    ftnlen);
    extern logical failed_(void);
    extern /* Subroutine */ int scdecd_(integer *, doublereal *, char *, 
	    ftnlen), ckmeta_(integer *, char *, integer *, ftnlen);
    static char begtim[32], endtim[32], spname[32];
    extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
	    char *, ftnlen);
    static integer spcrft;
    extern /* Subroutine */ int writla_(integer *, char *, integer *, ftnlen);
    static char typdsc[80];
    extern logical return_(void);

/* $ Abstract */

/*     Write a segment summary for a CK segment to a Fortran logical */
/*     unit. */

/* $ 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 */

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I   The logical unit to use for writing the summary. */
/*      SEGID     I   Segment ID for a segment in a CK file. */
/*      SEGINS    I   ID for the instrument having data in a CK segment. */
/*      SEGFRM    I   Reference frame for a segment in a CK file. */
/*      SEGTYP    I   Data type for a segment in a CK file. */
/*      SEGRTS    I   Flag for velocity info in a CK segment. */
/*      SEGBTM    I   Begin time (SCLK) for a segment in a CK file. */
/*      SEGETM    I   End time (SCLK) for a segment in a CK file. */

/* $ Detailed_Input */

/*      UNIT     The Fortran logical unit on which the segment summary */
/*               is to be written. */

/*      SEGID    Segment ID for the current segment in a CK file. */

/*      SEGINS   NAIF integer ID code for the instrument having data */
/*               in the current segment in a CK file. */

/*      SEGFRM   Inertial reference frame for the current segment in a */
/*               CK file. This is the NAIF integer code for the inertial */
/*               reference frame. */

/*      SEGTYP   Data type for the current segment in a CK file. This */
/*               is an integer code which specifies the type of the data */
/*               in the current segment. */

/*      SEGRTS   Integer flag which indicates whether the segment */
/*               contains angular velocity data in addition to pointing */
/*               data, SEGRTS .EQ. 1, or just pointing data, SEGRTS .EQ. */
/*               0. */

/*      SEGBTM   The beginning encoded SCLK time for the data in the */
/*               current segment in a CK file. */

/*      SEGETM   The ending encoded SCLK time for the data in the */
/*               current segment in a CK file. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If an error occurs while writing to the logical unit, the error */
/*        SPICE(FILEWRITEFAILED) will be signalled. */

/*     2) If an error occurs in a routine called by this routine, this */
/*        routine will check out and return. Presumably an appropriate */
/*        error message will already have been set. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will format and display a CK segment summary in a */
/*     human compatible fashion. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine performs time conversions using SCDECD, and */
/*        therefore requires that a SPICE SCLK kernel file be */
/*        loaded into the SPICELIB kernel pool before it is called. */

/*     2) This routine performs time conversions using ET2UTC, and */
/*        therefore requires that a SPICE leapseconds kernel file be */
/*        loaded into the SPICELIB kernel pool before it is called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     K.R. Gehringer (JPL) */

/* $ Version */

/* -    SPACIT Version 4.0.0,  08-MAR-2014 (NJB) */

/*        The routine was updated to handle CK type 6. */

/* -    SPACIT Version 3.0.0,  28-AUG-2002 (NJB) */

/*        The routine was updated to handle CK types 4 and 5. */

/* -    Beta Version 2.1.0,  7-FEB-1997 (WLT) */

/*        The routine was modified to use CKMETA to obtain the */
/*        spacecraft and spacecraft clock associated with a */
/*        a segment.  This replaces the old method of just dividing */
/*        by 1000. */

/* -    Beta Version 2.0.0, 24-JAN-1996 (KRG) */

/*        There have been several undocumented revisions of this */
/*        subroutine to improve its display formats and fix display bugs. */
/*        We are starting a new trend here, with the documentation of the */
/*        changes to this version. Hopefully we will continue to do so. */

/*        The changes to this version are: */

/*           Calling a new subroutien to get reference frame names, to */
/*           support the non-inertial frames software. */

/*           Fixing some display inconsistencies when body, or frame */
/*           names are not found. */

/* -    Beta Version 1.0.0, 25-FEB-1993 (KRG) */

/* -& */
/* $ Index_Entries */

/*      format and write a ck segment summary */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set the value for the maximum output display width. */


/*     Set the maximum length for the inertial reference frame name. */


/*     Set the maximum length for a body name. */


/*     Set the precision for fractions of seconds used for UTC times */
/*     when converted from ET times. */


/*     Set the length of a time string, UTC or SCLK. */


/*     Set the maximum length of a CK data type description. */


/*     Set a value for the length of the pointing only/pointing and */
/*     angular velocity messages. */


/*     Set the maximum number of CK data types. */


/*     Set up some mnemonics for accessing the correct labels. */


/*     Set the number of output lines. */


/*     Local variables */


/*     Initial Values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("CKWSS", (ftnlen)5);
    }

/*     Set up the line labels. */

    s_copy(lines, "   Segment ID     : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 160, "   Spacecraft     : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 80, "   Instrument Code: #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 560, "   UTC Start Time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 640, "   UTC Stop Time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 720, "   SCLK Start Time: #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 800, "   SCLK Stop Time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 240, "   Reference Frame: Frame #", (ftnlen)80, (ftnlen)27)
	    ;
    s_copy(lines + 320, "   CK Data Type   : Type #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 400, "      Description : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 480, "   Available Data : #", (ftnlen)80, (ftnlen)21);

/*     Format the segment ID. */

    repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
	    ftnlen)80);

/*     Get the spacecraft ID code from the instrument ID code by dividing */
/*     by 1000. */

    ckmeta_(segins, "SPK", &spcrft, (ftnlen)3);
    ckmeta_(segins, "SCLK", &sclk, (ftnlen)4);

/*     Format the spacecraft name and its name if we found it. */

    bodc2n_(&spcrft, spname, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 160, "#", &spcrft, lines + 160, (ftnlen)80, (ftnlen)1, 
		(ftnlen)80);
	repmc_(lines + 160, "#", spname, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 160, "#", &spcrft, lines + 160, (ftnlen)80, (ftnlen)1, 
		(ftnlen)80);
    }

/*     Format the instrument name if we found it. */

    repmi_(lines + 80, "#", segins, lines + 80, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);

/*     Convert the segment start and stop times from encoded SCLK */
/*     to SCLK time strings that are human readable. */

    scdecd_(&sclk, segbtm, begtim, (ftnlen)32);
    scdecd_(&sclk, segetm, endtim, (ftnlen)32);
    if (failed_()) {
	chkout_("CKWSS", (ftnlen)5);
	return 0;
    }

/*     Format the UTC AND SCLK times. */

    repmc_(lines + 720, "#", begtim, lines + 720, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 800, "#", endtim, lines + 800, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Convert the segment start and stop times from encoded SCLK to ET */
/*     so that we can convert them to UTC. */

    sct2e_(&sclk, segbtm, &beget);
    sct2e_(&sclk, segetm, &endet);
    if (failed_()) {
	chkout_("CKWSS", (ftnlen)5);
	return 0;
    }

/*     Convert the segment start and stop times from ET to UTC for */
/*     human readability. */

    et2utc_(&beget, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
    et2utc_(&endet, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
    if (failed_()) {
	chkout_("CKWSS", (ftnlen)5);
	return 0;
    }

/*     Format the UTC times. */

    repmc_(lines + 560, "#", begtim, lines + 560, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 640, "#", endtim, lines + 640, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Format the inertial reference frame and its name if we found it. */

    frmnam_(segfrm, frame, (ftnlen)32);
    if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
	repmc_(lines + 240, "#", "#, #", lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 240, "#", frame, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the CK segment type and a description if we have one. */

    if (*segtyp > 6 || *segtyp < 1) {
	s_copy(typdsc, "No description for this type. Do you need a new tool"
		"kit?", (ftnlen)80, (ftnlen)56);
    } else {
	s_copy(typdsc, cktyp + ((i__1 = *segtyp - 1) < 6 && 0 <= i__1 ? i__1 :
		 s_rnge("cktyp", i__1, "ckwss_", (ftnlen)424)) * 80, (ftnlen)
		80, (ftnlen)80);
    }
    repmi_(lines + 320, "#", segtyp, lines + 320, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);
    repmc_(lines + 400, "#", typdsc, lines + 400, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80, (ftnlen)80);

/*     Format the pointing / pointing and angular velocity status */

    repmc_(lines + 480, "#", pvstat + ((i__1 = *segrts) < 2 && 0 <= i__1 ? 
	    i__1 : s_rnge("pvstat", i__1, "ckwss_", (ftnlen)432)) * 40, lines 
	    + 480, (ftnlen)80, (ftnlen)1, (ftnlen)40, (ftnlen)80);

/*     Display the summary. */

    writla_(&c__11, lines, unit, (ftnlen)80);

/*     We were either successful or not on the previous write. In either */
/*     event, we want to check out and return to the caller, so there is */
/*     no need to check FAILED() here. */

    chkout_("CKWSS", (ftnlen)5);
    return 0;
} /* ckwss_ */
Ejemplo n.º 2
0
/* $Procedure      ZZHLP024 ( private help text ) */
/* Subroutine */ int zzhlp024_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 2208, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2209, "First, time strings need to be input as "
	    "strings.", text_len, (ftnlen)48);
    s_copy(text + text_len * 2210, "Strings must be enclosed", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 2211, "in quotes. The condition", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 2212, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2213, "TIME LT 1 JAN 1995", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 2214, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2215, "will not be recognized if it is part of "
	    "a SELECT command.  However,", text_len, (ftnlen)67);
    s_copy(text + text_len * 2216, "once you place quotes around the time, t"
	    "he time string will be", text_len, (ftnlen)62);
    s_copy(text + text_len * 2217, "recognized", text_len, (ftnlen)10);
    s_copy(text + text_len * 2218, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2219, "TIME LT \"1 JAN 1995\"", text_len, (
	    ftnlen)20);
    s_copy(text + text_len * 2220, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2221, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2222, "A wide variety of time formats are allow"
	    "ed as input to Inspekt.", text_len, (ftnlen)63);
    s_copy(text + text_len * 2223, "These formats are listed below.", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 2224, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2225, "@subsection Spacecraft Clock", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2226, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2227, "MO   SCLK mars observer spacecraft clock"
	    " string", text_len, (ftnlen)47);
    s_copy(text + text_len * 2228, "GLL  SCLK galileo spacecraft clock string"
	    , text_len, (ftnlen)41);
    s_copy(text + text_len * 2229, "VGR1 SCLK voyager 1 spacecraft clock str"
	    "ing", text_len, (ftnlen)43);
    s_copy(text + text_len * 2230, "VGR2 SCLK voyager 2 spacecraft clock str"
	    "ing", text_len, (ftnlen)43);
    s_copy(text + text_len * 2231, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2232, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2233, "To use these formats you must have eithe"
	    "r specified SCLK to be an", text_len, (ftnlen)65);
    s_copy(text + text_len * 2234, "appropriate  kernel (see Getting Started"
	    ") or have loaded an appropriate", text_len, (ftnlen)71);
    s_copy(text + text_len * 2235, "kernel via the LOAD SCLK KERNEL command.",
	     text_len, (ftnlen)40);
    s_copy(text + text_len * 2236, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2237, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2238, "@subsection ISO Formats", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 2239, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2240, "The International Standards Organization"
	    " (ISO) time format is used  by", text_len, (ftnlen)70);
    s_copy(text + text_len * 2241, "many NASA flight projects.", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 2242, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2243, "YYYY-MM-DDTHR:MN:SC    ISO UTC Calendar "
	    "format", text_len, (ftnlen)46);
    s_copy(text + text_len * 2244, "YYYY-DDDTHR:MN:SC      ISO UTC Day of ye"
	    "ar format", text_len, (ftnlen)49);
    s_copy(text + text_len * 2245, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2246, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2247, "@subsection Generic", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 2248, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2249, "In these formats Month stands for the mo"
	    "nth spelled out to 3 or more", text_len, (ftnlen)68);
    s_copy(text + text_len * 2250, "letters, e.g. Jan, Janu, Janua, etc.  Al"
	    "so note that where spaces have", text_len, (ftnlen)70);
    s_copy(text + text_len * 2251, "been used to separate the components of "
	    "the date you may also use a", text_len, (ftnlen)67);
    s_copy(text + text_len * 2252, "comma or a slash (i.e. the solidus (/) )"
	    ".  All times are UTC.", text_len, (ftnlen)61);
    s_copy(text + text_len * 2253, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2254, "MONTH DD YYYY  HR:MN:SC.##...#", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2255, "DD MONTH YYYY  HR:MN:SC.##...#", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2256, "YYYY DD MONTH  HR:MN:SC.##...#", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2257, "YYYY MONTH DD  HR:MN:SC.##...#", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2258, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2259, "YYYY MM DD HR:MN:SC.##...#", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 2260, "MM DD YYYY HR:MN:SC.##...#", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 2261, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2262, "JD244xxxx.xx...x", text_len, (ftnlen)16);
    s_copy(text + text_len * 2263, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2264, "@@Specifying Times", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 2265, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2266, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 2267, "Where Clause", text_len, (ftnlen)12);
    finish[63] = 2268;
    begin[64] = 2269;
    s_copy(text + text_len * 2268, "A symbol is a word that begins with a le"
	    "tter of the alphabet", text_len, (ftnlen)60);
    s_copy(text + text_len * 2269, "and does not end with a question mark.  "
	    "It must be 32 or", text_len, (ftnlen)56);
    s_copy(text + text_len * 2270, "fewer characters in length.  Moreover, y"
	    "ou must specifically", text_len, (ftnlen)60);
    s_copy(text + text_len * 2271, "designate this word to be a symbol via t"
	    "he DEFINE command.", text_len, (ftnlen)58);
    s_copy(text + text_len * 2272, "The define command associates a value wi"
	    "th the symbol.", text_len, (ftnlen)54);
    s_copy(text + text_len * 2273, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2274, "When you type a command in Inspekt that "
	    "contains a symbol,", text_len, (ftnlen)58);
    s_copy(text + text_len * 2275, "the symbol is replaced by its associated"
	    " value.  The command", text_len, (ftnlen)60);
    s_copy(text + text_len * 2276, "is then re-examined and any remaining sy"
	    "mbols are replaced", text_len, (ftnlen)58);
    s_copy(text + text_len * 2277, "by their associated values.", text_len, (
	    ftnlen)27);
    s_copy(text + text_len * 2278, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2279, "Symbols allow you to customize your Insp"
	    "ekt environment.  In", text_len, (ftnlen)60);
    s_copy(text + text_len * 2280, "addition they allow you to greatly reduc"
	    "e the amount of typing", text_len, (ftnlen)62);
    s_copy(text + text_len * 2281, "you need to do in order to issue frequen"
	    "tly occurring groups", text_len, (ftnlen)60);
    s_copy(text + text_len * 2282, "of words.", text_len, (ftnlen)9);
    s_copy(text + text_len * 2283, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2284, "Words that are surrounded by any of the "
	    "characters (\"'@) are not", text_len, (ftnlen)64);
    s_copy(text + text_len * 2285, "regarded as symbols and are processed as"
	    " they appear.", text_len, (ftnlen)53);
    s_copy(text + text_len * 2286, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2287, "Symbols are case insensitive in Inspekt."
	    "  If you define \"SPUD\"", text_len, (ftnlen)62);
    s_copy(text + text_len * 2288, "to be a symbol then \"spud\", \"Spud\","
	    " \"sPud\", etc. will all be", text_len, (ftnlen)60);
    s_copy(text + text_len * 2289, "interpreted as SPUD.", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 2290, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2291, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2292, "You may not define EDIT, DO, RECALL, STA"
	    "RT, STOP, DEFINE, ECHO", text_len, (ftnlen)62);
    s_copy(text + text_len * 2293, "@@Symbol", text_len, (ftnlen)8);
    s_copy(text + text_len * 2294, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2295, "Help", text_len, (ftnlen)4);
    finish[64] = 2296;
    begin[65] = 2297;
    s_copy(text + text_len * 2296, "The language you use to communicate with"
	    " Inspekt is a word oriented", text_len, (ftnlen)67);
    s_copy(text + text_len * 2297, "language.  With one exception the smalle"
	    "st significant component of a", text_len, (ftnlen)69);
    s_copy(text + text_len * 2298, "command is a word.  The words in a comma"
	    "nd must match a pattern that is", text_len, (ftnlen)71);
    s_copy(text + text_len * 2299, "called the syntax of the command. The sy"
	    "ntax of the commands you type", text_len, (ftnlen)69);
    s_copy(text + text_len * 2300, "at the prompt Inspekt> can be expressed "
	    "in a language called Meta/2.", text_len, (ftnlen)68);
    s_copy(text + text_len * 2301, "The sections below describe the various "
	    "constructs that make up a Meta/2", text_len, (ftnlen)72);
    return 0;
} /* zzhlp024_ */
Ejemplo n.º 3
0
/* $Procedure GETOPT ( Get an option from a menu ) */
/* Subroutine */ int getopt_(char *title, integer *nopt, char *optnam, char *
	opttxt, integer *option, ftnlen title_len, ftnlen optnam_len, ftnlen 
	opttxt_len)
{
    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    logical done;
    char line[80];
    integer iopt, i__;
    extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
	     ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, 
	    ftnlen, ftnlen, ftnlen);
    logical okequ;
    extern integer rtrim_(char *, ftnlen);
    extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
    char prmpt[80];
    extern logical failed_(void);
    logical ok, okdigi;
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
    logical okalph;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, 
	    ftnlen);
    extern logical return_(void);
    extern /* Subroutine */ int writln_(char *, integer *, ftnlen), prompt_(
	    char *, char *, ftnlen, ftnlen);
    char msg[80];

/* $ Abstract */

/*     Display a list of options in a standard menu format and get */
/*     an option from a user returning the corresponding index of */
/*     the option selected. */

/* $ 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 */

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TITLE      I   Title for the menu. */
/*     NOPT       I   Number of options available. */
/*     OPTNAM     I   Names for the options. */
/*     OPTTXT     I   Brief text describing an option. */
/*     OPTVAL     I   The value returned when its option is selected. */
/*     OPTION     O   The number of the option selected. */

/* $ Detailed_Input */

/*     TITLE    Title for the option menu. */

/*     NOPT     The number of menu options to be displayed. */

/*     OPTNAM   A list of single character names for the menu options. */
/*              These are the names used to select an option. The names */
/*              must each be a single alphanumeric character. All names */
/*              must be upper case if they are characters. */

/*              If the option names is a period, '.', then a blank line */
/*              is to be displayed at that position in the menu list. */

/*     OPTTXT   A list of character strings which contain brief */
/*              descriptions for each of the menu options. These */
/*              character strings should be kept relatively short. */

/*     Please note that the lengths of the option names, OPTNAM, and */
/*     the descriptive text for each option, OPTTXT, should be kept */
/*     reasonable, they both need to fit on the same output line with */
/*     a width of 80 characters. 13 characters out of the 80 available */
/*     are used for spacing and menu presentation, so there are 67 */
/*     characters available for the option name and the descriptive text */
/*     combined. */

/* $ Detailed_Output */

/*     OPTION   The index of the option selected from the menu. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1)   If the number of options, NOPT, is not > 0, the error */
/*          SPICE(INVALIDARGUMENT) will be signalled. */

/*     2)   If the option names are not all upper case alphanumeric */
/*          characters, the error SPICE(BADOPTIONNAME) will be signalled. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will display a menu of options in a standardized */
/*     format, promting for the selection of one of the listed options. */
/*     This routine will not return to the caller until one of the */
/*     supplied options has been selected or an error occurs. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     This routine makes explicit use fo the ASCII character sequence. */

/* $ Author_and_Institution */

/*     K.R. Gehringer  (JPL) */

/* $ Version */

/* -    Beta Version 4.2.0, 18-DEC-2010 (EDW) */

/*        Declared PROMPT as EXTERNAL. Eliminated unneeded Revisions */
/*        section. */

/* -    Beta Version 4.1.0, 05-JUL-1995  (KRG) */

/*        Removed the initial blank line that was printed before the */
/*        title of the menu. The calling program should determine the */
/*        whitespace requirements for the appearance of the menu */
/*        displayed by this routine. */

/* -    Beta Version 4.0.0, 25-APR-1994  (KRG) */

/*        Modified the routine to output the index into the list of menu */
/*        options rather than a character string representing the option */
/*        selected. Also removed several calling arguments that were not */
/*        needed anymore. */

/*        Added the capability of inserting a blank line into the menu. */
/*        This is done by placing a period, '.', into the option name */
/*        location where the blank line lshould occur. */

/*        Added the missing $ Index_Entries section to the header. */

/*        Clarified a few of the comments in the header. */

/* -    Beta Version 3.0.0, 03-SEP-1992  (KRG) */

/* -& */
/* $ Index_Entries */

/*      display a menu and get a user's selection */

/* -& */

/*     SPICELIB functions */


/*     Local Parameters */


/*     Mnemonic for the standard output. */


/*     Local variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("GETOPT", (ftnlen)6);
    }

/*     Check to make sure that the number of menu options is positive. */
/*     if it is not, then signal an error with an appropriate error */
/*     message. */

    if (*nopt < 1) {
	setmsg_("The number of options was not positive: #.", (ftnlen)42);
	errint_("#", nopt, (ftnlen)1);
	sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22);
	chkout_("GETOPT", (ftnlen)6);
	return 0;
    }

/*     Initialize the option prompt. */

    s_copy(prmpt, " ", (ftnlen)80, (ftnlen)1);
    s_copy(prmpt + 3, "Option: ", (ftnlen)77, (ftnlen)8);

/*     Check to make sure that all of the option names are alphanumeric */
/*     and uppercase. The only exception is the period, which signals a */
/*     blank line. */

    ok = TRUE_;
    i__1 = *nopt;
    for (i__ = 1; i__ <= i__1; ++i__) {
	okdigi = *(unsigned char *)&optnam[(i__ - 1) * optnam_len] >= '0' && *
		(unsigned char *)&optnam[(i__ - 1) * optnam_len] <= '9';
	okalph = *(unsigned char *)&optnam[(i__ - 1) * optnam_len] >= 'A' && *
		(unsigned char *)&optnam[(i__ - 1) * optnam_len] <= 'Z';
	okequ = *(unsigned char *)&optnam[(i__ - 1) * optnam_len] == '.';
	ok = ok && (okdigi || okalph || okequ);
	if (! ok) {
	    setmsg_("An illegal option name was found: option #, name '#'. ", 
		    (ftnlen)54);
	    errint_("#", &i__, (ftnlen)1);
	    sigerr_("SPICE(ILLEGALOPTIONNAME)", (ftnlen)24);
	    chkout_("GETOPT", (ftnlen)6);
	    return 0;
	}
    }

/*     Do until we get a valid option. */

    done = FALSE_;
    while(! done) {

/*        Display the menu title if it is non blank */

	if (s_cmp(title, " ", title_len, (ftnlen)1) != 0) {
	    s_copy(line, " ", (ftnlen)80, (ftnlen)1);
	    s_copy(line + 9, "#", (ftnlen)71, (ftnlen)1);
	    repmc_(line, "#", title, line, (ftnlen)80, (ftnlen)1, title_len, (
		    ftnlen)80);
	    writln_(line, &c__6, (ftnlen)80);
	}

/*        Display the menu and read in an option. */

	writln_(" ", &c__6, (ftnlen)1);
	i__1 = *nopt;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    s_copy(line, " ", (ftnlen)80, (ftnlen)1);
	    if (s_cmp(optnam + (i__ - 1) * optnam_len, ".", optnam_len, (
		    ftnlen)1) != 0) {
		s_copy(line + 3, "( # ) #", (ftnlen)77, (ftnlen)7);
		repmc_(line, "#", optnam + (i__ - 1) * optnam_len, line, (
			ftnlen)80, (ftnlen)1, optnam_len, (ftnlen)80);
		repmc_(line, "#", opttxt + (i__ - 1) * opttxt_len, line, (
			ftnlen)80, (ftnlen)1, opttxt_len, (ftnlen)80);
	    }
	    writln_(line, &c__6, (ftnlen)80);
	}
	writln_(" ", &c__6, (ftnlen)1);
	i__ = rtrim_(prmpt, (ftnlen)80) + 1;
	prompt_(prmpt, line, i__, (ftnlen)80);
	if (failed_()) {
	    chkout_("GETOPT", (ftnlen)6);
	    return 0;
	}

/*        Initialize the option value to zero, invalid option. */

	iopt = 0;
	if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) == 0) {
	    writln_(" ", &c__6, (ftnlen)1);
	} else {
	    ljust_(line, line, (ftnlen)80, (ftnlen)80);
	    ucase_(line, line, (ftnlen)80, (ftnlen)80);

/*           Check to make sure that the option we got is a valid */
/*           candidate: It must be alpha numeric. */

	    okdigi = *(unsigned char *)line >= '0' && *(unsigned char *)line 
		    <= '9';
	    okalph = *(unsigned char *)line >= 'A' && *(unsigned char *)line 
		    <= 'Z';
	    ok = okdigi || okalph;

/*           If we got a valid candidate for an option, see if it is one */
/*           of the options that we are supplying. */

	    if (ok) {
		iopt = isrchc_(line, nopt, optnam, (ftnlen)1, optnam_len);
		ok = iopt != 0;
	    }
	    if (! ok) {
		s_copy(msg, "'#' was not a valid option. Please try again.", (
			ftnlen)80, (ftnlen)45);
		repmc_(msg, "#", line, msg, (ftnlen)80, (ftnlen)1, (ftnlen)1, 
			(ftnlen)80);
		writln_(" ", &c__6, (ftnlen)1);
		s_copy(line, " ", (ftnlen)80, (ftnlen)1);
		s_copy(line + 3, "***", (ftnlen)77, (ftnlen)3);
		writln_(line, &c__6, (ftnlen)80);
		s_copy(line + 3, "*** #", (ftnlen)77, (ftnlen)5);
		repmc_(line, "#", msg, line, (ftnlen)80, (ftnlen)1, (ftnlen)
			80, (ftnlen)80);
		writln_(line, &c__6, (ftnlen)80);
		s_copy(line + 3, "***", (ftnlen)77, (ftnlen)3);
		writln_(line, &c__6, (ftnlen)80);
		writln_(" ", &c__6, (ftnlen)1);
	    } else {
		*option = iopt;
		done = TRUE_;
	    }
	}
    }
    chkout_("GETOPT", (ftnlen)6);
    return 0;
} /* getopt_ */
Ejemplo n.º 4
0
/* $Procedure PRINST (Display string of CK-file summary) */
/* Subroutine */ int prinst_0_(int n__, integer *id, doublereal *tbegin, 
	doublereal *tend, integer *avflag, integer *frame, char *tout, 
	logical *fdsp, logical *tdsp, logical *gdsp, logical *ndsp, ftnlen 
	tout_len)
{
    /* Initialized data */

    static doublereal tbprev = 0.;
    static doublereal teprev = 0.;
    static integer idprev = 0;

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    integer hint;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    integer scidw;
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    extern integer rtrim_(char *, ftnlen);
    integer frcode;
    extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char 
	    *, integer *, logical *, ftnlen);
    char idline[256], fnline[256], tbline[256], avline[256], teline[256];
    extern /* Subroutine */ int timecn_(doublereal *, integer *, char *, char 
	    *, ftnlen, ftnlen), frmnam_(integer *, char *, ftnlen), repmcw_(
	    char *, char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen,
	     ftnlen);
    char outlin[256];
    extern /* Subroutine */ int tostdo_(char *, ftnlen), intstr_(integer *, 
	    char *, ftnlen);

/* $ Abstract */

/*     Write a single CK-file summary record string to standard */
/*     output in requested format. */

/* $ 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 */

/*     CKBRIEF.UG */

/* $ Keywords */

/*     SUMMARY */
/*     CK */

/* $ Declarations */
/* $ 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. */

/* $ Author_and_Institution */

/*     Y.K. Zaiko     (BERC) */
/*     B.V. Semenov   (NAIF) */

/* $ Version */

/* -    Toolkit Version 6.1.0, 27-JUN-2014 (BVS) */

/*        BUG FIX: changed logic to make a combination of -a and an ID */
/*        specified on the command line work in all cases. */

/* -    CKBRIEF Version 6.0.0, 2014-04-28 (BVS) (NJB) */

/*        Modified to treat all files as a single file (-a). */

/*        Changed SCLKD display format to include 6 decimal */
/*        places. */

/*        Increased MAXBOD to 1,000,000 (from 100,000) and CMDSIZ to */
/*        50,000 (from 25,000). */

/*        Added support for CK type 6. */

/* -    CKBRIEF Version 5.0.0, 2009-02-11 (BVS) */

/*        Updated version. */

/* -    CKBRIEF Version 4.0.0, 2008-01-13 (BVS) */

/*        Increased MAXBOD to 100,000 (from 10,000). */

/*        Increased CMDSIZ to 25,000 (from 4,000). */

/*        Updated version string and changed its format to */
/*        '#.#.#, Month DD, YYYY' (from '#.#.#, YYYY-MM-DD'). */

/* -    CKBRIEF Version 3.2.0, 2006-11-02 (BVS) */

/*        Updated version string. */

/* -    CKBRIEF Version 3.1.0, 2005-11-08 (BVS) */

/*        Updated version string. */

/* -    CKBRIEF Version 2.0.0, 2001-05-16 (BVS) */

/*        Increased MAXBOD to 10000 (from 4000). Set LRGWIN to be */
/*        MAXBOD*2 (was MAXBOD). Changed version string. */

/* -    CKBRIEF Version 1.1.2, 2001-04-09 (BVS) */

/*        Changed version parameter. */

/* -    CKBRIEF Version 1.0.0 beta, 1999-02-17 (YKZ)(BVS) */

/*        Initial release. */

/* -& */

/*     The Version is stored as a string. */


/*     The maximum number of segments or interpolation intervals */
/*     that can be summarized is stored in the parameter MAXBOD. */
/*     This is THE LIMIT that should be increased if window */
/*     routines called by CKBRIEF fail. */


/*     The largest expected window -- must be twice the size of */
/*     MAXBOD for consistency. */


/*     The longest command line that can be accommodated is */
/*     given by CMDSIZ. */


/*     MAXUSE is the maximum number of objects that can be explicitly */
/*     specified on the command line for ckbrief summaries. */


/*     Generic line size for all modules. */


/*     Time type keys. */


/*     Output time format pictures. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     ID         I   NAIF ID code of object */
/*     TBEGIN     I   Start time of object coverage interval, SCLK ticks */
/*     TEND       I   End time of object coverage interval, SCLK ticks */
/*     AVFLAG     I   Angular velocity flag */
/*     FRAME      I   NAIF ID code of reference frame */
/*     TOUT       I   Key specifying times representation on output */
/*     FDSP       I   Flag defining whether frames name/id is printed */
/*     TDSP       I   Flag defining tabular/non-tabular summary format */
/*     GDSP       I   Flag requesting object grouping by coverage */
/*     NDSP       I   Flag to display frame assosiated with CK ID */

/* $ Detailed_Input */

/*     ID             Integer NAIF ID code found in summaries */
/*                    of CK-file and to be written to standard output. */

/*     TBEGIN         Begin time for object coverage given as DP */
/*                    SCLK ticks. */

/*     TEND           End time for object coverage given as DP */
/*                    SCLK ticks. */

/*     AVFLAG         Angular velocities presence flag: 0 - not present, */
/*                    1 - present, 2 - mixed. */

/*     FRAME          Integer NAIF ID code of reference frame relative */
/*                    to which orientation of the ID was given. */

/*     TOUT           Key specifying time representation on output: */
/*                    SCLK string, encoded SCLK, ET, UTC or DOY */

/*     FDSP           Flag defining whether name or ID code of the */
/*                    FRAME should appear on output. */

/*     TDSP           Flag defining whether summaries have to be written */
/*                    in tabular or non-tabular format. */

/*     GDSP           Flag defining whether objects with the same */
/*                    coverage must be grouped together. */

/*     NDSP           Flag requesting display of the name of the frame */
/*                    associated with CK ID. */

/* $ Detailed_Output */

/*     None. This subroutine displays summary line for a CK-file/segment */
/*     for subroutine DISPSM. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     Error free. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     None. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     Y.K. Zaiko      (BERC) */
/*     B.V. Semenov    (NAIF) */

/* $ Version */

/* -    CKBRIEF Beta Version 2.0.0, 13-OCT-2008 (BVS) */

/*        Added NDSP argument. Changed to display frame names associated */
/*        with CK IDs when NDSP is .TRUE.. */

/* -    CKBRIEF Beta Version 1.0.0, 17-FEB-1999 (YKZ)(BVS) */

/* -& */

/*     SPICELIB functions */


/*     Local parameters. */


/*     Output fields widths. */


/*     Preset output values. */


/*     Local variables */


/*     Save previous time boundaries and ID code. */


/*     Set initial value to zeros. */

    switch(n__) {
	case 1: goto L_prinsr;
	}


/*     Convert all inputs to strings that will appear on output. */

    if (*ndsp) {
	scidw = 26;
	ccifrm_(&c__3, id, &frcode, idline, &hint, &found, (ftnlen)256);
	if (! found) {
	    s_copy(idline, "NO FRAME FOR #", (ftnlen)256, (ftnlen)14);
	    repmi_(idline, "#", id, idline, (ftnlen)256, (ftnlen)1, (ftnlen)
		    256);
	}
    } else {
	scidw = 8;
	intstr_(id, idline, (ftnlen)256);
    }
    timecn_(tbegin, id, tout, tbline, tout_len, (ftnlen)256);
    timecn_(tend, id, tout, teline, tout_len, (ftnlen)256);
    if (*avflag == 2) {
	s_copy(avline, "*", (ftnlen)256, (ftnlen)1);
    } else if (*avflag == 1) {
	s_copy(avline, "Y", (ftnlen)256, (ftnlen)1);
    } else {
	s_copy(avline, "N", (ftnlen)256, (ftnlen)1);
    }
    frmnam_(frame, fnline, (ftnlen)256);
    if (s_cmp(fnline, " ", (ftnlen)256, (ftnlen)1) == 0) {
	if (*frame == 0) {
	    s_copy(fnline, "MIXED", (ftnlen)256, (ftnlen)5);
	} else {
	    intstr_(frame, fnline, (ftnlen)256);
	}
    }

/*     Make up output string and print them depending on what kind of */
/*     output format was requested. */

    if (*tdsp) {

/*        For table output, set output line template depending on */
/*        whether FRAME display was requested. */

	if (*fdsp) {
	    s_copy(outlin, "# # # #   #", (ftnlen)256, (ftnlen)11);
	} else {
	    s_copy(outlin, "# # # #", (ftnlen)256, (ftnlen)7);
	}

/*        Check whether coverage is the same as previous one and */
/*        reassign begin and end time to 'same' flag if so. */

	if (*tbegin == tbprev && *tend == teprev && s_cmp(tbline, "NEED LSK "
		"AND SCLK FILES", (ftnlen)256, (ftnlen)23) != 0 && s_cmp(
		teline, "NEED LSK AND SCLK FILES", (ftnlen)256, (ftnlen)23) !=
		 0) {
	    s_copy(tbline, "   -- same --", (ftnlen)256, (ftnlen)13);
	    s_copy(teline, "   -- same --", (ftnlen)256, (ftnlen)13);
	}

/*        Substitute string and print out the line. */

	repmcw_(outlin, "#", idline, &scidw, outlin, (ftnlen)256, (ftnlen)1, (
		ftnlen)256, (ftnlen)256);
	repmcw_(outlin, "#", tbline, &c__24, outlin, (ftnlen)256, (ftnlen)1, (
		ftnlen)256, (ftnlen)256);
	repmcw_(outlin, "#", teline, &c__24, outlin, (ftnlen)256, (ftnlen)1, (
		ftnlen)256, (ftnlen)256);
	repmcw_(outlin, "#", avline, &c__1, outlin, (ftnlen)256, (ftnlen)1, (
		ftnlen)256, (ftnlen)256);
	repmcw_(outlin, "#", fnline, &c__32, outlin, (ftnlen)256, (ftnlen)1, (
		ftnlen)256, (ftnlen)256);

/*        Display the line. */

	tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
    } else {

/*        If grouping flag is set, we display single coverage line for */
/*        multiple objects. If it's not set, we display multiple */
/*        coverage lines for a single object. Also when GDSP set we do */
/*        NOT display angular velocity flags or FRAME names/ids. */

	if (*gdsp) {
	    if (*tbegin == tbprev && *tend == teprev) {

/*              This is another object in a group with the same */
/*              coverage. Display just the object ID. */

		s_copy(outlin, "         #", (ftnlen)256, (ftnlen)10);
	    } else {

/*              This is the first object in a group with a different */
/*              coverage. Display blank line, coverage and ID of the */
/*              first object. */

		tostdo_(" ", (ftnlen)1);
		s_copy(outlin, "Begin #: #  End #: # ", (ftnlen)256, (ftnlen)
			21);
		repmc_(outlin, "#", tout, outlin, (ftnlen)256, (ftnlen)1, 
			tout_len, (ftnlen)256);
		repmcw_(outlin, "#", tbline, &c__24, outlin, (ftnlen)256, (
			ftnlen)1, (ftnlen)256, (ftnlen)256);
		repmc_(outlin, "#", tout, outlin, (ftnlen)256, (ftnlen)1, 
			tout_len, (ftnlen)256);
		repmcw_(outlin, "#", teline, &c__24, outlin, (ftnlen)256, (
			ftnlen)1, (ftnlen)256, (ftnlen)256);
		tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
		if (*ndsp) {
		    s_copy(outlin, "Frames:  #", (ftnlen)256, (ftnlen)10);
		} else {
		    s_copy(outlin, "Objects: #", (ftnlen)256, (ftnlen)10);
		}
	    }
	    repmcw_(outlin, "#", idline, &scidw, outlin, (ftnlen)256, (ftnlen)
		    1, (ftnlen)256, (ftnlen)256);
	    tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
	} else {

/*           No grouping by time was requested. So, display contains */
/*           sets of coverage intervals for a particular object. */

	    if (*id == idprev) {

/*              It's the same object. Print out only interval. */

		if (*fdsp) {
		    s_copy(outlin, "  # # #   #", (ftnlen)256, (ftnlen)11);
		} else {
		    s_copy(outlin, "  # # #", (ftnlen)256, (ftnlen)7);
		}
	    } else {

/*              It's another object. Print object ID, header and */
/*              the first interval. */

		tostdo_(" ", (ftnlen)1);
		if (*ndsp) {
		    s_copy(outlin, "Frame:   #", (ftnlen)256, (ftnlen)10);
		} else {
		    s_copy(outlin, "Object:  #", (ftnlen)256, (ftnlen)10);
		}
		repmcw_(outlin, "#", idline, &scidw, outlin, (ftnlen)256, (
			ftnlen)1, (ftnlen)256, (ftnlen)256);
		tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
		if (*fdsp) {
		    s_copy(outlin, "  Interval Begin #######   Interval End "
			    "#######     AV  Relative to FRAME", (ftnlen)256, (
			    ftnlen)73);
		    i__1 = rtrim_("#######", (ftnlen)7);
		    repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
			    256, (ftnlen)7, tout_len, (ftnlen)256);
		    i__1 = rtrim_("#######", (ftnlen)7);
		    repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
			    256, (ftnlen)7, tout_len, (ftnlen)256);
		    tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
		    s_copy(outlin, "  ------------------------ -------------"
			    "----------- --- ----------------- ", (ftnlen)256, 
			    (ftnlen)74);
		    tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
		    s_copy(outlin, "  # # #   #", (ftnlen)256, (ftnlen)11);
		} else {
		    s_copy(outlin, "  Interval Begin #######   Interval End "
			    "#######     AV  ", (ftnlen)256, (ftnlen)56);
		    i__1 = rtrim_("#######", (ftnlen)7);
		    repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
			    256, (ftnlen)7, tout_len, (ftnlen)256);
		    i__1 = rtrim_("#######", (ftnlen)7);
		    repmcw_(outlin, "#######", tout, &i__1, outlin, (ftnlen)
			    256, (ftnlen)7, tout_len, (ftnlen)256);
		    tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
		    s_copy(outlin, "  ------------------------ -------------"
			    "----------- --- ", (ftnlen)256, (ftnlen)56);
		    tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
		    s_copy(outlin, "  # # #", (ftnlen)256, (ftnlen)7);
		}
	    }
	    repmcw_(outlin, "#", tbline, &c__24, outlin, (ftnlen)256, (ftnlen)
		    1, (ftnlen)256, (ftnlen)256);
	    repmcw_(outlin, "#", teline, &c__24, outlin, (ftnlen)256, (ftnlen)
		    1, (ftnlen)256, (ftnlen)256);
	    repmcw_(outlin, "#", avline, &c__1, outlin, (ftnlen)256, (ftnlen)
		    1, (ftnlen)256, (ftnlen)256);
	    repmcw_(outlin, "#", fnline, &c__32, outlin, (ftnlen)256, (ftnlen)
		    1, (ftnlen)256, (ftnlen)256);
	    tostdo_(outlin, rtrim_(outlin, (ftnlen)256));
	}
    }

/*     Reassign saved variables. */

    tbprev = *tbegin;
    teprev = *tend;
    idprev = *id;
    return 0;
/* $Procedure PRINSR (Reset saved variables) */

L_prinsr:
/* $ Abstract */

/*     This entry point resets saved ID and start and stop time) */
/*     to make sure that CKBRIEF generates table headers correctly. */

/* $ 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 */

/*     CKBRIEF.UG */

/* $ Keywords */

/*     SUMMARY */
/*     CK */

/* $ Declarations */

/*     None. */

/* $ Brief_I/O */

/*     None. */

/* $ Detailed_Input */

/*     None. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     Error free. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     None. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     Y.K. Zaiko      (BERC) */
/*     B.V. Semenov    (NAIF) */

/* $ Version */

/* -    CKBRIEF Beta Version 2.0.0, 13-OCT-2008 (BVS) */

/* -& */
    tbprev = 0.;
    teprev = 0.;
    idprev = 0;
    return 0;
} /* prinst_ */
Ejemplo n.º 5
0
/* $Procedure      ZZHLP022 ( private help text ) */
/* Subroutine */ int zzhlp022_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 2032, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2033, "@numitem What leapsecond and SCLK kernel"
	    "s are loaded", text_len, (ftnlen)52);
    s_copy(text + text_len * 2034, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2035, "To see the current session environment, "
	    "type the command", text_len, (ftnlen)56);
    s_copy(text + text_len * 2036, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2037, "SHOW ENVIRONMENT", text_len, (ftnlen)16);
    s_copy(text + text_len * 2038, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2039, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2040, "@@SHOW ENVIRONMENT ...", text_len, (
	    ftnlen)22);
    s_copy(text + text_len * 2041, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2042, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 2043, "Making Help Wait", text_len, (ftnlen)16);
    s_copy(text + text_len * 2044, "Echoing Translated Commands", text_len, (
	    ftnlen)27);
    s_copy(text + text_len * 2045, "Kernels            --- LOAD", text_len, (
	    ftnlen)27);
    finish[55] = 2046;
    begin[56] = 2047;
    s_copy(text + text_len * 2046, "You can see what report format is curren"
	    "tly active by typing the", text_len, (ftnlen)64);
    s_copy(text + text_len * 2047, "command:", text_len, (ftnlen)8);
    s_copy(text + (text_len << 11), "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2049, "SHOW FORMAT;", text_len, (ftnlen)12);
    s_copy(text + text_len * 2050, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2051, "In addition to showing you the format, i"
	    "t will show you the current", text_len, (ftnlen)67);
    s_copy(text + text_len * 2052, "format being used for presenting time an"
	    "d in the case of MARKED", text_len, (ftnlen)63);
    s_copy(text + text_len * 2053, "TABULAR format the current format mark. "
	    " You will also be given", text_len, (ftnlen)63);
    s_copy(text + text_len * 2054, "the current value for triggering a data "
	    "DELUGE WARNING.  An example", text_len, (ftnlen)67);
    s_copy(text + text_len * 2055, "result is given here.", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 2056, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2057, "Report Format          :  MARKED TABULAR",
	     text_len, (ftnlen)40);
    s_copy(text + text_len * 2058, "Report Mark            :  '>'", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 2059, "Default Time     Format:  YYYY MON DD HR"
	    ":MN:SC::UTC::RND", text_len, (ftnlen)56);
    s_copy(text + text_len * 2060, "Default Integer  Format:  ###########", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 2061, "Default Floating Format:  #########.####",
	     text_len, (ftnlen)40);
    s_copy(text + text_len * 2062, "Deluge Warning         :  100", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 2063, "Auto Adjust            :  ASK (applies o"
	    "nly to tabular formats)", text_len, (ftnlen)63);
    s_copy(text + text_len * 2064, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2065, "@@SHOW FORMAT   ...", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 2066, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2067, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 2068, "Default Floating Format", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 2069, "Default Integer Format", text_len, (
	    ftnlen)22);
    s_copy(text + text_len * 2070, "Default Time Format", text_len, (ftnlen)
	    19);
    finish[56] = 2071;
    begin[57] = 2072;
    s_copy(text + text_len * 2071, "When you issue a select command to Inspe"
	    "kt, the speed", text_len, (ftnlen)53);
    s_copy(text + text_len * 2072, "with which it is executed may depend upo"
	    "n whether the", text_len, (ftnlen)53);
    s_copy(text + text_len * 2073, "columns referenced in the select command"
	    " are indexed.", text_len, (ftnlen)53);
    s_copy(text + text_len * 2074, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2075, "To get a list of all indexed columns, ty"
	    "pe the command", text_len, (ftnlen)54);
    s_copy(text + text_len * 2076, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2077, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2078, "SHOW INDEXED", text_len, (ftnlen)12);
    s_copy(text + text_len * 2079, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2080, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2081, "@@SHOW INDEXED  ...", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 2082, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2083, "Help", text_len, (ftnlen)4);
    finish[57] = 2084;
    begin[58] = 2085;
    s_copy(text + text_len * 2084, "You can create a summary of the loaded E"
	    "-kernels by typing the", text_len, (ftnlen)62);
    s_copy(text + text_len * 2085, "command", text_len, (ftnlen)7);
    s_copy(text + text_len * 2086, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2087, "SHOW KERNELS;", text_len, (ftnlen)13);
    s_copy(text + text_len * 2088, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2089, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2090, "There are two main reasons for issuing t"
	    "his command:", text_len, (ftnlen)52);
    s_copy(text + text_len * 2091, "@newlist", text_len, (ftnlen)8);
    s_copy(text + text_len * 2092, "@numitem Obtaining a quick summary of lo"
	    "aded kernels", text_len, (ftnlen)52);
    s_copy(text + text_len * 2093, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2094, "@numitem Finding out whether the tables "
	    "and kernels you thought you", text_len, (ftnlen)67);
    s_copy(text + text_len * 2095, "         loaded were in fact loaded by I"
	    "nspekt.", text_len, (ftnlen)47);
    s_copy(text + text_len * 2096, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2097, "@@SHOW KERNELS     ...", text_len, (
	    ftnlen)22);
    s_copy(text + text_len * 2098, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2099, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 2100, "SHOW COMMENTS ...", text_len, (ftnlen)17);
    finish[58] = 2101;
    begin[59] = 2102;
    s_copy(text + text_len * 2101, "You can see the current page settings (i"
	    "ncluding the report title", text_len, (ftnlen)65);
    s_copy(text + text_len * 2102, "and header attributes) by typing the com"
	    "mand:", text_len, (ftnlen)45);
    s_copy(text + text_len * 2103, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2104, "SHOW PAGE;", text_len, (ftnlen)10);
    s_copy(text + text_len * 2105, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2106, "A sample output is given below. (Note: t"
	    "he Page width refers to", text_len, (ftnlen)63);
    s_copy(text + text_len * 2107, "number of columns one character wide wil"
	    "l fit on the page.)", text_len, (ftnlen)59);
    s_copy(text + text_len * 2108, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2109, "Page height (rows)   :  20", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 2110, "Page width  (columns):  80", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 2111, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2112, "Page Title           :  Inspekt Report", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 2113, "Title Justification  :  LEFT", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2114, "Title Appears on     :  First page only", 
	    text_len, (ftnlen)39);
    s_copy(text + text_len * 2115, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2116, "Header Appears on    :  First page only", 
	    text_len, (ftnlen)39);
    s_copy(text + text_len * 2117, "@@SHOW PAGE        ...", text_len, (
	    ftnlen)22);
    s_copy(text + text_len * 2118, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2119, "Help", text_len, (ftnlen)4);
    return 0;
} /* zzhlp022_ */
Ejemplo n.º 6
0
/* $Procedure  ZZEKNRES ( Private: EK, resolve names in encoded query ) */
/* Subroutine */ int zzeknres_(char *query, integer *eqryi, char *eqryc, 
	logical *error, char *errmsg, integer *errptr, ftnlen query_len, 
	ftnlen eqryc_len, ftnlen errmsg_len)
{
    /* System generated locals */
    integer i__1, i__2, i__3, i__4, i__5;

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

    /* Local variables */
    integer base, ntab, ncnj, ncns, nord, nsel;
    extern /* Subroutine */ int zzekcchk_(char *, integer *, char *, integer *
	    , char *, char *, integer *, logical *, char *, integer *, ftnlen,
	     ftnlen, ftnlen, ftnlen, ftnlen), zzekqtab_(integer *, char *, 
	    integer *, char *, char *, ftnlen, ftnlen, ftnlen), zzekreqi_(
	    integer *, char *, integer *, ftnlen), zzekweqi_(char *, integer *
	    , integer *, ftnlen);
    integer i__, j;
    char table[64*10], alias[64*10];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer nload;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    integer cc[10];
    extern logical failed_(void);
    char ltable[64];
    extern /* Subroutine */ int ekntab_(integer *);
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
    integer cnstyp, iparse;
    extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, 
	    ftnlen), chkout_(char *, ftnlen), ektnam_(integer *, char *, 
	    ftnlen), ekccnt_(char *, integer *, ftnlen);
    logical fnd;
    integer lxb, lxe;

/* $ Abstract */

/*     SPICE Private routine intended solely for the support of SPICE */
/*     routines.  Users should not call this routine directly due */
/*     to the volatile nature of this routine. */

/*     Resolve and semantically check table names, aliases, and column */
/*     names in an encoded EK query. */

/* $ 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 */

/*     EK */

/* $ Keywords */

/*     EK */
/*     PRIVATE */

/* $ Declarations */
/* $ 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. */


/*     Include Section:  EK Boolean Enumerated Type */


/*        ekbool.inc Version 1   21-DEC-1994 (NJB) */


/*     Within the EK system, boolean values sometimes must be */
/*     represented by integer or character codes.  The codes and their */
/*     meanings are listed below. */

/*     Integer code indicating `true': */


/*     Integer code indicating `false': */


/*     Character code indicating `true': */


/*     Character code indicating `false': */


/*     End Include Section:  EK Boolean Enumerated Type */

/* $ 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. */


/*     Include Section:  EK Query Limit Parameters */

/*        ekqlimit.inc  Version 3    16-NOV-1995 (NJB) */

/*           Parameter MAXCON increased to 1000. */

/*        ekqlimit.inc  Version 2    01-AUG-1995 (NJB) */

/*           Updated to support SELECT clause. */


/*        ekqlimit.inc  Version 1    07-FEB-1995 (NJB) */


/*     These limits apply to character string queries input to the */
/*     EK scanner.  This limits are part of the EK system's user */
/*     interface:  the values should be advertised in the EK required */
/*     reading document. */


/*     Maximum length of an input query:  MAXQRY.  This value is */
/*     currently set to twenty-five 80-character lines. */


/*     Maximum number of columns that may be listed in the */
/*     `order-by clause' of a query:  MAXSEL.  MAXSEL = 50. */


/*     Maximum number of tables that may be listed in the `FROM */
/*     clause' of a query: MAXTAB. */


/*     Maximum number of relational expressions that may be listed */
/*     in the `constraint clause' of a query: MAXCON. */

/*     This limit applies to a query when it is represented in */
/*     `normalized form': that is, the constraints have been */
/*     expressed as a disjunction of conjunctions of relational */
/*     expressions. The number of relational expressions in a query */
/*     that has been expanded in this fashion may be greater than */
/*     the number of relations in the query as orginally written. */
/*     For example, the expression */

/*             ( ( A LT 1 ) OR ( B GT 2 ) ) */
/*        AND */
/*             ( ( C NE 3 ) OR ( D EQ 4 ) ) */

/*     which contains 4 relational expressions, expands to the */
/*     equivalent normalized constraint */

/*             (  ( A LT 1 ) AND ( C NE 3 )  ) */
/*        OR */
/*             (  ( A LT 1 ) AND ( D EQ 4 )  ) */
/*        OR */
/*             (  ( B GT 2 ) AND ( C NE 3 )  ) */
/*        OR */
/*             (  ( B GT 2 ) AND ( D EQ 4 )  ) */

/*     which contains eight relational expressions. */



/*     MXJOIN is the maximum number of tables that can be joined. */


/*     MXJCON is the maximum number of join constraints allowed. */


/*     Maximum number of order-by columns that may be used in the */
/*     `order-by clause' of a query: MAXORD. MAXORD = 10. */


/*     Maximum number of tokens in a query: 500. Tokens are reserved */
/*     words, column names, parentheses, and values. Literal strings */
/*     and time values count as single tokens. */


/*     Maximum number of numeric tokens in a query: */


/*     Maximum total length of character tokens in a query: */


/*     Maximum length of literal string values allowed in queries: */
/*     MAXSTR. */


/*     End Include Section:  EK Query Limit Parameters */

/* $ 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. */


/*     Include Section:  EK Encoded Query Internal Parameters */

/*        ekquery.inc  Version 3    16-NOV-1995 (NJB) */

/*           Updated to reflect increased value of MAXCON in */
/*           ekqlimit.inc. */

/*        ekquery.inc  Version 2    03-AUG-1995 (NJB) */

/*           Updated to support representation of the SELECT clause. */


/*        ekquery.inc  Version 1    12-JAN-1995 (NJB) */


/*     An encoded EK query is an abstract data type implemented */
/*     as an integer cell, along with a double precision cell and */
/*     a character string.  The d.p. cell and string contain numeric */
/*     and string values from the query string represented by the */
/*     encoded query. */

/*     The parameters in this file are intended for use only by the */
/*     EK encoded query access routines.  Callers of EK routines should */
/*     not use these parameters. */

/*     The following parameters are indices of specified elements */
/*     in the integer portion of the encoded query. */

/*     Encoded query architecture type: */


/*     `Name resolution' consists of: */

/*        - Verifying existence of tables:  any table names listed */
/*          in the FROM clause of a query must be loaded. */

/*        - Validating table aliases used to qualify column names. */

/*        - Verifying existence of columns and obtaining data types */
/*          for columns. */

/*        - Setting data type codes for literal values in the encoded */
/*          query. */

/*        - Checking consistency of operators and operand data types. */

/*        - Making sure unqualified column names are unambiguous. */

/*        - For constraints, mapping the table names used to qualify */
/*          column names to the ordinal position in the FROM clause */
/*          of the corresponding table. */


/*     Initialization status---this flag indicates whether the encoded */
/*     query has been initialized.  Values are ITRUE or IFALSE.  See the */
/*     include file ekbool.inc for parameter values. */


/*     Parse status---this flag indicates whether the parsing operation */
/*     that produced an encoded query has been completed. Values are */
/*     ITRUE or IFALSE. */


/*     Name resolution status---this flag indicates whether names */
/*     have been resolved in an encoded query.  Values are ITRUE or */
/*     IFALSE. */


/*     Time resolution status---this flag indicates whether time values */
/*     have been resolved in an encoded query.  Time resolution */
/*     consists of converting strings representing time values to ET. */
/*     Values of the status are ITRUE or IFALSE. */


/*     Semantic check status---this flag indicates whether semantic */
/*     checking of constraints has been performed. */


/*     Number of tables specified in FROM clause: */


/*     Number of constraints in query: */


/*     A special value is used to indicate the `maximal' constraint--- */
/*     one that logically cannot be satisfied.  If the constraints */
/*     are equivalent to the maximal constraint, the location EQNCNS */
/*     is assigned the value EQMXML */


/*     Number of constraint conjunctions: */


/*     Number of order-by columns: */


/*     Number of SELECT columns: */


/*     Size of double precision buffer: */


/*     `Free' pointer into double precision buffer: */


/*     Size of character string buffer: */


/*     `Free' pointer into character string buffer: */


/*     The following four base pointers will be valid after a query */
/*     has been parsed: */

/*     Base pointer for SELECT column descriptors: */


/*     Base pointer for constraint descriptors: */


/*     Base pointer for conjunction sizes: */


/*     Base pointer for order-by column descriptors: */


/*     After the quantities named above, the integer array contains */
/*     series of descriptors for tables, constraints, and order-by */
/*     columns, as well as a list of `conjunction sizes'---that is, */
/*     the sizes of the groups of constraints that form conjunctions, */
/*     after the input query has been re-arranged as a disjunction of */
/*     conjunctions of constraints. */


/*     The offsets of specific elements within descriptors are */
/*     parameterized. The base addresses of the descriptors themselves */
/*     must be  calculated using the counts and sizes of the items */
/*     preceding them. */

/*     A diagram of the structure of the variable-size portion of the */
/*     integer array is shown below: */


/*        +-------------------------------------+ */
/*        | Fixed-size portion of encoded query | */
/*        +-------------------------------------+ */
/*        |         Encoded FROM clause         | */
/*        +-------------------------------------+ */
/*        |      Encoded constraint clause      | */
/*        +-------------------------------------+ */
/*        |          Conjunction sizes          | */
/*        +-------------------------------------+ */
/*        |       Encoded ORDER BY clause       | */
/*        +-------------------------------------+ */
/*        |        Encoded SELECT clause        | */
/*        +-------------------------------------+ */


/*     Value Descriptors */
/*     ---------------- */

/*     In order to discuss the various descriptors below, we'll make use */
/*     of sub-structures called `value descriptors'.  These descriptors */
/*     come in two flavors:  character and double precision.  For */
/*     strings, a descriptor is a set of begin and end pointers that */
/*     indicate the location of the string in the character portion of an */
/*     encoded query, along with the begin and end pointers for the */
/*     corresponding lexeme in the original query.  The pointers are set */
/*     to zero when they are not in use, for example if they refer to an */
/*     optional lexeme that did not appear in the input query. */

/*     All value descriptors start with a data type indicator; values */
/*     are from ektype.inc.  Integer and time values are referred to */
/*     by double precision descriptors. */

/*     Parameters for string value descriptor elements: */


/*     Numeric value descriptors are similar to those for string values, */
/*     the difference being that they have only one pointer to the value */
/*     they represent.  This pointer is the index of the value in the */
/*     encoded query's numeric buffer. */


/*     All value descriptors have the same size.  In order to allow */
/*     table descriptors to have the same size as value descriptors, */
/*     we include an extra element in the descriptor. */


/*     Column Descriptors */
/*     ----------------- */

/*     Each column descriptor consists of a character descriptor for the */
/*     name of the column, followed by an index, which gives the ordinal */
/*     position of the column in the logical table to which the column */
/*     belongs.  The index element is filled in during name resolution. */


/*     Table Descriptors */
/*     ----------------- */

/*     Each table descriptor consists of a character descriptor for the */
/*     name of the table, followed by an index, which gives the ordinal */
/*     position of the table in the FROM clause in the original query. */
/*     The index element is filled in during name resolution.  Aliases */
/*     and table names have identical descriptor structures. */


/*     Constraint descriptors */
/*     ------------------ */

/*     Each constraint is characterized by: */

/*        - A code indicating whether the constraint compares values */
/*          in two columns or the value in a column and a literal */
/*          value.  The values of this element are EQCOL and EQVAL. */



/*        - A descriptor for the table used to qualify the */
/*          column name on the left side of the constraint. */


/*        - A character value descriptor for the column name on the left */
/*          side of the query. */


/*        - An operator code indicating the relational operator used */
/*          in the constraint. */


/*        If the constraint compares values from two columns, the */
/*        next items are table and column name descriptors that apply to */
/*        the column named on the right side of the relational operator. */


/*        If the constraint has a literal value on the right side, the */
/*        operator code is followed by... */

/*        - a value descriptor. */


/*        - Size of a constraint descriptor: */


/*     Conjunction sizes */
/*     ----------------- */

/*     The size of each conjunction of constraints occupies a single */
/*     integer. */




/*     Order-by Column Descriptors */
/*     --------------------------- */

/*     Each order-by column descriptor contains descriptors for */
/*     the table containing the column and for the name of the column */
/*     itself; one additional element is used to indicate the direction */
/*     of the ordering (ascending vs descending). */


/*        - The last integer in the descriptor indicates whether the */
/*          order direction is ascending or descending. */


/*        - Size of an order-by column descriptor: */


/*     Codes indicating sense of ordering (ascending vs descending): */


/*     SELECT Column Descriptors */
/*     --------------------------- */

/*     Each SELECT column descriptor contains descriptors for */
/*     the table containing the column and for the name of the column */
/*     itself. */


/*        - Size of a SELECT column descriptor: */


/*     Miscellaneous parameters: */


/*     EQIMIN is the minimum size of the integer portion of */
/*     an encoded query.  EQIMIN depends on the parameters */

/*        MAXTAB */
/*        MAXCON */
/*        MAXORD */
/*        MAXSEL */

/*     all of which are declared in the include file ekqlimit.inc. */
/*     The functional definition of EQIMIN is: */

/*     INTEGER               EQIMIN */
/*     PARAMETER           ( EQIMIN =   EQVBAS */
/*    .                              +  MAXTAB * EQVDSZ * 2 */
/*    .                              +  MAXCON * EQCDSZ */
/*    .                              +  MAXCON */
/*    .                              +  MAXORD * EQODSZ */
/*    .                              +  MAXSEL * EQSDSZ     ) */


/*     End Include Section:  EK Encoded Query Internal Parameters */

/* $ 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. */


/*     Include Section:  EK Table Name Size */

/*        ektnamsz.inc Version 1    17-JAN-1995 (NJB) */


/*     Size of table name, in characters. */


/*     End Include Section:  EK Table Name Size */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     EQRYI     I-O  Integer component of query. */
/*     EQRYC     I-O  Character component of query. */
/*     ERROR      O   Error flag. */
/*     ERRMSG     O   Error message. */
/*     ERRPTR     O   Position in query where error was detected. */

/* $ Detailed_Input */

/*     QUERY          is the original query from which EQRYI and EQRYC */
/*                    were obtained.  QUERY is used only for */
/*                    construction of error messages. */

/*     EQRYI          is the integer portion of an encoded EK query. */
/*                    The query must have been parsed. */

/*     EQRYC          is the character portion of an encoded EK query. */

/* $ Detailed_Output */

/*     EQRYI          is the integer portion of an encoded EK query. */
/*                    On output, all names have been resolved, and */
/*                    table names, aliases, and column names have */
/*                    been semantically checked. */

/*     EQRYC          is the character portion of an encoded EK query. */

/*     ERROR          is a logical flag indicating whether an error was */
/*                    detected.  The error could be a name resolution */
/*                    error or a semantic error. */

/*     ERRMSG         is an error message describing an error in the */
/*                    input query, if one was detected.  If ERROR is */
/*                    returned .FALSE., then ERRPTR is undefined. */

/*     ERRPTR         is the character position in the original query */
/*                    at which an error was detected, if an error was */
/*                    found.  This index refers to the offending lexeme's */
/*                    position in the original query represented by the */
/*                    input encoded query.  If ERROR is returned .FALSE., */
/*                    ERRPTR is undefined. */
/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1)  If the input query is not initialized, the error will be */
/*         diagnosed by routines called by this routine.  The outputs */
/*         will not be modified. */

/*     2)  If the input query has not been parsed, the error */
/*         SPICE(QUERYNOTPARSED) will be signalled.  The outputs */
/*         will not be modified. */

/*     3)  If any sort of name resolution error or semantic error is */
/*         detected in the input query, the output flag ERROR is set, */
/*         and an error message is returned.  The checks performed by */
/*         this routine are listed below: */

/*           - All tables named in the FROM clause must be loaded */
/*             in the EK system. */

/*           - All aliases in the FROM clause must be distinct. */

/*           - No alias may be the name of a table in the FROM clause, */
/*             unless it is identical to the name of the table it is */
/*             associated with. */

/*           - No column name may be qualified with a name that is not */
/*             the name or alias of a table in the FROM clause. */

/*           - Each qualified column must be present in the table */
/*             indicated by its qualifying name. */

/*           - Each unqualified column name must be the name of a */
/*             column present in exactly one of the tables listed in the */
/*             FROM clause. */
/* $ Files */

/*     None. */

/* $ Particulars */

/*     Resolution of table names involves finding each table's ordinal */
/*     position in the FROM clause, and setting the table's descriptor */
/*     to record that position.  The same is done for column descriptors. */

/* $ Examples */

/*     See EKFIND. */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman       (JPL) */

/* $ Version */

/* -    Beta Version 1.0.0, 17-OCT-1995 (NJB) */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     No error to start with. */

    *error = FALSE_;
    s_copy(errmsg, " ", errmsg_len, (ftnlen)1);
    *errptr = 0;

/*     The query must have been parsed at this point, or it's no go. */

    zzekreqi_(eqryi, "PARSED", &iparse, (ftnlen)6);
    if (failed_()) {
	return 0;
    }
    if (iparse == -1) {
	chkin_("ZZEKNRES", (ftnlen)8);
	setmsg_("Encoded query has not been parsed.", (ftnlen)34);
	sigerr_("SPICE(QUERYNOTPARSED)", (ftnlen)21);
	chkout_("ZZEKNRES", (ftnlen)8);
	return 0;
    }

/*     Get the important counts from the query. */

    zzekreqi_(eqryi, "NUM_TABLES", &ntab, (ftnlen)10);
    zzekreqi_(eqryi, "NUM_CONSTRAINTS", &ncns, (ftnlen)15);
    zzekreqi_(eqryi, "NUM_CONJUNCTIONS", &ncnj, (ftnlen)16);
    zzekreqi_(eqryi, "NUM_ORDERBY_COLS", &nord, (ftnlen)16);
    zzekreqi_(eqryi, "NUM_SELECT_COLS", &nsel, (ftnlen)15);

/*     Start out by fetching the table names and their aliases. */

    i__1 = ntab;
    for (i__ = 1; i__ <= i__1; ++i__) {
	zzekqtab_(eqryi, eqryc, &i__, table + (((i__2 = i__ - 1) < 10 && 0 <= 
		i__2 ? i__2 : s_rnge("table", i__2, "zzeknres_", (ftnlen)254))
		 << 6), alias + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : 
		s_rnge("alias", i__3, "zzeknres_", (ftnlen)254)) << 6), 
		eqryc_len, (ftnlen)64, (ftnlen)64);
    }

/*     Make sure that the aliases are distinct.  Rather than sorting */
/*     them, we'll check them in left-to-right order. */

    i__1 = ntab - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ntab;
	for (j = i__ + 1; j <= i__2; ++j) {
	    if (s_cmp(alias + (((i__3 = i__ - 1) < 10 && 0 <= i__3 ? i__3 : 
		    s_rnge("alias", i__3, "zzeknres_", (ftnlen)265)) << 6), 
		    alias + (((i__4 = j - 1) < 10 && 0 <= i__4 ? i__4 : 
		    s_rnge("alias", i__4, "zzeknres_", (ftnlen)265)) << 6), (
		    ftnlen)64, (ftnlen)64) == 0 && s_cmp(alias + (((i__5 = 
		    i__ - 1) < 10 && 0 <= i__5 ? i__5 : s_rnge("alias", i__5, 
		    "zzeknres_", (ftnlen)265)) << 6), " ", (ftnlen)64, (
		    ftnlen)1) != 0) {
		*error = TRUE_;
		s_copy(errmsg, "Non-distinct alias <#> was found.", 
			errmsg_len, (ftnlen)33);
		base = ((j - 1 << 1) + 1) * 6 + 19;
		lxb = eqryi[base + 7];
		lxe = eqryi[base + 8];
		repmc_(errmsg, "#", query + (lxb - 1), errmsg, errmsg_len, (
			ftnlen)1, lxe - (lxb - 1), errmsg_len);
		*errptr = lxb;
		return 0;
	    }

/*           We've checked the Jth alias for a match. */

	}
    }

/*     Make sure that no alias matches a table name other than that of */
/*     the table it corresponds to. */

    i__1 = ntab;
    for (i__ = 1; i__ <= i__1; ++i__) {
	j = isrchc_(alias + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : 
		s_rnge("alias", i__2, "zzeknres_", (ftnlen)295)) << 6), &ntab,
		 table, (ftnlen)64, (ftnlen)64);
	if (j != 0) {
	    if (j != i__) {
		*error = TRUE_;
		s_copy(errmsg, "Alias <#> conflicts with table name.", 
			errmsg_len, (ftnlen)36);
		base = ((i__ - 1 << 1) + 1) * 6 + 19;
		lxb = eqryi[base + 7];
		lxe = eqryi[base + 8];
		repmc_(errmsg, "#", query + (lxb - 1), errmsg, errmsg_len, (
			ftnlen)1, lxe - (lxb - 1), errmsg_len);
		*errptr = lxb;
		return 0;
	    }
	}
    }

/*     Make sure that all of the tables are loaded in the EK system. */

    ekntab_(&nload);
    i__1 = ntab;
    for (i__ = 1; i__ <= i__1; ++i__) {
	fnd = FALSE_;
	j = 1;
	while(j <= nload && ! fnd) {
	    ektnam_(&j, ltable, (ftnlen)64);
	    if (s_cmp(table + (((i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 : 
		    s_rnge("table", i__2, "zzeknres_", (ftnlen)336)) << 6), 
		    ltable, (ftnlen)64, (ftnlen)64) == 0) {

/*              When we find a loaded table, save the column count for */
/*              that table. */

		fnd = TRUE_;
		ekccnt_(table, &cc[(i__2 = i__ - 1) < 10 && 0 <= i__2 ? i__2 :
			 s_rnge("cc", i__2, "zzeknres_", (ftnlen)342)], (
			ftnlen)64);
	    } else {
		++j;
	    }
	}
	if (! fnd) {
	    *error = TRUE_;
	    s_copy(errmsg, "Table <#> is not currently loaded.", errmsg_len, (
		    ftnlen)34);

/*           In order to set the error pointer, we'll need the */
/*           lexeme begin value for the offending table. */

	    base = (i__ - 1) * 12 + 19;
	    lxb = eqryi[base + 7];
	    lxe = eqryi[base + 8];
	    repmc_(errmsg, "#", query + (lxb - 1), errmsg, errmsg_len, (
		    ftnlen)1, lxe - (lxb - 1), errmsg_len);
	    *errptr = lxb;
	    return 0;
	}
    }

/*     At this point, the tables and aliases are deemed correct.  For */
/*     safety, fill in each table and alias descriptor with its */
/*     ordinal position. */

    i__1 = ntab;
    for (i__ = 1; i__ <= i__1; ++i__) {
	base = (i__ - 1) * 12 + 19;
	eqryi[base + 11] = i__;
	eqryi[base + 17] = i__;
    }

/*     Check the column names used in the constraints. */

    i__1 = ncns;
    for (i__ = 1; i__ <= i__1; ++i__) {

/*        Calculate the base address of the constraint. */

	base = ntab * 12 + 19 + (i__ - 1) * 26;

/*        Obtain the constraint type. */

	cnstyp = eqryi[base + 6];

/*        Check the column and table on the LHS of the constraint. */

	i__2 = base + 1;
	zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &i__2, error, 
		errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)64, 
		errmsg_len);
	if (*error) {
	    return 0;
	}
	if (cnstyp == 1) {

/*           Check the column and table on the RHS of the constraint. */

	    i__2 = base + 14;
	    zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &i__2, error, 
		    errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)
		    64, errmsg_len);
	    if (*error) {
		return 0;
	    }
	}
    }

/*     Do the same checks and assignments for the SELECT columns. */

    i__1 = nsel;
    for (i__ = 1; i__ <= i__1; ++i__) {

/*        Calculate the base address of the SELECT column descriptor. */

	base = ntab * 12 + 19 + ncnj + ncns * 26 + nord * 13 + (i__ - 1) * 12;
	zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &base, error, 
		errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)64, 
		errmsg_len);
	if (*error) {
	    return 0;
	}
    }

/*     Do the same checks and assignments for the order-by columns. */

    i__1 = nord;
    for (i__ = 1; i__ <= i__1; ++i__) {

/*        Calculate the base address of the order-by column descriptor. */

	base = ntab * 12 + 19 + ncnj + ncns * 26 + (i__ - 1) * 13;
	zzekcchk_(query, eqryi, eqryc, &ntab, table, alias, &base, error, 
		errmsg, errptr, query_len, eqryc_len, (ftnlen)64, (ftnlen)64, 
		errmsg_len);
	if (*error) {
	    return 0;
	}
    }

/*     Indicate completion of name resolution. */

    zzekweqi_("NAMES_RESOLVED", &c__1, eqryi, (ftnlen)14);
    return 0;
} /* zzeknres_ */
Ejemplo n.º 7
0
/* $Procedure      ZZHLP021 ( private help text ) */
/* Subroutine */ int zzhlp021_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 1941, "where topic title is the title that appe"
	    "ars in one of the help menus.", text_len, (ftnlen)69);
    s_copy(text + text_len * 1942, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1943, "You don't have to enter the title exactl"
	    "y as it appears in the help system", text_len, (ftnlen)74);
    s_copy(text + text_len * 1944, "menus.  The help topic search does not d"
	    "epend upon the case of the letters", text_len, (ftnlen)74);
    s_copy(text + text_len * 1945, "you use.  Also, you may use a wild card "
	    "pattern for the topic title.", text_len, (ftnlen)68);
    s_copy(text + text_len * 1946, "This way you don't have to remember", 
	    text_len, (ftnlen)35);
    s_copy(text + text_len * 1947, "the exact topic.  However, you do run a "
	    "slight risk that some other help", text_len, (ftnlen)72);
    s_copy(text + text_len * 1948, "topic will match your pattern.  If more "
	    "than one topic matches the pattern,", text_len, (ftnlen)75);
    s_copy(text + text_len * 1949, "Inspekt will choose the one that occurs "
	    "first in an alphabetical listing", text_len, (ftnlen)72);
    s_copy(text + text_len * 1950, "of the help topics.", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 1951, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1952, "Once you are in the help system, you mus"
	    "t use the menus to navigate the", text_len, (ftnlen)71);
    s_copy(text + text_len * 1953, "various help topics.  You can not enter "
	    "the name of some other topic and", text_len, (ftnlen)72);
    s_copy(text + text_len * 1954, "display it directly.", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 1955, "@@Short Cut to Topics", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1956, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 1957, "Help", text_len, (ftnlen)4);
    finish[52] = 1958;
    begin[53] = 1959;
    s_copy(text + text_len * 1958, "You can get a snapshot of all of the att"
	    "ributes of a column (both", text_len, (ftnlen)65);
    s_copy(text + text_len * 1959, "the user adjustable attributes and fixed"
	    " attributes) by issuing", text_len, (ftnlen)63);
    s_copy(text + text_len * 1960, "the command.", text_len, (ftnlen)12);
    s_copy(text + text_len * 1961, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1962, "SHOW COLUMN column_name;", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 1963, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1964, "If more than one table possess a column "
	    "with your name", text_len, (ftnlen)54);
    s_copy(text + text_len * 1965, "you must specify which column you are ta"
	    "lking about.", text_len, (ftnlen)52);
    s_copy(text + text_len * 1966, "Do this by prefixing the table name to t"
	    "he column name as", text_len, (ftnlen)57);
    s_copy(text + text_len * 1967, "in", text_len, (ftnlen)2);
    s_copy(text + text_len * 1968, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1969, "SHOW COLUMN table.column_name", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 1970, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1971, "where <table> is the name of the column "
	    "of interest .", text_len, (ftnlen)53);
    s_copy(text + text_len * 1972, "Below is a possible result of the comman"
	    "d SHOW COLUMN ACTIVITY;", text_len, (ftnlen)63);
    s_copy(text + text_len * 1973, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1974, "Attributes of column:     :  ACTIVITY", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 1975, "Type                      :  CHARACTER*("
	    "32)", text_len, (ftnlen)43);
    s_copy(text + text_len * 1976, "Indexed                   :  YES", 
	    text_len, (ftnlen)32);
    s_copy(text + text_len * 1977, "Number of Components      :  1", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 1978, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1979, "User Adjustable Attributes", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 1980, "Column justification      :  LEFT", 
	    text_len, (ftnlen)33);
    s_copy(text + text_len * 1981, "Column width              :  32", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 1982, "Column heading            :  ACTIVITY", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 1983, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1984, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1985, "@@SHOW COLUMN   ...", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 1986, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 1987, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 1988, "SET COLUMN ...", text_len, (ftnlen)14);
    finish[53] = 1989;
    begin[54] = 1990;
    s_copy(text + text_len * 1989, "Every SPICE kernel provides a mechanism "
	    "for the creator of the", text_len, (ftnlen)62);
    s_copy(text + text_len * 1990, "product to attach documentation to the k"
	    "ernel.  This documentation is stored in", text_len, (ftnlen)79);
    s_copy(text + text_len * 1991, "of the file called the \"comments\" area."
	    , text_len, (ftnlen)39);
    s_copy(text + text_len * 1992, "All kernels should", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 1993, "have a non-empty comment section. The co"
	    "mments typically will", text_len, (ftnlen)61);
    s_copy(text + text_len * 1994, "provide information on one or more of th"
	    "e following items:", text_len, (ftnlen)58);
    s_copy(text + text_len * 1995, "@newlist", text_len, (ftnlen)8);
    s_copy(text + text_len * 1996, "@numitem the date the kernel was created,"
	    , text_len, (ftnlen)41);
    s_copy(text + text_len * 1997, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1998, "@numitem who created it,", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 1999, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2000, "@numitem who to contact if you have ques"
	    "tions about the kernel,", text_len, (ftnlen)63);
    s_copy(text + text_len * 2001, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2002, "@numitem the intended set of users of th"
	    "e kernel,", text_len, (ftnlen)49);
    s_copy(text + text_len * 2003, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2004, "@numitem special notes regarding the con"
	    "tents of the kernel.", text_len, (ftnlen)60);
    s_copy(text + text_len * 2005, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2006, "To see the comments stored in a loaded E"
	    "-kernel issue the command", text_len, (ftnlen)65);
    s_copy(text + text_len * 2007, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2008, "SHOW COMMENTS pattern", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 2009, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2010, "If the name of a loaded kernel", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2011, "matches this pattern, the comments for t"
	    "hat kernel will be", text_len, (ftnlen)58);
    s_copy(text + text_len * 2012, "displayed.", text_len, (ftnlen)10);
    s_copy(text + text_len * 2013, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2014, "If none of the kernel names match this p"
	    "attern, a message informing", text_len, (ftnlen)67);
    s_copy(text + text_len * 2015, "you of this condition will be displayed."
	    "  If a kernel matches the", text_len, (ftnlen)65);
    s_copy(text + text_len * 2016, "pattern, but no comments are in the kern"
	    "el a message will be displayed", text_len, (ftnlen)70);
    s_copy(text + text_len * 2017, "indicating that no comments are availabl"
	    "e.", text_len, (ftnlen)42);
    s_copy(text + text_len * 2018, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2019, "@@SHOW COMMENTS ...", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 2020, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2021, "Help", text_len, (ftnlen)4);
    finish[54] = 2022;
    begin[55] = 2023;
    s_copy(text + text_len * 2022, "There are a number of more or less globa"
	    "l features of", text_len, (ftnlen)53);
    s_copy(text + text_len * 2023, "an Inspekt session that affect how Inspe"
	    "kt carries out", text_len, (ftnlen)54);
    s_copy(text + text_len * 2024, "the commands you issue.  These items are"
	    " grouped together", text_len, (ftnlen)57);
    s_copy(text + text_len * 2025, "under the term Environment.  They includ"
	    "e:", text_len, (ftnlen)42);
    s_copy(text + text_len * 2026, "@newlist", text_len, (ftnlen)8);
    s_copy(text + text_len * 2027, "@numitem The editor used when you EDIT a"
	    " command.", text_len, (ftnlen)49);
    s_copy(text + text_len * 2028, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2029, "@numitem Whether or not Help waits for y"
	    "ou to", text_len, (ftnlen)45);
    s_copy(text + text_len * 2030, "         finish reading a page before it"
	    " prints", text_len, (ftnlen)47);
    s_copy(text + text_len * 2031, "         the next screen out material", 
	    text_len, (ftnlen)37);
    return 0;
} /* zzhlp021_ */
Ejemplo n.º 8
0
/* $Procedure      ZZHLP006 ( private help text ) */
/* Subroutine */ int zzhlp006_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 576, "EQ             column EQ   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 577, "GE             column GE   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 578, "GT             column GT   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 579, "NE             column NE   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 580, "<              column <    expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 581, "<=             column <=   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 582, "=              column =    expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 583, ">=             column >=   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 584, ">              column >    expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 585, "!=             column <>   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 586, "<>             column !=   expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 587, "LIKE           column LIKE expression", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 588, "NOT LIKE       column NOT LIKE expression",
	     text_len, (ftnlen)41);
    s_copy(text + text_len * 589, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 590, "BETWEEN        column BETWEEN expression", 
	    text_len, (ftnlen)40);
    s_copy(text + text_len * 591, "                      AND     expression", 
	    text_len, (ftnlen)40);
    s_copy(text + text_len * 592, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 593, "NOT BETWEEN    column NOT BETWEEN express"
	    "ion", text_len, (ftnlen)44);
    s_copy(text + text_len * 594, "                      AND         express"
	    "ion", text_len, (ftnlen)44);
    s_copy(text + text_len * 595, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 596, "where \"column\" is the name of some colu"
	    "mn and \"expression\"", text_len, (ftnlen)58);
    s_copy(text + text_len * 597, "is the name of a column or a literal valu"
	    "e such as 1 or", text_len, (ftnlen)55);
    s_copy(text + text_len * 598, "\"A Literal String\".", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 599, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 600, "Conditions listed above are true if:", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 601, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 602, "@setparamsize{NOT BETWEEN}", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 603, "@param LT or <.", text_len, (ftnlen)15);
    s_copy(text + text_len * 604, "the value column is less than the value o"
	    "f expression.", text_len, (ftnlen)54);
    s_copy(text + text_len * 605, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 606, "@param LE or <=.", text_len, (ftnlen)16);
    s_copy(text + text_len * 607, "the value of column is less than or equal"
	    " to the value", text_len, (ftnlen)54);
    s_copy(text + text_len * 608, "of expression", text_len, (ftnlen)13);
    s_copy(text + text_len * 609, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 610, "@param EQ or =.", text_len, (ftnlen)15);
    s_copy(text + text_len * 611, "the value of column is equal to the value"
	    " of expression.", text_len, (ftnlen)56);
    s_copy(text + text_len * 612, "Note that for strings, the case of charac"
	    "ters is significant.", text_len, (ftnlen)61);
    s_copy(text + text_len * 613, "The strings 'A' and 'a' are not equal.", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 614, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 615, "@param GE or >=.", text_len, (ftnlen)16);
    s_copy(text + text_len * 616, "the value of column is greater than or eq"
	    "ual to the value", text_len, (ftnlen)57);
    s_copy(text + text_len * 617, "of expression.", text_len, (ftnlen)14);
    s_copy(text + text_len * 618, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 619, "@param GT or >.", text_len, (ftnlen)15);
    s_copy(text + text_len * 620, "the value of column is greater than the v"
	    "alue of expression.", text_len, (ftnlen)60);
    s_copy(text + text_len * 621, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 622, "@param NE or != or <>.", text_len, (ftnlen)
	    22);
    s_copy(text + text_len * 623, "the value of column is not equal to the v"
	    "alue of expression.", text_len, (ftnlen)60);
    s_copy(text + text_len * 624, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 625, "@param LIKE.", text_len, (ftnlen)12);
    s_copy(text + text_len * 626, "the value of column matches the value of "
	    "expression when", text_len, (ftnlen)56);
    s_copy(text + text_len * 627, "expression is interpreted as a pattern.", 
	    text_len, (ftnlen)39);
    s_copy(text + text_len * 628, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 629, "@param NOT LIKE.", text_len, (ftnlen)16);
    s_copy(text + text_len * 630, "The value of column does not match the va"
	    "lue of expression", text_len, (ftnlen)58);
    s_copy(text + text_len * 631, "when expression is interpreted as a patte"
	    "rn.", text_len, (ftnlen)44);
    s_copy(text + text_len * 632, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 633, "@param BETWEEN.", text_len, (ftnlen)15);
    s_copy(text + text_len * 634, "The value of column is greater than or eq"
	    "ual to the smaller of", text_len, (ftnlen)62);
    s_copy(text + text_len * 635, "the two expressions AND less than or equa"
	    "l to the larger of the", text_len, (ftnlen)63);
    s_copy(text + text_len * 636, "two expressions.", text_len, (ftnlen)16);
    s_copy(text + text_len * 637, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 638, "@param NOT BETWEEN", text_len, (ftnlen)18);
    s_copy(text + text_len * 639, "The value of column is less than the smal"
	    "ler of the two expression", text_len, (ftnlen)66);
    s_copy(text + text_len * 640, "OR greater than the larger of the two exp"
	    "ression.", text_len, (ftnlen)49);
    s_copy(text + text_len * 641, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 642, "A WHERE clause is composed of the word \""
	    "WHERE\" followed by", text_len, (ftnlen)58);
    s_copy(text + text_len * 643, "a logical expression made up of condition"
	    "s connected by", text_len, (ftnlen)55);
    s_copy(text + text_len * 644, "AND's, OR's and NOT's and grouped using p"
	    "arentheses.", text_len, (ftnlen)52);
    s_copy(text + text_len * 645, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 646, "@@Conditional Operators", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 647, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 648, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 649, "Specifying Strings", text_len, (ftnlen)18);
    s_copy(text + text_len * 650, "Specifying Times", text_len, (ftnlen)16);
    s_copy(text + text_len * 651, "Where Clause", text_len, (ftnlen)12);
    finish[7] = 652;
    begin[8] = 653;
    s_copy(text + text_len * 652, "Inspekt can display any of it's current s"
	    "etting.  However, these", text_len, (ftnlen)64);
    s_copy(text + text_len * 653, "settings are grouped together in various "
	    "groupings.  To see one", text_len, (ftnlen)63);
    s_copy(text + text_len * 654, "of these grouping you type", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 655, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 656, "SHOW item", text_len, (ftnlen)9);
    s_copy(text + text_len * 657, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 658, "See the help topics below for more specif"
	    "ic descriptions.", text_len, (ftnlen)57);
    s_copy(text + text_len * 659, "@@Current Settings   --- SHOW", text_len, (
	    ftnlen)29);
    s_copy(text + text_len * 660, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 661, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 662, "SHOW COLUMN      ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 663, "SHOW COMMENTS    ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 664, "SHOW ENVIRONMENT ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 665, "SHOW FORMAT      ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 666, "SHOW INDEXED     ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 667, "SHOW KERNELS     ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 668, "SHOW PAGE        ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 669, "SHOW SUMMARY     ...", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 670, "Columns", text_len, (ftnlen)7);
    s_copy(text + text_len * 671, "Deluge Warning", text_len, (ftnlen)14);
    s_copy(text + text_len * 672, "Headers", text_len, (ftnlen)7);
    return 0;
} /* zzhlp006_ */
Ejemplo n.º 9
0
/* $Procedure      ZZHLP030 ( private help text ) */
/* Subroutine */ int zzhlp030_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    finish[69] = 2790;
    begin[70] = 2791;
    s_copy(text + text_len * 2790, "You may request time to be displayed in "
	    "an almost limitless variety of formats.", text_len, (ftnlen)79);
    s_copy(text + text_len * 2791, "The default format is UTC calendar forma"
	    "t. Other standard formats may be  set by", text_len, (ftnlen)80);
    s_copy(text + text_len * 2792, "using either of the commands:", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 2793, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2794, "SET COLUMN column_name FORMAT format;", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 2795, "SET DEFAULT TIME FORMAT format;", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 2796, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2797, "A number of standard formats may be spec"
	    "ified:", text_len, (ftnlen)46);
    s_copy(text + text_len * 2798, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2799, "@setparamsize{GLLSCLK}", text_len, (
	    ftnlen)22);
    s_copy(text + text_len * 2800, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2801, "@param  UTC.", text_len, (ftnlen)12);
    s_copy(text + text_len * 2802, "Default format: YYYY-MON-DD HR:MN:SC", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 2803, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2804, "@param ISO.", text_len, (ftnlen)11);
    s_copy(text + text_len * 2805, "International Standards format: YYYY-MM-"
	    "DDTHR:MN:SC", text_len, (ftnlen)51);
    s_copy(text + text_len * 2806, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2807, "@param ISODOY.", text_len, (ftnlen)14);
    s_copy(text + text_len * 2808, "International Standards day of year: YYY"
	    "Y-DOYTHR:MN:SC", text_len, (ftnlen)54);
    s_copy(text + text_len * 2809, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2810, "@param  JED.", text_len, (ftnlen)12);
    s_copy(text + text_len * 2811, "Julian Ephemeris date to 5 decimal places"
	    , text_len, (ftnlen)41);
    s_copy(text + text_len * 2812, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2813, "@param MOSCLK.", text_len, (ftnlen)14);
    s_copy(text + text_len * 2814, "Mars Observer Spacecraft Clock format", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 2815, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2816, "@param GLLSCLK.", text_len, (ftnlen)15);
    s_copy(text + text_len * 2817, "Galileo Spacecraft Clock format", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 2818, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2819, "These formats will be recognized regardl"
	    "ess of the case of the letters use to", text_len, (ftnlen)77);
    s_copy(text + text_len * 2820, "specify them.  The UTC, ISO and ISODY fo"
	    "rmats are all UTC times.  You may also", text_len, (ftnlen)78);
    s_copy(text + text_len * 2821, "create a custom format (see Custom Forma"
	    "ts).", text_len, (ftnlen)44);
    s_copy(text + text_len * 2822, "@@Time Formats", text_len, (ftnlen)14);
    s_copy(text + text_len * 2823, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2824, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 2825, "Custom Formats", text_len, (ftnlen)14);
    s_copy(text + text_len * 2826, "Default Time Format", text_len, (ftnlen)
	    19);
    finish[70] = 2827;
    begin[71] = 2828;
    s_copy(text + text_len * 2827, "Titles are single lines of text that app"
	    "ear at the beginning", text_len, (ftnlen)60);
    s_copy(text + text_len * 2828, "of Inspekt reports.  You may adjust the "
	    "text of the title,", text_len, (ftnlen)58);
    s_copy(text + text_len * 2829, "its positioning (left justified, centere"
	    "d, or right justified), and", text_len, (ftnlen)67);
    s_copy(text + text_len * 2830, "how often it is shown as a report is dis"
	    "played.  To see the current", text_len, (ftnlen)67);
    s_copy(text + text_len * 2831, "attributes of the report title, type", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 2832, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2833, "SHOW PAGE", text_len, (ftnlen)9);
    s_copy(text + text_len * 2834, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2835, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2836, "@@Titles", text_len, (ftnlen)8);
    s_copy(text + text_len * 2837, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2838, "Help", text_len, (ftnlen)4);
    finish[71] = 2839;
    begin[72] = 2840;
    s_copy(text + text_len * 2839, "Inspekt is a command driven program.  Yo"
	    "u type a command at the", text_len, (ftnlen)63);
    s_copy(text + text_len * 2840, "prompt", text_len, (ftnlen)6);
    s_copy(text + text_len * 2841, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2842, "Inspekt>", text_len, (ftnlen)8);
    s_copy(text + text_len * 2843, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2844, "The program performs some action based u"
	    "pon the typed command.  If", text_len, (ftnlen)66);
    s_copy(text + text_len * 2845, "a command is too long to fit on a single"
	    " line, hit the return key", text_len, (ftnlen)65);
    s_copy(text + text_len * 2846, "when you get to the end of the line and "
	    "continue typing on the next", text_len, (ftnlen)67);
    s_copy(text + text_len * 2847, "line. When you are finished typing the c"
	    "ommand, type a semi-colon", text_len, (ftnlen)65);
    s_copy(text + text_len * 2848, "(\";\").  The semi-colon is required at "
	    "the end of all commands typed", text_len, (ftnlen)67);
    s_copy(text + text_len * 2849, "in response to a prompt ending with \""
	    ">\".  It is needed even if the", text_len, (ftnlen)66);
    s_copy(text + text_len * 2850, "line will fit on a single line. Occasion"
	    "ally, Inspekt may prompt", text_len, (ftnlen)64);
    s_copy(text + text_len * 2851, "you to supply inputs other than commands"
	    " (such as in the Help", text_len, (ftnlen)61);
    s_copy(text + text_len * 2852, "system).  In such cases the prompt will "
	    "not end in a greater than", text_len, (ftnlen)65);
    s_copy(text + text_len * 2853, "sign \">\" and the semi-colon is not nee"
	    "ded.", text_len, (ftnlen)42);
    s_copy(text + text_len * 2854, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2855, "The commands you type may be in either u"
	    "pper or lower case.", text_len, (ftnlen)59);
    s_copy(text + text_len * 2856, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2857, "If you begin typing a command and realiz"
	    "e you've made an error or", text_len, (ftnlen)65);
    s_copy(text + text_len * 2858, "wish to start again, add a blank line to"
	    " the command entered so", text_len, (ftnlen)63);
    s_copy(text + text_len * 2859, "far. Inspekt will ignore what you've typ"
	    "ed and prompt you for a", text_len, (ftnlen)63);
    s_copy(text + text_len * 2860, "new command.", text_len, (ftnlen)12);
    s_copy(text + text_len * 2861, "@@Typing Commands", text_len, (ftnlen)17);
    s_copy(text + text_len * 2862, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 2863, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 2864, "Editing Commands", text_len, (ftnlen)16);
    s_copy(text + text_len * 2865, "Column and Table Abbreviations", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2866, "Using Symbols", text_len, (ftnlen)13);
    s_copy(text + text_len * 2867, "Special Symbols --- Queries", text_len, (
	    ftnlen)27);
    s_copy(text + text_len * 2868, "Collecting Commands In Files", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2869, " ", text_len, (ftnlen)1);
    finish[72] = 2870;
    begin[73] = 2871;
    s_copy(text + text_len * 2870, "@subsection An Example", text_len, (
	    ftnlen)22);
    s_copy(text + text_len * 2871, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2872, "Inspekt allows you to create special wor"
	    "ds that when", text_len, (ftnlen)52);
    s_copy(text + text_len * 2873, "encountered in a command are translated "
	    "into different words.", text_len, (ftnlen)61);
    s_copy(text + text_len * 2874, "These special words are called 'symbols'."
	    , text_len, (ftnlen)41);
    s_copy(text + text_len * 2875, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2876, "For example suppose that you frequently "
	    "want to edit your last", text_len, (ftnlen)62);
    s_copy(text + text_len * 2877, "\"Select\" command.  You could make up t"
	    "he symbol ES as shown below:", text_len, (ftnlen)66);
    return 0;
} /* zzhlp030_ */
Ejemplo n.º 10
0
/* $Procedure   COMMNT ( Comment utility program ) */
/* Main program */ MAIN__(void)
{
    /* Initialized data */

    static logical insbln = TRUE_;
    static char maintl[20] = "COMMNT Options      ";
    static char mainvl[20*5] = "QUIT                " "ADD_COMMENTS        " 
	    "READ_COMMENTS       " "EXTRACT_COMMENTS    " "DELETE_COMMENTS  "
	    "   ";
    static char maintx[40*5] = "Quit.                                   " 
	    "Add comments to a binary file.          " "Read the comments in"
	    " a binary file.     " "Extract comments from a binary file.    " 
	    "Delete the comments in a binary file.   ";
    static char mainnm[1*5] = "Q" "A" "R" "E" "D";

    /* System generated locals */
    address a__1[3];
    integer i__1[3], i__2, i__3, i__4, i__5;
    cllist cl__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
	     char **, integer *, integer *, ftnlen);
    integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, 
	    ftnlen, ftnlen), f_clos(cllist *);

    /* Local variables */
    static char arch[3];
    static logical done;
    static char line[1000];
    static logical more;
    static integer iopt;
    static char type__[4];
    static integer i__;
    extern /* Subroutine */ int dasdc_(integer *);
    extern integer cardi_(integer *);
    static integer r__;
    extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *, 
	    ftnlen, ftnlen), chkin_(char *, ftnlen), spcec_(integer *, 
	    integer *), spcdc_(integer *), errch_(char *, char *, ftnlen, 
	    ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen, 
	    ftnlen, ftnlen), reset_(void);
    extern integer rtrim_(char *, ftnlen);
    extern logical failed_(void);
    extern /* Subroutine */ int dafhof_(integer *);
    static integer handle;
    extern /* Subroutine */ int dafcls_(integer *), dasacu_(integer *, char *,
	     char *, logical *, integer *, ftnlen, ftnlen), cleari_(integer *,
	     integer *), delfil_(char *, ftnlen), dasecu_(integer *, integer *
	    , logical *), scardi_(integer *, integer *), dashof_(integer *);
    static logical fileok;
    extern /* Subroutine */ int clcomm_(void), getfat_(char *, char *, char *,
	     ftnlen, ftnlen, ftnlen), cnfirm_(char *, logical *, ftnlen);
    static char fnmtbl[128*2], messag[1000], errmsg[320], messgs[1000*7], 
	    option[20], prmtbl[80*2], statbl[3*2];
    extern logical exists_(char *, ftnlen);
    static integer comlun;
    static char status[1000*2];
    static integer numfnm;
    static char prmpts[80*2];
    static integer numopn, opnset[7], tblidx[2];
    static logical comnts, contnu, ndfnms, tryagn;
    extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen), 
	    erract_(char *, char *, ftnlen, ftnlen), errprt_(char *, char *, 
	    ftnlen, ftnlen), tostdo_(char *, ftnlen), ssizei_(integer *, 
	    integer *), getopt_(char *, integer *, char *, char *, integer *, 
	    ftnlen, ftnlen, ftnlen), getfnm_(char *, char *, char *, logical *
	    , char *, ftnlen, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen)
	    , sigerr_(char *, ftnlen), txtopr_(char *, integer *, ftnlen), 
	    dafopw_(char *, integer *, ftnlen), dasopw_(char *, integer *, 
	    ftnlen), dascls_(integer *), dafopr_(char *, integer *, ftnlen), 
	    spcrfl_(integer *, char *, logical *, ftnlen), spcrnl_(char *, 
	    logical *, ftnlen), dasopr_(char *, integer *, ftnlen), txtopn_(
	    char *, integer *, ftnlen), chkout_(char *, ftnlen);
    static logical eoc;
    static char tkv[12];

/* $ Abstract */

/*     NAIF Toolkit utility program for adding, reading, extracting, */
/*     and deleting comments from a binary file. */

/* $ 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 */

/*     SPC */
/*     DAS */

/* $ Author_and_Institution */

/*     W.L. Taber     (JPL) */
/*     K.R. Gehringer (JPL) */
/*     J.E. McLean    (JPL) */
/*     M.J. Spencer   (JPL) */

/* $ Version */

/* -    Version 6.0.1, 08-MAY-2001 (BVS) */

/*       Increased LINLEN from 255 to 1000 to make it consistent */
/*       with SPICELIB's SPC* and SUPPORT's DAF* internal line sizes. */

/* -    Version 5.0.1, 21-JUL-1997 (WLT) */

/*       Modified the banner at start up so that the version of the */
/*       toolkit used to link COMMNT will be displayed. */

/*       In addition all WRITE statements were replaced by calls to */
/*       TOSTDO. */

/* -    Version 5.0.0, 05-MAY-1994 (KRG) */

/*       Modified the program to use the new file type identification */
/*       capability that was added to spicelib. No file type menu is */
/*       necessary now, as the file type is determined during the */
/*       execution of the program. */

/*       The prompts for the begin and end markers used to extract a */
/*       subset of text lines from an input comment file which were then */
/*       placed into the comment area of a SPICE binary kernel file have */
/*       been removed. The entire input comment file is now placed into */
/*       the comment area of the binary kernel file. This change */
/*       simplifies the user interaction with the program. */

/*       Added support for the new PCK binary kernel files. */

/*       If an error occurs during the extraction of comments to a file, */
/*       the file that was being created is deleted. We cannot know */
/*       whether the file had been successfully created before the error */
/*       occurred. */

/* -    Version 4.0.0, 11-DEC-1992 (KRG) */

/*        Added code to support the E-Kernel, and redesigned the */
/*        user interface. */

/* -    Version 3.1.0, 19-NOV-1991 (MJS) */

/*        Variable QUIT initialized to FALSE. */

/* -    Version 3.0.1, 10-AUG-1991 (CHA) (NJB) */

/*        Updated comments to reflect status as a Toolkit */
/*        utility program.  Message indicating that no comments */
/*        were found in the specified file was changed to include */
/*        the file name. */

/* -    Version 2.0.0, 28-JUN-1991 (JEM) */

/*        The option to read the comments from the comment */
/*        area of a binary SPK or CK was added to the menu. */

/* -    Version 1.0.0, 05-APR-1991 (JEM) */

/* -& */

/*     SPICELIB functions */


/*     Parameters */

/*     Set the version of the comment program. This should be updated */
/*     every time a change is made, and it should agree with the */
/*     version number in the header. */


/*     Set a value for the logical unit which represents the standard */
/*     output device, commonly a terminal. A value of 6 is widely used, */
/*     but the Fortran standard does not specify a value, so it may be */
/*     different for different Fortran implementations. */


/*     Lower bound for a SPICELIB CELL data structure. */


/*     Maximum number of open binary files allowed. */


/*     Set a value for a replacement marker. */


/*     Set a value for a filename prompt. */


/*     File types */


/*     Set a value for the length of a text line. */


/*     Set a value for the length of an error message. */


/*     Set a value for the length of a filename. */


/*     Set a length for the prompts in the prompt table. */


/*     Set a length for the status of a file: 'OLD' or 'NEW'. */


/*     Set the length for the architecture of a file. */


/*     Set the length for the type of a file. */


/*     Set a length for the option values. */


/*     Set a length for the title of a menu. */


/*     Set a length for an option name (what is typed to select it) */
/*     for a menu. */


/*     Set the length of the text description of an option on a menu. */


/*     The number of options available on the main menu. */


/*     Set up some mnemonics for indexing the prompts in the prompt */
/*     table. */


/*     Set the maximum size of the filename table: this must be the */
/*     number of distinct ``types'' of files that the program may */
/*     require. */


/*     Set up some mnemonics for indexing the messages in the message */
/*     table. */


/*     Set the maximum size of the message table: There should be a */
/*     message for each ``type'' of action that the program can take. */


/*     Set up some mnemonics for the OK and not OK status messages. */


/*     Set the maximum number of status messages that are available. */


/*     We need to have TKVLEN characters to hold the current version */
/*     of the toolkit. */


/*     Variables */


/*     We want to insert a blank line between additions if there are */
/*     already comments in the binary file. We indicate this by giving */
/*     the variable INSBLN the value .TRUE.. */


/*     Define the main menu title ... */


/*     Define the main menu option values ... */


/*     Define the main menu descriptive text for each option ... */


/*     Define the main menu option names ... */


/*     Register the COMMNT main program with the SPICELIB error handler. */

    chkin_("COMMNT", (ftnlen)6);
    clcomm_();
    tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)12);
    r__ = rtrim_(tkv, (ftnlen)12);

/*     Set the error action to 'RETURN'. We don't want the program */
/*     to abort if an error is signalled. We check FAILED where */
/*     necessary. If an error is signalled, we'll just handle the */
/*     error, display an appropriate message, then call RESET at the */
/*     end of the loop to continue. */

    erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6);

/*     Set the error messages that we want to have displayed. We will */
/*     diaplay the SPICELIB short and long error messages. This is done */
/*     to ensure that some sort of an error message is displayed if an */
/*     error occurs. In several places, long error messages are not set, */
/*     so if only the long error messages were displayed, it would be */
/*     possible to have an error signalled and not see any error */
/*     information. This is not a very useful thing. */

    errprt_("SET", "NONE, SHORT, LONG, TRACEBACK", (ftnlen)3, (ftnlen)28);

/*     Set up the prompt table for the different types of files. */

    s_copy(prmtbl + 80, "Enter the name of the comment file to be #.", (
	    ftnlen)80, (ftnlen)43);
    s_copy(prmtbl, "Enter the name of the binary file.", (ftnlen)80, (ftnlen)
	    34);

/*     Set up the message table for the different ``types'' of */
/*     operations. The message table contains generic messages which will */
/*     have their missing parts filled in after the option and file type */
/*     havve been selected. */

    s_copy(messgs, "Reading the comment area of the # file.", (ftnlen)1000, (
	    ftnlen)39);
    s_copy(messgs + 1000, "Adding comments to the # file.", (ftnlen)1000, (
	    ftnlen)30);
    s_copy(messgs + 2000, "Extracting comments from the # file.", (ftnlen)
	    1000, (ftnlen)36);
    s_copy(messgs + 3000, "Deleting the comment area of # file.", (ftnlen)
	    1000, (ftnlen)36);
    s_copy(messgs + 4000, "Quitting the program.", (ftnlen)1000, (ftnlen)21);
    s_copy(messgs + 5000, "The comments were successfully #.", (ftnlen)1000, (
	    ftnlen)33);
    s_copy(messgs + 6000, "The comments were NOT successfully #.", (ftnlen)
	    1000, (ftnlen)37);

/*     Display a brief commercial with the name of the program and the */
/*     version. */

    s_copy(line, "   Welcome to COMMNT Version: #", (ftnlen)1000, (ftnlen)31);
    repmc_(line, "#", "6.0.1", line, (ftnlen)1000, (ftnlen)1, (ftnlen)5, (
	    ftnlen)1000);
    tostdo_(" ", (ftnlen)1);
    tostdo_(line, (ftnlen)1000);
/* Writing concatenation */
    i__1[0] = 23, a__1[0] = "        (Spice Toolkit ";
    i__1[1] = r__, a__1[1] = tkv;
    i__1[2] = 1, a__1[2] = ")";
    s_cat(line, a__1, i__1, &c__3, (ftnlen)1000);
    tostdo_(line, (ftnlen)1000);
    tostdo_(" ", (ftnlen)1);

/*     Initialize the CELL oriented set for collecting open DAF or DAS */
/*     files in the event of an error. */

    ssizei_(&c__1, opnset);

/*     While there is still more to do ... */

    done = FALSE_;
    while(! done) {

/*        We initialize a few things here, so that they get reset for */
/*        every trip through the loop. */

/*        Initialize the logical flags that we use. */

	comnts = FALSE_;
	contnu = TRUE_;
	eoc = FALSE_;
	ndfnms = FALSE_;

/*        Initialize the filename table, ... */

	s_copy(fnmtbl, " ", (ftnlen)128, (ftnlen)1);
	s_copy(fnmtbl + 128, " ", (ftnlen)128, (ftnlen)1);

/*        the file status table, ... */

	s_copy(statbl, " ", (ftnlen)3, (ftnlen)1);
	s_copy(statbl + 3, " ", (ftnlen)3, (ftnlen)1);

/*        the table indices, ... */

	tblidx[0] = 0;
	tblidx[1] = 0;

/*        set the number of file names to zero, ... */

	numfnm = 0;

/*        the prompts in the prompt table, ... */

	s_copy(prmpts, " ", (ftnlen)80, (ftnlen)1);
	s_copy(prmpts + 80, " ", (ftnlen)80, (ftnlen)1);

/*        the message, and the option. */

	s_copy(messag, " ", (ftnlen)1000, (ftnlen)1);
	s_copy(option, " ", (ftnlen)20, (ftnlen)1);

/*        Set the status messages. */

	s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
	s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)1000);

/*        Get the option to be performed from the main menu. */

	getopt_(maintl, &c__5, mainnm, maintx, &iopt, (ftnlen)20, (ftnlen)1, (
		ftnlen)40);
	s_copy(option, mainvl + ((i__2 = iopt - 1) < 5 && 0 <= i__2 ? i__2 : 
		s_rnge("mainvl", i__2, "commnt_", (ftnlen)502)) * 20, (ftnlen)
		20, (ftnlen)20);

/*        Set up the messages and other information for the option */
/*        selected. */

	if (contnu) {
	    if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) {
		ndfnms = TRUE_;
		numfnm = 2;
		s_copy(messag, messgs + 1000, (ftnlen)1000, (ftnlen)1000);
		tblidx[0] = 2;
		s_copy(prmpts, prmtbl + 80, (ftnlen)80, (ftnlen)80);
		repmc_(prmpts, "#", "added", prmpts, (ftnlen)80, (ftnlen)1, (
			ftnlen)5, (ftnlen)80);
		s_copy(statbl + 3, "OLD", (ftnlen)3, (ftnlen)3);
		tblidx[1] = 1;
		s_copy(prmpts + 80, prmtbl, (ftnlen)80, (ftnlen)80);
		s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);

/*              Set the operation status messages. */

		s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
		repmc_(status, "#", "added", status, (ftnlen)1000, (ftnlen)1, 
			(ftnlen)5, (ftnlen)1000);
		s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
			1000);
		repmc_(status + 1000, "#", "added", status + 1000, (ftnlen)
			1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000);
	    } else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13) 
		    == 0) {
		ndfnms = TRUE_;
		numfnm = 1;
		s_copy(messag, messgs, (ftnlen)1000, (ftnlen)1000);
		tblidx[0] = 1;
		s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
		s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);

/*              Set the operation status messages. */

		s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
		repmc_(status, "#", "read", status, (ftnlen)1000, (ftnlen)1, (
			ftnlen)4, (ftnlen)1000);
		s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
			1000);
		repmc_(status + 1000, "#", "read", status + 1000, (ftnlen)
			1000, (ftnlen)1, (ftnlen)4, (ftnlen)1000);
	    } else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
		    16) == 0) {
		ndfnms = TRUE_;
		numfnm = 2;
		s_copy(messag, messgs + 2000, (ftnlen)1000, (ftnlen)1000);
		tblidx[0] = 1;
		s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
		s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
		tblidx[1] = 2;
		s_copy(prmpts + 80, prmtbl + 80, (ftnlen)80, (ftnlen)80);
		repmc_(prmpts + 80, "#", "created", prmpts + 80, (ftnlen)80, (
			ftnlen)1, (ftnlen)7, (ftnlen)80);
		s_copy(statbl + 3, "NEW", (ftnlen)3, (ftnlen)3);

/*              Set the operation status messages. */

		s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
		repmc_(status, "#", "extracted", status, (ftnlen)1000, (
			ftnlen)1, (ftnlen)9, (ftnlen)1000);
		s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
			1000);
		repmc_(status + 1000, "#", "extracted", status + 1000, (
			ftnlen)1000, (ftnlen)1, (ftnlen)9, (ftnlen)1000);
	    } else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
		    15) == 0) {
		ndfnms = TRUE_;
		numfnm = 1;
		s_copy(messag, messgs + 3000, (ftnlen)1000, (ftnlen)1000);
		tblidx[0] = 1;
		s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
		s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);

/*              Set the operation status messages. */

		s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
		repmc_(status, "#", "deleted", status, (ftnlen)1000, (ftnlen)
			1, (ftnlen)7, (ftnlen)1000);
		s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
			1000);
		repmc_(status + 1000, "#", "deleted", status + 1000, (ftnlen)
			1000, (ftnlen)1, (ftnlen)7, (ftnlen)1000);
	    } else if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
		s_copy(messag, messgs + 4000, (ftnlen)1000, (ftnlen)1000);
	    }
	}

/*        Collect any filenames that we may need. */

	if (contnu && ndfnms) {

/*           we always need at least one filename if we get to here. */

	    i__ = 1;
	    more = TRUE_;
	    while(more) {
		fileok = FALSE_;
		tryagn = TRUE_;
		while(tryagn) {
		    tostdo_(" ", (ftnlen)1);
		    tostdo_(prmpts + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? 
			    i__2 : s_rnge("prmpts", i__2, "commnt_", (ftnlen)
			    614)) * 80, (ftnlen)80);
		    tostdo_(" ", (ftnlen)1);
		    getfnm_("Filename? ", statbl + ((i__3 = tblidx[(i__2 = 
			    i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("tblidx"
			    , i__2, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <= 
			    i__3 ? i__3 : s_rnge("statbl", i__3, "commnt_", (
			    ftnlen)617)) * 3, fnmtbl + (((i__5 = tblidx[(i__4 
			    = i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("tbl"
			    "idx", i__4, "commnt_", (ftnlen)617)] - 1) < 2 && 
			    0 <= i__5 ? i__5 : s_rnge("fnmtbl", i__5, "commn"
			    "t_", (ftnlen)617)) << 7), &fileok, errmsg, (
			    ftnlen)10, (ftnlen)3, (ftnlen)128, (ftnlen)320);

/*                 If the filename is OK, increment the filename index */
/*                 and leave the try again loop. Otherwise, write out the */
/*                 error message, and give the opportunity to go around */
/*                 again. */

		    if (fileok) {
			++i__;
			tryagn = FALSE_;
		    } else {
			tostdo_(" ", (ftnlen)1);
			tostdo_(errmsg, (ftnlen)320);
			tostdo_(" ", (ftnlen)1);
			cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20);
			if (! tryagn) {
			    contnu = FALSE_;
			    more = FALSE_;
			}
		    }
		}
		if (i__ > numfnm) {
		    more = FALSE_;
		}
	    }
	}

/*        Get the file architecture and type. */

	if (contnu && ndfnms) {
	    getfat_(fnmtbl, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4);
	    if (failed_()) {
		contnu = FALSE_;
	    }
	}

/*        Check to see that we got back a valid architecture and type. */

	if (contnu && ndfnms) {
	    if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__, 
		    "?", (ftnlen)4, (ftnlen)1) == 0) {
		contnu = FALSE_;
		setmsg_("The architecture and type of the binary file '#' co"
			"uld not be determined. A common error is to give the"
			" name of a text file instead of the name of a binary"
			" file.", (ftnlen)161);
		errch_("#", fnmtbl, (ftnlen)1, (ftnlen)128);
		sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20);
	    }
	}

/*        Customize the message. We know we can do this, because we */
/*        need files, and so we don't have the QUIT message. */

	if (contnu && ndfnms) {
	    repmc_(messag, "#", type__, messag, (ftnlen)1000, (ftnlen)1, (
		    ftnlen)4, (ftnlen)1000);
	}

/*        Process the option that was selected so long ago. */

	if (contnu) {
	    if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
		tostdo_(" ", (ftnlen)1);
		tostdo_(messag, (ftnlen)1000);
		tostdo_(" ", (ftnlen)1);
		done = TRUE_;
	    } else if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) 
		    == 0) {
		tostdo_(" ", (ftnlen)1);
		tostdo_(messag, (ftnlen)1000);
		s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
		repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
			 (ftnlen)128, (ftnlen)1000);
		tostdo_(" ", (ftnlen)1);
		tostdo_(line, (ftnlen)1000);
		s_copy(line, "To File  : #", (ftnlen)1000, (ftnlen)12);
		repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
			ftnlen)128, (ftnlen)1000);
		tostdo_(line, (ftnlen)1000);

/*              Open the text file which contains the comments to be */
/*              added to the binary file. */

		txtopr_(fnmtbl + 128, &comlun, (ftnlen)128);
		if (! failed_()) {
		    if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {

/*                    Open the binary file, add the comments, and close */
/*                    the binary file. */

			dafopw_(fnmtbl, &handle, (ftnlen)128);
			spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
				1);
			dafcls_(&handle);
		    } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 
			    0) {

/*                    Open the binary file, add the comments, and close */
/*                    the binary file. */

			dafopw_(fnmtbl, &handle, (ftnlen)128);
			spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
				1);
			dafcls_(&handle);
		    } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 
			    0) {

/*                    Open the binary file, add the comments, and close */
/*                    the binary file. */

			dafopw_(fnmtbl, &handle, (ftnlen)128);
			spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
				1);
			dafcls_(&handle);
		    } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
			     {

/*                    Open the binary file, add the comments, and close */
/*                    the binary file. */

			dasopw_(fnmtbl, &handle, (ftnlen)128);
			dasacu_(&comlun, " ", " ", &insbln, &handle, (ftnlen)
				1, (ftnlen)1);
			dascls_(&handle);
		    }

/*                 Close the comment file. */

		    cl__1.cerr = 0;
		    cl__1.cunit = comlun;
		    cl__1.csta = 0;
		    f_clos(&cl__1);
		}

/*              Display the status of the operation that was selected. */

		tostdo_(" ", (ftnlen)1);
		if (failed_()) {
		    tostdo_(status + 1000, (ftnlen)1000);
		} else {
		    tostdo_(status, (ftnlen)1000);
		}
	    } else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13) 
		    == 0) {
		tostdo_(" ", (ftnlen)1);
		tostdo_(messag, (ftnlen)1000);
		s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
		repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
			ftnlen)128, (ftnlen)1000);
		tostdo_(" ", (ftnlen)1);
		tostdo_(line, (ftnlen)1000);
		tostdo_(" ", (ftnlen)1);
		if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {

/*                 Open the binary file, read the comments, and close */
/*                 the binary file. */

		    dafopr_(fnmtbl, &handle, (ftnlen)128);

/*                 The comments are read a line at a time and displayed */
/*                 on the screen. */

		    spcrfl_(&handle, line, &eoc, (ftnlen)1000);
		    if (! failed_()) {
			if (eoc) {
			    tostdo_("There were no comments found in the fil"
				    "e.", (ftnlen)41);
			}
			while(! eoc && ! failed_()) {
			    tostdo_(line, (ftnlen)1000);
			    spcrnl_(line, &eoc, (ftnlen)1000);
			}
		    }
		    dafcls_(&handle);
		} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {

/*                 Open the binary file, read the comments, and close */
/*                 the binary file. */

		    dafopr_(fnmtbl, &handle, (ftnlen)128);

/*                 The comments are read a line at a time and displayed */
/*                 on the screen. */

		    spcrfl_(&handle, line, &eoc, (ftnlen)1000);
		    if (! failed_()) {
			if (eoc) {
			    tostdo_("There were no commentfound in the file.",
				     (ftnlen)39);
			}
			while(! eoc && ! failed_()) {
			    tostdo_(line, (ftnlen)1000);
			    spcrnl_(line, &eoc, (ftnlen)1000);
			}
		    }
		    dafcls_(&handle);
		} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {

/*                 Open the binary file, read the comments, and close */
/*                 the binary file. */

		    dafopr_(fnmtbl, &handle, (ftnlen)128);

/*                 The comments are read a line at a time and displayed */
/*                 on the screen. */

		    spcrfl_(&handle, line, &eoc, (ftnlen)1000);
		    if (! failed_()) {
			if (eoc) {
			    tostdo_("There were no comments found in the fil"
				    "e.", (ftnlen)41);
			}
			while(! eoc && ! failed_()) {
			    tostdo_(line, (ftnlen)1000);
			    spcrnl_(line, &eoc, (ftnlen)1000);
			}
		    }
		    dafcls_(&handle);
		} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {

/*                 Open the binary file, read the comments, and close */
/*                 the binary file. */

		    dasopr_(fnmtbl, &handle, (ftnlen)128);
		    dasecu_(&handle, &c__6, &comnts);
		    dascls_(&handle);
		    if (! comnts) {
			s_copy(line, "There were no comments found in the fi"
				"le.", (ftnlen)1000, (ftnlen)41);
			tostdo_(line, (ftnlen)1000);
		    }
		}

/*              Display the status of the operation that was selected. */

		tostdo_(" ", (ftnlen)1);
		if (failed_()) {
		    tostdo_(status + 1000, (ftnlen)1000);
		} else {
		    tostdo_(status, (ftnlen)1000);
		}
	    } else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
		    16) == 0) {
		tostdo_(" ", (ftnlen)1);
		tostdo_(messag, (ftnlen)1000);
		s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
		repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
			ftnlen)128, (ftnlen)1000);
		tostdo_(" ", (ftnlen)1);
		tostdo_(line, (ftnlen)1000);
		s_copy(line, "To File  : #", (ftnlen)1000, (ftnlen)12);
		repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
			 (ftnlen)128, (ftnlen)1000);
		tostdo_(line, (ftnlen)1000);

/*              Open the text file. */

		txtopn_(fnmtbl + 128, &comlun, (ftnlen)128);
		if (! failed_()) {
		    if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {

/*                    Open the binary file, extract the comments, and */
/*                    close the binary file. */

			dafopr_(fnmtbl, &handle, (ftnlen)128);
			spcec_(&handle, &comlun);
			dafcls_(&handle);
		    } else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 
			    0) {

/*                    Open the binary file, extract the comments, and */
/*                    close the binary file. */

			dafopr_(fnmtbl, &handle, (ftnlen)128);
			spcec_(&handle, &comlun);
			dafcls_(&handle);
		    } else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 
			    0) {

/*                    Open the binary file, extract the comments, and */
/*                    close the binary file. */

			dafopr_(fnmtbl, &handle, (ftnlen)128);
			spcec_(&handle, &comlun);
			dafcls_(&handle);
		    } else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
			     {

/*                    Open the binary file, extract the comments, and */
/*                    close the binary file. */

			dasopr_(fnmtbl, &handle, (ftnlen)128);
			dasecu_(&handle, &comlun, &comnts);
			dascls_(&handle);
			if (! comnts) {
			    s_copy(line, "There were no comments found in th"
				    "e file.", (ftnlen)1000, (ftnlen)41);
			    tostdo_(line, (ftnlen)1000);
			}
		    }

/*                 Close the text file that we opened. */

		    cl__1.cerr = 0;
		    cl__1.cunit = comlun;
		    cl__1.csta = 0;
		    f_clos(&cl__1);
		}

/*              Display the status of the operation that was selected. */

		tostdo_(" ", (ftnlen)1);
		if (failed_()) {
		    tostdo_(status + 1000, (ftnlen)1000);
		} else {
		    tostdo_(status, (ftnlen)1000);
		}
	    } else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
		    15) == 0) {
		tostdo_(" ", (ftnlen)1);
		tostdo_(messag, (ftnlen)1000);
		s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
		repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
			ftnlen)128, (ftnlen)1000);
		tostdo_(" ", (ftnlen)1);
		tostdo_(line, (ftnlen)1000);
		if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {

/*                 Open the binary file, delete the comments, and close */
/*                 the binary file. */

		    dafopw_(fnmtbl, &handle, (ftnlen)128);
		    spcdc_(&handle);
		    dafcls_(&handle);
		} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {

/*                 Open the binary file, delete the comments, and close */
/*                 the binary file. */

		    dafopw_(fnmtbl, &handle, (ftnlen)128);
		    spcdc_(&handle);
		    dafcls_(&handle);
		} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {

/*                 Open the binary file, delete the comments, and close */
/*                 the binary file. */

		    dafopw_(fnmtbl, &handle, (ftnlen)128);
		    spcdc_(&handle);
		    dafcls_(&handle);
		} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {

/*                 Open the binary file, delete the comments, and close */
/*                 the binary file. */

		    dasopw_(fnmtbl, &handle, (ftnlen)128);
		    dasdc_(&handle);
		    dascls_(&handle);
		}

/*              Display the status of the operation that was selected. */

		tostdo_(" ", (ftnlen)1);
		if (failed_()) {
		    tostdo_(status + 1000, (ftnlen)1000);
		} else {
		    tostdo_(status, (ftnlen)1000);
		}
	    }
	}

/*        If anything failed, close any binary files that might still be */
/*        open and reset the error handling before getting the next */
/*        option. */

	if (failed_()) {

/*           Before we can attempt to perform any clean up actions if an */
/*           error occurred, we need to reset the SPICELIB error handling */
/*           mechanism so that we can call the SPICELIB routines that we */
/*           need to. */

	    reset_();

/*           Clear out any binary file handles in the open set, OPNSET. */

	    scardi_(&c__0, opnset);
	    cleari_(&c__1, &opnset[6]);

/*           Get the handles for any DAF files which may still be open. */

	    dafhof_(opnset);
	    numopn = cardi_(opnset);
	    if (numopn > 0) {
		i__2 = numopn;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    dafcls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
			     s_rnge("opnset", i__3, "commnt_", (ftnlen)1100)])
			    ;
		}
	    }

/*           Clear out any binary file handles in the open set, OPNSET. */

	    scardi_(&c__0, opnset);
	    cleari_(&c__1, &opnset[6]);

/*           Get the handles for any DAS files which may still be open. */

	    dashof_(opnset);
	    numopn = cardi_(opnset);
	    if (numopn > 0) {
		i__2 = numopn;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    dascls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
			     s_rnge("opnset", i__3, "commnt_", (ftnlen)1121)])
			    ;
		}
	    }

/*           If there was an error and we were extracting comments to a */
/*           file, then we should delete the file that was created, */
/*           because we do not know whether the extraction was completed */
/*           successfully. */

	    if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)16) == 
		    0) {
		if (exists_(fnmtbl + 128, (ftnlen)128)) {
		    delfil_(fnmtbl + 128, (ftnlen)128);
		}
	    }

/*           Finally, reset the error handling, and go get the next */
/*           option. This is just to be sure. */

	    reset_();
	}
    }
    chkout_("COMMNT", (ftnlen)6);
    return 0;
} /* MAIN__ */
Ejemplo n.º 11
0
/* Subroutine */ int shosym_(char *templt, ftnlen templt_len)
{
    /* System generated locals */
    integer i__1, i__2, i__3;

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

    /* Local variables */
    char name__[32], line[132];
    integer ncol, item[3];
    logical tran;
    integer size[3];
    char rest[132];
    integer i__, n, r__, space[3];
    extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), 
	    repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, 
	    ftnlen);
    char value[2000];
    integer width[3];
    extern /* Subroutine */ int stran_(char *, char *, logical *, ftnlen, 
	    ftnlen);
    extern integer rtrim_(char *, ftnlen);
    logical justr[3];
    integer lmarge, pagewd;
    char spcial[1*3];
    extern /* Subroutine */ int pagscn_(char *, ftnlen);
    char margin[32], messge[132];
    extern /* Subroutine */ int pagset_(char *, integer *, ftnlen), tabrpt_(
	    integer *, integer *, integer *, integer *, logical *, logical *, 
	    char *, integer *, integer *, U_fp, ftnlen);
    char myline[132];
    extern /* Subroutine */ int pagrst_(void), nspmrg_(char *, ftnlen), 
	    symget_(char *, char *, ftnlen, ftnlen);
    char frstwd[32];
    extern /* Subroutine */ int nspglr_(integer *, integer *), nextwd_(char *,
	     char *, char *, ftnlen, ftnlen, ftnlen), sympat_(char *, ftnlen),
	     nspwln_(char *, ftnlen);
    extern /* Subroutine */ int retsym_();
    logical presrv[3];
    extern /* Subroutine */ int setsym_(char *, char *, char *, ftnlen, 
	    ftnlen, ftnlen);
    char def[2000];
    extern /* Subroutine */ int nicepr_1__(char *, char *, S_fp, ftnlen, 
	    ftnlen);

    r__ = rtrim_(templt, templt_len);
    sympat_(templt, r__);
    symget_(name__, def, (ftnlen)32, (ftnlen)2000);
    nspmrg_(margin, (ftnlen)32);
    if (s_cmp(name__, " ", (ftnlen)32, (ftnlen)1) == 0) {
	s_copy(messge, "There are no symbols that match the template \"#\".", 
		(ftnlen)132, (ftnlen)49);
	repmc_(messge, "#", templt, messge, (ftnlen)132, (ftnlen)1, r__, (
		ftnlen)132);
	nicepr_1__(messge, margin, (S_fp)nspwln_, (ftnlen)132, (ftnlen)32);
	return 0;
    }

/*     If still here there are some matching symbols.  Set up the */
/*     standard defaults. */

    s_copy(line, "=========================================================="
	    "================================================================"
	    "==============================================", (ftnlen)132, (
	    ftnlen)168);
    presrv[0] = TRUE_;
    presrv[1] = TRUE_;
    presrv[2] = TRUE_;
    lmarge = 1;
    space[0] = 2;
    space[1] = 2;
    space[2] = 2;
    *(unsigned char *)&spcial[0] = ' ';
    *(unsigned char *)&spcial[1] = ' ';
    *(unsigned char *)&spcial[2] = ' ';
    justr[0] = FALSE_;
    justr[1] = FALSE_;
    justr[2] = FALSE_;

/*     Get the width of the page and based upon that determine */
/*     the basic table style that will be used to display the */
/*     symbol definition. */

    nspglr_(&n, &pagewd);
    width[0] = 14;
    width[1] = 30;
    width[2] = 30;
    size[0] = 1;
    size[1] = 1;
    size[2] = 1;
    item[0] = 1;
    item[1] = 2;
    item[2] = 3;
    ncol = 3;

/*     Adjust all of the columns */

    i__1 = ncol;
    for (i__ = 1; i__ <= i__1; ++i__) {
	width[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("width", i__2,
		 "shosym_", (ftnlen)156)] = width[(i__3 = i__ - 1) < 3 && 0 <=
		 i__3 ? i__3 : s_rnge("width", i__3, "shosym_", (ftnlen)156)] 
		* pagewd / 80;
    }
    pagewd = 0;
    i__1 = ncol;
    for (i__ = 1; i__ <= i__1; ++i__) {
	pagewd = width[(i__2 = i__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge(
		"width", i__2, "shosym_", (ftnlen)162)] + space[(i__3 = i__ - 
		1) < 3 && 0 <= i__3 ? i__3 : s_rnge("space", i__3, "shosym_", 
		(ftnlen)162)] + pagewd;
    }
    pagewd -= space[(i__1 = ncol - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("space"
	    , i__1, "shosym_", (ftnlen)165)];
    nspwln_(" ", (ftnlen)1);
    nspwln_("Symbols Matching Request: ", (ftnlen)26);
    nspwln_(" ", (ftnlen)1);
    pagrst_();
    pagset_("PAGEWIDTH", &pagewd, (ftnlen)9);
    pagscn_("BODY", (ftnlen)4);
    setsym_("Symbol Name", "Definition", "Expanded Value", (ftnlen)11, (
	    ftnlen)10, (ftnlen)14);
    tabrpt_(&ncol, item, size, width, justr, presrv, spcial, &lmarge, space, (
	    U_fp)retsym_, (ftnlen)1);
    s_copy(myline, line, (ftnlen)132, pagewd);
    nspwln_(myline, (ftnlen)132);
    while(s_cmp(name__, " ", (ftnlen)32, (ftnlen)1) != 0) {

/*        Expand this symbol until there's nothing left to do. */

	s_copy(value, def, (ftnlen)2000, (ftnlen)2000);
	tran = TRUE_;
	while(tran) {
	    nextwd_(def, frstwd, rest, (ftnlen)2000, (ftnlen)32, (ftnlen)132);
	    ucase_(frstwd, frstwd, (ftnlen)32, (ftnlen)32);
	    if (s_cmp(frstwd, "DEFINE", (ftnlen)32, (ftnlen)6) != 0 && s_cmp(
		    frstwd, "UNDEFINE", (ftnlen)32, (ftnlen)8) != 0) {
		stran_(value, value, &tran, (ftnlen)2000, (ftnlen)2000);
	    } else {
		tran = FALSE_;
	    }
	}
	setsym_(name__, def, value, (ftnlen)32, (ftnlen)2000, (ftnlen)2000);
	tabrpt_(&ncol, item, size, width, justr, presrv, spcial, &lmarge, 
		space, (U_fp)retsym_, (ftnlen)1);
	symget_(name__, def, (ftnlen)32, (ftnlen)2000);
    }
    nspwln_(" ", (ftnlen)1);
    return 0;
} /* shosym_ */
Ejemplo n.º 12
0
/* $Procedure      PCKWSS ( PCK write segment summary ) */
/* Subroutine */ int pckwss_(integer *unit, char *segid, integer *segbod, 
	integer *segfrm, integer *segtyp, doublereal *segbtm, doublereal *
	segetm, ftnlen segid_len)
{
    /* Initialized data */

    static char pcktyp[80*3] = "***Not Used***                              "
	    "                                    " "Fixed Width, Fixed Order "
	    "Chebyshev Polynomials: Angles                          " "Variab"
	    "le Width Chebyshev Polynomials Angles (in degrees!!!)           "
	    "          ";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    static char body[32];
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
    static char frame[32];
    extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
	     char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
    static char lines[80*9];
    static logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, 
	    ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, 
	    ftnlen);
    extern logical failed_(void);
    static char begtim[32], endtim[32];
    extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
	    char *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
    static char typdsc[80];
    extern logical return_(void);

/* $ Abstract */

/*     Write the segment summary for a PCK segment to a Fortran logical */
/*     unit. */

/* $ 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 */

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I   The logical unit to use for writing the summary. */
/*      SEGIDS    I   Segment ID for the segment in a PCK file. */
/*      SEGBOD    I   Body for the segment in a PCK file. */
/*      SEGFRM    I   Reference frame for the segment in a PCK file. */
/*      SEGTYP    I   Ephemeris type for the segment in a PCK file. */
/*      SEGBTM    I   Begin time (ET) for the segment in a PCK file. */
/*      SEGETM    I   End time (ET) for the segment in a PCK file. */

/* $ Detailed_Input */

/*      UNIT     The Fortran logical unit to which the segment summary */
/*               is written. */

/*      SEGID    Segment ID for a segment in a PCK file. */

/*      SEGBOD   Body for a segment in a PCK file. This is the */
/*               NAIF integer code for the body. */

/*      SEGFRM   Inertial reference frame for a segment in a PCK file. */
/*               this is the NAIF integer code for the inertial reference */
/*               frame. */

/*      SEGTYP   Ephemeris type for a segment in a PCK file. This is an */
/*               integer code which represents the PCK segment data type. */

/*      SEGBTM   Begin time (ET) for a segment in a PCK file. */

/*      SEGETM   End time (ET) for a segment in a PCK file. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If an error occurs while writing to the logical unit, the error */
/*        will be signalled by a routine called by this routine. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will format and display a PCK segment summary in a */
/*     human compatible fashion. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine performs time conversions using ET2UTC, and */
/*        therefore requires that a SPICE leapseconds kernel file be */
/*        loaded into the SPICELIB kernel pool before being called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     W.L. Taber (JPL) */
/*     K.R. Gehringer (JPL) */

/* $ Version */

/* -    Beta Version 2.1.0, 17-May-2001 (WLT) (20 years in CA today!) */

/*        Added a description for type 03 PCK segments. */

/* -    Beta Version 2.0.0, 24-JAN-1996 (KRG) */

/*        There have been several undocumented revisions of this */
/*        subroutine to improve its display formats and fix display bugs. */
/*        We are starting a new trend here, with the documentation of the */
/*        changes to this version. Hopefully we will continue to do so. */

/*        The changes to this version are: */

/*           Calling a new subroutien to get reference frame names, to */
/*           support the non-inertial frames software. */

/*           Fixing some display inconsistencies when body, or frame */
/*           names are not found. */

/* -    Beta Version 1.0.0, 25-FEB-1993 (KRG) */

/* -& */
/* $ Index_Entries */

/*      format and write a pck segment summary */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set the value for the maximum output display width. */


/*     Set the maximum length for the inertial reference frame name. */


/*     Set the maximum length for a body name. */


/*     Set the precision for fractions of seconds used for UTC times */
/*     when converted from ET times. */


/*     Set the length of a UTC time string. */


/*     Set the maximum length of an PCK data type description. */


/*     Set the maximum number of PCK data types. */


/*     Set up some mnemonics for accessing the correct labels. */


/*     Set the number of output lines. */


/*     Local variables */


/*     Save everything to keep configuration control happy. */


/*     Initial Values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("PCKWSS", (ftnlen)6);
    }

/*     Set up the line labels. */

    s_copy(lines, "   Segment ID     : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 400, "   UTC Start time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 480, "   UTC Stop time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 560, "   ET Start time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 640, "   ET Stop time   : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 80, "   Body           : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 160, "   Reference frame: Frame #", (ftnlen)80, (ftnlen)27)
	    ;
    s_copy(lines + 240, "   PCK Data Type  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 320, "      Description : #", (ftnlen)80, (ftnlen)21);

/*     Format the segment ID. */

    repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
	    ftnlen)80);

/*     Convert the segment start and stop times from ET to UTC for */
/*     human readability. */

    et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
    et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
    if (failed_()) {
	chkout_("PCKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the UTC times. */

    repmc_(lines + 400, "#", begtim, lines + 400, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 480, "#", endtim, lines + 480, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Convert the ET times into Calendar format. */

    etcal_(segbtm, begtim, (ftnlen)32);
    etcal_(segetm, endtim, (ftnlen)32);
    if (failed_()) {
	chkout_("PCKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the ET times. */

    repmc_(lines + 560, "#", begtim, lines + 560, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 640, "#", endtim, lines + 640, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Format the body and its name if we found it. */

    bodc2n_(segbod, body, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the inertial reference frame and its name if we found it. */

    frmnam_(segfrm, frame, (ftnlen)32);
    if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
	repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 160, "#", frame, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the PCK segment type and a description if we have one. */
/*     The reason SEGTYP >= 2 is that this routine works on binary */
/*     PCK files, and their segment types begin with type 2. Type 1 is */
/*     considered to be the text PCK files. */

    if (*segtyp > 3 || *segtyp < 2) {
	s_copy(typdsc, "No description for this type. Do you need a new tool"
		"kit?", (ftnlen)80, (ftnlen)56);
    } else {
	s_copy(typdsc, pcktyp + ((i__1 = *segtyp - 1) < 3 && 0 <= i__1 ? i__1 
		: s_rnge("pcktyp", i__1, "pckwss_", (ftnlen)352)) * 80, (
		ftnlen)80, (ftnlen)80);
    }
    repmi_(lines + 240, "#", segtyp, lines + 240, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);
    repmc_(lines + 320, "#", typdsc, lines + 320, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80, (ftnlen)80);

/*     Display the summary. */

    writla_(&c__9, lines, unit, (ftnlen)80);

/*     We were either successful or not on the previous write. In either */
/*     event, we want to check out and return to the caller, so there is */
/*     no need to check FAILED() here. */

    chkout_("PCKWSS", (ftnlen)6);
    return 0;
} /* pckwss_ */
Ejemplo n.º 13
0
/* $Procedure   STCF01 (STAR catalog type 1, find stars in RA-DEC box) */
/* Subroutine */ int stcf01_(char *catnam, doublereal *westra, doublereal *
	eastra, doublereal *sthdec, doublereal *nthdec, integer *nstars, 
	ftnlen catnam_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    doublereal ramin;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    doublereal ramax;
    extern /* Subroutine */ int repmd_(char *, char *, doublereal *, integer *
	    , char *, ftnlen, ftnlen, ftnlen);
    logical error;
    char query[512], qrytm1[512], qrytm2[512];
    doublereal decmin;
    extern /* Subroutine */ int ekfind_(char *, integer *, logical *, char *, 
	    ftnlen, ftnlen);
    doublereal decmax;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen);
    char errmsg[512];
    extern /* Subroutine */ int setmsg_(char *, ftnlen);
    extern logical return_(void);
    extern doublereal dpr_(void);

/* $ Abstract */

/*     Search through a type 1 star catalog and return the number of */
/*     stars within a specified RA - DEC rectangle. */

/* $ 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 */

/*     EK */

/* $ Keywords */

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     CATNAM      I   Catalog table name. */
/*     WESTRA      I   Western most right ascension in radians. */
/*     EASTRA      I   Eastern most right ascension in radians. */
/*     STHDEC      I   Southern most declination in radians. */
/*     NTHDEC      I   Northern most declination in radians. */
/*     NSTARS      O   Number of stars found. */

/* $ Detailed_Input */

/*     CATNAM      is name of the catalog data table. This name is */
/*                 returned by the catalog loader routine STCL01. */

/*     WESTRA      are right ascension and declination constraints */
/*     EASTRA      giving the western, eastern, southern and northern */
/*     STHDEC      boundaries of a search rectangle as follows: */
/*     NTHDEC */
/*                       RA  BETWEEN WESTRA  AND EASTRA  and */
/*                       DEC BETWEEN STHDEC AND NTHDEC */

/*                 where RA and DEC are the right ascension and */
/*                 declination of a star. WESTRA always represents */
/*                 "west" side of this rectangle and EASTRA -- the */
/*                 "east" side.  STHDEC represents the "south" side */
/*                 of the rectangle, NTHDEC represents the "north" */
/*                 side of the rectangle. */

/*                 For an observer standing on the surface */
/*                 of the earth at the equator, the west side of the */
/*                 rectangle ( the side associated with WESTRA) rises */
/*                 first. The east side (the side associated with */
/*                 EASTRA) rises last.  All meridians that rise between */
/*                 the rising of the west and east edges of the */
/*                 rectangle  cross through the RA-DEC rectangle. */

/*                 To specify the 6 degrees wide RA-DEC */
/*                 square centered on the celestical equator that */
/*                 has western most right ascension of 357 degrees, */
/*                 use the following values for WESTRA, EASTRA, STHDEC, */
/*                 and NTHDEC (we multiply the angles by the SPICELIB */
/*                 function RPD to convert degrees to radians). */

/*                      WESTRA  = 357.0D0 * RPD() */
/*                      EASTRA  =   3.0D0 * RPD() */
/*                      STHDEC  =  -3.0D0 * RPD() */
/*                      DEXMAX  =   3.0D0 * RPD() */

/*                 To specify a 5 degree wide RA-DEC square that has */
/*                 western most right ascension 10 degrees and */
/*                 eastern most right ascension 15 degrees and southern */
/*                 most declination of 45 degrees, assign the following */
/*                 values to WESTRA, EASTRA, STHDEC and NTHDEC. */

/*                      WESTRA  =  10.0D0 * RPD() */
/*                      EASTRA  =  15.0D0 * RPD() */
/*                      STHDEC  =  45.0D0 * RPD() */
/*                      DEXMAX  =  50.0D0 * RPD() */

/*                 All RA and DECS should be in radians and relative */
/*                 to the J2000 inertial frame. */

/*                 All Right Ascension values should be in the */
/*                 interval [0, 2*pi ).  This routine does */
/*                 not "fold" Right Ascension values into the this */
/*                 interval.  For example if you request stars in */
/*                 whose right ascensions lie between 3*pi and 4*pi */
/*                 no stars will be found. */

/*                 All Declination values should be in the interval */
/*                 [-pi,pi]. */

/* $ Detailed_Output */

/*     NSTARS      is number of catalog stars found within the */
/*                 specified RA - DEC rectangle. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If no star catalog has been loaded, an error will be */
/*        signalled by a routine in the call tree of this routine. */

/*     2) If the catalog query fails for any reason then */
/*        the error 'SPICE(QUERYFAILURE)'is signalled. */

/* $ Files */

/*     This routine searches for stars within SPICE type 1 star catalog */
/*     files that have been loaded by calls to the STCL01 routine and */
/*     that contain that catalog data table named CATNAM. */

/*     SPICE type 1 star catalog files MUST contain a single data table. */
/*     It can occupy a single segment or it can spread across multiple */
/*     segments. This table MUST include the following columns: */

/*        column name                data type          units */
/*     ------------------------------------------------------- */
/*        RA                   DOUBLE PRECISION        DEGREES */
/*        DEC                  DOUBLE PRECISION        DEGREES */
/*        RA_SIGMA             DOUBLE PRECISION        DEGREES */
/*        DEC_SIGMA            DOUBLE PRECISION        DEGREES */
/*        CATALOG_NUMBER       INTEGER */
/*        SPECTRAL_TYPE        CHARACTER*(4) */
/*        VISUAL_MAGNITUDE     DOUBLE PRECISION */

/*     Nulls are not allowed in any of the columns. */
/*     Other columns can also be present in the table but their data */
/*     will NOT be accessible through STCF01 and STCG01 -- */
/*     the interface used to access data in the catalog. Note */
/*     that the names and attributes of these additional columns */
/*     must be identical for all segments containing this table. */

/* $ Particulars */

/*     This routine is intended to be a part of the user interface to */
/*     the SPICE type 1 star catalog. It allows the caller to find all */
/*     stars within a specified RA - DEC rectangle in the SPICE */
/*     EK type 1 star catalog files loaded by STCL01. This */
/*     subroutine MUST NOT be called before a catalog file has */
/*     been loaded. */

/*     Other routines in the SPICE type 1 star catalog access */
/*     family are: */

/*        STCL01  load the catalog file and make its data */
/*                available for search and retrieval. */

/*        STCG01  retrieve position and characteristics for */
/*                a specified star in the set found by this */
/*                routine. */

/* $ Examples */

/*     In the following code fragment, STCF01 is used to find */
/*     all stars within a specified RA - DEC rectangle in a SPICE */
/*     EK type 1 star catalog. */

/*     C */
/*     C     Load catalog file. */
/*     C */
/*           CALL STCL01 ( CATFN, TABNAM, HANDLE ) */
/*     C */
/*     C     Search through the loaded catalog. */
/*     C */
/*           CALL STCF01 ( TABNAM, WESTRA,  EASTRA, */
/*          .              STHDEC, NTHDEC, NSTARS ) */
/*     C */
/*     C     Retrieve data for every star found. */
/*     C */
/*           DO I = 1, NSTARS */

/*              CALL STCG01 ( I, RA, DEC, RASIG, DECSIG, */
/*          .                 CATNUM, SPTYPE, VMAG ) */

/*           END DO */

/* $ Restrictions */

/*     1) The catalog file STCF01 searches through MUST be loaded */
/*        by STCL01 before STCF01 is called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     B.V. Semenov    (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 15-MAY-1996 (BVS) */

/* -& */
/* $ Index_Entries */

/*      find stars in RA-DEC rectangle in type 1 star catalog */

/* -& */


/*     SPICELIB functions */


/*     Local parameters. */


/*     Local variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("STCF01", (ftnlen)6);
    }

/*     Query templates. */

    s_copy(qrytm1, "SELECT RA, DEC, RA_SIGMA, DEC_SIGMA,CATALOG_NUMBER, SPEC"
	    "TRAL_TYPE, VISUAL_MAGNITUDE FROM # WHERE ( RA  BETWEEN # AND # )"
	    " AND ( DEC BETWEEN # AND # ) ", (ftnlen)512, (ftnlen)149);
    s_copy(qrytm2, "SELECT RA, DEC, RA_SIGMA, DEC_SIGMA,CATALOG_NUMBER, SPEC"
	    "TRAL_TYPE, VISUAL_MAGNITUDE FROM # WHERE ( ( RA BETWEEN # AND 36"
	    "0 ) OR   ( RA BETWEEN 0 AND #   )      ) AND   ( DEC BETWEEN # A"
	    "ND # ) ", (ftnlen)512, (ftnlen)191);

/*     Choose query template to be used. */

    if (*westra <= *eastra) {
	s_copy(query, qrytm1, (ftnlen)512, (ftnlen)512);
    } else {
	s_copy(query, qrytm2, (ftnlen)512, (ftnlen)512);
    }

/*     Convert angles in radians to angles in degrees. */

    ramin = *westra * dpr_();
    ramax = *eastra * dpr_();
    decmin = *sthdec * dpr_();
    decmax = *nthdec * dpr_();

/*     Construct query using inputs and chosen template. */

    repmc_(query, "#", catnam, query, (ftnlen)512, (ftnlen)1, catnam_len, (
	    ftnlen)512);
    repmd_(query, "#", &ramin, &c__15, query, (ftnlen)512, (ftnlen)1, (ftnlen)
	    512);
    repmd_(query, "#", &ramax, &c__15, query, (ftnlen)512, (ftnlen)1, (ftnlen)
	    512);
    repmd_(query, "#", &decmin, &c__15, query, (ftnlen)512, (ftnlen)1, (
	    ftnlen)512);
    repmd_(query, "#", &decmax, &c__15, query, (ftnlen)512, (ftnlen)1, (
	    ftnlen)512);

/*     Submit query and get number of stars. Check for */
/*     errors in QUERY. */

    ekfind_(query, nstars, &error, errmsg, (ftnlen)512, (ftnlen)512);
    if (error) {
	setmsg_("Error querying type 1 star catalog. Error message: # ", (
		ftnlen)53);
	errch_("#", errmsg, (ftnlen)1, (ftnlen)512);
	sigerr_("SPICE(QUERYFAILURE)", (ftnlen)19);
	chkout_("STCF01", (ftnlen)6);
	return 0;
    }
    chkout_("STCF01", (ftnlen)6);
    return 0;
} /* stcf01_ */
Ejemplo n.º 14
0
/* $Procedure      ZZHLP013 ( private help text ) */
/* Subroutine */ int zzhlp013_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 1213, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1214, "E-kernels can be \"unloaded.\" When an E"
	    "-kernel is unloaded,", text_len, (ftnlen)58);
    s_copy(text + text_len * 1215, "Inspekt \"forgets\" about the existence "
	    "of the kernel. Data in the kernel", text_len, (ftnlen)71);
    s_copy(text + text_len * 1216, "can not be retrieved or manipulated with"
	    "out first", text_len, (ftnlen)49);
    s_copy(text + text_len * 1217, "re-loading it.", text_len, (ftnlen)14);
    s_copy(text + text_len * 1218, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1219, "To load or unload an E-kernel, type", 
	    text_len, (ftnlen)35);
    s_copy(text + text_len * 1220, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1221, "LOAD EK (filename of E-kernel)", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 1222, "UNLOAD  (filename of previously loaded E"
	    "-kernel).", text_len, (ftnlen)49);
    s_copy(text + text_len * 1223, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1224, "The filename used in the UNLOAD command "
	    "must be the same as the filename used to", text_len, (ftnlen)80);
    s_copy(text + text_len * 1225, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1226, "Two other files may be loaded: a leapsec"
	    "onds kernel and an SCLK kernel. These ar", text_len, (ftnlen)80);
    s_copy(text + text_len * 1227, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1228, "LOAD LEAPSECONDS (filename of leapsecond"
	    "s kernel)", text_len, (ftnlen)49);
    s_copy(text + text_len * 1229, "LOAD SCLK KERNEL (filename of SCLK kerne"
	    "l)", text_len, (ftnlen)42);
    s_copy(text + text_len * 1230, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1231, "You can avoid having to load leapseconds"
	    " or SCLK kernels by", text_len, (ftnlen)59);
    s_copy(text + text_len * 1232, "setting up the environment variables SCL"
	    "K and LEAPSECONDS to", text_len, (ftnlen)60);
    s_copy(text + text_len * 1233, "point to the corresponding kernel prior "
	    "to starting Inspekt.", text_len, (ftnlen)60);
    s_copy(text + text_len * 1234, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1235, "Leapsecond and SCLK kernels cannot be un"
	    "loaded.", text_len, (ftnlen)47);
    s_copy(text + text_len * 1236, "However, you can load a different leapse"
	    "conds or SCLK kernel.", text_len, (ftnlen)61);
    s_copy(text + text_len * 1237, "When a new SLCK or leapseconds kernel is"
	    " loaded Inspekt behaves", text_len, (ftnlen)63);
    s_copy(text + text_len * 1238, "as if you had never loaded the previous "
	    "SCLK", text_len, (ftnlen)44);
    s_copy(text + text_len * 1239, "or leapseconds kernel. Only the data in "
	    "the freshly loaded kernel", text_len, (ftnlen)65);
    s_copy(text + text_len * 1240, "will be used by Inspekt.", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 1241, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1242, "There are two commands for determining w"
	    "hat kernels have been loaded.", text_len, (ftnlen)69);
    s_copy(text + text_len * 1243, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1244, "SHOW KERNELS;", text_len, (ftnlen)13);
    s_copy(text + text_len * 1245, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1246, "displays which E-kernels have been loaded"
	    , text_len, (ftnlen)41);
    s_copy(text + text_len * 1247, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1248, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1249, "SHOW ENVIRONMENT", text_len, (ftnlen)16);
    s_copy(text + text_len * 1250, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1251, "displays which leapseconds and SCLK kern"
	    "els (if any) have been", text_len, (ftnlen)62);
    s_copy(text + text_len * 1252, "loaded along with other information abou"
	    "t the current Inspekt", text_len, (ftnlen)61);
    s_copy(text + text_len * 1253, "settings.", text_len, (ftnlen)9);
    s_copy(text + text_len * 1254, "@@Kernels            --- LOAD", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 1255, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 1256, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 1257, "Environment Variables", text_len, (ftnlen)
	    21);
    finish[28] = 1258;
    begin[29] = 1259;
    s_copy(text + text_len * 1258, "Listed below are the limits for various "
	    "aspects of Inspekt.", text_len, (ftnlen)59);
    s_copy(text + text_len * 1259, "@setparamsize{Total number of Columns}", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 1260, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1261, "@param  Loaded E-kernels.", text_len, (
	    ftnlen)25);
    s_copy(text + text_len * 1262, "a maximum of 20 E-kernels may be loaded "
	    "at once.", text_len, (ftnlen)48);
    s_copy(text + text_len * 1263, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1264, "@param Total number of columns.", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 1265, "a maximum of 500 columns may", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 1266, "be present in all of the loaded kernels", 
	    text_len, (ftnlen)39);
    s_copy(text + text_len * 1267, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1268, "@param Page Width.", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 1269, "the page must be at least 40 characters "
	    "wide and", text_len, (ftnlen)48);
    s_copy(text + text_len * 1270, "no  more than 132 characters wide.", 
	    text_len, (ftnlen)34);
    s_copy(text + text_len * 1271, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1272, "@param  Column width.", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1273, "a column must be at least 8 characters w"
	    "ide and no", text_len, (ftnlen)50);
    s_copy(text + text_len * 1274, "more than 80 characters wide.", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 1275, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1276, "@param  Command Size.", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1277, "A command can contain no more than 1760 "
	    "character", text_len, (ftnlen)49);
    s_copy(text + text_len * 1278, "(it should fit on one 24 by 80 character"
	    " screen).", text_len, (ftnlen)49);
    s_copy(text + text_len * 1279, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1280, "@param Events per Report.", text_len, (
	    ftnlen)25);
    s_copy(text + text_len * 1281, "A default limit of 100 rows will be pres"
	    "ented in", text_len, (ftnlen)48);
    s_copy(text + text_len * 1282, "any report.  You can override this limit"
	    " with the", text_len, (ftnlen)49);
    s_copy(text + text_len * 1283, "SET DELUGE command or at the time a repo"
	    "rt is", text_len, (ftnlen)45);
    s_copy(text + text_len * 1284, "ready for output.", text_len, (ftnlen)17);
    s_copy(text + text_len * 1285, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1286, "@@Limits", text_len, (ftnlen)8);
    s_copy(text + text_len * 1287, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 1288, "Help", text_len, (ftnlen)4);
    finish[29] = 1289;
    begin[30] = 1290;
    s_copy(text + text_len * 1289, "To view events in a report, you need to "
	    "issue a \"SELECT\" command. The form of", text_len, (ftnlen)77);
    s_copy(text + text_len * 1290, "this command is shown below (\"WHERE\" a"
	    "nd \"ORDER BY\" clauses are optional).", text_len, (ftnlen)74);
    s_copy(text + text_len * 1291, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1292, "SELECT a comma delimited", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 1293, "       list of unambiguous", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 1294, "       column names", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 1295, "FROM   a comma delimited", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 1296, "       list of tables-alias pairs", 
	    text_len, (ftnlen)33);
    s_copy(text + text_len * 1297, "WHERE    condition_1", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 1298, "   AND/OR condition_2", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1299, "   ...", text_len, (ftnlen)6);
    s_copy(text + text_len * 1300, "   AND/OR condition_n", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1301, "ORDER BY a comma delimited", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 1302, "         list of unambiguous", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 1303, "         column names", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1304, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1305, "All but one of the conditions in the \"W"
	    "HERE\" clause have the form:", text_len, (ftnlen)66);
    s_copy(text + text_len * 1306, "@literal", text_len, (ftnlen)8);
    return 0;
} /* zzhlp013_ */
Ejemplo n.º 15
0
/* Subroutine */ int kerman_0_(int n__, char *commnd, char *infile__, char *
	error, ftnlen commnd_len, ftnlen infile_len, ftnlen error_len)
{
    /* Initialized data */

    static integer nfiles = 0;
    static logical first = TRUE_;
    static char synval[80*9] = "                                            "
	    "                                    " "                         "
	    "                                                       " "      "
	    "                                                                "
	    "          " "                                                   "
	    "                             " "                                "
	    "                                                " "             "
	    "                                                                "
	    "   " "EK #word[ekfile]                                          "
	    "                      " "LEAPSECONDS #word[leapfile]            "
	    "                                         " "SCLK KERNEL #word[sc"
	    "lkfile]                                                     ";

    /* System generated locals */
    integer i__1, i__2, i__3;

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

    /* Local variables */
    static integer need;
    static char file[127], name__[32];
    static integer clen;
    extern logical have_(char *, ftnlen);
    static integer left, reqd, nseg;
    static char indx[4], pval[32*4];
    static integer hits;
    static char size[32], type__[32];
    static logical quit;
    extern /* Subroutine */ int zzeksinf_(integer *, integer *, char *, 
	    integer *, char *, integer *, ftnlen, ftnlen);
    static integer i__, j, k;
    extern integer cardc_(char *, ftnlen);
    static integer l, n;
    extern /* Subroutine */ int clgai_(integer *, char *, integer *, integer *
	    , ftnlen), clgac_(integer *, char *, char *, ftnlen, ftnlen);
    static integer r__;
    static char cname[80], break__[80];
    static integer headr[5];
    extern /* Subroutine */ int eklef_(char *, integer *, ftnlen), clnid_(
	    integer *, integer *, logical *);
    static integer space;
    extern logical match_(char *, char *, ftnlen, ftnlen);
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    static integer tcode, ncomc;
    extern /* Subroutine */ int ekuef_(integer *);
    static char rname[6], tname[32];
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen), clnew_(char *, integer *, integer *, 
	    integer *, integer *, integer *, logical *, logical *, integer *, 
	    ftnlen);
    static logical found;
    static integer csize, ncols, ncomr;
    static logical cnull;
    static integer right, width[5], ctype;
    extern integer ltrim_(char *, ftnlen);
    static integer count;
    extern integer rtrim_(char *, ftnlen);
    static integer sizes[5];
    static char style[80];
    extern /* Subroutine */ int clnum_(integer *);
    static logical justr[5];
    extern /* Subroutine */ int m2chck_(char *, char *, integer *, char *, 
	    char *, ftnlen, ftnlen, ftnlen, ftnlen), m2getc_(char *, char *, 
	    logical *, char *, ftnlen, ftnlen, ftnlen), m2ints_(integer *, 
	    char *, integer *, char *, ftnlen, ftnlen);
    static integer id, nb;
    static char bs[1];
    extern logical m2xist_(char *, ftnlen);
    static integer nh, sb, handle;
    static char ifname[60], tabnam[64], tabcol[80*506], rnamec[7], cnames[64*
	    100];
    static integer handls[20], segdsc[24];
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), 
	    eknseg_(integer *);
    extern /* Subroutine */ int gcolmn_();
    extern integer isrchi_(integer *, integer *, integer *);
    extern /* Subroutine */ int pagput_(char *, ftnlen);
    extern logical return_(void);
    extern /* Subroutine */ int nspwln_(char *, ftnlen);
    static char synkey[32*9];
    static integer synptr[9];
    static char ekfils[127*20], thisfl[127], messge[300], idword[8];
    static integer cdscrs[1100]	/* was [11][100] */, widest, totalc, nresvr, 
	    nresvc;
    static logical cindxd;
    static char spcial[4*5], lsttab[32];
    static integer colids[506], lmarge, ordvec[500];
    static logical presrv[5];
    extern /* Subroutine */ int replch_(char *, char *, char *, char *, 
	    ftnlen, ftnlen, ftnlen, ftnlen), prefix_(char *, integer *, char *
	    , ftnlen, ftnlen), chkout_(char *, ftnlen), expool_(char *, 
	    logical *, ftnlen), repmct_(char *, char *, integer *, char *, 
	    char *, ftnlen, ftnlen, ftnlen, ftnlen), clunld_(integer *), 
	    ldpool_(char *, ftnlen);
    static integer nid;
    extern /* Subroutine */ int dasfnh_(char *, integer *, ftnlen);
    static integer col, seg, ids[5];
    extern /* Subroutine */ int remlac_(integer *, integer *, char *, integer 
	    *, ftnlen), nspglr_(integer *, integer *), nspmrg_(char *, ftnlen)
	    , suffix_(char *, integer *, char *, ftnlen, ftnlen), pagrst_(
	    void), pagset_(char *, integer *, ftnlen), ssizec_(integer *, 
	    char *, ftnlen), ssizei_(integer *, integer *), appndc_(char *, 
	    char *, ftnlen, ftnlen), appndi_(integer *, integer *), pagscn_(
	    char *, ftnlen), scolmn_(integer *, integer *, char *, ftnlen), 
	    tabrpt_(integer *, integer *, integer *, integer *, logical *, 
	    logical *, char *, integer *, integer *, U_fp, ftnlen), orderc_(
	    char *, integer *, integer *, ftnlen);
    extern integer pos_(char *, char *, integer *, ftnlen, ftnlen);
    extern /* Subroutine */ int pagsft_(void), dasrfr_(integer *, char *, 
	    char *, integer *, integer *, integer *, integer *, ftnlen, 
	    ftnlen), nspshc_(integer *, logical *), bbputc_1__(char *, char *,
	     integer *, char *, ftnlen, ftnlen, ftnlen), nicepr_1__(char *, 
	    char *, S_fp, ftnlen, ftnlen);


/*     Version 2.4.0, 26-SEP-2005 */

/*        Minor bug fix: replaced FILE with INFILE in the RTRIM call */
/*        constructing "The file # is not listed ..." error message. */

/*     Version 2.3.0, 21-JUN-1999 */

/*        Added RETURN before first entry points. */

/*     Version 2.2.0, 22-APR-1997 */

/*        Declared PAGPUT external */

/*     Version 2.1.0  14-SEP-1995 */

/*        Variable INDEX removed. */

/*     Version 2.0.0  23-AUG-1995 */

/*        The widest string in a string column is no longer supplied */
/*        by the EK summary stuff.  We just set the value WIDEST */
/*        to 24. */


/*     This routine handles the loading of E-kernels, leapsecond and */
/*     SCLK kernels. */


/*     Passable routines */


/*     Parameters that contain the routine name for use in check-in, */
/*     check-out, and error messages. */


/*     SPICELIB functions */


/*     E-kernel functions */


/*     Meta/2 Functions */


/*     Interface to the SPICELIB error handling. */


/*     Ek include files. */

/* +============================================================== */
/* $ 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. */


/*     Include Section:  EK Column Descriptor Parameters */

/*        ekcoldsc.inc Version 6    23-AUG-1995 (NJB) */


/*     Note:  The column descriptor size parameter CDSCSZ  is */
/*     declared separately in the include section CDSIZE$INC.FOR. */

/*     Offset of column descriptors, relative to start of segment */
/*     integer address range.  This number, when added to the last */
/*     integer address preceding the segment, yields the DAS integer */
/*     base address of the first column descriptor.  Currently, this */
/*     offset is exactly the size of a segment descriptor.  The */
/*     parameter SDSCSZ, which defines the size of a segment descriptor, */
/*     is declared in the include file eksegdsc.inc. */


/*     Size of column descriptor */


/*     Indices of various pieces of column descriptors: */


/*     CLSIDX is the index of the column's class code.  (We use the */
/*     word `class' to distinguish this item from the column's data */
/*     type.) */


/*     TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/*     or TIME).  The type is actually implied by the class, but it */
/*     will frequently be convenient to look up the type directly. */



/*     LENIDX is the index of the column's string length value, if the */
/*     column has character type.  A value of IFALSE in this element of */
/*     the descriptor indicates that the strings have variable length. */


/*     SIZIDX is the index of the column's element size value.  This */
/*     descriptor element is meaningful for columns with fixed-size */
/*     entries.  For variable-sized columns, this value is IFALSE. */


/*     NAMIDX is the index of the base address of the column's name. */


/*     IXTIDX is the data type of the column's index.  IXTIDX */
/*     contains a type value only if the column is indexed. For columns */
/*     that are not indexed, the location IXTIDX contains the boolean */
/*     value IFALSE. */


/*     IXPIDX is a pointer to the column's index.  IXTPDX contains a */
/*     meaningful value only if the column is indexed.  The */
/*     interpretation of the pointer depends on the data type of the */
/*     index. */


/*     NFLIDX is the index of a flag indicating whether nulls are */
/*     permitted in the column.  The value at location NFLIDX is */
/*     ITRUE if nulls are permitted and IFALSE otherwise. */


/*     ORDIDX is the index of the column's ordinal position in the */
/*     list of columns belonging to the column's parent segment. */


/*     METIDX is the index of the column's integer metadata pointer. */
/*     This pointer is a DAS integer address. */


/*     The last position in the column descriptor is reserved.  No */
/*     parameter is defined to point to this location. */


/*     End Include Section:  EK Column Descriptor Parameters */

/* $ 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. */


/*     Include Section:  EK Segment Descriptor Parameters */

/*        eksegdsc.inc  Version 8  06-NOV-1995 (NJB) */


/*     All `base addresses' referred to below are the addresses */
/*     *preceding* the item the base applies to.  This convention */
/*     enables simplied address calculations in many cases. */

/*     Size of segment descriptor.  Note:  the include file ekcoldsc.inc */
/*     must be updated if this parameter is changed.  The parameter */
/*     CDOFF in that file should be kept equal to SDSCSZ. */


/*     Index of the segment type code: */


/*     Index of the segment's number.  This number is the segment's */
/*     index in the list of segments contained in the EK to which */
/*     the segment belongs. */


/*     Index of the DAS integer base address of the segment's integer */
/*     meta-data: */


/*     Index of the DAS character base address of the table name: */


/*     Index of the segment's column count: */


/*     Index of the segment's record count: */


/*     Index of the root page number of the record tree: */


/*     Index of the root page number of the character data page tree: */


/*     Index of the root page number of the double precision data page */
/*     tree: */


/*     Index of the root page number of the integer data page tree: */


/*     Index of the `modified' flag: */


/*     Index of the `initialized' flag: */


/*     Index of the shadowing flag: */


/*     Index of the companion file handle: */


/*     Index of the companion segment number: */


/*     The next three items are, respectively, the page numbers of the */
/*     last character, d.p., and integer data pages allocated by the */
/*     segment: */


/*     The next three items are, respectively, the page-relative */
/*     indices of the last DAS word in use in the segment's */
/*     last character, d.p., and integer data pages: */


/*     Index of the DAS character base address of the column name list: */


/*     The last descriptor element is reserved for future use.  No */
/*     parameter is defined to point to this location. */


/*     End Include Section:  EK Segment Descriptor Parameters */

/* $ 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. */


/*     Include Section:  EK Boolean Enumerated Type */


/*        ekbool.inc Version 1   21-DEC-1994 (NJB) */


/*     Within the EK system, boolean values sometimes must be */
/*     represented by integer or character codes.  The codes and their */
/*     meanings are listed below. */

/*     Integer code indicating `true': */


/*     Integer code indicating `false': */


/*     Character code indicating `true': */


/*     Character code indicating `false': */


/*     End Include Section:  EK Boolean Enumerated Type */

/* +============================================================== */

/*     Meta/2 syntax definition variables. */

/* $ 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. */


/*     Include Section:  EK Data Types */

/*        ektype.inc Version 1  27-DEC-1994 (NJB) */


/*     Within the EK system, data types of EK column contents are */
/*     represented by integer codes.  The codes and their meanings */
/*     are listed below. */

/*     Integer codes are also used within the DAS system to indicate */
/*     data types; the EK system makes no assumptions about compatibility */
/*     between the codes used here and those used in the DAS system. */


/*     Character type: */


/*     Double precision type: */


/*     Integer type: */


/*     `Time' type: */

/*     Within the EK system, time values are represented as ephemeris */
/*     seconds past J2000 (TDB), and double precision numbers are used */
/*     to store these values.  However, since time values require special */
/*     treatment both on input and output, and since the `TIME' column */
/*     has a special role in the EK specification and code, time values */
/*     are identified as a type distinct from double precision numbers. */


/*     End Include Section:  EK Data Types */


/*     E-kernel column type definitions */


/*     INTEGER               CH */
/*     PARAMETER           ( CH   = 1 ) */

/*     INTEGER               DP */
/*     PARAMETER           ( DP   = 2 ) */

/*     INTEGER               INT */
/*     PARAMETER           ( INT  = 3 ) */

/*     INTEGER               TIME */
/*     PARAMETER           ( TIME = 4 ) */

/*     Local Parameters */

/*     FILSIZ   is the maximum number of characters allowed for a */
/*              filename */

/*     LNGSIZ   is the maximum number of characters allowed for */
/*              use in reporting the columns associated with a given */
/*              file. */

/*     MAXFIL   is the maximum number of E-kernels that can be loaded */
/*              at any one time. */

/*     NNAMES   is the maximum number of names/headings that can appear */
/*              in a report of loaded files and columns. */

/*     MAXCOL   is the maximum number of columns that may be present */
/*              in any segment of an E-kernel */

/*     LNSIZE   is the standard text line length. */


/*     Initialization logical */


/*     Loaded file database (shared between entry points) */


/*     Local Variables */


/*     INTEGER               IFALSE */
/*     PARAMETER           ( IFALSE = -1 ) */


/*     Variables needed by NSPEKS */


/*     Save everything. */


/*     Initial Values */

    /* Parameter adjustments */
    if (error) {
	}

    /* Function Body */
    switch(n__) {
	case 1: goto L_nspld;
	case 2: goto L_nspuld;
	case 3: goto L_nspeks;
	case 4: goto L_nspekc;
	}

    return 0;

/*  Load an E-, leapsecond, or sclk kernel. */


L_nspld:

/*     Standard Spicelib error handling. */

    s_copy(rname, "NSPLD", (ftnlen)6, (ftnlen)5);
    s_copy(rnamec, "NSPLD:", (ftnlen)7, (ftnlen)6);
    if (return_()) {
	return 0;
    }
    chkin_(rname, (ftnlen)6);

/*     On the first pass establish the syntax that this routine */
/*     is responsible for recognizing. */

    if (first) {
	first = FALSE_;
	*(unsigned char *)bs = '@';
	for (i__ = 1; i__ <= 100; ++i__) {
	    s_copy(cnames + (((i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : 
		    s_rnge("cnames", i__1, "kerman_", (ftnlen)361)) << 6), 
		    " ", (ftnlen)64, (ftnlen)1);
	}
	for (i__ = 1; i__ <= 3; ++i__) {
	    replch_(synval + ((i__1 = i__ + 5) < 9 && 0 <= i__1 ? i__1 : 
		    s_rnge("synval", i__1, "kerman_", (ftnlen)366)) * 80, 
		    "#", bs, synval + ((i__2 = i__ + 5) < 9 && 0 <= i__2 ? 
		    i__2 : s_rnge("synval", i__2, "kerman_", (ftnlen)366)) * 
		    80, (ftnlen)80, (ftnlen)1, (ftnlen)1, (ftnlen)80);
	}
	m2ints_(&c__3, synkey, synptr, synval, (ftnlen)32, (ftnlen)80);
    }

/*     See if this command matches a known syntax.  If it doesn't */
/*     there is no point in hanging around. */

    m2chck_(commnd, synkey, synptr, synval, error, commnd_len, (ftnlen)32, (
	    ftnlen)80, error_len);
    if (have_(error, error_len)) {
	prefix_(rnamec, &c__1, error, (ftnlen)7, error_len);
	chkout_(rname, (ftnlen)6);
	return 0;
    }
    if (m2xist_("ekfile", (ftnlen)6)) {

/*        We need to have a leapseconds kernel loaded before */
/*        we can load an E-kernel. */

	expool_("DELTET/DELTA_AT", &found, (ftnlen)15);
	if (! found) {
	    s_copy(error, "Before an E-kernel can be loaded, you must load a"
		    " leapseconds kernel.  ", error_len, (ftnlen)71);
	    chkout_(rname, (ftnlen)6);
	    return 0;
	}
	m2getc_("ekfile", commnd, &found, file, (ftnlen)6, commnd_len, (
		ftnlen)127);

/*        See if we already have this file. */

	if (isrchc_(file, &nfiles, ekfils, (ftnlen)127, (ftnlen)127) > 0) {
	    chkout_(rname, (ftnlen)6);
	    return 0;
	}

/*        Make sure there is room for this file. */

	if (nfiles == 20) {
	    s_copy(error, "The maximum number of E-kernels that can loaded a"
		    "t open by INSPEKT at one time is #.  That number has alr"
		    "eady been reached. You will need to unload one of the fi"
		    "les that have already been loaded before you will be abl"
		    "e to load any other files. ", error_len, (ftnlen)244);
	    repmct_(error, "#", &c__20, "L", error, error_len, (ftnlen)1, (
		    ftnlen)1, error_len);
	    prefix_(rnamec, &c__1, error, (ftnlen)7, error_len);
	    chkout_(rname, (ftnlen)6);
	    return 0;
	}

/*        Load the file as an e-kernel. */

	eklef_(file, &handle, rtrim_(file, (ftnlen)127));
	if (have_(error, error_len)) {
	    prefix_(rnamec, &c__1, error, (ftnlen)7, error_len);
	    chkout_(rname, (ftnlen)6);
	    return 0;
	}

/*        Store the name of this file. */

	++nfiles;
	s_copy(ekfils + ((i__1 = nfiles - 1) < 20 && 0 <= i__1 ? i__1 : 
		s_rnge("ekfils", i__1, "kerman_", (ftnlen)442)) * 127, file, (
		ftnlen)127, (ftnlen)127);

/*        Determine how many segments are in the file we just loaded. */

	nseg = eknseg_(&handle);

/*        For each segment in the newly loaded file ... */

	i__1 = nseg;
	for (seg = 1; seg <= i__1; ++seg) {
	    s_copy(tabnam, " ", (ftnlen)64, (ftnlen)1);
	    for (i__ = 1; i__ <= 100; ++i__) {
		s_copy(cnames + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 :
			 s_rnge("cnames", i__2, "kerman_", (ftnlen)457)) << 6)
			, " ", (ftnlen)64, (ftnlen)1);
	    }
	    zzeksinf_(&handle, &seg, tabnam, segdsc, cnames, cdscrs, (ftnlen)
		    64, (ftnlen)64);

/*           Add each column name to the list of columns held by the */
/*           column manager. */

	    ncols = segdsc[4];
	    i__2 = ncols;
	    for (col = 1; col <= i__2; ++col) {

/*              We need to make the column name include table it */
/*              belongs to (a fully qualified column name). */

		prefix_(".", &c__0, cnames + (((i__3 = col - 1) < 100 && 0 <= 
			i__3 ? i__3 : s_rnge("cnames", i__3, "kerman_", (
			ftnlen)475)) << 6), (ftnlen)1, (ftnlen)64);
		prefix_(tabnam, &c__0, cnames + (((i__3 = col - 1) < 100 && 0 
			<= i__3 ? i__3 : s_rnge("cnames", i__3, "kerman_", (
			ftnlen)476)) << 6), (ftnlen)64, (ftnlen)64);
		cindxd = cdscrs[(i__3 = col * 11 - 6) < 1100 && 0 <= i__3 ? 
			i__3 : s_rnge("cdscrs", i__3, "kerman_", (ftnlen)478)]
			 != -1;
		cnull = cdscrs[(i__3 = col * 11 - 4) < 1100 && 0 <= i__3 ? 
			i__3 : s_rnge("cdscrs", i__3, "kerman_", (ftnlen)479)]
			 != -1;
		ctype = cdscrs[(i__3 = col * 11 - 10) < 1100 && 0 <= i__3 ? 
			i__3 : s_rnge("cdscrs", i__3, "kerman_", (ftnlen)481)]
			;
		clen = cdscrs[(i__3 = col * 11 - 9) < 1100 && 0 <= i__3 ? 
			i__3 : s_rnge("cdscrs", i__3, "kerman_", (ftnlen)482)]
			;
		csize = cdscrs[(i__3 = col * 11 - 8) < 1100 && 0 <= i__3 ? 
			i__3 : s_rnge("cdscrs", i__3, "kerman_", (ftnlen)483)]
			;

/*              This is what used to be here, but the item NBLIDX */
/*              vanished by design.  We now just set this so something */
/*              reasonable.  24 seemed like the reasonable thing at */
/*              the time.  (See the column manager and do a bit of */
/*              code diving to see what this is used for.) */

/*              WIDEST    = CDSCRS ( NBLIDX, COL ) */

		widest = 24;
		clnew_(cnames + (((i__3 = col - 1) < 100 && 0 <= i__3 ? i__3 :
			 s_rnge("cnames", i__3, "kerman_", (ftnlen)496)) << 6)
			, &handle, &ctype, &clen, &widest, &csize, &cindxd, &
			cnull, &id, (ftnlen)64);
	    }
	}

/*        If anything went wrong, unload the file. */

	if (have_(error, error_len)) {
	    prefix_(rnamec, &c__1, error, (ftnlen)7, error_len);
	    ekuef_(&handle);
	    clunld_(&handle);
	    --nfiles;
	    chkout_(rname, (ftnlen)6);
	    return 0;
	}
    } else if (m2xist_("leapfile", (ftnlen)8)) {
	m2getc_("leapfile", commnd, &found, file, (ftnlen)8, commnd_len, (
		ftnlen)127);
	ldpool_(file, (ftnlen)127);
	bbputc_1__("POST", "LEAPSECONDS", &c__1, file, (ftnlen)4, (ftnlen)11, 
		(ftnlen)127);
    } else if (m2xist_("sclkfile", (ftnlen)8)) {
	m2getc_("sclkfile", commnd, &found, file, (ftnlen)8, commnd_len, (
		ftnlen)127);
	ldpool_(file, (ftnlen)127);
	bbputc_1__("APPEND", "SCLK", &c__1, file, (ftnlen)6, (ftnlen)4, (
		ftnlen)127);
    } else {
	s_copy(error, "The input command was unrecognized and somehow got to"
		" an \"impossible\" place in KERMAN.FOR", error_len, (ftnlen)
		89);
    }
    if (have_(error, error_len)) {
	prefix_(rnamec, &c__1, error, (ftnlen)7, error_len);
	chkout_(rname, (ftnlen)6);
	return 0;
    }
    chkout_(rname, (ftnlen)6);
    return 0;

/*  Unload an E-kernel from the list of known files. */


L_nspuld:
    s_copy(rname, "NSPULD", (ftnlen)6, (ftnlen)6);
    s_copy(rnamec, "NSPULD:", (ftnlen)7, (ftnlen)7);
    if (return_()) {
	return 0;
    }
    chkin_(rname, (ftnlen)6);
    j = isrchc_(infile__, &nfiles, ekfils, infile_len, (ftnlen)127);
    if (j == 0) {
	s_copy(error, "The file # is not listed among those files that have "
		"been loaded. ", error_len, (ftnlen)66);
	repmc_(error, "#", infile__, error, error_len, (ftnlen)1, rtrim_(
		infile__, infile_len), error_len);
	chkout_(rname, (ftnlen)6);
	return 0;
    }

/*     Get the handle associated with this file. */

    dasfnh_(infile__, &handle, rtrim_(infile__, infile_len));
    if (have_(error, error_len)) {
	chkout_(rname, (ftnlen)6);
	return 0;
    }

/*     Now unload the file, and detach its handle from any columns to */
/*     which it might be attached. */

    ekuef_(&handle);
    clunld_(&handle);

/*     Finally remove this file from our internal list of files. */

    remlac_(&c__1, &j, ekfils, &nfiles, (ftnlen)127);
    chkout_(rname, (ftnlen)6);
    return 0;

/*  Create a report regarding currently loaded kernels/columns. */


L_nspeks:

/*     Version 2.0  Aug 3, 1995 */

/*        This routine was rewritten to provide a more friendly */
/*        kernel summary. */

/*     ---B. Taber */

/*     This routine displays the currently loaded E-kernels. */

    s_copy(rname, "NSPEKS", (ftnlen)6, (ftnlen)6);
    s_copy(rnamec, "NSPEKS:", (ftnlen)7, (ftnlen)7);
    if (return_()) {
	return 0;
    }

/*     write (*,*) 'Checking in:' */

    chkin_(rname, (ftnlen)6);
    if (nfiles <= 0) {
	nspwln_(" ", (ftnlen)1);
	nspwln_("There are no E-kernels loaded now.", (ftnlen)34);
	nspwln_(" ", (ftnlen)1);
	chkout_(rname, (ftnlen)6);
	return 0;
    }

/*     First thing we do is set up the NICEPR_1 style string */
/*     to be used in creation of summary headers. */

/*     write (*,*) 'Fetching margins: ' */
    nspglr_(&left, &right);
    nspmrg_(style, (ftnlen)80);
    suffix_("FLAG", &c__1, style, (ftnlen)4, (ftnlen)80);
    suffix_("E-kernel:", &c__1, style, (ftnlen)9, (ftnlen)80);

/*     Reset the output page, title frequency and header frequency */
/*     values. */

/*     write (*,*) 'Resetting page and setting up page attributes:' */

    pagrst_();
    pagset_("TITLEFREQUENCY", &c__0, (ftnlen)14);
    pagset_("HEADERFREQUENCY", &c__0, (ftnlen)15);
    pagset_("NOSPACEFOOTER", &c__1, (ftnlen)13);
    pagset_("FOOTERFREQUENCY", &c_n1, (ftnlen)15);
    s_copy(pval, "CH", (ftnlen)32, (ftnlen)2);
    s_copy(pval + 32, "D.P.", (ftnlen)32, (ftnlen)4);
    s_copy(pval + 64, "INTEGER", (ftnlen)32, (ftnlen)7);
    s_copy(pval + 96, "TIME", (ftnlen)32, (ftnlen)4);
    lmarge = 1;
    space = 1;

/*     Next we set up the the column id codes, sizes, */
/*     default widths, justifications, component preservation, */
/*     and special marker attributes for each column. */

    headr[0] = 1;
    headr[1] = 2;
    headr[2] = 3;
    headr[3] = 4;
    headr[4] = 5;
    sizes[0] = 1;
    sizes[1] = 1;
    sizes[2] = 1;
    sizes[3] = 1;
    sizes[4] = 1;
    width[0] = 16;
    width[1] = 16;
    width[2] = 8;
    width[3] = 8;
    width[4] = 6;
    need = width[0] + width[1] + width[2] + width[3] + width[4] + 4;
    right = min(right,need);
    pagset_("PAGEWIDTH", &right, (ftnlen)9);
    reqd = width[2] + width[3] + width[4] + 4;

/*     If the page width is less than default needed, we reset the */
/*     widths of the first two columns so they will fit in available */
/*     space. */

    if (right < need) {
	width[0] = (right - reqd) / 2;
	width[1] = width[0];
    }
    justr[0] = FALSE_;
    justr[1] = FALSE_;
    justr[2] = FALSE_;
    justr[3] = TRUE_;
    justr[4] = TRUE_;
    presrv[0] = TRUE_;
    presrv[1] = TRUE_;
    presrv[2] = TRUE_;
    presrv[3] = TRUE_;
    presrv[4] = TRUE_;
    s_copy(spcial, " ", (ftnlen)4, (ftnlen)1);
    s_copy(spcial + 4, " ", (ftnlen)4, (ftnlen)1);
    s_copy(spcial + 8, " ", (ftnlen)4, (ftnlen)1);
    s_copy(spcial + 12, " ", (ftnlen)4, (ftnlen)1);
    s_copy(spcial + 16, " ", (ftnlen)4, (ftnlen)1);

/*     write (*,*) 'Starting file loop:' */

    i__1 = nfiles;
    for (i__ = 1; i__ <= i__1; ++i__) {

/*        Get the handle associated with this file, and get the */
/*        number of ID's currently known. */

	dasfnh_(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge(
		"ekfils", i__2, "kerman_", (ftnlen)738)) * 127, &handle, (
		ftnlen)127);
	clnum_(&nid);
/*        write (*,*) 'File: ', I, 'Handle: ', HANDLE */

/*        Now empty out the table/column data for this file. */

/*        write (*,*) 'Empty out the column collector.' */
	ssizec_(&c__500, tabcol, (ftnlen)80);
	ssizei_(&c__500, colids);

/*        Cycle over all column id's to determine if they */
/*        are attached to this particular file. */

/*        write (*,*) 'Beginning Column search:  ', NID, ' Columns' */
	i__2 = nid;
	for (j = 1; j <= i__2; ++j) {
	    clnid_(&j, &id, &found);
	    clgai_(&id, "HANDLES", &nh, handls, (ftnlen)7);
	    if (isrchi_(&handle, &nh, handls) > 0) {

/*              This column is associated with this file.  Store */
/*              its name and id-code for the next section of code. */

/*              write (*,*) 'Column id and associated handle match.' */

		clgac_(&id, "NAME", cname, (ftnlen)4, (ftnlen)80);
		appndc_(cname, tabcol, (ftnlen)80, (ftnlen)80);
		appndi_(&id, colids);
	    }
	}

/*        Layout the pages.  We perform a soft page reset */
/*        so that the various sections will be empty. */
/*        Note this doesn't affect frequency parameter */
/*        or other geometry attributes of pages. */

/*        write (*,*) 'Creating page: Title:' */

	pagscn_("TITLE", (ftnlen)5);
	pagput_(" ", (ftnlen)1);
	pagput_("Summary of Loaded E-kernels", (ftnlen)27);
	pagput_(" ", (ftnlen)1);

/*        write (*,*) 'Creating page: Header' */

/*        Set up the various items needed for the report header. */

	pagscn_("HEADER", (ftnlen)6);
	pagput_(" ", (ftnlen)1);
	nicepr_1__(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		s_rnge("ekfils", i__2, "kerman_", (ftnlen)791)) * 127, style, 
		(S_fp)pagput_, (ftnlen)127, (ftnlen)80);
	pagput_(" ", (ftnlen)1);
	scolmn_(&c__1, &c__1, "Table Name", (ftnlen)10);
	scolmn_(&c__2, &c__1, "Column Name", (ftnlen)11);
	scolmn_(&c__3, &c__1, "Type", (ftnlen)4);
	scolmn_(&c__4, &c__1, "Size", (ftnlen)4);
	scolmn_(&c__5, &c__1, "Index", (ftnlen)5);

/*        write (*,*) 'Creating page: Column headings' */

	tabrpt_(&c__5, headr, sizes, width, justr, presrv, spcial, &lmarge, &
		space, (U_fp)gcolmn_, (ftnlen)4);
	s_copy(break__, "==================================================="
		"=============================", (ftnlen)80, (ftnlen)80);
	pagput_(break__, right);

/*        Now set the page section to the body portion for */
/*        preparing to fill in the e-kernel summary. */

/*        write (*,*) 'Creating page: Body of report:' */
	pagscn_("BODY", (ftnlen)4);
	n = cardc_(tabcol, (ftnlen)80);
	orderc_(tabcol + 480, &n, ordvec, (ftnlen)80);
	s_copy(lsttab, " ", (ftnlen)32, (ftnlen)1);
	i__2 = n;
	for (j = 1; j <= i__2; ++j) {
	    k = ordvec[(i__3 = j - 1) < 500 && 0 <= i__3 ? i__3 : s_rnge(
		    "ordvec", i__3, "kerman_", (ftnlen)826)];
	    clgac_(&colids[(i__3 = k + 5) < 506 && 0 <= i__3 ? i__3 : s_rnge(
		    "colids", i__3, "kerman_", (ftnlen)828)], "TABLE", tname, 
		    (ftnlen)5, (ftnlen)32);
	    clgac_(&colids[(i__3 = k + 5) < 506 && 0 <= i__3 ? i__3 : s_rnge(
		    "colids", i__3, "kerman_", (ftnlen)829)], "NAME", cname, (
		    ftnlen)4, (ftnlen)80);
	    clgac_(&colids[(i__3 = k + 5) < 506 && 0 <= i__3 ? i__3 : s_rnge(
		    "colids", i__3, "kerman_", (ftnlen)830)], "SIZE", size, (
		    ftnlen)4, (ftnlen)32);
	    clgac_(&colids[(i__3 = k + 5) < 506 && 0 <= i__3 ? i__3 : s_rnge(
		    "colids", i__3, "kerman_", (ftnlen)831)], "INDEXED", indx,
		     (ftnlen)7, (ftnlen)4);

/*           Note:  There is only one type associated with each */
/*           handle.  Thus TCODE does not need to be an array. */

	    clgai_(&colids[(i__3 = k + 5) < 506 && 0 <= i__3 ? i__3 : s_rnge(
		    "colids", i__3, "kerman_", (ftnlen)836)], "TYPE", &count, 
		    &tcode, (ftnlen)4);
	    if (s_cmp(tname, lsttab, (ftnlen)32, (ftnlen)32) == 0) {
		s_copy(tname, " ", (ftnlen)32, (ftnlen)1);
	    } else if (s_cmp(lsttab, " ", (ftnlen)32, (ftnlen)1) != 0) {
		pagput_(" ", (ftnlen)1);
		s_copy(lsttab, tname, (ftnlen)32, (ftnlen)32);
	    } else {
		s_copy(lsttab, tname, (ftnlen)32, (ftnlen)32);
	    }
	    nb = pos_(cname, ".", &c__1, (ftnlen)80, (ftnlen)1) + 1;
	    s_copy(name__, cname + (nb - 1), (ftnlen)32, 80 - (nb - 1));
	    if (tcode == 1) {
		clgac_(&colids[(i__3 = k + 5) < 506 && 0 <= i__3 ? i__3 : 
			s_rnge("colids", i__3, "kerman_", (ftnlen)852)], 
			"TYPE", type__, (ftnlen)4, (ftnlen)32);
		sb = pos_(type__, "*", &c__1, (ftnlen)32, (ftnlen)1);
		s_copy(pval, "CH", (ftnlen)32, (ftnlen)2);
		suffix_(type__ + (sb - 1), &c__0, pval, 32 - (sb - 1), (
			ftnlen)32);
	    }
	    scolmn_(&c__6, &c__1, tname, (ftnlen)32);
	    scolmn_(&c__7, &c__1, name__, (ftnlen)32);
	    scolmn_(&c__8, &c__1, pval + (((i__3 = tcode - 1) < 4 && 0 <= 
		    i__3 ? i__3 : s_rnge("pval", i__3, "kerman_", (ftnlen)860)
		    ) << 5), (ftnlen)32);
	    scolmn_(&c__9, &c__1, size, (ftnlen)32);
	    scolmn_(&c__10, &c__1, indx, (ftnlen)4);
	    ids[0] = 6;
	    ids[1] = 7;
	    ids[2] = 8;
	    ids[3] = 9;
	    ids[4] = 10;

/*           write (*,*) 'Creating next row:' */
/*           write (*,*) TNAME */
/*           write (*,*) NAME */
/*           write (*,*) PVAL(TCODE) */
/*           write (*,*) SIZE */
/*           write (*,*) INDX */

	    tabrpt_(&c__5, ids, sizes, width, justr, presrv, spcial, &lmarge, 
		    &space, (U_fp)gcolmn_, (ftnlen)4);
/*           write (*,*) 'Row created.' */

	}

/*        Do a soft page reset so for the next file to be displayed */

/*        write (*,*) 'Performing soft page reset.' */
	pagsft_();
	pagrst_();
	pagset_("TITLEFREQUENCY", &c_n1, (ftnlen)14);
	pagset_("HEADERFREQUENCY", &c__0, (ftnlen)15);
	pagset_("NOSPACEFOOTER", &c__1, (ftnlen)13);
	pagset_("FOOTERFREQUENCY", &c_n1, (ftnlen)15);
    }
    chkout_(rname, (ftnlen)6);
    return 0;
/* $Procedure      NSPEKC ( Inspekt the comments from EK files ) */

L_nspekc:
/*     This entry point examines each file that matches the */
/*     template given by INFILE and if comments exist for the */
/*     file, they are displayed. */
/*     Version 1.0.0 25-AUG-1995 (WLT) */
    chkin_("NSPEKC", (ftnlen)6);
    totalc = 0;
    s_copy(thisfl, " ", (ftnlen)127, (ftnlen)1);
/*     We might not need the style string, but it doesn't hurt to */
/*     get it. */
    nspmrg_(style, (ftnlen)80);
/*     If there are no loaded E-kernels say so and return. */
    if (nfiles == 0) {
	s_copy(messge, "There are no E-kernels loaded now. ", (ftnlen)300, (
		ftnlen)35);
	nicepr_1__(messge, style, (S_fp)nspwln_, (ftnlen)300, (ftnlen)80);
	chkout_("NSPEKC", (ftnlen)6);
	return 0;
    }
/*     Count the number of characters present in the files */
/*     that match the template. */
    r__ = rtrim_(infile__, infile_len);
    l = ltrim_(infile__, infile_len);
    i__1 = nfiles;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if (match_(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		s_rnge("ekfils", i__2, "kerman_", (ftnlen)945)) * 127, 
		infile__ + (l - 1), (ftnlen)127, r__ - (l - 1))) {
	    dasfnh_(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		    s_rnge("ekfils", i__2, "kerman_", (ftnlen)947)) * 127, &
		    handle, (ftnlen)127);
	    dasrfr_(&handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc,
		     (ftnlen)8, (ftnlen)60);
	    totalc += ncomc;
	    ++hits;
	    s_copy(thisfl, ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? 
		    i__2 : s_rnge("ekfils", i__2, "kerman_", (ftnlen)955)) * 
		    127, (ftnlen)127, (ftnlen)127);
	}
    }
/*     If we didn't get any characters there several possible */
/*     reasons.  We can look at HITS to see why and form a */
/*     grammatically reasonable message. */
    if (totalc == 0) {
	if (hits == 0) {
	    s_copy(messge, "There are no E-kernels loaded whose file name ma"
		    "tches the supplied template '#'.", (ftnlen)300, (ftnlen)
		    80);
	    repmc_(messge, "#", infile__ + (l - 1), messge, (ftnlen)300, (
		    ftnlen)1, r__ - (l - 1), (ftnlen)300);
	} else if (hits == 1) {
	    s_copy(messge, "There are no comments present in the file '#'. ", 
		    (ftnlen)300, (ftnlen)47);
	    repmc_(messge, "#", thisfl, messge, (ftnlen)300, (ftnlen)1, (
		    ftnlen)127, (ftnlen)300);
	} else if (hits == 2) {
	    s_copy(messge, "There are no comments present in either of the #"
		    " files that match the supplied template. ", (ftnlen)300, (
		    ftnlen)89);
	    repmct_(messge, "#", &hits, "L", messge, (ftnlen)300, (ftnlen)1, (
		    ftnlen)1, (ftnlen)300);
	} else {
	    s_copy(messge, "There are no comments present in any of the # fi"
		    "les that match the supplied template. ", (ftnlen)300, (
		    ftnlen)86);
	    repmct_(messge, "#", &hits, "L", messge, (ftnlen)300, (ftnlen)1, (
		    ftnlen)1, (ftnlen)300);
	}
	nicepr_1__(messge, style, (S_fp)nspwln_, (ftnlen)300, (ftnlen)80);
	chkout_("NSPEKC", (ftnlen)6);
	return 0;
    }
/*     Ok. We've got something.  Set up the output page to receive */
/*     the comments a file at a time. */
    suffix_("FLAG E-kernel:", &c__1, style, (ftnlen)14, (ftnlen)80);
    i__1 = nfiles;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if (match_(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		s_rnge("ekfils", i__2, "kerman_", (ftnlen)1012)) * 127, 
		infile__ + (l - 1), (ftnlen)127, r__ - (l - 1))) {
	    dasfnh_(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		    s_rnge("ekfils", i__2, "kerman_", (ftnlen)1014)) * 127, &
		    handle, (ftnlen)127);
	    dasrfr_(&handle, idword, ifname, &nresvr, &nresvc, &ncomr, &ncomc,
		     (ftnlen)8, (ftnlen)60);
	    if (ncomc == 0) {
		s_copy(messge, "# contains no comments.", (ftnlen)300, (
			ftnlen)23);
		repmc_(messge, "#", ekfils + ((i__2 = i__ - 1) < 20 && 0 <= 
			i__2 ? i__2 : s_rnge("ekfils", i__2, "kerman_", (
			ftnlen)1023)) * 127, messge, (ftnlen)300, (ftnlen)1, (
			ftnlen)127, (ftnlen)300);
		nspwln_(" ", (ftnlen)1);
		nicepr_1__(messge, style, (S_fp)nspwln_, (ftnlen)300, (ftnlen)
			80);
	    } else {
		pagrst_();
		pagscn_("HEADER", (ftnlen)6);
		pagset_("TITLEFREQUENCY", &c__0, (ftnlen)14);
		pagset_("HEADERFREQUENCY", &c__0, (ftnlen)15);
		pagset_("NOSPACEFOOTER", &c__1, (ftnlen)13);
		pagset_("FOOTERFREQUENCY", &c_n1, (ftnlen)15);
		pagput_(" ", (ftnlen)1);
		nicepr_1__(ekfils + ((i__2 = i__ - 1) < 20 && 0 <= i__2 ? 
			i__2 : s_rnge("ekfils", i__2, "kerman_", (ftnlen)1038)
			) * 127, style, (S_fp)pagput_, (ftnlen)127, (ftnlen)
			80);
		pagput_(" ", (ftnlen)1);
		nspshc_(&handle, &quit);
		if (quit) {
		    nspwln_(" ", (ftnlen)1);
		    chkout_("NSPEKC", (ftnlen)6);
		    return 0;
		}
	    }
	}
    }
    nspwln_(" ", (ftnlen)1);
    chkout_("NSPEKC", (ftnlen)6);
    return 0;
} /* kerman_ */
Ejemplo n.º 16
0
/* $Procedure      ZZHLP027 ( private help text ) */
/* Subroutine */ int zzhlp027_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 2502, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2503, "(1:3)@name(John|Bobby|Teddy)", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2504, "!endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2505, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2506, "@section Switches", text_len, (ftnlen)17);
    s_copy(text + text_len * 2507, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2508, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2509, "The construct", text_len, (ftnlen)13);
    s_copy(text + text_len * 2510, "@exliteral", text_len, (ftnlen)10);
    s_copy(text + text_len * 2511, "    (1:1){ NONE", text_len, (ftnlen)15);
    s_copy(text + text_len * 2512, "         | FIRST", text_len, (ftnlen)16);
    s_copy(text + text_len * 2513, "         | 1ST", text_len, (ftnlen)14);
    s_copy(text + text_len * 2514, "         | ALL", text_len, (ftnlen)14);
    s_copy(text + text_len * 2515, "         | EVERY @int(2:) }", text_len, (
	    ftnlen)27);
    s_copy(text + text_len * 2516, "!endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2517, "is called a switch.  It is the final con"
	    "struct that you need to know.", text_len, (ftnlen)69);
    s_copy(text + text_len * 2518, "Although it looks forbidding, it is real"
	    "ly quite simple.  A switch is", text_len, (ftnlen)69);
    s_copy(text + text_len * 2519, "a list of keyword-template phrases, sepa"
	    "rated by vertical bars, and", text_len, (ftnlen)67);
    s_copy(text + text_len * 2520, "surrounded by braces.  The left brace is"
	    " prefixed with a quantifier,", text_len, (ftnlen)68);
    s_copy(text + text_len * 2521, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2522, "   (n:m){ ... }", text_len, (ftnlen)15);
    s_copy(text + text_len * 2523, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2524, "Whenever you see a switch,  it means tha"
	    "t at least n and not more than", text_len, (ftnlen)70);
    s_copy(text + text_len * 2525, "m of the phrases separated by vertical b"
	    "ars must appear;  however, they", text_len, (ftnlen)71);
    s_copy(text + text_len * 2526, "may appear in any order.  Thus, the synt"
	    "ax", text_len, (ftnlen)42);
    s_copy(text + text_len * 2527, "@exliteral", text_len, (ftnlen)10);
    s_copy(text + text_len * 2528, "SET TITLE FREQUENCY (1:1){ NONE", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 2529, "                         | FIRST", 
	    text_len, (ftnlen)32);
    s_copy(text + text_len * 2530, "                         | 1ST", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2531, "                         | ALL", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 2532, "                         | EVERY @int(2:"
	    ") }", text_len, (ftnlen)43);
    s_copy(text + text_len * 2533, "!endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2534, "matches all of the following commands.", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 2535, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2536, "SET TITLE FREQUENCY FIRST", text_len, (
	    ftnlen)25);
    s_copy(text + text_len * 2537, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2538, "SET TITLE FREQUENCY EVERY 3", text_len, (
	    ftnlen)27);
    s_copy(text + text_len * 2539, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2540, "SET TITLE FREQUENCY ALL", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 2541, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2542, "but does not match", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 2543, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2544, "SET TITLE FREQUENCY NONE FIRST ALL EVERY"
	    " @int(2:)", text_len, (ftnlen)49);
    s_copy(text + text_len * 2545, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2546, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2547, "When you see the special word", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 2548, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2549, "@options", text_len, (ftnlen)8);
    s_copy(text + text_len * 2550, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2551, "within a switch, it means that the phras"
	    "es following the token are", text_len, (ftnlen)66);
    s_copy(text + text_len * 2552, "optional, whereas the phrases preceding "
	    "the token are required (again,", text_len, (ftnlen)70);
    s_copy(text + text_len * 2553, "the phrases may appear in any order).  F"
	    "or example the construct", text_len, (ftnlen)64);
    s_copy(text + text_len * 2554, "@exliteral", text_len, (ftnlen)10);
    s_copy(text + text_len * 2555, "   (2:3){         WIDTH  @int(40:132)", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 2556, "        |         HEIGHT @int(22:)", 
	    text_len, (ftnlen)34);
    s_copy(text + text_len * 2557, "        | @options", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 2558, "        |         TITLE (1:3)@word }", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 2559, "!endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2560, "means that the phrases beginning with th"
	    "e keywords WIDTH and HEIGHT must", text_len, (ftnlen)72);
    s_copy(text + text_len * 2561, "appear, while the phrase beginning with "
	    "TITLE is optional.", text_len, (ftnlen)58);
    s_copy(text + text_len * 2562, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2563, "@subsection Nesting Switches", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2564, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2565, "Switches cannot be nested.  The construct"
	    , text_len, (ftnlen)41);
    s_copy(text + text_len * 2566, "@exliteral", text_len, (ftnlen)10);
    s_copy(text + text_len * 2567, "   (a:b){ ...", text_len, (ftnlen)13);
    s_copy(text + text_len * 2568, "        | (c:d){ ...  }", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 2569, "        }", text_len, (ftnlen)9);
    s_copy(text + text_len * 2570, "!endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2571, "is illegal.", text_len, (ftnlen)11);
    s_copy(text + text_len * 2572, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2573, "@section Examples", text_len, (ftnlen)17);
    s_copy(text + text_len * 2574, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2575, "Given the syntax description", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2576, "@exliteral", text_len, (ftnlen)10);
    s_copy(text + text_len * 2577, "   SET FORMAT (0:1){ SPACED  | MARKED } "
	    "TABULAR", text_len, (ftnlen)47);
    s_copy(text + text_len * 2578, "              (0:1){ PRESERVED }", 
	    text_len, (ftnlen)32);
    s_copy(text + text_len * 2579, "!endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2580, "Convince yourself that the following are"
	    " all valid  commands.", text_len, (ftnlen)61);
    s_copy(text + text_len * 2581, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2582, "SET FORMAT TABULAR;", text_len, (ftnlen)
	    19);
    s_copy(text + text_len * 2583, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2584, "SET FORMAT SPACED TABULAR;", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 2585, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2586, "SET FORMAT MARKED TABULAR PRESERVED;", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 2587, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2588, "SET FORMAT TABULAR PRESERVED;", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 2589, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2590, "SET FORMAT SPACE TABULAR PRESERVED;", 
	    text_len, (ftnlen)35);
    s_copy(text + text_len * 2591, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2592, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2593, "Convince yourself that the following are"
	    " not valid commands.", text_len, (ftnlen)60);
    s_copy(text + text_len * 2594, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 2595, "SET FORMAT SPACED;", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 2596, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2597, "SET FORMAT PRESERVED TABULAR;", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 2598, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 2599, "SET FORMAT MARKED PRESERVED;", text_len, (
	    ftnlen)28);
    s_copy(text + text_len * 2600, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 2601, "@@Syntax Description Language", text_len, 
	    (ftnlen)29);
    return 0;
} /* zzhlp027_ */
Ejemplo n.º 17
0
/* $Procedure ZZDYNBID ( Fetch body ID kernel variable ) */
/* Subroutine */ int zzdynbid_(char *frname, integer *frcode, char *item, 
	integer *idcode, ftnlen frname_len, ftnlen item_len)
{
    integer n;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, 
	    ftnlen, ftnlen, ftnlen);
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    char dtype[1];
    extern integer rtrim_(char *, ftnlen);
    extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
    extern logical failed_(void);
    char bodnam[36];
    integer codeln, nameln;
    char kvname[32], cdestr[32];
    integer itemln, reqnam;
    extern /* Subroutine */ int chkout_(char *, ftnlen);
    extern logical return_(void);
    integer reqnum;
    extern /* Subroutine */ int intstr_(integer *, char *, ftnlen), dtpool_(
	    char *, logical *, integer *, char *, ftnlen, ftnlen), setmsg_(
	    char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char 
	    *, ftnlen), gcpool_(char *, integer *, integer *, integer *, char 
	    *, logical *, ftnlen, ftnlen), gipool_(char *, integer *, integer 
	    *, integer *, integer *, logical *, ftnlen);

/* $ Abstract */

/*     SPICE Private routine intended solely for the support of SPICE */
/*     routines.  Users should not call this routine directly due */
/*     to the volatile nature of this routine. */

/*     Look up a frame definition kernel variable whose associated value */
/*     is a body name or body ID code.  The returned value is always an */
/*     ID code.  The frame name or frame ID may be used as part of the */
/*     variable's name. */

/*     If the kernel variable is not present, or if the variable */
/*     is not a body name or a numeric value, signal an error. */

/* $ 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 */

/*     FRAMES */
/*     KERNEL */
/*     PRIVATE */
/*     UTILITY */

/* $ Declarations */
/* $ Abstract */

/*     This include file lists the parameter collection */
/*     defining the number of SPICE ID -> NAME mappings. */

/* $ 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 */

/*     naif_ids.req */

/* $ Keywords */

/*     Body mappings. */

/* $ Author_and_Institution */

/*     E.D. Wright (JPL) */

/* $ Version */

/*     SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */


/*     A script generates this file. Do not edit by hand. */
/*     Edit the creation script to modify the contents of */
/*     ZZBODTRN.INC. */


/*     Maximum size of a NAME string */


/*     Count of default SPICE mapping assignments. */

/* $ Abstract */

/*     Include file zzdyn.inc */

/*     SPICE private file intended solely for the support of SPICE */
/*     routines.  Users should not include this file directly due */
/*     to the volatile nature of this file */

/*     The parameters defined below are used by the SPICELIB dynamic */
/*     frame subsystem. */

/* $ 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. */

/* $ Parameters */

/*     This file declares parameters required by the dynamic */
/*     frame routines of the SPICELIB frame subsystem. */

/* $ Restrictions */

/*     The parameter BDNMLN is this routine must be kept */
/*     consistent with the parameter MAXL defined in */

/*        zzbodtrn.inc */


/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.1.0, 12-JAN-2005 (NJB) */

/*        Parameters KWX, KWY, KWZ renamed to KVX, KVY, KVZ. */

/* -    SPICELIB Version 1.0.0, 22-DEC-2004 (NJB) */

/* -& */

/*     String length parameters */
/*     ======================== */


/*     Kernel variable name length.  This parameter must be */
/*     kept consistent with the parameter MAXLEN used in the */
/*     POOL umbrella routine. */


/*     Length of a character kernel pool datum. This parameter must be */
/*     kept consistent with the parameter MAXCHR used in the POOL */
/*     umbrella routine. */


/*     Reference frame name length.  This parameter must be */
/*     kept consistent with the parameter WDSIZE used in the */
/*     FRAMEX umbrella routine. */


/*     Body name length.  This parameter is used to provide a level */
/*     of indirection so the dynamic frame source code doesn't */
/*     have to change if the name of this SPICELIB-scope parameter */
/*     is changed.  The value MAXL used here is defined in the */
/*     INCLUDE file */

/*        zzbodtrn.inc */

/*     Current value of MAXL = 36 */


/*     Numeric parameters */
/*     =================================== */

/*     The parameter MAXCOF is the maximum number of polynomial */
/*     coefficients that may be used to define an Euler angle */
/*     in an "Euler frame" definition */


/*     The parameter LBSEP is the default angular separation limit for */
/*     the vectors defining a two-vector frame.  The angular separation */
/*     of the vectors must differ from Pi and 0 by at least this amount. */


/*     The parameter QEXP is used to determine the width of */
/*     the interval DELTA used for the discrete differentiation */
/*     of velocity in the routines ZZDYNFRM, ZZDYNROT, and their */
/*     recursive analogs.  This parameter is appropriate for */
/*     64-bit IEEE double precision numbers; when SPICELIB */
/*     is hosted on platforms where longer mantissas are supported, */
/*     this parameter (and hence this INCLUDE file) will become */
/*     platform-dependent. */

/*     The choice of QEXP is based on heuristics.  It's believed to */
/*     be a reasonable choice obtainable without expensive computation. */

/*     QEXP is the largest power of 2 such that */

/*        1.D0 + 2**QEXP  =  1.D0 */

/*     Given an epoch T0 at which a discrete derivative is to be */
/*     computed, this choice provides a value of DELTA that usually */
/*     contributes no round-off error in the computation of the function */
/*     evaluation epochs */

/*        T0 +/- DELTA */

/*     while providing the largest value of DELTA having this form that */
/*     causes the order of the error term O(DELTA**2) in the quadratric */
/*     function approximation to round to zero.  Note that the error */
/*     itself will normally be small but doesn't necessarily round to */
/*     zero.  Note also that the small function approximation error */
/*     is not a measurement of the error in the discrete derivative */
/*     itself. */

/*     For ET values T0 > 2**27 seconds past J2000, the value of */
/*     DELTA will be set to */

/*        T0 * 2**QEXP */

/*     For smaller values of T0, DELTA should be set to 1.D0. */


/*     Frame kernel parameters */
/*     ======================= */

/*     Parameters relating to kernel variable names (keywords) start */
/*     with the letters */

/*        KW */

/*     Parameters relating to kernel variable values start with the */
/*     letters */

/*        KV */


/*     Generic parameters */
/*     --------------------------------- */

/*     Token used to build the base frame keyword: */


/*     Frame definition style parameters */
/*     --------------------------------- */

/*     Token used to build the frame definition style keyword: */


/*     Token indicating parameterized dynamic frame. */


/*     Freeze epoch parameters */
/*     --------------------------------- */

/*     Token used to build the freeze epoch keyword: */


/*     Rotation state parameters */
/*     --------------------------------- */

/*     Token used to build the rotation state keyword: */


/*     Token indicating rotating rotation state: */


/*     Token indicating inertial rotation state: */


/*     Frame family parameters */
/*     --------------------------------- */

/*     Token used to build the frame family keyword: */


/*     Token indicating mean equator and equinox of date frame. */


/*     Token indicating mean ecliptic and equinox of date frame. */


/*     Token indicating true equator and equinox of date frame. */


/*     Token indicating two-vector frame. */


/*     Token indicating Euler frame. */


/*     "Of date" frame family parameters */
/*     --------------------------------- */

/*     Token used to build the precession model keyword: */


/*     Token used to build the nutation model keyword: */


/*     Token used to build the obliquity model keyword: */


/*     Mathematical models used to define "of date" frames will */
/*     likely accrue over time.  We will simply assign them */
/*     numbers. */


/*     Token indicating the Lieske earth precession model: */


/*     Token indicating the IAU 1980 earth nutation model: */


/*     Token indicating the IAU 1980 earth mean obliqity of */
/*     date model.  Note the name matches that of the preceding */
/*     nutation model---this is intentional.  The keyword */
/*     used in the kernel variable definition indicates what */
/*     kind of model is being defined. */


/*     Two-vector frame family parameters */
/*     --------------------------------- */

/*     Token used to build the vector axis keyword: */


/*     Tokens indicating axis values: */


/*     Prefixes used for primary and secondary vector definition */
/*     keywords: */


/*     Token used to build the vector definition keyword: */


/*     Token indicating observer-target position vector: */


/*     Token indicating observer-target velocity vector: */


/*     Token indicating observer-target near point vector: */


/*     Token indicating constant vector: */


/*     Token used to build the vector observer keyword: */


/*     Token used to build the vector target keyword: */


/*     Token used to build the vector frame keyword: */


/*     Token used to build the vector aberration correction keyword: */


/*     Token used to build the constant vector specification keyword: */


/*     Token indicating rectangular coordinates used to */
/*     specify constant vector: */


/*     Token indicating latitudinal coordinates used to */
/*     specify constant vector: */


/*     Token indicating RA/DEC coordinates used to */
/*     specify constant vector: */


/*     Token used to build the cartesian vector literal keyword: */


/*     Token used to build the constant vector latitude keyword: */


/*     Token used to build the constant vector longitude keyword: */


/*     Token used to build the constant vector right ascension keyword: */


/*     Token used to build the constant vector declination keyword: */


/*     Token used to build the angular separation tolerance keyword: */


/*     See the section "Physical unit parameters" below for additional */
/*     parameters applicable to two-vector frames. */


/*     Euler frame family parameters */
/*     --------------------------------- */

/*     Token used to build the epoch keyword: */


/*     Token used to build the Euler axis sequence keyword: */


/*     Tokens used to build the Euler angle coefficients keywords: */


/*     See the section "Physical unit parameters" below for additional */
/*     parameters applicable to Euler frames. */


/*     Physical unit parameters */
/*     --------------------------------- */

/*     Token used to build the units keyword: */


/*     Token indicating radians: */


/*     Token indicating degrees: */


/*     End of include file zzdyn.inc */

/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  ------------------------------------------------- */
/*     FRNAME     I   Frame name. */
/*     FRCODE     I   Frame ID code. */
/*     ITEM       I   Item associated with frame definition. */
/*     IDCODE     O   Body ID code. */

/* $ Detailed_Input */

/*     FRNAME         is the name of the reference frame with which */
/*                    the requested variable is associated. */

/*     FRCODE         is the frame ID code of the reference frame with */
/*                    which the requested variable is associated. */

/*     ITEM           is a string identifying the specific datum */
/*                    to be fetched.  The kernel variable name */
/*                    has the form */

/*                       FRAME_<frame ID code>_<ITEM> */

/*                    or */

/*                       FRAME_<frame name>_<ITEM> */

/*                    The former of the two names takes precedence: */
/*                    this routine will look for a numeric variable */
/*                    of that name first. */

/*                    The value associated with the kernel variable */
/*                    must be one of */

/*                       - a nbody ID code */

/*                       - a string representation of an integer, */
/*                         for example '5' */

/*                       - a body frame name */

/* $ Detailed_Output */

/*     IDCODE         is the requested body ID code. */

/*                    The kernel variable name of the form */

/*                       FRAME_<frame ID code>_<ITEM> */

/*                    will be looked up first; if this variable */
/*                    is found and has numeric type, the associated */
/*                    value will be returned.  If this variable is */
/*                    found and has character type, the value will */
/*                    be converted to a body ID code, and that */
/*                    code will be returned. */

/*                    If this variable is not found, the variable */

/*                       FRAME_<frame name>_<ITEM> */

/*                    will be looked up.  If this variable is found and */
/*                    has numeric type, the associated value will be */
/*                    returned.  If this variable is found and has */
/*                    character type, the value will be converted to a */
/*                    body ID code, and that code will be returned. */

/*                    If a numeric value associated with the selected */
/*                    kernel variable is not integral, it will be */
/*                    rounded to the closest integer. */

/* $ Parameters */

/*     See zzdyn.inc for definition of KVNMLN. */

/* $ Exceptions */

/*     1) If neither the frame-ID-based or frame-name-based form of the */
/*        requested kernel variable name matches a kernel variable */
/*        present in the kernel pool, the error SPICE(KERNELVARNOTFOUND) */
/*        will be signaled. */

/*     2) If either the frame-ID-based or frame-name-based form of the */
/*        requested kernel variable name has length greater than KVNMLN, */
/*        that variable will not be searched for. */

/*     3) If both the frame-ID-based and frame-name-based forms of the */
/*        requested kernel variable name have length greater than KVNMLN, */
/*        the error SPICE(VARNAMETOOLONG) will be signaled. */

/*     4) If kernel variable matching one form of the requested kernel */
/*        variable names is found, but that variable has more than 1 */
/*        associated value, the error SPICE(BADVARIABLESIZE) will be */
/*        signaled. */

/*     5) If a name match is found for a character kernel variable, but */
/*        the value associated with the variable cannot be mapped to a */
/*        body ID code, the error SPICE(NOTRANSLATION) will be */
/*        signaled. */

/*     6) If a name match is found for a numeric kernel variable, */
/*        but that variable has a value that cannot be rounded to an */
/*        integer representable on the host platform, an error will */
/*        be signaled by a routine in the call tree of this routine. */

/* $ Files */

/*     1) Kernel variables fetched by this routine are normally */
/*        introduced into the kernel pool by loading one or more */
/*        frame kernels.  See the Frames Required Reading for */
/*        details. */

/* $ Particulars */

/*     This routine centralizes logic for kernel variable lookups that */
/*     must be performed by the SPICELIB frame subsystem. Part of the */
/*     functionality of this routine consists of handling error */
/*     conditions such as the unavailability of required kernel */
/*     variables; hence no "found" flag is returned to the caller. */

/*     As indicated above, the requested kernel variable may have a name */
/*     of the form */

/*        FRAME_<frame ID code>_<ITEM> */

/*     or */

/*        FRAME_<frame name>_<ITEM> */

/*     Because most frame definition keywords have the first form, this */
/*     routine looks for a name of that form first. */

/*     Note that although this routine considers the two forms of the */
/*     names to be synonymous, from the point of view of the kernel pool */
/*     access routines, these names are distinct.  Hence kernel */
/*     variables having names of both forms, but having possibly */
/*     different attributes, can be simultaneously present in the kernel */
/*     pool. Intentional use of this kernel pool feature is discouraged. */

/* $ Examples */

/*     1) See ZZDYNFRM. */

/*     2) Applications of this routine include finding ID codes of */
/*        observer or target bodies serving to define two-vector dynamic */
/*        frames. */

/* $ Restrictions */

/*     1) This is a SPICE private routine; the routine is subject */
/*        to change without notice.  User applications should not */
/*        call this routine. */

/*     2) An array-valued kernel variable matching the "ID code form" */
/*        of the requested kernel variable name could potentially */
/*        mask a scalar-valued kernel variable matching the "name */
/*        form" of the requested name.  This problem can be prevented */
/*        by sensible frame kernel design. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */

/*        References to parameterized dynamic frames in long error */
/*        messages were changed to references to "reference frames." */
/*        This change was made to enable this utility to support */
/*        kernel variable look-ups for non-dynamic frames. */

/* -    SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */

/* -& */
/* $ Revisions */

/* -    SPICELIB Version 2.0.0, 05-AUG-2005 (NJB) */

/*        References to parameterized dynamic frames in long error */
/*        messages were changed to references to "reference frames." */
/*        This change was made to enable this utility to support */
/*        kernel variable look-ups for non-dynamic frames. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     TEMPLN is the length of the keyword template, minus */
/*     the sum of the lengths of the two substitution markers ('#'). */


/*     Local variables */

    if (return_()) {
	return 0;
    }
    chkin_("ZZDYNBID", (ftnlen)8);

/*     Prepare to check the name of the kernel variable we're about */
/*     to look up. */

/*     Convert the frame code to a string. */

    intstr_(frcode, cdestr, (ftnlen)32);
    if (failed_()) {
	chkout_("ZZDYNBID", (ftnlen)8);
	return 0;
    }

/*     Get the lengths of the input frame code, name and item. */
/*     Compute the length of the ID-based kernel variable name; */
/*     check this length against the maximum allowed value.  If */
/*     the name is too long, proceed to look up the form of the */
/*     kernel variable name based on the frame name. */

    codeln = rtrim_(cdestr, (ftnlen)32);
    nameln = rtrim_(frname, frname_len);
    itemln = rtrim_(item, item_len);
    reqnum = codeln + itemln + 7;
    if (reqnum <= 32) {

/*        First try looking for a kernel variable including the frame ID */
/*        code. */

/*        Note the template is */

/*            'FRAME_#_#' */

	repmi_("FRAME_#_#", "#", frcode, kvname, (ftnlen)9, (ftnlen)1, (
		ftnlen)32);
	repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
		ftnlen)32);
	dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
    } else {

/*        The ID-based name is too long. We can't find the variable if */
/*        we can't look it up. */

	found = FALSE_;
    }
    if (! found) {

/*        We need to look up the frame name-based kernel variable. */
/*        Determine the length of the name of this variable; make */
/*        sure it's not too long. */

	reqnam = nameln + itemln + 7;
	if (reqnam > 32 && reqnum > 32) {

/*           Both forms of the name are too long. */

	    setmsg_("Kernel variable FRAME_#_# has length #; kernel variable"
		    " FRAME_#_# has length #; maximum allowed length is #.  N"
		    "either variable could be searched for in the kernel pool"
		    " due to these name length errors.", (ftnlen)200);
	    errint_("#", frcode, (ftnlen)1);
	    errch_("#", item, (ftnlen)1, item_len);
	    errint_("#", &reqnum, (ftnlen)1);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    errch_("#", item, (ftnlen)1, item_len);
	    errint_("#", &reqnam, (ftnlen)1);
	    errint_("#", &c__32, (ftnlen)1);
	    sigerr_("SPICE(VARNAMETOOLONG)", (ftnlen)21);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	} else if (reqnam > 32) {

/*           We couldn't find the variable having the ID-based name, */
/*           and the frame name-based variable name is too long to */
/*           look up. */

/*           Note that at this point KVNAME contains the ID-based */
/*           kernel variable name. */

	    setmsg_("Kernel variable # was expected to be present in the ker"
		    "nel pool but was not found.  The alternative form of ker"
		    "nel variable name FRAME_#_# was not searched for because"
		    " this name has excessive length (# characters vs allowed"
		    " maximum of #).  One of these variables is needed to def"
		    "ine the reference frame #.  Usually this type of problem"
		    " is due to a missing keyword assignment in a frame kerne"
		    "l.  Another, less likely, possibility is that other erro"
		    "rs in a frame kernel have confused the frame subsystem i"
		    "nto wrongly deciding these variables are needed.", (
		    ftnlen)551);
	    errch_("#", kvname, (ftnlen)1, (ftnlen)32);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    errch_("#", item, (ftnlen)1, item_len);
	    errint_("#", &reqnam, (ftnlen)1);
	    errint_("#", &c__32, (ftnlen)1);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}

/*        Now try looking for a kernel variable including the frame */
/*        name. */

	repmc_("FRAME_#_#", "#", frname, kvname, (ftnlen)9, (ftnlen)1, 
		frname_len, (ftnlen)32);
	repmc_(kvname, "#", item, kvname, (ftnlen)32, (ftnlen)1, item_len, (
		ftnlen)32);
	dtpool_(kvname, &found, &n, dtype, (ftnlen)32, (ftnlen)1);
	if (! found && reqnum > 32) {

/*           The kernel variable's presence (in one form or the other) */
/*           is mandatory:  signal an error.  The error message */
/*           depends on which variables we were able to try to */
/*           look up.  In this case, we never tried to look up the */
/*           frame ID-based name. */

/*           Note that at this point KVNAME contains the name-based */
/*           kernel variable name. */

	    setmsg_("Kernel variable # was expected to be present in the ker"
		    "nel pool but was not found.  The alternative form of ker"
		    "nel variable name FRAME_#_# was not searched for because"
		    " this name has excessive length (# characters vs allowed"
		    " maximum of #).  One of these variables is needed to def"
		    "ine the reference frame #.  Usually this type of problem"
		    " is due to a missing keyword assignment in a frame kerne"
		    "l.  Another, less likely, possibility is that other erro"
		    "rs in a frame kernel have confused the frame subsystem i"
		    "nto wrongly deciding these variables are needed.", (
		    ftnlen)551);
	    errch_("#", kvname, (ftnlen)1, (ftnlen)32);
	    errint_("#", frcode, (ftnlen)1);
	    errch_("#", item, (ftnlen)1, item_len);
	    errint_("#", &reqnum, (ftnlen)1);
	    errint_("#", &c__32, (ftnlen)1);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	} else if (! found) {

/*           We tried to look up both names and failed. */

	    setmsg_("At least one of the kernel variables FRAME_#_# or FRAME"
		    "_#_# was expected to be present in the kernel pool but n"
		    "either was found. One of these variables is needed to de"
		    "fine the reference frame #.  Usually this type of proble"
		    "m is due to a missing keyword assignment in a frame kern"
		    "el.  Another, less likely, possibility is that other err"
		    "ors in a frame kernel have confused the frame subsystem "
		    "into wrongly deciding these variables are needed.", (
		    ftnlen)440);
	    errint_("#", frcode, (ftnlen)1);
	    errch_("#", item, (ftnlen)1, item_len);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    errch_("#", item, (ftnlen)1, item_len);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}
    }

/*     Getting to this point means we found a kernel variable. The name */
/*     of the variable is KVNAME.  The data type is DTYPE and the */
/*     cardinality is N. */

    if (*(unsigned char *)dtype == 'C') {

/*        Rather than using BADKPV, we check the cardinality of the */
/*        kernel variable in-line so we can create a more detailed error */
/*        message if need be. */

	if (n > 1) {
	    setmsg_("The kernel variable # has used to define frame # was ex"
		    "pected to have size not exceeding 1 but in fact has size"
		    " #. Usually this type of problem is due to an error in a"
		    " frame definition provided in a frame kernel.", (ftnlen)
		    212);
	    errch_("#", kvname, (ftnlen)1, (ftnlen)32);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    errint_("#", &n, (ftnlen)1);
	    sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}

/*        Look up the kernel variable. */

	gcpool_(kvname, &c__1, &c__1, &n, bodnam, &found, (ftnlen)32, (ftnlen)
		36);
	if (! found) {
	    setmsg_("Variable # not found after DTPOOL indicated it was pres"
		    "ent in pool.", (ftnlen)67);
	    errch_("#", kvname, (ftnlen)1, (ftnlen)32);
	    sigerr_("SPICE(BUG)", (ftnlen)10);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}

/*        Convert the body name to a body code. */

	bods2c_(bodnam, idcode, &found, (ftnlen)36);
	if (! found) {
	    setmsg_("Body name # could not be translated to an ID code.", (
		    ftnlen)50);
	    errch_("#", bodnam, (ftnlen)1, (ftnlen)36);
	    sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}
    } else {

/*        The variable has numeric type. */

	if (n > 1) {
	    setmsg_("The kernel variable # has used to define frame # was ex"
		    "pected to have size not exceeding 1 but in fact has size"
		    " #. Usually this type of problem is due to an error in a"
		    " frame definition provided in a frame kernel.", (ftnlen)
		    212);
	    errch_("#", kvname, (ftnlen)1, (ftnlen)32);
	    errch_("#", frname, (ftnlen)1, frname_len);
	    errint_("#", &n, (ftnlen)1);
	    sigerr_("SPICE(BADVARIABLESIZE)", (ftnlen)22);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}

/*        Look up the kernel variable. */

	gipool_(kvname, &c__1, &c__1, &n, idcode, &found, (ftnlen)32);
	if (! found) {
	    setmsg_("Variable # not found after DTPOOL indicated it was pres"
		    "ent in pool.", (ftnlen)67);
	    errch_("#", kvname, (ftnlen)1, (ftnlen)32);
	    sigerr_("SPICE(BUG)", (ftnlen)10);
	    chkout_("ZZDYNBID", (ftnlen)8);
	    return 0;
	}
    }
    chkout_("ZZDYNBID", (ftnlen)8);
    return 0;
} /* zzdynbid_ */
Ejemplo n.º 18
0
/* $Procedure      SPKWSS ( SPK write segment summary ) */
/* Subroutine */ int spkwss_(integer *unit, char *segid, integer *segtgt, 
	integer *segcen, integer *segfrm, integer *segtyp, doublereal *segbtm,
	 doublereal *segetm, ftnlen segid_len)
{
    /* Initialized data */

    static char spktyp[80*21] = "Modified Difference Array                  "
	    "                                     " "Fixed Width, Fixed Order"
	    " Chebyshev Polynomials: Pos                             " "Fixed"
	    " Width, Fixed Order Chebyshev Polynomials: Pos, Vel             "
	    "           " "TRW Elements (Space Telescope, TDRS)              "
	    "                              " "Two Body Propagation Using Disc"
	    "rete States                                      " "Type 6      "
	    "                                                                "
	    "    " "Precession Conic Elements                                "
	    "                       " "Discrete States, Evenly Spaced, Lagran"
	    "ge Interpolation                          " "Discrete States, Un"
	    "evenly Spaced, Lagrange Interpolation                        " 
	    "Two-Line Elements (Short Period)                               "
	    "                 " "Two-Line Elements (Long Period)             "
	    "                                    " "Discrete States, Evenly S"
	    "paced, Hermite Interpolation                           " "Discre"
	    "te States, Unevenly Spaced, Hermite Interpolation               "
	    "          " "Variable Width, Fixed order Chebyshev Polynomials: "
	    "Pos, Vel                     " "Two-Body with J2 precession     "
	    "                                                " "ISO elements "
	    "                                                                "
	    "   " "Precessing Equinoctial Elements                           "
	    "                      " "Mex/Rosetta Hermite/Lagrange Interpolat"
	    "ion                                      " "ESOC/DDID Piecewise "
	    "Interpolation                                               " 
	    "Fixed Width, Fixed Order Chebyshev Polynomials: Vel            "
	    "                 " "Extended Modified Difference Array          "
	    "                                    ";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    char body[32];
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
    char frame[32];
    extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
	     char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
    char lines[80*10];
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, 
	    ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, 
	    ftnlen);
    extern logical failed_(void);
    char begtim[32], endtim[32];
    extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
	    char *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
    char typdsc[80];
    extern logical return_(void);

/* $ Abstract */

/*     Write the segment summary for an SPK segment to a Fortran logical */
/*     unit. */

/* $ 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 */

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I   The logical unit to use for writing the summary. */
/*      SEGIDS    I   Segment ID for the segment in an SPK file. */
/*      SEGTGT    I   Target body for the segment in an SPK file. */
/*      SEGCEN    I   Center body for the segment in an SPK file. */
/*      SEGFRM    I   Reference frame for the segment in an SPK file. */
/*      SEGTYP    I   Ephemeris type for the segment in an SPK file. */
/*      SEGBTM    I   Begin time (ET) for the segment in an SPK file. */
/*      SEGETM    I   End time (ET) for the segment in an SPK file. */

/* $ Detailed_Input */

/*      UNIT     The Fortran logical unit to which the segment summary */
/*               is written. */

/*      SEGID    Segment ID for a segment in an SPK file. */

/*      SEGTGT   Target body for a segment in an SPK file. This is the */
/*               NAIF integer code for the target body. */

/*      SEGCEN   Center body for a segment in an SPK file. This is the */
/*               NAIF integer code for the center body. */

/*      SEGFRM   Inertial reference frame for a segment in an SPK file. */
/*               this is the NAIF integer code for the inertial reference */
/*               frame. */

/*      SEGTYP   Ephemeris type for a segment in an SPK file. This is an */
/*               integer code which represents the SPK segment data type. */

/*      SEGBTM   Begin time (ET) for a segment in an SPK file. */

/*      SEGETM   End time (ET) for a segment in an SPK file. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If an error occurs while writing to the logical unit, the error */
/*        will be signaled by a routine called by this routine. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will format and display an SPK segment summary in a */
/*     human compatible fashion. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine performs time conversions using ET2UTC, and */
/*        therefore requires that a SPICE leapseconds kernel file be */
/*        loaded into the SPICELIB kernel pool before being called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     K.R. Gehringer (JPL) */
/*     W.L. Taber     (JPL) */

/* $ Version */

/* -    SPACIT Version 4.0.0, 18-OCT-2012 (NJB) */

/*        Updated to support SPK types 19, 20, and 21. */

/* -    SPACIT Version 3.0.0, 28-AUG-2002 (NJB) */

/*        Updated to support SPK type 18.  Fixed typo in type 13 */
/*        description. */

/* -    Beta Version 2.1.0, 28-FEB-1997 (WLT) */

/*        Added descriptions for types 4, 7, 10, 11, 12, 13, 15, 16 */
/*        and 17. */

/* -    Beta Version 2.0.0, 24-JAN-1996 (KRG) */

/*        There have been several undocumented revisions of this */
/*        subroutine to improve its display formats and fix display bugs. */
/*        We are starting a new trend here, with the documentation of the */
/*        changes to this version. Hopefully we will continue to do so. */

/*        The changes to this version are: */

/*           Calling a new subroutine to get reference frame names, to */
/*           support the non-inertial frames software. */

/*           Fixing some display inconsistencies when body, or frame */
/*           names are not found. */

/* -    Beta Version 1.0.0, 25-FEB-1993 (KRG) */

/* -& */
/* $ Index_Entries */

/*      format and write an spk segment summary */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set the value for the maximum output display width. */


/*     Set the maximum length for the inertial reference frame name. */


/*     Set the maximum length for a body name. */


/*     Set the precision for fractions of seconds used for UTC times */
/*     when converted from ET times. */


/*     Set the length of a UTC time string. */


/*     Set the maximum length of an SPK data type description. */


/*     Set the maximum number of SPK data types. */


/*     Set up some mnemonics for accessing the correct labels. */


/*     Set the number of output lines. */


/*     Local variables */


/*     Initial Values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("SPKWSS", (ftnlen)6);
    }

/*     Set up the line labels. */

    s_copy(lines, "   Segment ID     : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 480, "   UTC Start Time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 560, "   UTC Stop Time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 640, "   ET Start Time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 720, "   ET Stop time   : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 80, "   Target Body    : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 160, "   Center Body    : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 240, "   Reference frame: Frame #", (ftnlen)80, (ftnlen)27)
	    ;
    s_copy(lines + 320, "   SPK Data Type  : Type #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 400, "      Description : #", (ftnlen)80, (ftnlen)21);

/*     Format segment ID. */

    repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
	    ftnlen)80);

/*     Convert the segment start and stop times from ET to UTC for */
/*     human readability. */

    et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
    et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
    if (failed_()) {
	chkout_("SPKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the UTC times. */

    repmc_(lines + 480, "#", begtim, lines + 480, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 560, "#", endtim, lines + 560, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Convert the ET times into Calendar format. */

    etcal_(segbtm, begtim, (ftnlen)32);
    etcal_(segetm, endtim, (ftnlen)32);
    if (failed_()) {
	chkout_("SPKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the ET times. */

    repmc_(lines + 640, "#", begtim, lines + 640, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 720, "#", endtim, lines + 720, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Format the target body and its name if we found it. */

    bodc2n_(segtgt, body, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 80, "#", segtgt, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 80, "#", segtgt, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the central body and its name if we found it. */

    bodc2n_(segcen, body, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 160, "#", segcen, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 160, "#", body, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 160, "#", segcen, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the reference frame and its name if we found it. */

    frmnam_(segfrm, frame, (ftnlen)32);
    if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
	repmc_(lines + 240, "#", "#, #", lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 240, "#", frame, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the SPK segment type and a description if we have one. */

    if (*segtyp > 21 || *segtyp < 1) {
	s_copy(typdsc, "No description for this type. Do you need a new tool"
		"kit?", (ftnlen)80, (ftnlen)56);
    } else {
	s_copy(typdsc, spktyp + ((i__1 = *segtyp - 1) < 21 && 0 <= i__1 ? 
		i__1 : s_rnge("spktyp", i__1, "spkwss_", (ftnlen)400)) * 80, (
		ftnlen)80, (ftnlen)80);
    }
    repmi_(lines + 320, "#", segtyp, lines + 320, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);
    repmc_(lines + 400, "#", typdsc, lines + 400, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80, (ftnlen)80);

/*     Display the summary. */

    writla_(&c__10, lines, unit, (ftnlen)80);

/*     We were either successful or not on the previous write. In either */
/*     event, we want to check out and return to the caller, so there is */
/*     no need to check FAILED() here. */

    chkout_("SPKWSS", (ftnlen)6);
    return 0;
} /* spkwss_ */
Ejemplo n.º 19
0
/* $Procedure      CHCKDO ( Check presence of required input parameters ) */
/* Subroutine */ int chckdo_(char *indtvl, integer *outtvl, integer *param, 
	integer *nparam, char *doval, ftnlen indtvl_len, ftnlen doval_len)
{
    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    integer l;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen, 
	    ftnlen, ftnlen, ftnlen);
    logical found;
    extern integer rtrim_(char *, ftnlen), isrchi_(integer *, integer *, 
	    integer *);
    extern logical return_(void);
    char errlin[512];
    extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, 
	    ftnlen), inssub_(char *, char *, integer *, char *, ftnlen, 
	    ftnlen, ftnlen), chkout_(char *, ftnlen);

/* $ Abstract */

/*     This routine is a module of the MKSPK program. It checks whether */
/*     set of input parameters specified in the DATA_ORDER value */
/*     contains all parameters required for a given input data type and */
/*     output SPK type. */

/* $ 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 */

/*     MKSPK User's Guide */

/* $ Keywords */

/*     None. */

/* $ Declarations */
/* $ Abstract */

/*     MKSPK Include File. */

/* $ 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. */

/* $ Author_and_Institution */

/*     N.G. Khavenson (IKI RAS, Russia) */
/*     B.V. Semenov   (NAIF, JPL) */

/* $ Version */

/* -    Version 1.3.0, 08-FEB-2012 (BVS). */

/*        Added TLE coverage and ID keywords. Added default TLE pad */
/*        parameter. */

/* -    Version 1.2.0, 16-JAN-2008 (BVS). */

/*        Added ETTMWR parameter */

/* -    Version 1.1.0, 05-JUN-2001 (BVS). */

/*        Added MAXDEG parameter. */

/* -    Version 1.0.4, 21-MAR-2001 (BVS). */

/*        Added parameter for command line flag '-append' indicating */
/*        that appending to an existing output file was requested. */
/*        Added corresponding setup file keyword ('APPEND_TO_OUTPUT'.) */
/*        Added parameters for yes and no values of this keyword. */

/* -    Version 1.0.3, 28-JAN-2000 (BVS). */

/*        Added parameter specifying number of supported input data */
/*        types and parameter specifying number of supported output SPK */
/*        types */

/* -    Version 1.0.2, 22-NOV-1999 (NGK). */

/*        Added parameters for two-line elements processing. */

/* -    Version 1.0.1, 18-MAR-1999 (BVS). */

/*        Added usage, help and template displays. Corrected comments. */

/* -    Version 1.0.0,  8-SEP-1998 (NGK). */

/* -& */

/*     Begin Include Section:  MKSPK generic parameters. */


/*     Maximum number of states allowed per one segment. */


/*     String size allocation parameters */


/*     Length of buffer for input text processing */


/*     Length of a input text line */


/*     Length of file name and comment line */


/*     Length of string for keyword value processing */


/*     Length of string for word processing */


/*     Length of data order parameters string */


/*     Length of string reserved as delimiter */


/*     Numbers of different parameters */



/*     Maximum number of allowed comment lines. */


/*     Reserved number of input parameters */


/*     Full number of delimiters */


/*     Number of delimiters that may appear in time string */


/*     Command line flags */


/*     Setup file keywords reserved values */


/*     Standard YES and NO values for setup file keywords. */


/*     Number of supported input data types and input DATA TYPE */
/*     reserved values. */


/*     Number of supported output SPK data types -- this version */
/*     supports SPK types 5, 8, 9, 10, 12, 13, 15 and 17. */


/*     End of input record marker */


/*     Maximum allowed polynomial degree. The value of this parameter */
/*     is consistent with the ones in SPKW* routines. */


/*     Special time wrapper tag for input times given as ET seconds past */
/*     J2000 */


/*     Default TLE pad, 1/2 day in seconds. */


/*     End Include Section:  MKSPK generic parameters. */

/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     INDTVL     I   Input data type. */
/*     OUTTVL     I   Output spk type. */
/*     PARAM      I   Array of DATA_ORDER parameter IDs */
/*     NPARAM     I   Number of not zero parameter IDs in PARAM */
/*     DOVAL      I   Array of parameter values acceptable in DATA_ORDER */

/* $ Detailed_Input */

/*     INDTVL      is the input data type. See MKSPK.INC for the */
/*                 current list of supported input data types. */

/*     OUTTVL      is the output SPK type. Currently supported output */
/*                 SPK types are 5, 8, 9, 12, 13, 15 and 17. */

/*     PARAM       is an integer array containing indexes of the */
/*                 recognizable input parameters present in the */
/*                 DATA_ORDER keyword value in the order in which they */
/*                 were provided in that value. */

/*     NPARAM      is the number of elements in PARAM. */

/*     DOVAL       is an array containing complete set recognizable */
/*                 input parameters. (see main module for the current */
/*                 list) */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     If the set of input parameters does not contain some of the */
/*     required tokens, then the error 'SPICE(MISSINGDATAORDERTK)' */
/*     will be signalled. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     None. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.G. Khavenson (IKI RAS, Russia) */
/*     B.V. Semenov   (NAIF, JPL) */

/* $ Version */

/* -    Version 1.0.3, 29-MAR-1999 (NGK). */

/*        Added comments. */

/* -    Version 1.0.2, 18-MAR-1999 (BVS). */

/*        Corrected comments. */

/* -    Version 1.0.1, 13-JAN-1999 (BVS). */

/*        Modified error messages. */

/* -    Version 1.0.0, 08-SEP-1998 (NGK). */

/* -& */
/* $ Index_Entries */

/*     Check adequacy of the DATA_ORDER defined in MKSPK setup */

/* -& */

/*     SPICELIB functions */


/*     Parameters INELTP, INSTTP, INEQTP containing supported */
/*     input data type names and keyword parameter KDATOR are declared */
/*     in the include file. */


/*     Local variables */


/*     Error line variable. Size LINLEN declared in the include file. */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("CHCKDO", (ftnlen)6);
    }

/*     Check if EPOCH is present among specified input parameters. */

    if (isrchi_(&c__1, nparam, param) == 0) {
	setmsg_("Set of input data parameters specified in the setup file ke"
		"yword '#' must contain token '#' designating epoch position "
		"in the input data records.", (ftnlen)145);
	errch_("#", "DATA_ORDER", (ftnlen)1, (ftnlen)10);
	errch_("#", doval, (ftnlen)1, doval_len);
	sigerr_("SPICE(MISSINGEPOCHTOKEN)", (ftnlen)24);
    }

/*     Check whether all necessary input parameters are present */
/*     according to the input data type. */

    found = TRUE_;
    s_copy(errlin, "The following token(s) designating input parameter(s) re"
	    "quired when input data type is '#' is(are) missing in the value "
	    "of the setup file keyword '#':", (ftnlen)512, (ftnlen)150);
    if (s_cmp(indtvl, "ELEMENTS", rtrim_(indtvl, indtvl_len), (ftnlen)8) == 0)
	     {

/*        Input type is ELEMENTS. Check whether eccentricity, */
/*        inclination, argument of periapsis and longitude of ascending */
/*        node are present in the input data. */

	repmc_(errlin, "#", "ELEMENTS", errlin, (ftnlen)512, (ftnlen)1, (
		ftnlen)8, (ftnlen)512);
	repmc_(errlin, "#", "DATA_ORDER", errlin, (ftnlen)512, (ftnlen)1, (
		ftnlen)10, (ftnlen)512);
	if (isrchi_(&c__9, nparam, param) == 0) {
	    i__1 = rtrim_(errlin, (ftnlen)512) + 1;
	    inssub_(errlin, " '#',", &i__1, errlin, (ftnlen)512, (ftnlen)5, (
		    ftnlen)512);
	    repmc_(errlin, "#", doval + (doval_len << 3), errlin, (ftnlen)512,
		     (ftnlen)1, doval_len, (ftnlen)512);
	    found = FALSE_;
	}
	for (l = 13; l <= 15; ++l) {
	    if (isrchi_(&l, nparam, param) == 0) {
		i__1 = rtrim_(errlin, (ftnlen)512) + 1;
		inssub_(errlin, " '#',", &i__1, errlin, (ftnlen)512, (ftnlen)
			5, (ftnlen)512);
		repmc_(errlin, "#", doval + (l - 1) * doval_len, errlin, (
			ftnlen)512, (ftnlen)1, doval_len, (ftnlen)512);
		found = FALSE_;
	    }
	}
    } else if (s_cmp(indtvl, "STATES", rtrim_(indtvl, indtvl_len), (ftnlen)6) 
	    == 0) {

/*        Input type is STATES. Check whether all state vector */
/*        components are present in the input data. */

	repmc_(errlin, "#", "STATES", errlin, (ftnlen)512, (ftnlen)1, (ftnlen)
		6, (ftnlen)512);
	repmc_(errlin, "#", "DATA_ORDER", errlin, (ftnlen)512, (ftnlen)1, (
		ftnlen)10, (ftnlen)512);
	for (l = 2; l <= 7; ++l) {
	    if (isrchi_(&l, nparam, param) == 0) {
		i__1 = rtrim_(errlin, (ftnlen)512) + 1;
		inssub_(errlin, " '#',", &i__1, errlin, (ftnlen)512, (ftnlen)
			5, (ftnlen)512);
		repmc_(errlin, "#", doval + (l - 1) * doval_len, errlin, (
			ftnlen)512, (ftnlen)1, doval_len, (ftnlen)512);
		found = FALSE_;
	    }
	}
    } else if (s_cmp(indtvl, "EQ_ELEMENTS", rtrim_(indtvl, indtvl_len), (
	    ftnlen)11) == 0) {

/*        Input type is EQ_ELEMENTS. Check whether all equinoctial */
/*        elements are present in the input data. */

	repmc_(errlin, "#", "EQ_ELEMENTS", errlin, (ftnlen)512, (ftnlen)1, (
		ftnlen)11, (ftnlen)512);
	repmc_(errlin, "#", "DATA_ORDER", errlin, (ftnlen)512, (ftnlen)1, (
		ftnlen)10, (ftnlen)512);
	for (l = 21; l <= 29; ++l) {
	    if (isrchi_(&l, nparam, param) == 0) {
		i__1 = rtrim_(errlin, (ftnlen)512) + 1;
		inssub_(errlin, " '#',", &i__1, errlin, (ftnlen)512, (ftnlen)
			5, (ftnlen)512);
		repmc_(errlin, "#", doval + (l - 1) * doval_len, errlin, (
			ftnlen)512, (ftnlen)1, doval_len, (ftnlen)512);
		found = FALSE_;
	    }
	}
    }

/*     Signal the error if any of the required parameters wasn't found. */

    if (! found) {
	i__1 = rtrim_(errlin, (ftnlen)512) - 1;
	s_copy(errlin + i__1, ".", rtrim_(errlin, (ftnlen)512) - i__1, (
		ftnlen)1);
	setmsg_(errlin, (ftnlen)512);
	sigerr_("SPICE(MISSINGDATAORDERTK)", (ftnlen)25);
    }

/*     Check whether all necessary input parameters are present */
/*     according to the output SPK type. */

    found = TRUE_;
    if (*outtvl == 17) {

/*        Output type is 17. Verify if dM/dt, dNOD/dt, dPER/dt */
/*        exist in input data. */

	s_copy(errlin, "The following token(s) designating input parameter(s"
		") required when output SPK type is 17 is(are) missing in the"
		" value of the setup file keyword '#':", (ftnlen)512, (ftnlen)
		149);
	for (l = 27; l <= 29; ++l) {
	    if (isrchi_(&l, nparam, param) == 0) {
		i__1 = rtrim_(errlin, (ftnlen)512) + 1;
		inssub_(errlin, " '#',", &i__1, errlin, (ftnlen)512, (ftnlen)
			5, (ftnlen)512);
		repmc_(errlin, "#", doval + (l - 1) * doval_len, errlin, (
			ftnlen)512, (ftnlen)1, doval_len, (ftnlen)512);
		found = FALSE_;
	    }
	}
    }

/*     Signal the error if any of the required parameters wasn't found. */

    if (! found) {
	i__1 = rtrim_(errlin, (ftnlen)512) - 1;
	s_copy(errlin + i__1, ".", rtrim_(errlin, (ftnlen)512) - i__1, (
		ftnlen)1);
	setmsg_(errlin, (ftnlen)512);
	sigerr_("SPICE(MISSINGDATAORDERTK)", (ftnlen)25);
    }
    chkout_("CHCKDO", (ftnlen)6);
    return 0;
} /* chckdo_ */
Ejemplo n.º 20
0
/* $Procedure      SUMCK ( Summarize a CK file ) */
/* Subroutine */ int sumck_(integer *handle, char *binfnm, char *lpsfnm, char 
	*sclfnm, logical *logfil, integer *loglun, ftnlen binfnm_len, ftnlen 
	lpsfnm_len, ftnlen sclfnm_len)
{
    /* Initialized data */

    static char menutl[20] = "CK Summary Options  ";
    static char menuvl[20*6] = "QUIT                " "Skip                " 
	    "ENTIRE_FILE         " "BY_INSTRUMENT_ID    " "BY_UTC_INTERVAL  "
	    "   " "BY_SCLK_INTERVAL    ";
    static char menutx[40*6] = "Quit, returning to main menu.           " 
	    "Skip                                    " "Summarize entire fil"
	    "e.                  " "Summarize by NAIF instrument ID code.   " 
	    "Summarize by UTC time interval.         " "Summarize by SCLK ti"
	    "me interval.        ";
    static char menunm[1*6] = "Q" "." "F" "I" "U" "S";

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, 
	    ftnlen, ftnlen), s_wsle(cilist *), e_wsle(void), do_lio(integer *,
	     integer *, char *, ftnlen);

    /* Local variables */
    static logical done;
    static char line[255];
    extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
    extern integer cardd_(doublereal *);
    static doublereal beget;
    static char segid[40];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    static char bsclk[32];
    static doublereal endet;
    static char esclk[32];
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    static char separ[80];
    static logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), ckgss_(char *, integer *, integer *, 
	    integer *, integer *, doublereal *, doublereal *, integer *, 
	    integer *, ftnlen), reset_(void);
    static logical error;
    extern /* Subroutine */ int ckwss_(integer *, char *, integer *, integer *
	    , integer *, integer *, doublereal *, doublereal *, ftnlen);
    extern integer rtrim_(char *, ftnlen);
    extern /* Subroutine */ int utc2et_(char *, doublereal *, ftnlen), 
	    et2utc_(doublereal *, char *, integer *, char *, ftnlen, ftnlen), 
	    daffna_(logical *);
    extern logical failed_(void);
    static integer segbad;
    extern /* Subroutine */ int scdecd_(integer *, doublereal *, char *, 
	    ftnlen), dafbfs_(integer *);
    static integer segead;
    static doublereal begscl;
    extern /* Subroutine */ int scardd_(integer *, doublereal *), scencd_(
	    integer *, char *, doublereal *, ftnlen);
    static logical segfnd;
    static doublereal endscl;
    static char begutc[32];
    extern /* Subroutine */ int cnfirm_(char *, logical *, ftnlen), getchr_(
	    char *, char *, logical *, logical *, char *, ftnlen, ftnlen, 
	    ftnlen);
    static logical haveit;
    static char endutc[32];
    static integer segfrm;
    static doublereal segbtm, segetm;
    static integer instid, segins;
    static doublereal segint[8];
    static logical anyseg;
    extern /* Subroutine */ int getint_(char *, integer *, logical *, logical 
	    *, char *, ftnlen, ftnlen);
    static char errmsg[320], option[20], sumsep[80];
    extern logical return_(void);
    static char fnmout[255], sclout[255];
    static integer missin;
    static char lpsout[255];
    static integer menuop, segrts;
    static char tmpstr[80];
    static integer segtyp;
    static doublereal intrvl[8], intsct[8];
    static logical contnu, tryagn;
    extern /* Subroutine */ int ssized_(integer *, doublereal *), writln_(
	    char *, integer *, ftnlen), getopt_(char *, integer *, char *, 
	    char *, integer *, ftnlen, ftnlen, ftnlen), wninsd_(doublereal *, 
	    doublereal *, doublereal *), wnintd_(doublereal *, doublereal *, 
	    doublereal *);
    static char typout[255];
    extern /* Subroutine */ int chkout_(char *, ftnlen);

    /* Fortran I/O blocks */
    static cilist io___23 = { 0, 6, 0, 0, 0 };
    static cilist io___24 = { 0, 6, 0, 0, 0 };
    static cilist io___25 = { 0, 6, 0, 0, 0 };
    static cilist io___26 = { 0, 6, 0, 0, 0 };
    static cilist io___27 = { 0, 6, 0, 0, 0 };
    static cilist io___28 = { 0, 6, 0, 0, 0 };
    static cilist io___29 = { 0, 6, 0, 0, 0 };
    static cilist io___30 = { 0, 6, 0, 0, 0 };
    static cilist io___32 = { 0, 6, 0, 0, 0 };
    static cilist io___33 = { 0, 6, 0, 0, 0 };
    static cilist io___34 = { 0, 6, 0, 0, 0 };
    static cilist io___36 = { 0, 6, 0, 0, 0 };
    static cilist io___37 = { 0, 6, 0, 0, 0 };
    static cilist io___38 = { 0, 6, 0, 0, 0 };
    static cilist io___39 = { 0, 6, 0, 0, 0 };
    static cilist io___41 = { 0, 6, 0, 0, 0 };
    static cilist io___42 = { 0, 6, 0, 0, 0 };
    static cilist io___43 = { 0, 6, 0, 0, 0 };
    static cilist io___44 = { 0, 6, 0, 0, 0 };
    static cilist io___46 = { 0, 6, 0, 0, 0 };
    static cilist io___47 = { 0, 6, 0, 0, 0 };
    static cilist io___48 = { 0, 6, 0, 0, 0 };
    static cilist io___49 = { 0, 6, 0, 0, 0 };
    static cilist io___51 = { 0, 6, 0, 0, 0 };
    static cilist io___52 = { 0, 6, 0, 0, 0 };
    static cilist io___53 = { 0, 6, 0, 0, 0 };
    static cilist io___54 = { 0, 6, 0, 0, 0 };
    static cilist io___56 = { 0, 6, 0, 0, 0 };
    static cilist io___57 = { 0, 6, 0, 0, 0 };
    static cilist io___58 = { 0, 6, 0, 0, 0 };
    static cilist io___59 = { 0, 6, 0, 0, 0 };
    static cilist io___60 = { 0, 6, 0, 0, 0 };
    static cilist io___61 = { 0, 6, 0, 0, 0 };
    static cilist io___62 = { 0, 6, 0, 0, 0 };
    static cilist io___63 = { 0, 6, 0, 0, 0 };
    static cilist io___65 = { 0, 6, 0, 0, 0 };
    static cilist io___66 = { 0, 6, 0, 0, 0 };
    static cilist io___67 = { 0, 6, 0, 0, 0 };
    static cilist io___68 = { 0, 6, 0, 0, 0 };
    static cilist io___70 = { 0, 6, 0, 0, 0 };
    static cilist io___71 = { 0, 6, 0, 0, 0 };
    static cilist io___72 = { 0, 6, 0, 0, 0 };
    static cilist io___73 = { 0, 6, 0, 0, 0 };
    static cilist io___75 = { 0, 6, 0, 0, 0 };
    static cilist io___76 = { 0, 6, 0, 0, 0 };
    static cilist io___77 = { 0, 6, 0, 0, 0 };
    static cilist io___78 = { 0, 6, 0, 0, 0 };
    static cilist io___80 = { 0, 6, 0, 0, 0 };


/* $ Abstract */

/*     Summarize a CK file. */

/* $ 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. */

/* $ Declarations */

/*     Set the number of double precision components in an unpacked CK */
/*     descriptor. */


/*     Set the number of integer components in an unpacked CK descriptor. */


/*     Set the size of a packed CK descriptor. */


/*     Set the length of a CK segment identifier. */


/*     Set the value for the lower bound of the CELL data type. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     HANDLE     I   Handle of the SPK file to be summarized. */
/*     LOGFIL     I   Write the summary to a log file and to screen? */
/*     LOGLUN     I   Logical unit connected to the log file. */
/*     NDC        P   Number of d.p. components in SPK descriptor. */
/*     NIC        P   Number of integer components in SPK descriptor. */
/*     NC         P   Size of packed SPK descriptor. */
/*     IDSIZ      P   Length of SPK segment identifier. */
/*     LBCELL     P   Lower bound for the SPICELIB CELL data structure. */

/* $ Detailed_Input */

/*     HANDLE     is the integer handle of the CK file to be summarized. */

/*     LOGFIL     if TRUE means that the summary will be written to */
/*                a log file as well as displayed on the terminal */
/*                screen.  Otherwise, the summary will not be written */
/*                to a log file. */

/*     LOGLUN     is the logical unit connected to a log file to which */
/*                the summary is to be written if LOGFIL is TRUE. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     NDC        is the number of double precision components in an */
/*                unpacked SPK descriptor. */

/*     NIC        is the number of integer components in an unpacked */
/*                SPK descriptor. */

/*     NC         is the size of a packed SPK descriptor. */

/*     IDSIZ      is the length of an SPK segment identifier. */

/*     LBCELL     is the lower bound for the SPICELIB CELL data */
/*                structure. */

/* $ Exceptions */

/*     None. */

/* $ Files */

/*     The CK file to be summarized is referred throughout this routine */
/*     by its handle. The file should already be opened for read. */

/* $ Particulars */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

/*     K.R. Gehringer  (JPL) */
/*     M.J. Spencer    (JPL) */
/*     J.E. McLean     (JPL) */
/*     R.E. Thurman    (JPL) */

/* $ Version */

/* -    Beta Version 5.0.0  21-JUL-1995 (KRG) */

/*        Added several arguments to the call of this subroutine and */
/*        made other modifications to allow it to perform its own */
/*        formatting of the summary, including filenames and separators. */

/* -    Beta Version 4.0.0  11-APR-1994 (KRG) */

/*        Modified this routine to make use of new routines to get and */
/*        format and write CK segment summaries. */

/*        Added a missing $ Index_Entries header section. */

/*        Fixed a few typos in the header. */

/*        The routine DISPC is now obsolete. It is no longer used. */

/* -    Beta Version 3.0.0  22-MAR-1993 (KRG) */

/*        1) Changed the names of the variables TOFILE and UNIT to LOGFIL */
/*           and LOGLUN, respectively. */

/*        2) Updated the program to use the menuing subroutine GETOPT */
/*           which removes the need for the routine QSUMC. Redesigned */
/*           the case sructure of the code to facilitate the use of the */
/*           menuing routine. */

/*        3) Rearranged some of thee initializations that were performed, */
/*           moved several calls to SCARDD outside the main loop, etc. */

/*        5) Performed some general cleanup as deemed necessary. */

/* -    Beta Version 2.1.0  20-NOV-1991 (MJS) */

/*        Checked FAILED function in main loop. */

/* -    Beta Version 2.0.0  17-JUN-1991 (JEM) */

/*        1.  Added the arguments TOFILE and UNIT.  Previously the */
/*            summary was only displayed on the terminal screen. */
/*            Now, if requested by TOFILE, the summary is also */
/*            written to the file connected to UNIT. */

/*        2.  A user may cancel a task selected in QSUMC and */
/*            select another. */

/* -    SPICELIB Version 1.1.0  31-AUG-1990 (JEM) */

/*        This routine was updated due to changes in the CK and */
/*        SCLK design.  Also, several implementation-specific */
/*        parameters were moved from the header to the local */
/*        parameters section. */

/* -    SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */

/* -& */
/* $ Index_Entries */

/*      summarize the segments in a binary ck file */

/* -& */
/* $ Revisions */

/* -    Beta Version 5.0.0  21-JUL-1995 (KRG) */

/*        Added several arguments to the call of this subroutine and */
/*        made other modifications to allow it to perform its own */
/*        formatting of the summary, including filenames and separators. */

/* -    Beta Version 4.0.0  11-APR-1994 (KRG) */

/*        Modified this routine to make use of new routines to get and */
/*        format and write CK segment summaries. */

/*        Added a missing $ Index_Entries header section. */

/*        Fixed a few typos in the header. */

/*        The routine DISPC is now obsolete. It is no longer used. */

/* -    Beta Version 3.0.0  22-MAR-1993 (KRG) */

/*        1) Changed the names of the variables TOFILE and UNIT to LOGFIL */
/*           and LOGLUN, respectively. */

/*        2) Updated the program to use the menuing subroutine GETOPT */
/*           which removes the need for the routine QSUMC. Redesigned */
/*           the case sructure of the code to facilitate the use of the */
/*           menuing routine. */

/*        3) Rearranged some of thee initializations that were performed, */
/*           moved several calls to SCARDD outside the main loop, etc. */

/*        5) Performed some general cleanup as deemed necessary. */

/* -    Beta Version 2.1.0  20-NOV-1991 (MJS) */

/*        Checked FAILED function in main loop. In the previous version, */
/*        if any time conversion produced an error, the summary would go */
/*        in an endless loop. */

/* -    Beta Version 2.0.0  22-MAY-1991 (JEM) */

/*        1.  In addition to adding the arguments TOFILE and UNIT to */
/*            the calling sequence, the following code changes were */
/*            made. The two new arguments were added to the calling */
/*            sequence of DISPC as well.  If TOFILE is true, a */
/*            description of the type of summary is written to the */
/*            output file before calling DISPC to write the summary. */
/*            If no segments are found, the message is written to the */
/*            output file as well as the terminal screen when */
/*            TOFILE is true. */

/*        2.  QSUMC was changed.  'NONE' is now a possible task */
/*            returned from QSUMC and means a task was selected, */
/*            then cancelled.  QSUMC is called repeatedly until the */
/*            task returned is something other than NONE.  In */
/*            this way the user is able to select another task. */

/* -    SPICELIB Version 1.1.0  31-AUG-1990 (JEM) */

/*        This routine was updated to handle these changes to the */
/*        C-kernel design: */

/*           1.  Ephemeris time is no longer included in CK files. */
/*               All data is associated with spacecraft clock time only. */
/*               The segment descriptor no longer contains the */
/*               start and stop ET.  Thus, the number of double */
/*               precision components (NDC) is now two instead of four. */

/*           2.  Segments may now contain rate information, along with */
/*               pointing data.  The segment descriptor contains a flag */
/*               that indicates whether or not the segment includes */
/*               rate information.  Thus, the number of integer */
/*               components (NIC) is now six instead of five. */

/*        This version of SUMCK converts encoded SCLK times to ET for */
/*        comparison with input times which are converted from UTC to ET. */

/*        This routine was also updated to handle these changes to the */
/*        SCLK design: */

/*           1.  The name of the routine that encodes spacecraft */
/*               clock time was changed from ENSCLK to SCENCD, and */
/*               the order of arguments in the calling sequence */
/*               was changed. */

/*           2.  Instrument ID codes are now negative integers to */
/*               avoid conflict with other body id codes. */

/*        The parameters that pertain to the CK file architecture, */
/*        like the number of double precision components in the */
/*        segment descriptor (NDC), were moved from the header */
/*        to the local parameter section.  These parameters are */
/*        implementation specific.  Further, the user is not invited */
/*        to change them, nor are they needed in any argument */
/*        declaration.  Thus they do not belong in the header. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set value for a separator */


/*     Set up the instrument ID code prompt. */


/*     Set up the spacecraft ID code prompt. */


/*     Set up the SCLK time string prompt. */


/*     Set up labels for various output things. */


/*     Set up the UTC time string prompt. */


/*     Set the length for a line of text. */


/*     Set the length for an output line. */


/*     Set the length for an error message. */


/*     Set the length for a UTC time string. */


/*     Set the precision for the fractional part of UTC times. */


/*     Set a length for the option values. */


/*     Set a length for the title of a menu. */



/*     Set the length of the text description of an option on a menu. */


/*     The number of options available on the main menu. */


/*     Parameter for the standard output unit. */


/*     Local variables */


/*     Save everything to keep control happy. */


/*     Initial Values */

/*     Define the menu title ... */


/*     Define the menu option values ... */


/*     Define the menu descriptive text for each option ... */


/*     Define the menu option names ... */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("SUMCK", (ftnlen)5);
    }

/*     Initialize the separator. */

    s_copy(separ, "*********************************************************"
	    "***********************", (ftnlen)80, (ftnlen)80);

/*     Initialize the segment separator. */

    s_copy(sumsep, "--------------------------------------------------------"
	    "------------------------", (ftnlen)80, (ftnlen)80);

/*     Set the sizes of the window cells that we will use if the file */
/*     is to be summarized by time. */

    ssized_(&c__2, intrvl);
    ssized_(&c__2, segint);
    ssized_(&c__2, intsct);

/*     Initialize a few things before we start. */

    instid = 0;
    done = FALSE_;
    while(! done) {

/*        Initialize those things we reuse on every iteration. */

	contnu = TRUE_;
	writln_(" ", &c__6, (ftnlen)1);
	getopt_(menutl, &c__6, menunm, menutx, &menuop, (ftnlen)20, (ftnlen)1,
		 (ftnlen)40);
	if (failed_()) {
	    contnu = FALSE_;
	}
	if (contnu) {

/*           Perform all of the setup necessary to perform the summary. */
/*           This include prompting for input values required, etc. */

	    repmc_("Summary for CK file: #", "#", binfnm, fnmout, (ftnlen)22, 
		    (ftnlen)1, binfnm_len, (ftnlen)255);
	    repmc_("Leapseconds File   : #", "#", lpsfnm, lpsout, (ftnlen)22, 
		    (ftnlen)1, lpsfnm_len, (ftnlen)255);
	    repmc_("SCLK File          : #", "#", sclfnm, sclout, (ftnlen)22, 
		    (ftnlen)1, sclfnm_len, (ftnlen)255);
	    s_copy(option, menuvl + ((i__1 = menuop - 1) < 6 && 0 <= i__1 ? 
		    i__1 : s_rnge("menuvl", i__1, "sumck_", (ftnlen)553)) * 
		    20, (ftnlen)20, (ftnlen)20);
	    if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
		contnu = FALSE_;
		done = TRUE_;
	    } else if (s_cmp(option, "ENTIRE_FILE", (ftnlen)20, (ftnlen)11) ==
		     0) {

/*              Summarize the entire file. */

		repmc_("Summary Type       : #", "#", "Entire File", typout, (
			ftnlen)22, (ftnlen)1, (ftnlen)11, (ftnlen)255);
	    } else if (s_cmp(option, "BY_INSTRUMENT_ID", (ftnlen)20, (ftnlen)
		    16) == 0) {

/*              Summarize for a specified body. */

/*              First, we need to get the instrument ID code. */

		s_copy(errmsg, " ", (ftnlen)320, (ftnlen)1);
		haveit = FALSE_;
		tryagn = TRUE_;
		while(tryagn) {
		    error = FALSE_;
		    s_wsle(&io___23);
		    e_wsle();
		    s_wsle(&io___24);
		    do_lio(&c__9, &c__1, "Enter the desired NAIF instrument "
			    "code.", (ftnlen)39);
		    e_wsle();
		    s_wsle(&io___25);
		    e_wsle();
		    getint_("Instrument ID code? ", &instid, &haveit, &error, 
			    errmsg, (ftnlen)20, (ftnlen)320);
		    if (! haveit || error) {
			if (error) {
			    s_wsle(&io___26);
			    e_wsle();
			    s_wsle(&io___27);
			    do_lio(&c__9, &c__1, errmsg, rtrim_(errmsg, (
				    ftnlen)320));
			    e_wsle();
			}
			if (! haveit) {
			    s_wsle(&io___28);
			    e_wsle();
			    s_wsle(&io___29);
			    do_lio(&c__9, &c__1, "A NAIF instrument ID code "
				    "must be entered for this option.", (
				    ftnlen)58);
			    e_wsle();
			}
			if (! haveit || error) {
			    s_wsle(&io___30);
			    e_wsle();
			    cnfirm_("Try Again? (Yes/No) ", &tryagn, (ftnlen)
				    20);
			    if (! tryagn) {
				contnu = FALSE_;
			    }
			}
		    } else {
			tryagn = FALSE_;
		    }
		}

/*              Write the type of summary to the log file if we need to. */

		if (contnu) {
		    s_copy(tmpstr, "By Instrument ID #", (ftnlen)80, (ftnlen)
			    18);
		    repmc_("Summary Type       : #", "#", tmpstr, typout, (
			    ftnlen)22, (ftnlen)1, (ftnlen)80, (ftnlen)255);
		    repmi_(typout, "#", &instid, typout, (ftnlen)255, (ftnlen)
			    1, (ftnlen)255);
		}
	    } else if (s_cmp(option, "BY_UTC_INTERVAL", (ftnlen)20, (ftnlen)
		    15) == 0) {

/*              Summarize for given UTC time interval. */

/*              First, we need to get the UTC time string for the */
/*              begin time. */

		s_copy(errmsg, " ", (ftnlen)320, (ftnlen)1);
		haveit = FALSE_;
		tryagn = TRUE_;
		while(tryagn) {
		    error = FALSE_;
		    s_wsle(&io___32);
		    e_wsle();
		    s_wsle(&io___33);
		    do_lio(&c__9, &c__1, "Enter the desired beginning UTC ti"
			    "me.", (ftnlen)37);
		    e_wsle();
		    s_wsle(&io___34);
		    e_wsle();
		    getchr_("UTC time? ", begutc, &haveit, &error, errmsg, (
			    ftnlen)10, (ftnlen)32, (ftnlen)320);
		    if (! haveit || error) {
			if (error) {
			    s_wsle(&io___36);
			    e_wsle();
			    s_wsle(&io___37);
			    do_lio(&c__9, &c__1, errmsg, rtrim_(errmsg, (
				    ftnlen)320));
			    e_wsle();
			}
			if (! haveit) {
			    s_wsle(&io___38);
			    e_wsle();
			    s_wsle(&io___39);
			    do_lio(&c__9, &c__1, "A beginning UTC time strin"
				    "g must be entered for this option.", (
				    ftnlen)60);
			    e_wsle();
			}
		    } else {
			tryagn = FALSE_;
		    }

/*                 We now have the beginning time in UTC, so attempt */
/*                 to convert it to ET. If the conversion fails, we */
/*                 need to immediately reset the error handling so that */
/*                 we can continue processing. Remember, we are in a */
/*                 menuing subroutine, and we are not allowed to exit */
/*                 on an error: we must go back to the menu. thus the */
/*                 need for a resetting of the error handler here. If */
/*                 we got to here, there were no errors, so as long as */
/*                 we maintain that status, everything will be hunky */
/*                 dory. We also convert the ET back into UTC to get */
/*                 a consistent format for display. */

		    if (haveit) {
			utc2et_(begutc, &beget, (ftnlen)32);
			et2utc_(&beget, "C", &c__3, begutc, (ftnlen)1, (
				ftnlen)32);
			if (failed_()) {
			    reset_();
			    error = TRUE_;
			}
		    }

/*                 Check to see if they want to try and enter the */
/*                 beginning UTC time string again. */

		    if (! haveit || error) {
			s_wsle(&io___41);
			e_wsle();
			cnfirm_("Try Again? (Yes/No) ", &tryagn, (ftnlen)20);
			if (! tryagn) {
			    contnu = FALSE_;
			}
		    }
		}
/*              Now, if we can, we need to get the UTC time string for */
/*              the end time. */

		if (contnu) {
		    s_copy(errmsg, " ", (ftnlen)320, (ftnlen)1);
		    haveit = FALSE_;
		    tryagn = TRUE_;
		    while(tryagn) {
			error = FALSE_;
			s_wsle(&io___42);
			e_wsle();
			s_wsle(&io___43);
			do_lio(&c__9, &c__1, "Enter the desired ending UTC t"
				"ime.", (ftnlen)34);
			e_wsle();
			s_wsle(&io___44);
			e_wsle();
			getchr_("UTC time? ", endutc, &haveit, &error, errmsg,
				 (ftnlen)10, (ftnlen)32, (ftnlen)320);
			if (! haveit || error) {
			    if (error) {
				s_wsle(&io___46);
				e_wsle();
				s_wsle(&io___47);
				do_lio(&c__9, &c__1, errmsg, rtrim_(errmsg, (
					ftnlen)320));
				e_wsle();
			    }
			    if (! haveit) {
				s_wsle(&io___48);
				e_wsle();
				s_wsle(&io___49);
				do_lio(&c__9, &c__1, "An ending UTC time str"
					"ing must be entered for this option.",
					 (ftnlen)58);
				e_wsle();
			    }
			} else {
			    tryagn = FALSE_;
			}

/*                    We now have the ending time in UTC, so attempt */
/*                    to convert it to ET. If the conversion fails, we */
/*                    need to immediately reset the error handling so */
/*                    that we can continue processing. Remember, we are */
/*                    in a menuing subroutine, and we are not allowed */
/*                    to exit on an error: we must go back to the menu. */
/*                    thus the need for a resetting of the error handler */
/*                    here. If we got to here, there were no errors, so */
/*                    as long as we maintain that status, everything */
/*                    will be hunky dory. We also convert the ET back */
/*                    into UTC to get a consistent format for display. */

			if (haveit) {
			    utc2et_(endutc, &endet, (ftnlen)32);
			    et2utc_(&endet, "C", &c__3, endutc, (ftnlen)1, (
				    ftnlen)32);
			    if (failed_()) {
				reset_();
				error = TRUE_;
			    }
			}

/*                    Check to see if they want to try and enter the */
/*                    beginning UTC time string again. */

			if (! haveit || error) {
			    s_wsle(&io___51);
			    e_wsle();
			    cnfirm_("Try Again? (Yes/No) ", &tryagn, (ftnlen)
				    20);
			    if (! tryagn) {
				contnu = FALSE_;
			    }
			} else {
			    tryagn = FALSE_;
			}
		    }
		}

/*              Create an interval out of the begin and end ET times, */
/*              if we can. */

		if (contnu) {
		    scardd_(&c__0, intrvl);
		    wninsd_(&beget, &endet, intrvl);
		    if (failed_()) {
			contnu = FALSE_;
		    }
		}

/*              Write the type of summary to the output file, if we can. */

		if (contnu) {
		    s_copy(tmpstr, "By # Time Interval #", (ftnlen)80, (
			    ftnlen)20);
		    repmc_("Summary Type       : #", "#", tmpstr, typout, (
			    ftnlen)22, (ftnlen)1, (ftnlen)80, (ftnlen)255);
		    repmc_(typout, "#", "UTC", typout, (ftnlen)255, (ftnlen)1,
			     (ftnlen)3, (ftnlen)255);
		    repmc_(typout, "#", "(#, #)", typout, (ftnlen)255, (
			    ftnlen)1, (ftnlen)6, (ftnlen)255);
		    repmc_(typout, "#", begutc, typout, (ftnlen)255, (ftnlen)
			    1, (ftnlen)32, (ftnlen)255);
		    repmc_(typout, "#", endutc, typout, (ftnlen)255, (ftnlen)
			    1, (ftnlen)32, (ftnlen)255);
		}
	    } else if (s_cmp(option, "BY_SCLK_INTERVAL", (ftnlen)20, (ftnlen)
		    16) == 0) {

/*              Summarize for given SCLK time interval. */

/*              First, we need to get spacecraft ID code. */

		s_copy(errmsg, " ", (ftnlen)320, (ftnlen)1);
		haveit = FALSE_;
		tryagn = TRUE_;
		while(tryagn) {
		    error = FALSE_;
		    s_wsle(&io___52);
		    e_wsle();
		    s_wsle(&io___53);
		    do_lio(&c__9, &c__1, "Enter the desired NAIF spacecraft "
			    "ID code.", (ftnlen)42);
		    e_wsle();
		    s_wsle(&io___54);
		    e_wsle();
		    getint_("Spacecraft ID code? ", &missin, &haveit, &error, 
			    errmsg, (ftnlen)20, (ftnlen)320);
		    if (! haveit || error) {
			if (error) {
			    s_wsle(&io___56);
			    e_wsle();
			    s_wsle(&io___57);
			    do_lio(&c__9, &c__1, errmsg, rtrim_(errmsg, (
				    ftnlen)320));
			    e_wsle();
			}
			if (! haveit) {
			    s_wsle(&io___58);
			    e_wsle();
			    s_wsle(&io___59);
			    do_lio(&c__9, &c__1, "A NAIF spacecraft ID code "
				    "must be entered for this option.", (
				    ftnlen)58);
			    e_wsle();
			}
			if (! haveit || error) {
			    s_wsle(&io___60);
			    e_wsle();
			    cnfirm_("Try Again? (Yes/No) ", &tryagn, (ftnlen)
				    20);
			    if (! tryagn) {
				contnu = FALSE_;
			    }
			}
		    } else {
			tryagn = FALSE_;
		    }
		}

/*              Now, we need to get the SCLK time string for the */
/*              begin time. */

		if (contnu) {
		    s_copy(errmsg, " ", (ftnlen)320, (ftnlen)1);
		    haveit = FALSE_;
		    tryagn = TRUE_;
		    while(tryagn) {
			error = FALSE_;
			s_wsle(&io___61);
			e_wsle();
			s_wsle(&io___62);
			do_lio(&c__9, &c__1, "Enter the desired beginning SC"
				"LK time.", (ftnlen)38);
			e_wsle();
			s_wsle(&io___63);
			e_wsle();
			getchr_("SCLK time? ", bsclk, &haveit, &error, errmsg,
				 (ftnlen)11, (ftnlen)32, (ftnlen)320);
			if (! haveit || error) {
			    if (error) {
				s_wsle(&io___65);
				e_wsle();
				s_wsle(&io___66);
				do_lio(&c__9, &c__1, errmsg, rtrim_(errmsg, (
					ftnlen)320));
				e_wsle();
			    }
			    if (! haveit) {
				s_wsle(&io___67);
				e_wsle();
				s_wsle(&io___68);
				do_lio(&c__9, &c__1, "A beginning SCLK time "
					"string must be entered for this opti"
					"on.", (ftnlen)61);
				e_wsle();
			    }
			} else {
			    tryagn = FALSE_;
			}

/*                    We now have the beginning time in SCLK, so attempt */
/*                    to convert it to ET. If the conversion fails, we */
/*                    need to immediately reset the error handling so */
/*                    that we can continue processing. Remember, we are */
/*                    in a menuing subroutine, and we are not allowed to */
/*                    exit on an error: we must go back to the menu. thus */
/*                    the need for a resetting of the error handler here. */
/*                    If we got to here, there were no errors, so as long */
/*                    as we maintain that status, everything will be */
/*                    hunky dory. We also convert the ET back into SCLK, */
/*                    and UTC to get a consistent format for display. */

			if (haveit) {
			    scencd_(&missin, bsclk, &begscl, (ftnlen)32);
			    sct2e_(&missin, &begscl, &beget);
			    et2utc_(&beget, "C", &c__3, begutc, (ftnlen)1, (
				    ftnlen)32);
			    scdecd_(&missin, &begscl, bsclk, (ftnlen)32);
			    if (failed_()) {
				reset_();
				error = TRUE_;
			    }
			}

/*                    Check to see if they want to try and enter the */
/*                    beginning UTC time string again. */

			if (! haveit || error) {
			    s_wsle(&io___70);
			    e_wsle();
			    cnfirm_("Try Again? (Yes/No) ", &tryagn, (ftnlen)
				    20);
			    if (! tryagn) {
				contnu = FALSE_;
			    }
			}
		    }
		}
/*              Now, if we can, we need to get the UTC time string for */
/*              the end time. */

		if (contnu) {
		    s_copy(errmsg, " ", (ftnlen)320, (ftnlen)1);
		    haveit = FALSE_;
		    tryagn = TRUE_;
		    while(tryagn) {
			error = FALSE_;
			s_wsle(&io___71);
			e_wsle();
			s_wsle(&io___72);
			do_lio(&c__9, &c__1, "Enter the desired ending SCLK "
				"time.", (ftnlen)35);
			e_wsle();
			s_wsle(&io___73);
			e_wsle();
			getchr_("SCLK time? ", esclk, &haveit, &error, errmsg,
				 (ftnlen)11, (ftnlen)32, (ftnlen)320);
			if (! haveit || error) {
			    if (error) {
				s_wsle(&io___75);
				e_wsle();
				s_wsle(&io___76);
				do_lio(&c__9, &c__1, errmsg, rtrim_(errmsg, (
					ftnlen)320));
				e_wsle();
			    }
			    if (! haveit) {
				s_wsle(&io___77);
				e_wsle();
				s_wsle(&io___78);
				do_lio(&c__9, &c__1, "An ending SCLK time st"
					"ring must be entered for this option."
					, (ftnlen)59);
				e_wsle();
			    }
			} else {
			    tryagn = FALSE_;
			}

/*                    We now have the ending time in UTC, so attempt */
/*                    to convert it to ET. If the conversion fails, we */
/*                    need to immediately reset the error handling so */
/*                    that we can continue processing. Remember, we are */
/*                    in a menuing subroutine, and we are not allowed */
/*                    to exit on an error: we must go back to the menu. */
/*                    thus the need for a resetting of the error handler */
/*                    here. If we got to here, there were no errors, so */
/*                    as long as we maintain that status, everything */
/*                    will be hunky dory. We also convert the ET back */
/*                    into UTC to get a consistent format for display. */

			if (haveit) {
			    scencd_(&missin, esclk, &endscl, (ftnlen)32);
			    sct2e_(&missin, &endscl, &endet);
			    et2utc_(&endet, "C", &c__3, endutc, (ftnlen)1, (
				    ftnlen)32);
			    scdecd_(&missin, &endscl, esclk, (ftnlen)32);
			    if (failed_()) {
				reset_();
				error = TRUE_;
			    }
			}

/*                    Check to see if they want to try and enter the */
/*                    ending SCLK time string again. */

			if (! haveit || error) {
			    s_wsle(&io___80);
			    e_wsle();
			    cnfirm_("Try Again? (Yes/No) ", &tryagn, (ftnlen)
				    20);
			    if (! tryagn) {
				contnu = FALSE_;
			    }
			} else {
			    tryagn = FALSE_;
			}
		    }
		}

/*              Create an interval out of the begin and end ET times, */
/*              if we can. */

		if (contnu) {
		    scardd_(&c__0, intrvl);
		    wninsd_(&beget, &endet, intrvl);
		    if (failed_()) {
			contnu = FALSE_;
		    }
		}

/*              Write the type of summary to the output file, if we can. */

		if (contnu) {
		    s_copy(tmpstr, "By # Time Interval #", (ftnlen)80, (
			    ftnlen)20);
		    repmc_("Summary Type       : #", "#", tmpstr, typout, (
			    ftnlen)22, (ftnlen)1, (ftnlen)80, (ftnlen)255);
		    repmc_(typout, "#", "SCLK", typout, (ftnlen)255, (ftnlen)
			    1, (ftnlen)4, (ftnlen)255);
		    repmc_(typout, "#", "(#, #)", typout, (ftnlen)255, (
			    ftnlen)1, (ftnlen)6, (ftnlen)255);
		    repmc_(typout, "#", bsclk, typout, (ftnlen)255, (ftnlen)1,
			     (ftnlen)32, (ftnlen)255);
		    repmc_(typout, "#", esclk, typout, (ftnlen)255, (ftnlen)1,
			     (ftnlen)32, (ftnlen)255);
		}
	    }

/*           Now, if we can, search through the file from the beginning. */
/*           Keep track of whether or not any segments satisfy the search */
/*           criteria. */

	    if (contnu) {
		writln_(" ", &c__6, (ftnlen)1);
		writln_(separ, &c__6, (ftnlen)80);
		writln_(" ", &c__6, (ftnlen)1);
		writln_(fnmout, &c__6, (ftnlen)255);
		writln_(lpsout, &c__6, (ftnlen)255);
		writln_(sclout, &c__6, (ftnlen)255);
		writln_(typout, &c__6, (ftnlen)255);
		writln_(" ", &c__6, (ftnlen)1);
		if (*logfil) {
		    writln_(" ", loglun, (ftnlen)1);
		    writln_(separ, loglun, (ftnlen)80);
		    writln_(" ", loglun, (ftnlen)1);
		    writln_(fnmout, loglun, (ftnlen)255);
		    writln_(lpsout, loglun, (ftnlen)255);
		    writln_(sclout, loglun, (ftnlen)255);
		    writln_(typout, loglun, (ftnlen)255);
		    writln_(" ", loglun, (ftnlen)1);
		}
		anyseg = FALSE_;
		dafbfs_(handle);
		daffna_(&found);
		while(found && contnu) {

/*                 On each iteration of the loop, we have not found */
/*                 anything initially. */

		    segfnd = FALSE_;
		    scardd_(&c__0, intsct);
		    scardd_(&c__0, segint);

/*                 Get the descriptor of the segment. */

		    ckgss_(segid, &segins, &segfrm, &segtyp, &segrts, &segbtm,
			     &segetm, &segbad, &segead, (ftnlen)40);

/*                 Check to see if the current segment satisfies the */
/*                 current search criteria. */

		    if (s_cmp(option, "ENTIRE_FILE", (ftnlen)20, (ftnlen)11) 
			    == 0) {
			segfnd = TRUE_;
		    } else if (s_cmp(option, "BY_INSTRUMENT_ID", (ftnlen)20, (
			    ftnlen)16) == 0) {
			segfnd = instid == segins;
		    } else if (s_cmp(option, "BY_UTC_INTERVAL", (ftnlen)20, (
			    ftnlen)15) == 0) {

/*                    Create an interval out of the epochs in the */
/*                    segment. */

			missin = segins / 1000;
			sct2e_(&missin, &segbtm, &beget);
			sct2e_(&missin, &segetm, &endet);
			wninsd_(&beget, &endet, segint);

/*                    Intersect it with the input interval. */

			wnintd_(segint, intrvl, intsct);
			if (failed_()) {
			    reset_();
			    contnu = FALSE_;
			} else {
			    segfnd = cardd_(intsct) > 0;
			}
		    } else if (s_cmp(option, "BY_SCLK_INTERVAL", (ftnlen)20, (
			    ftnlen)16) == 0) {

/*                    Create an interval out of the epochs in the */
/*                    segment. */

			if (missin == segins / 1000) {
			    sct2e_(&missin, &segbtm, &beget);
			    sct2e_(&missin, &segetm, &endet);
			    wninsd_(&beget, &endet, segint);

/*                       Intersect it with the input interval. */

			    wnintd_(segint, intrvl, intsct);
			    if (failed_()) {
				reset_();
				contnu = FALSE_;
			    } else {
				segfnd = cardd_(intsct) > 0;
			    }
			} else {
			    segfnd = FALSE_;
			}
		    }
		    if (contnu && segfnd) {
			anyseg = TRUE_;

/*                    Display the segment summary. */

			writln_(sumsep, &c__6, (ftnlen)80);
			if (*logfil) {
			    writln_(sumsep, loglun, (ftnlen)80);
			}
			ckwss_(&c__6, segid, &segins, &segfrm, &segtyp, &
				segrts, &segbtm, &segetm, (ftnlen)40);
			if (*logfil) {
			    ckwss_(loglun, segid, &segins, &segfrm, &segtyp, &
				    segrts, &segbtm, &segetm, (ftnlen)40);
			}
			writln_(sumsep, &c__6, (ftnlen)80);
			if (*logfil) {
			    writln_(sumsep, loglun, (ftnlen)80);
			}
		    }

/*                 Find that next segment. */

		    daffna_(&found);
		    if (failed_()) {
			contnu = FALSE_;
		    }
		}
	    }

/*           Better say something if no segments were matching the */
/*           search criteria were found. */

	    if (contnu && ! anyseg) {
		s_copy(line, "No matching segments were found.", (ftnlen)255, 
			(ftnlen)32);
		writln_(line, &c__6, (ftnlen)255);
		if (*logfil) {
		    writln_(line, loglun, (ftnlen)255);
		}
	    }
	    if (contnu) {
		writln_(" ", &c__6, (ftnlen)1);
		writln_(separ, &c__6, (ftnlen)80);
		writln_(" ", &c__6, (ftnlen)1);
		if (*logfil) {
		    writln_(" ", loglun, (ftnlen)1);
		    writln_(separ, loglun, (ftnlen)80);
		    writln_(" ", loglun, (ftnlen)1);
		}
	    }
	}

/*        If anything failed, rset the error handling so that we can */
/*        redisplay the menu and keep doing things. */

	if (failed_()) {
	    reset_();
	}
    }
    chkout_("SUMCK", (ftnlen)5);
    return 0;
} /* sumck_ */
Ejemplo n.º 21
0
/* $Procedure  HX2INT  ( Signed hexadecimal string to integer ) */
/* Subroutine */ int hx2int_(char *string, integer *number, logical *error, 
	char *errmsg, ftnlen string_len, ftnlen errmsg_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    char ch__1[1];

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

    /* Local variables */
    static integer mini, maxi;
    logical more;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    static integer iplus, lccbeg, digbeg, lccend, uccbeg, digend, uccend, 
	    ispace;
    integer idigit;
    static integer minmod, maxmod;
    integer strbeg;
    logical negtiv;
    extern integer intmin_(void), intmax_(void);
    integer letter, strend;
    static integer iminus;
    integer tmpnum, pos;

/* $ Abstract */

/*     Convert a signed hexadecimal string representation of an integer */
/*     to its equivalent integer. */

/* $ 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 */

/*     ALPHANUMERIC */
/*     CONVERSION */

/* $ Declarations */


/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     STRING     I   Hexadecimal string to be converted to an integer. */
/*     NUMBER     O   Integer value to be returned. */
/*     ERROR      O   A logical flag which is .TRUE. on error. */
/*     ERRMSG     O   A descriptive error message. */

/* $ Detailed_Input */

/*     STRING   The hexadecimal string to be converted to an integer. */

/*              The following table describes the character set used */
/*              to represent the hexadecimal digits and their */
/*              corresponding values. */

/*              Character    Value           Character    Value */
/*              ---------    -----           ---------    ----- */
/*                '0'          0                '8'          8 */
/*                '1'          1                '9'          9 */
/*                '2'          2              'A','a'       10 */
/*                '3'          3              'B','b'       11 */
/*                '4'          4              'C','c'       12 */
/*                '5'          5              'D','d'       13 */
/*                '6'          6              'E','e'       14 */
/*                '7'          7              'F','f'       15 */

/*             The plus sign, '+', and the minus sign, '-', are used as */
/*             well, and they have their usual meanings. */

/*             A hexadecimal character string parsed by this routine */
/*             should consist of a sign, '+' or '-' (the plus sign is */
/*             optional for nonnegative numbers), followed immediately */
/*             by a contiguous sequence of hexadecimal digits, e.g.: */

/*                (1)   +h h ... h */
/*                        1 2     n */

/*                (2)   -h h ... h */
/*                        1 2     n */

/*                (3)   h h ... h */
/*                       1 2     n */

/*             where h  represents an hexadecimal digit. */
/*                    i */

/*             STRING may have leading and trailing blanks, but blanks */
/*             embedded within the signficant portion of the character */
/*             string are not allowed. This includes any blanks which */
/*             appear between the sign character and the first */
/*             hexadecimal digit. */

/* $ Detailed_Output */

/*     NUMBER   The integer value to be returned. The value of this */
/*              variable is not changed if an error occurs while parsing */
/*              the hexadecimal character string. */

/*     ERROR    A logical flag which indicates whether an error occurred */
/*              while attempting to parse NUMBER from the hexadecimal */
/*              character string STRING. ERROR will have the value */
/*              .TRUE. if an error occurs. It will have the value */
/*              .FALSE. otherwise. */

/*     ERRMSG   Contains a descriptive error message if an error */
/*              occurs while attempting to parse NUMBER from the */
/*              hexadecimal character string STRING, blank otherwise. */
/*              The error message will be left justified. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     Error free. */

/*     1)   If an unexpected character is encountered while parsing the */
/*          hexadecimal character string, an appropriate error message */
/*          will be set, and the routine will exit. The value of NUMBER */
/*          will be unchanged. */

/*     2)   If the string represents a number that is larger than */
/*          the maximum representable integer an appropriate error */
/*          message will be set, and the routine will exit. The value */
/*          of NUMBER will be unchanged. */

/*     3)   If the string represents a number that is smaller than */
/*          the minimum representable integer, an appropriate error */
/*          message will be set, and the routine will exit. The value */
/*          of NUMBER will be unchanged. */

/*     4)   If the input string is blank, an appropriate error message */
/*          will be set, and the routine will exit. The value of NUMBER */
/*          will be unchanged. */

/*     5)   If the error message string is not long enough to contain */
/*          the entire error message, the error message will be */
/*          truncated on the right. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will convert a signed hexadecimal character string */
/*     representation of an integer into its equivalent integer. This */
/*     provides a machine independent mechanism for storing or porting */
/*     integer values. This routine is used by the routine HX2DP which */
/*     converts a character string representation of a double precision */
/*     into its equivalent double precision value. */

/*     This routine is one of a pair of routines which are used to */
/*     perform conversions between integers and equivalent signed */
/*     hexadecimal character strings: */

/*           INT2HX -- Convert an integer into a signed hexadecimal */
/*                     character string. */

/*           HX2INT -- Convert a signed hexadecimal character string */
/*                     into an integer. */

/* $ Examples */

/*     All of the values shown are for a two's complement 32 bit */
/*     representation for signed integers. */

/*     The following argument values illustrate the action of HX2INT for */
/*     various input values. */

/*         STRING                 NUMBER        ERROR   ERRMSG */
/*         ---------------------  ------------  ------  ------ */
/*          '1'                    1            .FALSE.   ' ' */
/*          '-1'                  -1            .FALSE.   ' ' */
/*          'DF'                   223          .FALSE.   ' ' */
/*          'Df'                   223          .FALSE.   ' ' */
/*          '+3ABC'                15036        .FALSE.   ' ' */
/*          'ff'                   255          .FALSE.   ' ' */
/*          '-20'                 -32           .FALSE.   ' ' */
/*          '0'                    0            .FALSE.   ' ' */

/*          '7FFFFFFF'             2147483647   .FALSE.   ' ' */
/*          (Maximum 32 bit integer) */

/*          '-7FFFFFFF'           -2147483647   .FALSE.   ' ' */
/*          (Minimum 32 bit integer + 1) */

/*          '-80000000'           -2147483648   .FALSE.   ' ' */
/*          (Minimum 32 bit integer) */

/*          STRING = ' ' */
/*          NUMBER = ( Not defined ) */
/*          ERROR  = .TRUE. */
/*          ERRMSG = 'ERROR: A blank input string is not allowed.' */

/*          STRING = '-AB238Q' */
/*          NUMBER = ( Not defined ) */
/*          ERROR  = .TRUE. */
/*          ERRMSG = 'ERROR: Illegal character ''Q'' encountered.' */

/*          STRING = '- AAA' */
/*          NUMBER = ( Not defined ) */
/*          ERROR  = .TRUE. */
/*          ERRMSG = 'ERROR: Illegal character '' '' encountered.' */

/*          STRING = '80000000' */
/*          NUMBER = ( Not defined ) */
/*          ERROR  = .TRUE. */
/*          ERRMSG = 'ERROR: Integer too large to be represented.' */

/*          STRING = '-800F0000' */
/*          NUMBER = ( Not defined ) */
/*          ERROR  = .TRUE. */
/*          ERRMSG = 'ERROR: Integer too small to be represented.' */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

/*      K.R. Gehringer   (JPL) */

/* $ Literature_References */

/*      None. */

/* $ Version */

/* -     SPICELIB Version 1.1.0, 10-MAR-1994 (KRG) */

/*         Changed an IF test operand from .LE. to .LT. so that */
/*         the ELSE IF clause could be reached. This change has */
/*         NO effect on the execution of the routine because it */
/*         makes use of a base that is a power of 2 (16), so the */
/*         ELSE IF clause never needs to be reached. The algorithm */
/*         was meant to be as general as possible, however, so that */
/*         only the base and digits would need to be changed in order to */
/*         implement a different number base. */

/* -     SPICELIB Version 1.0.0, 22-OCT-1992 (KRG) */

/* -& */
/* $ Index_Entries */

/*     convert signed hexadecimal string to integer */

/* -& */
/* $ Revisions */

/* -     SPICELIB Version 1.1.0, 10-MAR-1994 (KRG) */

/*         Changed an IF test operand from .LE. to .LT. so that */
/*         the ELSE IF clause could be reached. This change has */
/*         NO effect on the execution of the routine because it */
/*         makes use of a base that is a power of 2 (16), so the */
/*         ELSE IF clause never needs to be reached. The algorithm */
/*         was meant to be as general as possible, however, so that */
/*         only the base and digits would need to be changed in order to */
/*         implement a different number base. */

/*         Old code was: */

/*            IF ( TMPNUM .LE. MAXI ) THEN */

/*               TMPNUM = TMPNUM * BASE + IDIGIT */
/*               POS    = POS + 1 */

/*            ELSE IF ( ( TMPNUM .EQ. MAXI   ) .AND. */
/*     .                ( IDIGIT .LE. MAXMOD ) ) THEN */

/*               TMPNUM = TMPNUM * BASE + IDIGIT */
/*               POS    = POS + 1 */

/*            ELSE ... */

/*         New code: */

/*            IF ( TMPNUM .LT. MAXI ) THEN */

/*               TMPNUM = TMPNUM * BASE + IDIGIT */
/*               POS    = POS + 1 */

/*            ELSE IF ( ( TMPNUM .EQ. MAXI   ) .AND. */
/*     .                ( IDIGIT .LE. MAXMOD ) ) THEN */

/*               TMPNUM = TMPNUM * BASE + IDIGIT */
/*               POS    = POS + 1 */

/*            ELSE ... */

/* -& */

/*     SPICELIB functions */


/*     Local Parameters */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     The input hexadecimal string is scanned from left to right, and */
/*     the integer is generated by repeated multiplications and additions */
/*     or subtractions. */

/*     If this is the first time that this routine has been called, */
/*     we need to do some setup stuff. */

    if (first) {
	first = FALSE_;

/*        Initialize the upper and lower bounds for the decimal digits, */
/*        the upper and lower bounds for the uppercase hexadecimal */
/*        digits, the upper and lower bounds for the lowercase */
/*        hexadecimal digits, the space, the plus sign, and the minus */
/*        sign in the character sequence. */

	digbeg = '0';
	digend = '9';
	uccbeg = 'A';
	uccend = 'F';
	lccbeg = 'a';
	lccend = 'f';
	iminus = '-';
	iplus = '+';
	ispace = ' ';

/*        Initialize some boundary values for error checking while */
/*        constructing the desired integer. These are used to help */
/*        determine integer overflow or integer underflow errors. */

	mini = intmin_() / 16;
	minmod = (mini << 4) - intmin_();
	maxi = intmax_() / 16;
	maxmod = intmax_() - (maxi << 4);
    }

/*     There are no errors initially, so set the error flag to */
/*     .FALSE. */

    *error = FALSE_;

/*     If the string is blank, set the error flag and return immediately. */

    if (s_cmp(string, " ", string_len, (ftnlen)1) == 0) {
	*error = TRUE_;
	s_copy(errmsg, "ERROR: A blank input string is not allowed.", 
		errmsg_len, (ftnlen)43);
	return 0;
    }

/*     Initialize a few other things. */

    s_copy(errmsg, " ", errmsg_len, (ftnlen)1);
    tmpnum = 0;

/*     Assume that the number is nonnegative. */

    negtiv = FALSE_;

/*     Skip any leading white space. We know that there is at least */
/*     one nonblank character at this point, so we will not loop */
/*     off the end of the string. */

    strbeg = 1;
    while(*(unsigned char *)&string[strbeg - 1] == ispace) {
	++strbeg;
    }

/*     Now, we want to find the end of the significant portion of */
/*     the input string. */

    strend = strbeg + 1;
    more = TRUE_;
    while(more) {
	if (strend <= i_len(string, string_len)) {
	    if (s_cmp(string + (strend - 1), " ", string_len - (strend - 1), (
		    ftnlen)1) != 0) {
		++strend;
	    } else {
		more = FALSE_;
	    }
	} else {
	    more = FALSE_;
	}
    }

/*     At this point, STREND is one larger than the length of the */
/*     significant portion of the string because we incremented */
/*     its value after the test. We will subtract one from the */
/*     value of STREND so that it exactly represents the position */
/*     of the last significant character in the string. */

    --strend;

/*     Set the position pointer to the beginning of the significant */
/*     part, i.e., the nonblank part, of the string, because we are */
/*     now ready to try and parse the number. */

    pos = strbeg;

/*     The first character should be a plus sign, '+', a minus sign, */
/*     '-', or a digit, '0' - '9', 'A' - 'F', or 'a' - 'f'. Anything */
/*     else is bogus, and we will catch it in the main loop below. */

/*     If the character is a minus sign, we want to set the value of */
/*     NEGTIV to .TRUE. and increment the position. */

/*     If the character is a plus sign, we want to increment the */
/*     position. */

    if (*(unsigned char *)&string[pos - 1] == iminus) {
	negtiv = TRUE_;
	++pos;
    } else if (*(unsigned char *)&string[pos - 1] == iplus) {
	++pos;
    }

/*     When we build up the number from the hexadecimal string we */
/*     need to treat nonnegative numbers differently from negative */
/*     numbers. This is because on many computers the minimum */
/*     integer is one less than the negation of the maximum integer. */
/*     Negative numbers are the ones which truly might cause */
/*     problems, because ABS(minimum integer) may equal ABS(maximum */
/*     integer) + 1, on some machines. For example, on many machines */
/*     with 32 bit numbers, INTMIN = -2147483648 and INTMAX = */
/*     2147483647. */

/*     Build up the number from the hexadecimal character string. */

    if (negtiv) {
	while(pos <= strend) {
	    letter = *(unsigned char *)&string[pos - 1];
	    if (letter >= digbeg && letter <= digend) {
		idigit = letter - digbeg;
	    } else if (letter >= uccbeg && letter <= uccend) {
		idigit = letter + 10 - uccbeg;
	    } else if (letter >= lccbeg && letter <= lccend) {
		idigit = letter + 10 - lccbeg;
	    } else {
		*error = TRUE_;
		s_copy(errmsg, "ERROR: Illegal character '#' encountered.", 
			errmsg_len, (ftnlen)41);
		*(unsigned char *)&ch__1[0] = letter;
		repmc_(errmsg, "#", ch__1, errmsg, errmsg_len, (ftnlen)1, (
			ftnlen)1, errmsg_len);
		return 0;
	    }
	    if (tmpnum > mini) {
		tmpnum = (tmpnum << 4) - idigit;
		++pos;
	    } else if (tmpnum == mini && idigit <= minmod) {
		tmpnum = (tmpnum << 4) - idigit;
		++pos;
	    } else {
		*error = TRUE_;
		s_copy(errmsg, "ERROR: Integer too small to be represented.", 
			errmsg_len, (ftnlen)43);
		return 0;
	    }
	}
    } else {
	while(pos <= strend) {
	    letter = *(unsigned char *)&string[pos - 1];
	    if (letter >= digbeg && letter <= digend) {
		idigit = letter - digbeg;
	    } else if (letter >= uccbeg && letter <= uccend) {
		idigit = letter + 10 - uccbeg;
	    } else if (letter >= lccbeg && letter <= lccend) {
		idigit = letter + 10 - lccbeg;
	    } else {
		*error = TRUE_;
		s_copy(errmsg, "ERROR: Illegal character '#' encountered.", 
			errmsg_len, (ftnlen)41);
		*(unsigned char *)&ch__1[0] = letter;
		repmc_(errmsg, "#", ch__1, errmsg, errmsg_len, (ftnlen)1, (
			ftnlen)1, errmsg_len);
		return 0;
	    }
	    if (tmpnum < maxi) {
		tmpnum = (tmpnum << 4) + idigit;
		++pos;
	    } else if (tmpnum == maxi && idigit <= maxmod) {
		tmpnum = (tmpnum << 4) + idigit;
		++pos;
	    } else {
		*error = TRUE_;
		s_copy(errmsg, "ERROR: Integer too large to be represented.", 
			errmsg_len, (ftnlen)43);
		return 0;
	    }
	}
    }

/*     If we got to here, we have successfully parsed the hexadecimal */
/*     string into an integer. Set the value and return. */

    *number = tmpnum;
    return 0;
} /* hx2int_ */
Ejemplo n.º 22
0
/* $Procedure      ZZHLP007 ( private help text ) */
/* Subroutine */ int zzhlp007_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 673, "Time Formats", text_len, (ftnlen)12);
    s_copy(text + text_len * 674, "Titles", text_len, (ftnlen)6);
    s_copy(text + text_len * 675, "Other Settings", text_len, (ftnlen)14);
    s_copy(text + text_len * 676, "Setting up Inspekt --- SET", text_len, (
	    ftnlen)26);
    finish[8] = 677;
    begin[9] = 678;
    s_copy(text + text_len * 677, "To create a custom time format for a colu"
	    "mn, enter the command:", text_len, (ftnlen)63);
    s_copy(text + text_len * 678, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 679, "SET COLUMN <column_name> FORMAT <format>;",
	     text_len, (ftnlen)41);
    s_copy(text + text_len * 680, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 681, "where <column_name> is the name of the co"
	    "lumn and <format> is the", text_len, (ftnlen)65);
    s_copy(text + text_len * 682, "custom format you desire.", text_len, (
	    ftnlen)25);
    s_copy(text + text_len * 683, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 684, "Custom formats work as follows.  Given a "
	    "time, there are associated", text_len, (ftnlen)67);
    s_copy(text + text_len * 685, "with it the current year, month, day, day"
	    " of year, hour, minutes,", text_len, (ftnlen)65);
    s_copy(text + text_len * 686, "seconds, current julian date, current num"
	    "ber of seconds past the", text_len, (ftnlen)64);
    s_copy(text + text_len * 687, "epoch of J2000, etc.  When a time is to b"
	    "e displayed, the custom", text_len, (ftnlen)64);
    s_copy(text + text_len * 688, "format you have provided is used as a rec"
	    "ipe for constructing the", text_len, (ftnlen)65);
    s_copy(text + text_len * 689, "time string.  Reading from left to right "
	    "the string formatter looks", text_len, (ftnlen)67);
    s_copy(text + text_len * 690, "for special substrings (listed below).  U"
	    "nrecognized substrings", text_len, (ftnlen)63);
    s_copy(text + text_len * 691, "are simply copied into the output string."
	    "  (This allows you to add", text_len, (ftnlen)66);
    s_copy(text + text_len * 692, "any label you might like to the output ti"
	    "mes.)  However, when a", text_len, (ftnlen)63);
    s_copy(text + text_len * 693, "recognized substring is found, the time f"
	    "ormatter determines the", text_len, (ftnlen)64);
    s_copy(text + text_len * 694, "corresponding component of time and appen"
	    "ds this to the output time", text_len, (ftnlen)67);
    s_copy(text + text_len * 695, "string that is under construction.", 
	    text_len, (ftnlen)34);
    s_copy(text + text_len * 696, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 697, "NOTE THAT TIME FORMATS ARE CASE SENSITIVE"
	    ".  To get a particular", text_len, (ftnlen)63);
    s_copy(text + text_len * 698, "component of the time into the output str"
	    "ing you must use exactly", text_len, (ftnlen)65);
    s_copy(text + text_len * 699, "the substring given in the list below. Fo"
	    "r example, if you wish", text_len, (ftnlen)63);
    s_copy(text + text_len * 700, "have the 3 letter abbreviation for the mo"
	    "nth appear in your output", text_len, (ftnlen)66);
    s_copy(text + text_len * 701, "times, you must use \"MON\";  the string"
	    " \"mon\" will simply be copied", text_len, (ftnlen)66);
    s_copy(text + text_len * 702, "as is into any of your time strings.", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 703, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 704, "(Substrings beginning with \"::\" do not "
	    "affect the appearance of", text_len, (ftnlen)63);
    s_copy(text + text_len * 705, "the format only the time system or roundi"
	    "ng)", text_len, (ftnlen)44);
    s_copy(text + text_len * 706, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 707, "@setparamsize{::UTC,::TDB,::TDT}", 
	    text_len, (ftnlen)32);
    s_copy(text + text_len * 708, "@param ::UTC,::TDB,::TDT.", text_len, (
	    ftnlen)25);
    s_copy(text + text_len * 709, " use the time system UTC, TDB, TDT respec"
	    "tively  (default UTC)", text_len, (ftnlen)62);
    s_copy(text + text_len * 710, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 711, "@param ::RND, ::TRUNC.", text_len, (ftnlen)
	    22);
    s_copy(text + text_len * 712, " Round or Truncate time respectively (def"
	    "ault truncate)", text_len, (ftnlen)55);
    s_copy(text + text_len * 713, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 714, "@param YYYY.", text_len, (ftnlen)12);
    s_copy(text + text_len * 715, "year", text_len, (ftnlen)4);
    s_copy(text + text_len * 716, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 717, "@param MON, MM.", text_len, (ftnlen)15);
    s_copy(text + text_len * 718, " 3 letter abbreviation, 2 digit number fo"
	    "r month resp.", text_len, (ftnlen)54);
    s_copy(text + text_len * 719, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 720, "@param DD, DOY.", text_len, (ftnlen)15);
    s_copy(text + text_len * 721, " day of month, day of year respectively", 
	    text_len, (ftnlen)39);
    s_copy(text + text_len * 722, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 723, "@param WKD.", text_len, (ftnlen)11);
    s_copy(text + text_len * 724, " 3 letter abbreviation for day of week", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 725, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 726, "@param HR, MN, SC.", text_len, (ftnlen)18);
    s_copy(text + text_len * 727, " hour, minutes, seconds respectively", 
	    text_len, (ftnlen)36);
    s_copy(text + text_len * 728, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 729, "@param JD,SP1950, SP2000.", text_len, (
	    ftnlen)25);
    s_copy(text + text_len * 730, " Julian date, seconds past 1950 or 2000 r"
	    "espectively", text_len, (ftnlen)52);
    s_copy(text + text_len * 731, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 732, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 733, "@param ##---#.", text_len, (ftnlen)14);
    s_copy(text + text_len * 734, "when these follow  a decimal point, they "
	    "indicate the number of", text_len, (ftnlen)63);
    s_copy(text + text_len * 735, "decimal places to use in the representati"
	    "on of the", text_len, (ftnlen)50);
    s_copy(text + text_len * 736, "preceding numeric component.  For example"
	    " 'SC.###' indicates that", text_len, (ftnlen)65);
    s_copy(text + text_len * 737, "the seconds component of a time should be"
	    " presented with", text_len, (ftnlen)56);
    s_copy(text + text_len * 738, "3 decimal points.", text_len, (ftnlen)17);
    s_copy(text + text_len * 739, "@@Custom Formats", text_len, (ftnlen)16);
    s_copy(text + text_len * 740, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 741, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 742, "Example Time Formats", text_len, (ftnlen)
	    20);
    finish[9] = 743;
    begin[10] = 744;
    s_copy(text + text_len * 743, "When printing a double precision number i"
	    "n a report,", text_len, (ftnlen)52);
    s_copy(text + text_len * 744, "Inspekt first examines", text_len, (ftnlen)
	    22);
    s_copy(text + text_len * 745, "the column attributes to determine if you"
	    " have specified", text_len, (ftnlen)56);
    s_copy(text + text_len * 746, "a particular format for that column.  If "
	    "you have that format", text_len, (ftnlen)61);
    s_copy(text + text_len * 747, "is used to create the text that is presen"
	    "ted in the report.", text_len, (ftnlen)59);
    s_copy(text + text_len * 748, "If you have not specified a particular fo"
	    "rmat, Inspekt looks", text_len, (ftnlen)60);
    s_copy(text + text_len * 749, "up the \"default floating format\" and us"
	    "es this to create the text", text_len, (ftnlen)65);
    s_copy(text + text_len * 750, "to be used in the report.  You may adjust"
	    " the default floating", text_len, (ftnlen)62);
    s_copy(text + text_len * 751, "format.  To do this issue the command", 
	    text_len, (ftnlen)37);
    s_copy(text + text_len * 752, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 753, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 754, "SET DEFAULT FLOATING FORMAT format;", 
	    text_len, (ftnlen)35);
    s_copy(text + text_len * 755, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 756, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 757, "where \"format\" is the format you'd like"
	    " Inspekt to use", text_len, (ftnlen)54);
    s_copy(text + text_len * 758, "when you have not specified a particular "
	    "format for a column.", text_len, (ftnlen)61);
    s_copy(text + text_len * 759, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 760, "If you've specified a format for a double"
	    " precision column, and would", text_len, (ftnlen)69);
    s_copy(text + text_len * 761, "like to return to using the default float"
	    "ing format issue the", text_len, (ftnlen)61);
    s_copy(text + text_len * 762, "command", text_len, (ftnlen)7);
    s_copy(text + text_len * 763, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 764, "SET COLUMN column_name FORMAT DEFAULT;", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 765, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 766, "Until you change the format for the speci"
	    "fied column again,", text_len, (ftnlen)59);
    return 0;
} /* zzhlp007_ */
Ejemplo n.º 23
0
/* $Procedure KPLFRM ( Kernel pool frame IDs ) */
/* Subroutine */ int kplfrm_(integer *frmcls, integer *idset)
{
    /* System generated locals */
    integer i__1, i__2;

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

    /* Local variables */
    integer i__, l, m, n, w;
    extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
	     char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    extern integer sizei_(integer *);
    integer idcode, to;
    extern /* Subroutine */ int scardi_(integer *, integer *);
    char frname[32];
    extern /* Subroutine */ int validi_(integer *, integer *, integer *);
    char kvcode[32];
    integer fclass;
    char kvname[32], kvbuff[32*100], kvclas[32];
    extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer 
	    *, char *, logical *, ftnlen, ftnlen), gipool_(char *, integer *, 
	    integer *, integer *, integer *, logical *, ftnlen);
    char tmpnam[32];
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, 
	    ftnlen);
    char kvtemp[32];
    extern /* Subroutine */ int gnpool_(char *, integer *, integer *, integer 
	    *, char *, logical *, ftnlen, ftnlen);
    extern logical return_(void);

/* $ Abstract */

/*     Return a SPICE set containing the frame IDs of all reference */
/*     frames of a given class having specifications in the kernel pool. */

/* $ 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 */

/*     CELLS */
/*     FRAMES */
/*     KERNEL */
/*     NAIF_IDS */
/*     SETS */

/* $ Keywords */

/*     FRAME */
/*     SET */
/*     UTILITY */

/* $ Declarations */
/* $ Abstract */

/*     The parameters below form an enumerated list of the recognized */
/*     frame types.  They are: INERTL, PCK, CK, TK, DYN.  The meanings */
/*     are outlined below. */

/* $ 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. */

/* $ Parameters */

/*     INERTL      an inertial frame that is listed in the routine */
/*                 CHGIRF and that requires no external file to */
/*                 compute the transformation from or to any other */
/*                 inertial frame. */

/*     PCK         is a frame that is specified relative to some */
/*                 INERTL frame and that has an IAU model that */
/*                 may be retrieved from the PCK system via a call */
/*                 to the routine TISBOD. */

/*     CK          is a frame defined by a C-kernel. */

/*     TK          is a "text kernel" frame.  These frames are offset */
/*                 from their associated "relative" frames by a */
/*                 constant rotation. */

/*     DYN         is a "dynamic" frame.  These currently are */
/*                 parameterized, built-in frames where the full frame */
/*                 definition depends on parameters supplied via a */
/*                 frame kernel. */

/*     ALL         indicates any of the above classes. This parameter */
/*                 is used in APIs that fetch information about frames */
/*                 of a specified class. */


/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */
/*     W.L. Taber      (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */

/*       The parameter ALL was added to support frame fetch APIs. */

/* -    SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */

/*       The parameter DYN was added to support the dynamic frame class. */

/* -    SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */

/*        Various unused frames types were removed and the */
/*        frame time TK was added. */

/* -    SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */

/* -& */

/*     End of INCLUDE file frmtyp.inc */

/* $ Abstract */

/*     This file contains the number of inertial reference */
/*     frames that are currently known by the SPICE toolkit */
/*     software. */

/* $ 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 */

/*     FRAMES */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     NINERT     P   Number of known inertial reference frames. */

/* $ Parameters */

/*     NINERT     is the number of recognized inertial reference */
/*                frames.  This value is needed by both CHGIRF */
/*                ZZFDAT, and FRAMEX. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */

/* -& */
/* $ Abstract */

/*     This file contains the number of non-inertial reference */
/*     frames that are currently built into the SPICE toolkit */
/*     software. */


/* $ 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 */

/*     FRAMES */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     NINERT     P   Number of built-in non-inertial reference frames. */

/* $ Parameters */

/*     NINERT     is the number of built-in non-inertial reference */
/*                frames.  This value is needed by both  ZZFDAT, and */
/*                FRAMEX. */

/* $ Author_and_Institution */

/*     B.V. Semenov    (JPL) */
/*     W.L. Taber      (JPL) */
/*     F.S. Turner     (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.5.0, 11-OCT-2011 (BVS) */

/*        Increased the number of non-inertial frames from 100 to 105 */
/*        in order to accomodate the following PCK based frames: */

/*           IAU_CERES */
/*           IAU_PALLAS */
/*           IAU_LUTETIA */
/*           IAU_DAVIDA */
/*           IAU_STEINS */

/* -    SPICELIB Version 1.4.0, 11-MAY-2010 (BVS) */

/*        Increased the number of non-inertial frames from 96 to 100 */
/*        in order to accomodate the following PCK based frames: */

/*           IAU_BORRELLY */
/*           IAU_TEMPEL_1 */
/*           IAU_VESTA */
/*           IAU_ITOKAWA */

/* -    SPICELIB Version 1.3.0, 12-DEC-2002 (BVS) */

/*        Increased the number of non-inertial frames from 85 to 96 */
/*        in order to accomodate the following PCK based frames: */

/*           IAU_CALLIRRHOE */
/*           IAU_THEMISTO */
/*           IAU_MAGACLITE */
/*           IAU_TAYGETE */
/*           IAU_CHALDENE */
/*           IAU_HARPALYKE */
/*           IAU_KALYKE */
/*           IAU_IOCASTE */
/*           IAU_ERINOME */
/*           IAU_ISONOE */
/*           IAU_PRAXIDIKE */

/* -    SPICELIB Version 1.2.0, 02-AUG-2002 (FST) */

/*        Increased the number of non-inertial frames from 81 to 85 */
/*        in order to accomodate the following PCK based frames: */

/*           IAU_PAN */
/*           IAU_GASPRA */
/*           IAU_IDA */
/*           IAU_EROS */

/* -    SPICELIB Version 1.1.0, 20-FEB-1997 (WLT) */

/*        Increased the number of non-inertial frames from 79 to 81 */
/*        in order to accomodate the following earth rotation */
/*        models: */

/*           ITRF93 */
/*           EARTH_FIXED */

/* -    SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */

/* -& */
/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     FRMCLS     I   Frame class. */
/*     IDSET      O   Set of ID codes of frames of the specified class. */

/* $ Detailed_Input */

/*     FRMCLS         is an integer code specifying the frame class or */
/*                    classes for which frame ID codes are requested. */
/*                    The applicable reference frames are those having */
/*                    specifications present in the kernel pool. */

/*                    FRMCLS may designate a single class or "all */
/*                    classes." */

/*                    The include file frmtyp.inc declares parameters */
/*                    identifying frame classes. The supported values */
/*                    and corresponding meanings of FRMCLS are */

/*                       Parameter      Value    Meaning */
/*                       =========      =====    ================= */
/*                       ALL              -1     All frame classes */
/*                                               specified in the */
/*                                               kernel pool. Class 1 */
/*                                               is not included. */

/*                       INERTL            1     Built-in inertial. */
/*                                               No frames will be */
/*                                               returned in the */
/*                                               output set. */

/*                       PCK               2     PCK-based frame */

/*                       CK                3     CK-based frame */

/*                       TK                4     Fixed rotational */
/*                                               offset ("text */
/*                                               kernel") frame */

/*                       DYN               5     Dynamic frame */

/* $ Detailed_Output */

/*     IDSET          is a SPICE set containing the ID codes of all */
/*                    reference frames having specifications present in */
/*                    the kernel pool and belonging to the specified */
/*                    class or classes. */

/*                    Note that if FRMCLS is set to INERTL, IDSET */
/*                    will be empty on output. */

/* $ Parameters */

/*     See the INCLUDE file frmtyp.inc. */

/* $ Exceptions */

/*     1)  If the input frame class argument is not defined in */
/*         frmtyp.inc, the error SPICE(BADFRAMECLASS) is signaled. */

/*     2)  If the size of IDSET is too small to hold the requested frame */
/*         ID set, the error SPICE(SETTOOSMALL) is signaled. */

/*     3)  Frames of class 1 may not be specified in the kernel pool. */
/*         However, for the convenience of users, this routine does not */
/*         signal an error if the input class is set to INERTL. In this */
/*         case the output set will be empty. */

/*     4)  This routine relies on the presence of just three kernel */
/*         variable assignments for a reference frame in order to */
/*         determine that that reference frame has been specified: */

/*           FRAME_<frame name>       = <ID code> */
/*           FRAME_<ID code>_NAME     = <frame name> */

/*        and either */

/*           FRAME_<ID code>_CLASS    = <class> */

/*        or */

/*           FRAME_<frame name>_CLASS = <class> */

/*        It is possible for the presence of an incomplete frame */
/*        specification to trick this routine into incorrectly */
/*        deciding that a frame has been specified. This routine */
/*        does not attempt to diagnose this problem. */

/* $ Files */

/*     1) Reference frame specifications for frames that are not */
/*        built in are typically established by loading frame kernels. */

/* $ Particulars */

/*     This routine enables SPICE-based applications to conveniently */
/*     find the frame ID codes of reference frames having specifications */
/*     present in the kernel pool. Such frame specifications are */
/*     introduced into the kernel pool either by loading frame kernels */
/*     or by means of calls to the kernel pool "put" API routines */

/*        PCPOOL */
/*        PDPOOL */
/*        PIPOOL */

/*     Given a reference frame's ID code, other attributes of the */
/*     frame can be obtained via calls to entry points of the */
/*     umbrella routine FRAMEX: */

/*        FRMNAM {Return a frame's name} */
/*        FRINFO {Return a frame's center, class, and class ID} */

/*     This routine has a counterpart */

/*        BLTFRM */

/*     which fetches the frame IDs of all built-in reference frames. */

/* $ Examples */

/*     1)  Display the IDs and names of all reference frames having */
/*         specifications present in the kernel pool. Group the outputs */
/*         by frame class. Also fetch and display the entire set of IDs */
/*         and names using the parameter ALL. */

/*         The meta-kernel used for this example is shown below. The */
/*         Rosetta kernels referenced by the meta-kernel are available */
/*         in the path */

/*            pub/naif/ROSETTA/kernels/fk */

/*         on the NAIF server. Older, but officially archived versions */
/*         of these kernels are available in the path */

/*            pub/naif/pds/data/ros-e_m_a_c-spice-6-v1.0/ */
/*            rossp_1000/DATA/FK */

/*         The referenced PCK is available from the pck path under the */
/*         generic_kernels path on the same server. */


/*            KPL/MK */

/*            \begindata */

/*               KERNELS_TO_LOAD = ( 'pck00010.tpc' */
/*                                   'EARTHFIXEDITRF93.TF' */
/*                                   'ROS_LUTETIA_RSOC_V03.TF' */
/*                                   'ROS_V18.TF' */
/*                                   'RSSD0002.TF'            ) */
/*            \begintext */


/*         Program source code: */


/*                PROGRAM EX1 */
/*                IMPLICIT NONE */

/*                INCLUDE 'frmtyp.inc' */
/*          C */
/*          C     SPICELIB functions */
/*          C */
/*                INTEGER               CARDI */
/*          C */
/*          C     Local parameters */
/*          C */
/*                CHARACTER*(*)         META */
/*                PARAMETER           ( META   = 'kplfrm.tm' ) */

/*                INTEGER               NFRAME */
/*                PARAMETER           ( NFRAME = 1000 ) */

/*                INTEGER               LBCELL */
/*                PARAMETER           ( LBCELL = -5 ) */

/*                INTEGER               LNSIZE */
/*                PARAMETER           ( LNSIZE = 80 ) */

/*                INTEGER               FRNMLN */
/*                PARAMETER           ( FRNMLN = 32 ) */

/*          C */
/*          C     Local variables */
/*          C */
/*                CHARACTER*(FRNMLN)    FRNAME */
/*                CHARACTER*(LNSIZE)    OUTLIN */

/*                INTEGER               I */
/*                INTEGER               IDSET ( LBCELL : NFRAME ) */
/*                INTEGER               J */

/*          C */
/*          C     Initialize the frame set. */
/*          C */
/*                CALL SSIZEI ( NFRAME, IDSET ) */

/*          C */
/*          C     Load kernels that contain frame specifications. */
/*          C */
/*                CALL FURNSH ( META ) */

/*          C */
/*          C     Fetch and display the frames of each class. */
/*          C */
/*                DO I = 1, 6 */

/*                   IF ( I .LT. 6 ) THEN */
/*          C */
/*          C           Fetch the frames of class I. */
/*          C */
/*                      CALL KPLFRM ( I, IDSET ) */

/*                      OUTLIN = 'Number of frames of class #: #' */
/*                      CALL REPMI ( OUTLIN, '#', I,            OUTLIN ) */
/*                      CALL REPMI ( OUTLIN, '#', CARDI(IDSET), OUTLIN ) */

/*                   ELSE */
/*          C */
/*          C           Fetch IDs of all frames specified in the kernel */
/*          C           pool. */
/*          C */
/*                      CALL KPLFRM ( ALL, IDSET ) */

/*                      OUTLIN = 'Number of frames in the kernel pool: #' */
/*                      CALL REPMI ( OUTLIN, '#', CARDI(IDSET), OUTLIN ) */

/*                   END IF */

/*                   CALL TOSTDO ( ' '    ) */
/*                   CALL TOSTDO ( OUTLIN ) */
/*                   CALL TOSTDO ( '   Frame IDs and names' ) */

/*                   DO J = 1, CARDI(IDSET) */
/*                      CALL FRMNAM ( IDSET(J), FRNAME ) */
/*                      WRITE (*,*) IDSET(J), '  ', FRNAME */
/*                   END DO */

/*                END DO */

/*                END */


/*         The output from the program, when the program was linked */
/*         against the N0064 SPICE Toolkit, is shown below. The output */
/*         shown here has been abbreviated. */


/*            Number of frames of class 1: 0 */
/*               Frame IDs and names */

/*            Number of frames of class 2: 3 */
/*               Frame IDs and names */
/*                 1000012   67P/C-G_FIXED */
/*                 2000021   LUTETIA_FIXED */
/*                 2002867   STEINS_FIXED */

/*            Number of frames of class 3: 7 */
/*               Frame IDs and names */
/*                 -226570   ROS_RPC_BOOM2 */
/*                 -226215   ROS_VIRTIS-M_SCAN */
/*                 -226072   ROS_HGA_AZ */
/*                 -226071   ROS_HGA_EL */
/*                 -226025   ROS_SA-Y */
/*                 -226015   ROS_SA+Y */
/*                 -226000   ROS_SPACECRAFT */

/*            Number of frames of class 4: 64 */
/*               Frame IDs and names */
/*                -2260021   ROS_LUTETIA */
/*                 -226999   ROSLND_LOCAL_LEVEL */
/*                 -226900   ROSLND_LANDER */
/*                 -226560   ROS_RPC_BOOM1 */

/*                    ... */

/*                 -226030   ROS_MGA-S */
/*                 -226020   ROS_SA-Y_ZERO */
/*                 -226010   ROS_SA+Y_ZERO */
/*                 1502010   HCI */
/*                 1502301   LME2000 */
/*                 1503299   VME2000 */
/*                 1503499   MME2000 */

/*            Number of frames of class 5: 19 */
/*               Frame IDs and names */
/*                 -226967   2867/STEINS_CSO */
/*                 -226945   45P/H-M-P_CSO */
/*                 -226921   21/LUTETIA_CSO */
/*                 -226920   21/LUTETIA_CSEQ */
/*                 -226912   67P/C-G_CSO */
/*                 -226910   67P/C-G_CSEQ */
/*                 1500010   HEE */
/*                 1500299   VSO */
/*                 1500301   LSE */
/*                 1500399   GSE */
/*                 1500499   MME */
/*                 1501010   HEEQ */
/*                 1501299   VME */
/*                 1501301   LME */
/*                 1501399   EME */
/*                 1501499   MME_IAU2000 */
/*                 1502399   GSEQ */
/*                 1502499   MSO */
/*                 1503399   ECLIPDATE */

/*            Number of frames in the kernel pool: 93 */
/*               Frame IDs and names */
/*                -2260021   ROS_LUTETIA */
/*                 -226999   ROSLND_LOCAL_LEVEL */
/*                 -226967   2867/STEINS_CSO */
/*                 -226945   45P/H-M-P_CSO */
/*                 -226921   21/LUTETIA_CSO */

/*                    ... */

/*                 1503299   VME2000 */
/*                 1503399   ECLIPDATE */
/*                 1503499   MME2000 */
/*                 2000021   LUTETIA_FIXED */
/*                 2002867   STEINS_FIXED */


/* $ Restrictions */

/*     1) This routine will work correctly if the kernel pool */
/*        contains no invalid frame specifications. See the */
/*        description of exception 4 above. Users must ensure */
/*        that no invalid frame specifications are introduced */
/*        into the kernel pool, either by loaded kernels or */
/*        by means of the kernel pool "put" APIs. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 22-MAY-2012 (NJB) */

/* -& */
/* $ Index_Entries */

/*     fetch IDs of reference_frames from the kernel_pool */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */

    if (return_()) {
	return 0;
    }
    chkin_("KPLFRM", (ftnlen)6);

/*     The output set starts out empty. */

    scardi_(&c__0, idset);

/*     Check the input frame class. */

/*     This block of code must be kept in sync with frmtyp.inc. */

    if (*frmcls > 5 || *frmcls == 0 || *frmcls < -1) {
	setmsg_("Frame class specifier FRMCLS was #; this value is not suppo"
		"rted.", (ftnlen)64);
	errint_("#", frmcls, (ftnlen)1);
	sigerr_("SPICE(BADFRAMECLASS)", (ftnlen)20);
	chkout_("KPLFRM", (ftnlen)6);
	return 0;
    }

/*     Initialize the output buffer index. The */
/*     index is to be incremented prior to each */
/*     write to the buffer. */

    to = 0;

/*     Find all of the kernel variables having names */
/*     that could correspond to frame name assignments. */

/*     We expect that all frame specifications will */
/*     include assignments of the form */

/*         FRAME_<ID code>_NAME = <frame name> */

/*     We may pick up some additional assignments that are not part of */
/*     frame specifications; we plan to filter out as many as possible */
/*     by looking the corresponding frame ID and frame class */
/*     assignments. */

    s_copy(kvtemp, "FRAME_*_NAME", (ftnlen)32, (ftnlen)12);
    gnpool_(kvtemp, &c__1, &c__100, &n, kvbuff, &found, (ftnlen)32, (ftnlen)
	    32);
    while(n > 0) {

/*        At least one kernel variable was found by the last */
/*        GNPOOL call. Each of these variables is a possible */
/*        frame name. Look up each of these candidate names. */

	i__1 = n;
	for (i__ = 1; i__ <= i__1; ++i__) {

/*           Attempt to fetch the right hand side value for */
/*           the Ith kernel variable found on the previous */
/*           GNPOOL call. */

	    gcpool_(kvbuff + (((i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : 
		    s_rnge("kvbuff", i__2, "kplfrm_", (ftnlen)523)) << 5), &
		    c__1, &c__1, &m, frname, &found, (ftnlen)32, (ftnlen)32);
	    if (found) {

/*              We found a possible frame name. Attempt to look */
/*              up an ID code variable for the name. The assignment */
/*              for the ID code, if present, will have the form */

/*                 FRAME_<name> = <ID code> */

/*              Create the kernel variable name on the left hand */
/*              side of the assignment. */

		s_copy(kvcode, "FRAME_<name>", (ftnlen)32, (ftnlen)12);
		repmc_(kvcode, "<name>", frname, kvcode, (ftnlen)32, (ftnlen)
			6, (ftnlen)32, (ftnlen)32);

/*              Try to fetch the ID code. */

		gipool_(kvcode, &c__1, &c__1, &l, &idcode, &found, (ftnlen)32)
			;
		if (found) {

/*                 We found an integer on the right hand side */
/*                 of the assignment. We probably have a */
/*                 frame specification at this point. Check that */
/*                 the variable */

/*                    FRAME_<ID code>_NAME */

/*                 is present in the kernel pool and maps to */
/*                 the name FRNAME. */

		    s_copy(kvname, "FRAME_<code>_NAME", (ftnlen)32, (ftnlen)
			    17);
		    repmi_(kvname, "<code>", &idcode, kvname, (ftnlen)32, (
			    ftnlen)6, (ftnlen)32);
		    gcpool_(kvname, &c__1, &c__1, &w, tmpnam, &found, (ftnlen)
			    32, (ftnlen)32);
		    if (found) {

/*                    Try to look up the frame class using a */
/*                    kernel variable name of the form */

/*                       FRAME_<integer ID code>_CLASS */

/*                    Create the kernel variable name on the left */
/*                    hand side of the frame class assignment. */

			s_copy(kvclas, "FRAME_<integer>_CLASS", (ftnlen)32, (
				ftnlen)21);
			repmi_(kvclas, "<integer>", &idcode, kvclas, (ftnlen)
				32, (ftnlen)9, (ftnlen)32);

/*                    Look for the frame class. */

			gipool_(kvclas, &c__1, &c__1, &w, &fclass, &found, (
				ftnlen)32);
			if (! found) {

/*                       Try to look up the frame class using a kernel */
/*                       variable name of the form */

/*                          FRAME_<frame name>_CLASS */

			    s_copy(kvclas, "FRAME_<name>_CLASS", (ftnlen)32, (
				    ftnlen)18);
			    repmc_(kvclas, "<name>", frname, kvclas, (ftnlen)
				    32, (ftnlen)6, (ftnlen)32, (ftnlen)32);
			    gipool_(kvclas, &c__1, &c__1, &w, &fclass, &found,
				     (ftnlen)32);
			}

/*                    At this point FOUND indicates whether we found */
/*                    the frame class. */

			if (found) {

/*                       Check whether the frame class is one */
/*                       we want. */

			    if (*frmcls == -1 || *frmcls == fclass) {

/*                          We have a winner. Add it to the output set. */

/*                          First make sure the set is large enough to */
/*                          hold another element. */

				if (to == sizei_(idset)) {
				    setmsg_("Frame ID set argument IDSET has"
					    " size #; required size is at lea"
					    "st #. Make sure that the caller "
					    "of this routine has initialized "
					    "IDSET via SSIZEI.", (ftnlen)144);
				    i__2 = sizei_(idset);
				    errint_("#", &i__2, (ftnlen)1);
				    i__2 = to + 1;
				    errint_("#", &i__2, (ftnlen)1);
				    sigerr_("SPICE(SETTOOSMALL)", (ftnlen)18);
				    chkout_("KPLFRM", (ftnlen)6);
				    return 0;
				}
				++to;
				idset[to + 5] = idcode;
			    }

/*                       End of IF block for processing a frame having */
/*                       a frame class matching the request. */

			}

/*                    End of IF block for finding the frame class. */

		    }

/*                 End of IF block for finding the frame name. */

		}

/*              End of IF block for finding the frame ID. */

	    }

/*           End of IF block for finding string value corresponding to */
/*           the Ith kernel variable matching the name template. */

	}

/*        End of loop for processing last batch of potential */
/*        frame names. */

/*        Fetch next batch of potential frame names. */

	i__1 = n + 1;
	gnpool_(kvtemp, &i__1, &c__100, &n, kvbuff, &found, (ftnlen)32, (
		ftnlen)32);
    }

/*     At this point all kernel variables that matched the frame name */
/*     keyword template have been processed. All frames of the specified */
/*     class or classes have had their ID codes appended to IDSET. In */
/*     general IDSET is not yet a SPICELIB set, since it's not sorted */
/*     and it may contain duplicate values. */

/*     Turn IDSET into a set. VALIDI sorts and removes duplicates. */

    i__1 = sizei_(idset);
    validi_(&i__1, &to, idset);
    chkout_("KPLFRM", (ftnlen)6);
    return 0;
} /* kplfrm_ */
Ejemplo n.º 24
0
/* $Procedure      ZZHLP014 ( private help text ) */
/* Subroutine */ int zzhlp014_(integer *begin, integer *finish, char *text, 
	ftnlen text_len)
{
    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);

/* $ Abstract */

/*     Fill out a portion of the help text needed by percy. */

/*     Private routine intended solely for the support of Inspekt */

/* $ 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 */

/*     PRIVATE */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     BEGIN      O   Indexes of begins of text help */
/*     FINISH     O   Indexes of ends of text help */
/*     TEXT       O   A block of text help. */

/* $ Exceptions */

/*     Error free. */

/* $ Particulars */

/*     This routine simply fills begin and end markers as well */
/*     as actual text for a block of help text for percy. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    Inspekt Version 1.0.0, 1-AUG-1997 (WLT) */


/* -& */
    j = finish[0];
    i__ = begin[0];
    finish[0] = j;
    begin[0] = i__;
    repmc_(text, "*", "*", text, text_len, (ftnlen)1, (ftnlen)1, text_len);
    s_copy(text + text_len * 1307, "[NOT] column <relation> value", text_len, 
	    (ftnlen)29);
    s_copy(text + text_len * 1308, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1309, "If", text_len, (ftnlen)2);
    s_copy(text + text_len * 1310, "the column is a character or time column"
	    ", the value must be enclosed in either s", text_len, (ftnlen)80);
    s_copy(text + text_len * 1311, "Allowed relations are EQ NE LT LE GT GE "
	    "and LIKE (used for pattern", text_len, (ftnlen)66);
    s_copy(text + text_len * 1312, "matching).", text_len, (ftnlen)10);
    s_copy(text + text_len * 1313, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1314, "@@Looking at Data    --- SELECT", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 1315, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 1316, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 1317, "Column and Table Abbreviations", text_len,
	     (ftnlen)30);
    s_copy(text + text_len * 1318, "Select Clause", text_len, (ftnlen)13);
    s_copy(text + text_len * 1319, "From Clause", text_len, (ftnlen)11);
    s_copy(text + text_len * 1320, "Where Clause", text_len, (ftnlen)12);
    s_copy(text + text_len * 1321, "Order By", text_len, (ftnlen)8);
    s_copy(text + text_len * 1322, "Combining Tables", text_len, (ftnlen)16);
    s_copy(text + text_len * 1323, "Reports", text_len, (ftnlen)7);
    s_copy(text + text_len * 1324, "Getting Too Much Data", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1325, " ", text_len, (ftnlen)1);
    finish[30] = 1326;
    begin[31] = 1327;
    s_copy(text + text_len * 1326, "When you select a help topic for which t"
	    "here is some text that", text_len, (ftnlen)62);
    s_copy(text + text_len * 1327, "should be displayed, the help system beg"
	    "ins sending this text", text_len, (ftnlen)61);
    s_copy(text + text_len * 1328, "to your display.  If there is a lot of t"
	    "ext, some of it may", text_len, (ftnlen)59);
    s_copy(text + text_len * 1329, "scroll by before you have a chance to re"
	    "ad it.  There", text_len, (ftnlen)53);
    s_copy(text + text_len * 1330, "are two ways to deal with this.", 
	    text_len, (ftnlen)31);
    s_copy(text + text_len * 1331, "@newlist", text_len, (ftnlen)8);
    s_copy(text + text_len * 1332, "@numitem You can hit CTRL-S on your keyp"
	    "ad to cause output", text_len, (ftnlen)58);
    s_copy(text + text_len * 1333, "to your display to be temporarily disabl"
	    "ed. Hit CTRL-Q to restart", text_len, (ftnlen)65);
    s_copy(text + text_len * 1334, "the output.  This works on most terminal"
	    "s and terminal emulators.", text_len, (ftnlen)65);
    s_copy(text + text_len * 1335, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1336, "@numitem You can tell Inspekt to wait on"
	    "ce it finishes displaying", text_len, (ftnlen)65);
    s_copy(text + text_len * 1337, "a page full of text.", text_len, (ftnlen)
	    20);
    s_copy(text + text_len * 1338, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1339, "To do this at the Inspekt prompt type:", 
	    text_len, (ftnlen)38);
    s_copy(text + text_len * 1340, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1341, "Inspekt> SET HELP WAIT;", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 1342, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1343, "The Inspekt help system will now pause a"
	    "fter each page of", text_len, (ftnlen)57);
    s_copy(text + text_len * 1344, "text it displays and wait for you to hit"
	    " a carriage return before", text_len, (ftnlen)65);
    s_copy(text + text_len * 1345, "it displays the next page or related top"
	    "ics menu.", text_len, (ftnlen)49);
    s_copy(text + text_len * 1346, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1347, "To return to the original help system be"
	    "haviour, type the command", text_len, (ftnlen)65);
    s_copy(text + text_len * 1348, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1349, "Inspekt> SET HELP NO WAIT;", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 1350, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1351, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1352, "Note that the size of a page is also und"
	    "er your control.  You may", text_len, (ftnlen)65);
    s_copy(text + text_len * 1353, "set the number of lines that will fit on"
	    " a page by using the", text_len, (ftnlen)60);
    s_copy(text + text_len * 1354, "command \"SET PAGE HEIGHT\".  This comma"
	    "nd is described in the", text_len, (ftnlen)60);
    s_copy(text + text_len * 1355, "\"SET PAGE ...\" help topic.", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 1356, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1357, "@@Making Help Wait", text_len, (ftnlen)18)
	    ;
    s_copy(text + text_len * 1358, "Quit Help", text_len, (ftnlen)9);
    s_copy(text + text_len * 1359, "Help", text_len, (ftnlen)4);
    s_copy(text + text_len * 1360, "SET PAGE   ...", text_len, (ftnlen)14);
    finish[31] = 1361;
    begin[32] = 1362;
    s_copy(text + text_len * 1361, "A numeric format is specified by creatin"
	    "g a picture of the", text_len, (ftnlen)58);
    s_copy(text + text_len * 1362, "format.  For example to specify that a n"
	    "umber should start", text_len, (ftnlen)58);
    s_copy(text + text_len * 1363, "with 3 digits and be displayed to 3 deci"
	    "mal places use", text_len, (ftnlen)54);
    s_copy(text + text_len * 1364, "a picture such as this:", text_len, (
	    ftnlen)23);
    s_copy(text + text_len * 1365, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1366, "###.###", text_len, (ftnlen)7);
    s_copy(text + text_len * 1367, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1368, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1369, "If the first character of the picture is"
	    " a minus sign,", text_len, (ftnlen)54);
    s_copy(text + text_len * 1370, "the first character in the output string"
	    " will be", text_len, (ftnlen)48);
    s_copy(text + text_len * 1371, "a blank if the number is non-negative, a"
	    " minus sign", text_len, (ftnlen)51);
    s_copy(text + text_len * 1372, "if the number is negative.", text_len, (
	    ftnlen)26);
    s_copy(text + text_len * 1373, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1374, "If the first character of the picture is"
	    " a plus sign,", text_len, (ftnlen)53);
    s_copy(text + text_len * 1375, "the first character of the output string"
	    " will be a", text_len, (ftnlen)50);
    s_copy(text + text_len * 1376, "plus if the number is positive, a blank "
	    "if the number", text_len, (ftnlen)53);
    s_copy(text + text_len * 1377, "is zero, and a minus sign if the number "
	    "is negative.", text_len, (ftnlen)52);
    s_copy(text + text_len * 1378, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1379, "If the first character of the string is "
	    "NOT a sign", text_len, (ftnlen)50);
    s_copy(text + text_len * 1380, "(plus or minus) the first character of t"
	    "he output", text_len, (ftnlen)49);
    s_copy(text + text_len * 1381, "string will be a minus sign if the numbe"
	    "r is negative", text_len, (ftnlen)53);
    s_copy(text + text_len * 1382, "and will be the first character of the i"
	    "nteger part", text_len, (ftnlen)51);
    s_copy(text + text_len * 1383, "of the number otherwise.", text_len, (
	    ftnlen)24);
    s_copy(text + text_len * 1384, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1385, "The integer portion of STRING will conta"
	    "in at least", text_len, (ftnlen)51);
    s_copy(text + text_len * 1386, "as many characters as appear before the "
	    "decimal point", text_len, (ftnlen)53);
    s_copy(text + text_len * 1387, "(or last character if there is no decima"
	    "l point) but", text_len, (ftnlen)52);
    s_copy(text + text_len * 1388, "after a leading + or -. There will ALWAY"
	    "S be at least", text_len, (ftnlen)53);
    s_copy(text + text_len * 1389, "one digit output in integer portion of S"
	    "TRING.", text_len, (ftnlen)46);
    s_copy(text + text_len * 1390, " ", text_len, (ftnlen)1);
    s_copy(text + text_len * 1391, "If the picture begins with a any of the "
	    "following", text_len, (ftnlen)49);
    s_copy(text + text_len * 1392, "@literal", text_len, (ftnlen)8);
    s_copy(text + text_len * 1393, "   '+0', '-0', or '0'", text_len, (ftnlen)
	    21);
    s_copy(text + text_len * 1394, "|endliteral", text_len, (ftnlen)11);
    s_copy(text + text_len * 1395, "it is said to have a leading zero.  If a"
	    " picture has", text_len, (ftnlen)52);
    s_copy(text + text_len * 1396, "a leading zero and the integer portion i"
	    "s not large", text_len, (ftnlen)51);
    s_copy(text + text_len * 1397, "enough to fill up the integer space spec"
	    "ified by", text_len, (ftnlen)48);
    s_copy(text + text_len * 1398, "the picture, the output will be zero pad"
	    "ded from the sign (if", text_len, (ftnlen)61);
    s_copy(text + text_len * 1399, "one is required) up to the first charact"
	    "er of the", text_len, (ftnlen)49);
    s_copy(text + text_len * 1400, "integer part of the number.", text_len, (
	    ftnlen)27);
    return 0;
} /* zzhlp014_ */