/* $Procedure SYPOPD ( Pop a value from a particular symbol ) */
/* Subroutine */ int sypopd_(char *name__, char *tabsym, integer *tabptr,
doublereal *tabval, doublereal *value, logical *found, ftnlen
name_len, ftnlen tabsym_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nval, nptr, nsym;
extern integer cardc_(char *, ftnlen), cardd_(doublereal *), cardi_(
integer *);
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sumai_(integer *, integer *);
extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), scardd_(
integer *, doublereal *), remlac_(integer *, integer *, char *,
integer *, ftnlen);
extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int remlad_(integer *, integer *, doublereal *,
integer *), scardi_(integer *, integer *), remlai_(integer *,
integer *, integer *, integer *);
integer locval;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Pop a value associated with a particular symbol in a double */
/* precision symbol table. The first value associated with the */
/* symbol is removed, and subsequent values are moved forward. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose associated value is to be */
/* popped. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I/O Components of the symbol table. */
/* VALUE O Value that was popped. */
/* FOUND O True if the symbol exists, false if it does not. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose associated value is to */
/* be popped. If NAME is not in the symbol table, FOUND is */
/* false. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a double precision symbol table. */
/* $ Detailed_Output */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a double precision symbol table. */
/* The value is removed from the symbol table, and the */
/* remaining values associated with the symbol are moved */
/* forward in the value table. If no other values are */
/* associated with the symbol, the symbol is removed from */
/* the symbol table. */
/* VALUE is the value that was popped. This value was the first */
/* value in the symbol table that was associated with the */
/* symbol NAME. */
/* FOUND is true if NAME is in the symbol table, otherwise */
/* it is false. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* If there are no remaining values associated with the symbol */
/* after VALUE has been popped, the symbol is removed from the */
/* symbol table. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BODY4_POLE_RA --> 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0 */
/* DELTA_T_A --> 3.2184D1 */
/* K --> 1.657D-3 */
/* MEAN_ANOM --> 6.239996D0 */
/* 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* The call, */
/* CALL SYPOPD ( 'MEAN_ANOM', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */
/* modifies the contents of the symbol table to be: */
/* BODY4_POLE_RA --> 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0C */
/* DELTA_T_A --> 3.2184D1 */
/* K --> 1.657D-3 */
/* MEAN_ANOM --> 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* FOUND is TRUE, and VALUE is 6.239996D0. */
/* The next call, */
/* CALL SYPOPD ( 'K', TABSYM, TABPTR, TABVAL, VALUE, FOUND ) */
/* modifies the contents of the symbol table to be: */
/* BODY4_POLE_RA --> 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0C */
/* DELTA_T_A --> 3.2184D1 */
/* MEAN_ANOM --> 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* FOUND is TRUE, and VALUE is 1.657D-3. Note that because */
/* "K" had only one value associated with it, it was removed */
/* from the symbol table. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* pop a value from a particular symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYPOPD", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
nptr = cardi_(tabptr);
nval = cardd_(tabval);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If it's not in the table, it's definitely a problem. */
if (locsym == 0) {
*found = FALSE_;
/* If it is in the table, we can proceed without fear of overflow. */
} else {
*found = TRUE_;
/* Begin by saving and removing the initial value for this */
/* symbol from the value table. */
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + 1;
*value = tabval[locval + 5];
remlad_(&c__1, &locval, &tabval[6], &nval);
scardd_(&nval, tabval);
/* If this was the sole value for the symbol, remove the */
/* symbol from the name and pointer tables. Otherwise just */
/* decrement the dimension. */
if (tabptr[locsym + 5] == 1) {
remlac_(&c__1, &locsym, tabsym + tabsym_len * 6, &nsym,
tabsym_len);
scardc_(&nsym, tabsym, tabsym_len);
remlai_(&c__1, &locsym, &tabptr[6], &nptr);
scardi_(&nptr, tabptr);
} else {
--tabptr[locsym + 5];
}
}
chkout_("SYPOPD", (ftnlen)6);
return 0;
} /* sypopd_ */
/* $Procedure SYDIMI ( Return the dimension of a symbol ) */
integer sydimi_(char *name__, char *tabsym, integer *tabptr, integer *tabval,
ftnlen name_len, ftnlen tabsym_len)
{
/* System generated locals */
integer ret_val;
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Return the dimension of a particular symbol in an integer symbol */
/* table. If the symbol is not found, the function returns the */
/* value zero. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose dimension is desired. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I/O Components of the symbol table. */
/* The function returns the dimension of the symbol NAME. If NAME is */
/* not in the symbol table, the function returns the value zero. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose dimension is to be */
/* returned. If the symbol is not in the symbol table, the */
/* function returns the value zero. This function is case */
/* sensitive, NAME must match a symbol exactly. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of an integer symbol table. */
/* The table may or may not contain the symbol NAME. */
/* $ Detailed_Output */
/* The function returns the dimension of the symbol NAME. The */
/* dimension of a symbol is the number of values associated with */
/* that symbol. If NAME is not in the symbol table, the function */
/* returns the value zero. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* The contents of the symbol table are: */
/* books --> 5 */
/* 8 */
/* erasers --> 6 */
/* pencils --> 12 */
/* pens --> 10 */
/* 12 */
/* 24 */
/* Let NUMVAL be equal to the dimension of the symbols in the table. */
/* The following code returns the values of NUMVAL indicated in the */
/* table. */
/* NUMVAL = SYDIMI ( 'books', TABSYM, TABPTR, TABVAL ) */
/* NUMVAL = SYDIMI ( 'pencils', TABSYM, TABPTR, TABVAL ) */
/* NUMVAL = SYDIMI ( 'pens', TABSYM, TABPTR, TABVAL ) */
/* NUMVAL = SYDIMI ( 'erasers', TABSYM, TABPTR, TABVAL ) */
/* NUMVAL = SYDIMI ( 'tablets', TABSYM, TABPTR, TABVAL ) */
/* ----SYMBOL----------NUMVAL------ */
/* | books | 2 | */
/* | pencils | 1 | */
/* | pens | 3 | */
/* | erasers | 1 | */
/* | tablets | 0 | */
/* -------------------------------- */
/* Note that the dimension of "tablets" is zero. This is due to the */
/* fact that "tablets" is not in the symbol table. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */
/* If the value of the function RETURN is TRUE upon execution of */
/* this module, this function is assigned a default value of */
/* either 0, 0.0D0, .FALSE., or blank depending on the type of */
/* the function. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* fetch the dimension of a symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling */
if (return_()) {
ret_val = 0;
return ret_val;
} else {
chkin_("SYDIMI", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If it's not in the table, return zero. Otherwise, look up */
/* the dimension directly. */
if (locsym == 0) {
ret_val = 0;
} else {
ret_val = tabptr[locsym + 5];
}
chkout_("SYDIMI", (ftnlen)6);
return ret_val;
} /* sydimi_ */
/* $Procedure SYTRNI (Transpose two values associated with a symbol) */
/* Subroutine */ int sytrni_(char *name__, integer *i__, integer *j, char *
tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen
tabsym_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sumai_(integer *, integer *);
extern /* Subroutine */ int swapi_(integer *, integer *);
extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
integer locval;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Transpose two values associated with a particular symbol in an */
/* integer symbol table. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose associated values are to */
/* be transposed. */
/* I I Index of the first associated value to be */
/* transposed. */
/* J I Index of the second associated value to be */
/* transposed. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I/O Components of the symbol table. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose associated values are */
/* to be transposed. If NAME is not in the symbol table, */
/* the symbol tables are not modified. */
/* I is the index of the first associated value to be */
/* transposed. */
/* J is the index of the second associated value to be */
/* transposed. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are components of the integer symbol table. */
/* $ Detailed_Output */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are components of the integer symbol table. */
/* If the symbol NAME is not in the symbol table */
/* the symbol tables are not modified. Otherwise, */
/* the values that I and J refer to are transposed */
/* in the value table. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If I < 1, J < 1, I > the dimension of NAME, or J > the */
/* dimension of NAME, the error SPICE(INVALIDINDEX) is signaled. */
/* 2) If NAME is not in the symbol table, the symbol tables are not */
/* modified. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* The contents of the symbol table are: */
/* books --> 5 */
/* erasers --> 6 */
/* pencils --> 12 */
/* 18 */
/* 24 */
/* pens --> 10 */
/* 20 */
/* 30 */
/* 40 */
/* The call, */
/* CALL SYTRNI ( 'pens', 2, 3, TABSYM, TABPTR, TABVAL ) */
/* modifies the contents of the symbol table to be: */
/* books --> 5 */
/* erasers --> 6 */
/* pencils --> 12 */
/* 18 */
/* 24 */
/* pens --> 10 */
/* 30 */
/* 20 */
/* 40 */
/* The next call, */
/* CALL SYTRNI ( 'pencils', 2, 4, TABSYM, TABPTR, TABVAL ) */
/* causes the error SPICE(INVALIDINDEX) to be signaled. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */
/* Updated so no "exchange" occurs if I equals J. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* transpose two values associated with a symbol */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */
/* Updated so no "exchange" occurs if I equals J. */
/* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */
/* If one of the indices of the values to be transposed is */
/* invalid, an error is signaled and the symbol table is */
/* not modified. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYTRNI", (ftnlen)6);
}
/* How many symbols? */
nsym = cardc_(tabsym, tabsym_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
if (locsym > 0) {
/* Are there enough values associated with the symbol? */
n = tabptr[locsym + 5];
/* Are the indices valid? */
if (*i__ >= 1 && *i__ <= n && *j >= 1 && *j <= n) {
/* Exchange the values in place. */
if (*i__ != *j) {
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + 1;
swapi_(&tabval[locval + *i__ + 4], &tabval[locval + *j + 4]);
}
} else {
setmsg_("The first index was *. The second index was *.", (ftnlen)
46);
errint_("*", i__, (ftnlen)1);
errint_("*", j, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
}
}
chkout_("SYTRNI", (ftnlen)6);
return 0;
} /* sytrni_ */
/* $Procedure ZZGAPOOL ( Private: get agent set for watched variable ) */
/* Subroutine */ int zzgapool_(char *varnam, char *wtvars, integer *wtptrs,
integer *wtpool, char *wtagnt, char *agtset, ftnlen varnam_len,
ftnlen wtvars_len, ftnlen wtagnt_len, ftnlen agtset_len)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer node;
extern integer cardc_(char *, ftnlen);
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sizec_(char *, ftnlen);
extern /* Subroutine */ int scardc_(integer *, char *, ftnlen), validc_(
integer *, integer *, char *, ftnlen);
extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
integer nfetch;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern integer lnknxt_(integer *, integer *);
extern logical return_(void);
integer loc;
/* $ 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. */
/* Return a SPICE set containing the names of agents watching */
/* a specified kernel variable. */
/* $ 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 */
/* KERNEL */
/* $ Keywords */
/* KERNEL */
/* PRIVATE */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* VARNAM I Kernel variable name. */
/* WTVARS I Watched kernel variable set. */
/* WTPTRS I Pointers from variables into the watch pool. */
/* WTPOOL I Watch pool used for managing agent names. */
/* WTAGNT I Array of agent names. */
/* AGTSET O Set of agents for VARNAM. */
/* $ Detailed_Input */
/* VARNAM is the name of a kernel variable. */
/* WTVARS is a SPICE set containing the contents of the kernel */
/* pool watcher system's set WTVARS. */
/* WTPTRS is an array containing the contents of the kernel */
/* pool watcher system's array WTPTRS. */
/* WTPOOL is a SPICE doubly linked list pool containing the */
/* contents of the kernel pool watcher system's pool */
/* WTPOOL. */
/* WTAGNT is an array containing the contents of the kernel */
/* pool watcher system's array WTAGNT. */
/* $ Detailed_Output */
/* AGTSET is a SPICE set containing the names of the agents */
/* associated with the kernel variable designated by */
/* VARNAM. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the output set AGTSET is too small to hold the set of */
/* agents watching VARNAM, the error will be diagnosed by routines */
/* in the call tree of this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine is not part of the SPICELIB API. This routine */
/* may be removed in a later version of the SPICE Toolkit, or */
/* its interface may change. */
/* SPICE-based application code should not call this routine. */
/* $ Examples */
/* See POOL entry point SWPOOL. */
/* $ Restrictions */
/* 1) This is a private routine. See $Particulars above. */
/* 2) Contents of the input arrays are assumed to be valid. */
/* The output returned by this routine is meaningless */
/* otherwise. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* get agent set for watched kernel variable */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local variables */
if (return_()) {
return 0;
}
chkin_("ZZGAPOOL", (ftnlen)8);
/* The output agent set is empty until we find any */
/* agents. */
scardc_(&c__0, agtset, agtset_len);
/* Find the location of VARNAM in the set of watched */
/* variables. */
i__1 = cardc_(wtvars, wtvars_len);
loc = bsrchc_(varnam, &i__1, wtvars + wtvars_len * 6, varnam_len,
wtvars_len);
if (loc == 0) {
/* This variable is not watched. The agent set is */
/* empty. */
chkout_("ZZGAPOOL", (ftnlen)8);
return 0;
}
/* Set NODE to the head node of the agent list for VARNAM. */
/* Traverse the agent list for VARNAM. Collect the agents */
/* as an unordered list, then turn the list into a set. */
node = wtptrs[loc - 1];
nfetch = 0;
while(node > 0) {
++nfetch;
s_copy(agtset + (nfetch + 5) * agtset_len, wtagnt + (node - 1) *
wtagnt_len, agtset_len, wtagnt_len);
node = lnknxt_(&node, wtpool);
}
i__1 = sizec_(agtset, agtset_len);
validc_(&i__1, &nfetch, agtset, agtset_len);
chkout_("ZZGAPOOL", (ftnlen)8);
return 0;
} /* zzgapool_ */
/* $Procedure SYNTHI ( Return the Nth component of a symbol ) */
/* Subroutine */ int synthi_(char *name__, integer *nth, char *tabsym,
integer *tabptr, integer *tabval, integer *value, logical *found,
ftnlen name_len, ftnlen tabsym_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *,
char *, ftnlen, ftnlen);
integer locval;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Return the Nth component of a particular symbol in an integer */
/* symbol table. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose Nth component is to be */
/* returned. */
/* NTH I Index of the value to be returned. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I Components of the symbol table. */
/* VALUE O Nth value associated with the symbol. */
/* FOUND O True if the Nth value of the symbol exists, false */
/* if it does not. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose Nth component is to be */
/* returned. If NAME is not in the symbol table, FOUND is */
/* false. */
/* NTH is the index of the component to be returned. If the */
/* value of NTH is out of range ( NTH < 1 or NTH is */
/* greater than the dimension of the symbol ) FOUND is */
/* false. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of an integer symbol table. */
/* The symbol table is not modified by this subroutine. */
/* $ Detailed_Output */
/* VALUES is the NTH component of the symbol NAME. */
/* FOUND is true if NAME is in the symbol table and the NTH */
/* component of NAME exists. Otherwise FOUND is false. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* Two conditions will cause the value of FOUND to be false: */
/* 1) The symbol NAME is not in the symbol table. */
/* 2) NTH is out of range ( NTH < 1 or NTH is greater than the */
/* dimension of the symbol ). */
/* $ Examples */
/* The contents of the symbol table are: */
/* books --> 5 */
/* erasers --> 6 */
/* pencils --> 12 */
/* 24 */
/* pens --> 10 */
/* 12 */
/* 24 */
/* The calls, */
/* CALL SYNTHI ( 'pens', 2, TABSYM, TABPTR, TABVAL, VALUE, */
/* . FOUND ) */
/* CALL SYNTHI ( 'pencils', 3, TABSYM, TABPTR, TABVAL, VALUE, */
/* . FOUND ) */
/* CALL SYNTHI ( 'chairs', 1, TABPTR, TABVAL, TABVAL, VALUE, */
/* . FOUND ) */
/* return the values of VALUE and FOUND corresponding to NAME and */
/* NTH: */
/* NAME NTH VALUE FOUND */
/* ---------- ----- ------- ------- */
/* pens 2 12 TRUE */
/* pencils FALSE */
/* chairs FALSE */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* fetch nth value associated with a symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYNTHI", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If it's not in the table, it's definitely a problem. */
if (locsym == 0) {
*found = FALSE_;
/* If the value of NTH is out of range, that's a problem too. */
} else if (*nth < 1 || *nth > tabptr[locsym + 5]) {
*found = FALSE_;
/* Otherwise, we can proceed without fear of error. Merely locate */
/* and return the appropriate component from the values table. */
} else {
*found = TRUE_;
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + *nth;
*value = tabval[locval + 5];
}
chkout_("SYNTHI", (ftnlen)6);
return 0;
} /* synthi_ */
/* $Procedure SYORDD ( Order the components of a single symbol ) */
/* Subroutine */ int syordd_(char *name__, char *tabsym, integer *tabptr,
doublereal *tabval, ftnlen name_len, ftnlen tabsym_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *,
char *, ftnlen, ftnlen);
extern /* Subroutine */ int shelld_(integer *, doublereal *);
integer locval;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Order the components of a single symbol in a double precision */
/* symbol table. The components are sorted in increasing order. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose components are to be */
/* ordered. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I/O Components of the symbol table. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose components are to be */
/* ordered. If NAME is not in the symbol table, the symbol */
/* table is not modified. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a double precision symbol table. */
/* $ Detailed_Output */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are the components of a double precision symbol table. */
/* The components of the symbol are sorted in increasing */
/* order. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Particulars */
/* If the symbol NAME is not in the symbol table, the symbol table */
/* is not modified. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BODY4_POLE_RA --> 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0 */
/* DELTA_T_A --> 3.2184D1 */
/* K --> 1.657D-3 */
/* MEAN_ANOM --> 6.239996D0 */
/* 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* The call, */
/* CALL SYORDD ( 'BODY4_POLE_RA', TABSYM, TABPTR, TABVAL ) */
/* modifies the contents of the symbol table to be: */
/* BODY4_POLE_RA --> 0.0D0 */
/* 1.08D-1 */
/* 3.17681D2 */
/* DELTA_T_A --> 3.2184D1 */
/* K --> 1.657D-3 */
/* MEAN_ANOM --> 6.239996D0 */
/* 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* Note that the call, */
/* CALL SYORDD ( 'BODY4_PRIME', TABSYM, TABPTR, TABVAL ) */
/* will not modify the symbol table because the symbol "BODY4_PRIME" */
/* is not in the symbol table. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* order the components of a single symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYORDD", (ftnlen)6);
}
/* How many symbols? */
nsym = cardc_(tabsym, tabsym_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If so, sort the components in place. */
if (locsym > 0) {
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + 1;
n = tabptr[locsym + 5];
shelld_(&tabptr[locsym + 5], &tabval[locval + 5]);
}
chkout_("SYORDD", (ftnlen)6);
return 0;
} /* syordd_ */
/* $Procedure SYSELD ( Select a subset of the values of a symbol ) */
/* Subroutine */ int syseld_(char *name__, integer *begin, integer *end, char
*tabsym, integer *tabptr, doublereal *tabval, doublereal *values,
logical *found, ftnlen name_len, ftnlen tabsym_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *,
char *, ftnlen, ftnlen);
integer locval;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Select a subset of the values associated with a particular */
/* symbol in a double precision symbol table. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose associated values are to */
/* be returned. */
/* BEGIN I Index of the first associated value to be returned. */
/* END I Index of the last associated value to be returned. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I Components of the symbol table. */
/* VALUES O Subset of the values associated with the symbol */
/* NAME. */
/* FOUND O True if the subset of values exists. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose subset of associated */
/* values to be returned. If NAME is not in the symbol */
/* table, FOUND is false. */
/* BEGIN is the index of the first associated value to be */
/* returned. If BEGIN is out of range (BEGIN < 1 or */
/* BEGIN > END) FOUND is false. */
/* END is the index of the last associated value to be */
/* returned. If END is out of range (END < 1 or */
/* END > is greater than the dimension of NAME) */
/* FOUND is false. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are components of the double precision symbol table. */
/* $ Detailed_Output */
/* VALUES is a subset of the values associated with the */
/* symbol NAME. If the subset specified by BEGIN and */
/* END exists, as many values as will fit in VALUES */
/* are returned. If the subset does not exist, no */
/* values are returned and FOUND is false. */
/* FOUND is true if the subset of values is exists. */
/* FOUND is false if BEGIN < 1, BEGIN > END, END < 1, */
/* END > the dimension of NAME, or NAME is not */
/* in the symbol table. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This subroutine does not check to see if the output array */
/* VALUES is large enough to hold the selected set of values. */
/* The caller must provide the required space. */
/* $ Files */
/* None. */
/* $ Particulars */
/* FOUND will be false if the bounds of the subset specified by */
/* BEGIN and END are out of range. Values of BEGIN and END which */
/* specify bounds out of range are BEGIN < 1, BEGIN > END, */
/* END < 1, or END > the dimension of NAME. FOUND is also false */
/* if the symbol NAME is not in the symbol table. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BODY4_POLE_RA --> 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0 */
/* DELTA_T_A --> 3.2184D1 */
/* K --> 1.657D-3 */
/* MEAN_ANOM --> 6.239996D0 */
/* 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* Let the dimension of the array VALUES be 3. */
/* The ouput values of VALUES and FOUND for the input values of */
/* NAME, BEGIN, and END are contained in this table: */
/* NAME BEGIN END VALUES FOUND */
/* ------------- ----- --- --------------------- ------- */
/* MEAN_ANOM 1 2 6.239996D0 TRUE */
/* 1.99096871D-7 */
/* BODY4_POLE_RA 1 3 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0 */
/* BODY4_PRIME 1 3 FALSE */
/* MEAN_ANOM 2 1 FALSE */
/* ORBIT_ECC 1 -2 FALSE */
/* K 1 5 FALSE */
/* ---------------------------------------------------------------- */
/* Note that FOUND is FALSE for examples 3 through 6 because: */
/* - In the 3rd example, the symbol 'BODY4_PRIME' is not in the */
/* symbol table. */
/* - In the 4th example, BEGIN > END. */
/* - In the 5th example, END < 0. */
/* - In the 6th example, END is greater than the dimension of the */
/* symbol 'K'. */
/* $ Restrictions */
/* 1) See Exceptions section. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */
/* Various header corrections were made. In particular, */
/* the header no longer asserts that this routine will */
/* "return as many values as will fit" in the output array */
/* VALUES. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* select a subset of the values of a symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYSELD", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If it's not in the table, it's definitely a problem. */
if (locsym == 0) {
*found = FALSE_;
} else {
/* We could still have a problem: do these components exist? */
/* Does this request even make sense? */
n = tabptr[locsym + 5];
if (*begin >= 1 && *begin <= n && *end >= 1 && *end <= n && *begin <=
*end) {
*found = TRUE_;
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + 1;
i__1 = *end - *begin + 1;
moved_(&tabval[locval + *begin + 4], &i__1, values);
} else {
*found = FALSE_;
}
}
chkout_("SYSELD", (ftnlen)6);
return 0;
} /* syseld_ */
/* $Procedure REMOVC ( Remove an item from a character set ) */
/* Subroutine */ int removc_(char *item, char *a, ftnlen item_len, ftnlen
a_len)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer card, i__;
extern integer cardc_(char *, ftnlen);
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical in;
extern /* Subroutine */ int scardc_(integer *, char *, ftnlen);
extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
integer loc;
/* $ Abstract */
/* Remove an item from a character set. */
/* $ 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 */
/* SETS */
/* $ Keywords */
/* CELLS, SETS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ITEM I Item to be removed. */
/* A I/O Removal set. */
/* ERROR O Error flag. */
/* $ Detailed_Input */
/* ITEM is an item which is to be removed from the */
/* specified set. ITEM may or may not already */
/* be an element of the set. */
/* A is a set. */
/* On input, A may or may not contain the input item */
/* as an element. */
/* $ Detailed_Output */
/* A on output contains the difference of the input set */
/* and the input item. If the item is not an element of */
/* the set, the set is not changed. */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* In the following example, the element 'PLUTO' is removed from */
/* the character set PLANETS and inserted into the character set */
/* ASTEROIDS. */
/* CALL REMOVC ( 'PLUTO', PLANETS ) */
/* CALL INSRTC ( 'PLUTO', ASTEROIDS, ERROR ) */
/* If 'PLUTO' is not an element of PLANETS, then the contents of */
/* PLANETS are not changed. Similarly, if 'PLUTO' is already an */
/* element of ASTEROIDS, the contents of ASTEROIDS remain unchanged. */
/* Because inserting an element into a set can increase the */
/* cardinality of the set, the insertion routines return an */
/* error flag. The flag is blank if the set is large enough to */
/* hold the new element. Otherwise, a message (constructed by */
/* the cell routine EXCESS) is returned. */
/* $ Restrictions */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* C.A. Curzon (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* remove an item from a character set */
/* -& */
/* $ Revisions */
/* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */
/* Now participates in error handling. References to RETURN, */
/* CHKIN, and CHKOUT added. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard error handling: */
if (return_()) {
return 0;
} else {
chkin_("REMOVC", (ftnlen)6);
}
/* What is the cardinality of the set? */
card = cardc_(a, a_len);
/* Determine the location (if any) of the item within the set. */
loc = bsrchc_(item, &card, a + a_len * 6, item_len, a_len);
/* Is the item in the set? If so, it needs to be removed. */
in = loc > 0;
if (in) {
/* Move succeeding elements forward to take up the slack left */
/* by the departing element. And update the cardinality for */
/* future reference. */
i__1 = card - 1;
for (i__ = loc; i__ <= i__1; ++i__) {
s_copy(a + (i__ + 5) * a_len, a + (i__ + 6) * a_len, a_len, a_len)
;
}
i__1 = card - 1;
scardc_(&i__1, a, a_len);
}
chkout_("REMOVC", (ftnlen)6);
return 0;
} /* removc_ */
