/* $Procedure TKFRAM (Text kernel frame transformation ) */
/* Subroutine */ int tkfram_(integer *id, doublereal *rot, integer *frame,
logical *found)
{
/* Initialized data */
static integer at = 0;
static logical first = TRUE_;
/* System generated locals */
address a__1[2];
integer i__1, i__2[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);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char name__[32];
static integer tail;
static char spec[32], item[32*14];
static integer idnt[1], axes[3];
static logical full;
static integer pool[52] /* was [2][26] */;
extern doublereal vdot_(doublereal *, doublereal *);
static char type__[1];
static doublereal qtmp[4];
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
static integer i__, n, r__;
static doublereal buffd[180] /* was [9][20] */;
static integer buffi[20] /* was [1][20] */, oldid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static char agent[32];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
ident_(doublereal *), errch_(char *, char *, ftnlen, ftnlen);
static doublereal tempd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, vhatg_(doublereal *, integer *, doublereal *);
extern integer lnktl_(integer *, integer *);
static char idstr[32];
extern integer rtrim_(char *, ftnlen);
static char versn[8], units[32];
static integer ar;
extern logical failed_(void), badkpv_(char *, char *, char *, integer *,
integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
static char frname[32];
static doublereal angles[3];
static char oldagt[32];
static logical buffrd;
extern /* Subroutine */ int locati_(integer *, integer *, integer *,
integer *, integer *, logical *), frmnam_(integer *, char *,
ftnlen), namfrm_(char *, integer *, ftnlen);
static logical update;
static char altnat[32];
extern /* Subroutine */ int lnkini_(integer *, integer *);
extern integer lnknfn_(integer *);
static integer idents[20] /* was [1][20] */;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen), gdpool_(char *, integer *,
integer *, integer *, doublereal *, logical *, ftnlen), sigerr_(
char *, ftnlen), gipool_(char *, integer *, integer *, integer *,
integer *, logical *, ftnlen), chkout_(char *, ftnlen), sharpr_(
doublereal *), dtpool_(char *, logical *, integer *, char *,
ftnlen, ftnlen), setmsg_(char *, ftnlen);
static doublereal matrix[9] /* was [3][3] */;
extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), dwpool_(
char *, ftnlen), errint_(char *, integer *, ftnlen), vsclip_(
doublereal *, doublereal *);
static doublereal quatrn[4];
extern /* Subroutine */ int convrt_(doublereal *, char *, char *,
doublereal *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int q2m_(doublereal *, doublereal *), intstr_(
integer *, char *, ftnlen), swpool_(char *, integer *, char *,
ftnlen, ftnlen);
static logical fnd;
static char alt[32*14];
/* $ Abstract */
/* This routine returns the rotation from the input frame */
/* specified by ID to the associated frame given by FRAME. */
/* $ 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 */
/* FRAMES */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ---------------------------------------------- */
/* ID I Class identification code for the instrument */
/* ROT O The rotation from ID to FRAME. */
/* FRAME O The integer code of some reference frame. */
/* FOUND O TRUE if the rotation could be determined. */
/* $ Detailed_Input */
/* ID The identification code used to specify an */
/* instrument in the SPICE system. */
/* $ Detailed_Output */
/* ROT is a rotation matrix that gives the transformation */
/* from the frame specified by ID to the frame */
/* specified by FRAME. */
/* FRAME is the id code of the frame used to define the */
/* orientation of the frame given by ID. ROT gives */
/* the transformation from the IF frame to */
/* the frame specified by FRAME. */
/* FOUND is a logical indicating whether or not a frame */
/* definition for frame ID was constructed from */
/* kernel pool data. If ROT and FRAME were constructed */
/* FOUND will be returned with the value TRUE. */
/* Otherwise it will be returned with the value FALSE. */
/* $ Parameters */
/* BUFSIZ is the number of rotation, frame id pairs that */
/* can have their instance data buffered for the */
/* sake of improving run-time performance. This */
/* value MUST be positive and should probably be */
/* at least 10. */
/* $ Exceptions */
/* 1) If some instance value associated with this frame */
/* cannot be located, or does not have the proper type */
/* or dimension, the error will be diagnosed by the */
/* routine BADKPV. In such a case FOUND will be set to .FALSE. */
/* 2) If the input ID has the value 0, the error */
/* SPICE(ZEROFRAMEID) will be signaled. FOUND will be set */
/* to FALSE. */
/* 3) If the name of the frame corresponding to ID cannot be */
/* determined, the error 'SPICE(INCOMPLETEFRAME)' is signaled. */
/* 4) If the frame given by ID is defined relative to a frame */
/* that is unrecognized, the error SPICE(BADFRAMESPEC) */
/* will be signaled. FOUND will be set to FALSE. */
/* 5) If the kernel pool specification for ID is not one of */
/* MATRIX, ANGLES, or QUATERNION, then the error */
/* SPICE(UNKNOWNFRAMESPEC) will be signaled. FOUND will be */
/* set to FALSE. */
/* $ Files */
/* This routine makes use of the loaded text kernels to */
/* determine the rotation from a constant offset frame */
/* to its defining frame. */
/* $ Particulars */
/* This routine is used to construct the rotation from some frame */
/* that is a constant rotation offset from some other reference */
/* frame. This rotation is derived from data stored in the kernel */
/* pool. */
/* It is considered to be an low level routine that */
/* will need to be called directly only by persons performing */
/* high volume processing. */
/* $ Examples */
/* This is intended to be used as a low level routine by */
/* the frame system software. However, you could use this */
/* routine to directly retrieve the rotation from an offset */
/* frame to its relative frame. One instance in which you */
/* might do this is if you have a properly specified topocentric */
/* frame for some site on earth and you wish to determine */
/* the geodetic latitude and longitude of the site. Here's how. */
/* Suppose the name of the topocentric frame is: 'MYTOPO'. */
/* First we get the id-code of the topocentric frame. */
/* CALL NAMFRM ( 'MYTOPO', FRCODE ) */
/* Next get the rotation from the topocentric frame to */
/* the bodyfixed frame. */
/* CALL TKFRAM ( FRCODE, ROT, FRAME, FOUND ) */
/* Make sure the topoframe is relative to one of the earth */
/* fixed frames. */
/* CALL FRMNAM( FRAME, TEST ) */
/* IF ( TEST .NE. 'IAU_EARTH' */
/* . .AND. TEST .NE. 'EARTH_FIXED' */
/* . .AND. TEST .NE. 'ITRF93' ) THEN */
/* WRITE (*,*) 'The frame MYTOPO does not appear to be ' */
/* WRITE (*,*) 'defined relative to an earth fixed frame.' */
/* STOP */
/* END IF */
/* Things look ok. Get the location of the Z-axis in the */
/* topocentric frame. */
/* Z(1) = ROT(1,3) */
/* Z(2) = ROT(2,3) */
/* Z(3) = ROT(3,3) */
/* Convert the Z vector to latitude longitude and radius. */
/* CALL RECLAT ( Z, LAT, LONG, RAD ) */
/* WRITE (*,*) 'The geodetic coordinates of the center of' */
/* WRITE (*,*) 'the topographic frame are: ' */
/* WRITE (*,*) */
/* WRITE (*,*) 'Latitude (deg): ', LAT *DPR() */
/* WRITE (*,*) 'Longitude (deg): ', LONG*DPR() */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 23-APR-2009 (NJB) */
/* Bug fix: watch is deleted only for frames */
/* that are deleted from the buffer. */
/* - SPICELIB Version 2.0.0, 19-MAR-2009 (NJB) */
/* Bug fix: this routine now deletes watches set on */
/* kernel variables of frames that are discarded from */
/* the local buffering system. */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* - SPICELIB Version 1.1.0, 21-NOV-2001 (FST) */
/* Updated this routine to dump the buffer of frame ID codes */
/* it saves when it or one of the modules in its call tree signals */
/* an error. This fixes a bug where a frame's ID code is */
/* buffered, but the matrix and kernel pool watcher were not set */
/* properly. */
/* - SPICELIB Version 1.0.0, 18-NOV-1996 (WLT) */
/* -& */
/* $ Index_Entries */
/* Fetch the rotation and frame of a text kernel frame */
/* Fetch the rotation and frame of a constant offset frame */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Local Variables */
/* Saved variables */
/* Initial values */
/* Programmer's note: this routine makes use of the *implementation* */
/* of LOCATI. If that routine is changed, the logic this routine */
/* uses to locate buffered, old frame IDs may need to change as well. */
/* Before we even check in, if N is less than 1 we can */
/* just return. */
/* Perform any initializations that might be needed for this */
/* routine. */
if (first) {
first = FALSE_;
s_copy(versn, "1.0.0", (ftnlen)8, (ftnlen)5);
lnkini_(&c__20, pool);
}
/* Now do the standard SPICE error handling. Sure this is */
/* a bit unconventional, but nothing will be hurt by doing */
/* the stuff above first. */
if (return_()) {
return 0;
}
chkin_("TKFRAM", (ftnlen)6);
/* So far, we've not FOUND the rotation to the specified frame. */
*found = FALSE_;
/* Check the ID to make sure it is non-zero. */
if (*id == 0) {
lnkini_(&c__20, pool);
setmsg_("Frame identification codes are required to be non-zero. Yo"
"u've specified a frame with ID value zero. ", (ftnlen)102);
sigerr_("SPICE(ZEROFRAMEID)", (ftnlen)18);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Find out whether our linked list pool is already full. */
/* We'll use this information later to decide whether we're */
/* going to have to delete a watcher. */
full = lnknfn_(pool) == 0;
if (full) {
/* If the input frame ID is not buffered, we'll need to */
/* overwrite an existing buffer entry. In this case */
/* the call to LOCATI we're about to make will overwrite */
/* the ID code in the slot we're about to use. We need */
/* this ID code, so extract it now while we have the */
/* opportunity. The old ID sits at the tail of the list */
/* whose head node is AT. */
tail = lnktl_(&at, pool);
oldid = idents[(i__1 = tail - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"idents", i__1, "tkfram_", (ftnlen)413)];
/* Create the name of the agent associated with the old */
/* frame. */
s_copy(oldagt, "TKFRAME_#", (ftnlen)32, (ftnlen)9);
repmi_(oldagt, "#", &oldid, oldagt, (ftnlen)32, (ftnlen)1, (ftnlen)32)
;
}
/* Look up the address of the instance data. */
idnt[0] = *id;
locati_(idnt, &c__1, idents, pool, &at, &buffrd);
if (full && ! buffrd) {
/* Since the buffer is already full, we'll delete the watcher for */
/* the kernel variables associated with OLDID, since there's no */
/* longer a need for that watcher. */
/* First clear the update status of the old agent; DWPOOL won't */
/* delete an agent with a unchecked update. */
cvpool_(oldagt, &update, (ftnlen)32);
dwpool_(oldagt, (ftnlen)32);
}
/* Until we have better information we put the identity matrix */
/* into the output rotation and set FRAME to zero. */
ident_(rot);
*frame = 0;
/* If we have to look up the data for our frame, we do */
/* it now and perform any conversions and computations that */
/* will be needed when it's time to convert coordinates to */
/* directions. */
/* Construct the name of the agent associated with the */
/* requested frame. (Each frame has its own agent). */
intstr_(id, idstr, (ftnlen)32);
frmnam_(id, frname, (ftnlen)32);
if (s_cmp(frname, " ", (ftnlen)32, (ftnlen)1) == 0) {
lnkini_(&c__20, pool);
setmsg_("The Text Kernel (TK) frame with id-code # does not have a r"
"ecognized name. ", (ftnlen)75);
errint_("#", id, (ftnlen)1);
sigerr_("SPICE(INCOMPLETFRAME)", (ftnlen)21);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = idstr;
s_cat(agent, a__1, i__2, &c__2, (ftnlen)32);
r__ = rtrim_(agent, (ftnlen)32);
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = frname;
s_cat(altnat, a__1, i__2, &c__2, (ftnlen)32);
ar = rtrim_(altnat, (ftnlen)32);
/* If the frame is buffered, we check the kernel pool to */
/* see if there has been an update to this frame. */
if (buffrd) {
cvpool_(agent, &update, r__);
} else {
/* If the frame is not buffered we definitely need to update */
/* things. */
update = TRUE_;
}
if (! update) {
/* Just look up the rotation matrix and relative-to */
/* information from the local buffer. */
rot[0] = buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)506)];
rot[1] = buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)507)];
rot[2] = buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)508)];
rot[3] = buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)509)];
rot[4] = buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)510)];
rot[5] = buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)511)];
rot[6] = buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)512)];
rot[7] = buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)513)];
rot[8] = buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)514)];
*frame = buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"buffi", i__1, "tkfram_", (ftnlen)516)];
} else {
/* Determine how the frame is specified and what it */
/* is relative to. The variables that specify */
/* how the frame is represented and what it is relative to */
/* are TKFRAME_#_SPEC and TKFRAME_#_RELATIVE where # is */
/* replaced by the text value of ID or the frame name. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(alt, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(alt + 32, a__1, i__2, &c__2, (ftnlen)32);
/* See if the friendlier version of the kernel pool variables */
/* are available. */
for (i__ = 1; i__ <= 2; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)537)) << 5), found,
&n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("item", i__1, "tkfram_", (ftnlen)540)) << 5),
alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ? i__3 :
s_rnge("alt", i__3, "tkfram_", (ftnlen)540)) << 5), (
ftnlen)32, (ftnlen)32);
}
}
/* If either the SPEC or RELATIVE frame are missing from */
/* the kernel pool, we simply return. */
if (badkpv_("TKFRAM", item, "=", &c__1, &c__1, "C", (ftnlen)6, (
ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM", item +
32, "=", &c__1, &c__1, "C", (ftnlen)6, (ftnlen)32, (ftnlen)1,
(ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* If we make it this far, look up the SPEC and RELATIVE frame. */
gcpool_(item, &c__1, &c__1, &n, spec, &fnd, (ftnlen)32, (ftnlen)32);
gcpool_(item + 32, &c__1, &c__1, &n, name__, &fnd, (ftnlen)32, (
ftnlen)32);
/* Look up the id-code for this frame. */
namfrm_(name__, frame, (ftnlen)32);
if (*frame == 0) {
lnkini_(&c__20, pool);
setmsg_("The frame to which frame # is relatively defined is not"
" recognized. The kernel pool specification of the relati"
"ve frame is '#'. This is not a recognized frame. ", (
ftnlen)161);
errint_("#", id, (ftnlen)1);
errch_("#", name__, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BADFRAMESPEC)", (ftnlen)19);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Convert SPEC to upper case so that we can easily check */
/* to see if this is one of the expected specification types. */
ucase_(spec, spec, (ftnlen)32, (ftnlen)32);
if (s_cmp(spec, "MATRIX", (ftnlen)32, (ftnlen)6) == 0) {
/* This is the easiest case. Just grab the matrix */
/* from the kernel pool (and polish it up a bit just */
/* to make sure we have a rotation matrix). */
/* We give preference to the kernel pool variable */
/* TKFRAME_<name>_MATRIX if it is available. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__9, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* The variable meets current expectations, look it up */
/* from the kernel pool. */
gdpool_(item + 64, &c__1, &c__9, &n, matrix, &fnd, (ftnlen)32);
/* In this case the full transformation matrix has been */
/* specified. We simply polish it up a bit. */
moved_(matrix, &c__9, rot);
sharpr_(rot);
/* The matrix might not be right-handed, so correct */
/* the sense of the second and third columns if necessary. */
if (vdot_(&rot[3], &matrix[3]) < 0.) {
vsclip_(&c_b95, &rot[3]);
}
if (vdot_(&rot[6], &matrix[6]) < 0.) {
vsclip_(&c_b95, &rot[6]);
}
} else if (s_cmp(spec, "ANGLES", (ftnlen)32, (ftnlen)6) == 0) {
/* Look up the angles, their units and axes for the */
/* frame specified by ID. (Note that UNITS are optional). */
/* As in the previous case we give preference to the */
/* form TKFRAME_<name>_<item> over TKFRAME_<id>_<item>. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(alt + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(alt + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Again, we give preference to the more friendly form */
/* of TKFRAME specification. */
for (i__ = 3; i__ <= 5; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)668)) << 5),
found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1
: s_rnge("item", i__1, "tkfram_", (ftnlen)671)) <<
5), alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ?
i__3 : s_rnge("alt", i__3, "tkfram_", (ftnlen)671)
) << 5), (ftnlen)32, (ftnlen)32);
}
}
if (badkpv_("TKFRAM", item + 64, "=", &c__3, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM",
item + 96, "=", &c__3, &c__1, "N", (ftnlen)6, (ftnlen)32,
(ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
s_copy(units, "RADIANS", (ftnlen)32, (ftnlen)7);
gdpool_(item + 64, &c__1, &c__3, &n, angles, &fnd, (ftnlen)32);
gipool_(item + 96, &c__1, &c__3, &n, axes, &fnd, (ftnlen)32);
gcpool_(item + 128, &c__1, &c__1, &n, units, &fnd, (ftnlen)32, (
ftnlen)32);
/* Convert angles to radians. */
for (i__ = 1; i__ <= 3; ++i__) {
convrt_(&angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("angles", i__1, "tkfram_", (ftnlen)700)],
units, "RADIANS", &tempd, (ftnlen)32, (ftnlen)7);
angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"angles", i__1, "tkfram_", (ftnlen)701)] = tempd;
}
if (failed_()) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Compute the rotation from instrument frame to CK frame. */
eul2m_(angles, &angles[1], &angles[2], axes, &axes[1], &axes[2],
rot);
} else if (s_cmp(spec, "QUATERNION", (ftnlen)32, (ftnlen)10) == 0) {
/* Look up the quaternion and convert it to a rotation */
/* matrix. Again there are two possible variables that */
/* may point to the quaternion. We give preference to */
/* the form TKFRAME_<name>_Q over the form TKFRAME_<id>_Q. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__4, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* In this case we have the quaternion representation. */
/* Again, we do a small amount of polishing of the input. */
gdpool_(item + 64, &c__1, &c__4, &n, quatrn, &fnd, (ftnlen)32);
vhatg_(quatrn, &c__4, qtmp);
q2m_(qtmp, rot);
} else {
/* We don't recognize the SPEC for this frame. Say */
/* so. Also note that perhaps the user needs to upgrade */
/* the toolkit. */
lnkini_(&c__20, pool);
setmsg_("The frame specification \"# = '#'\" is not one of the r"
"econized means of specifying a text-kernel constant offs"
"et frame (as of version # of the routine TKFRAM). This m"
"ay reflect a typographical error or may indicate that yo"
"u need to consider updating your version of the SPICE to"
"olkit. ", (ftnlen)284);
errch_("#", item, (ftnlen)1, (ftnlen)32);
errch_("#", spec, (ftnlen)1, (ftnlen)32);
errch_("#", versn, (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(UNKNOWNFRAMESPEC)", (ftnlen)23);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Buffer the identifier, relative frame and rotation matrix. */
buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)784)] = rot[0];
buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)785)] = rot[1];
buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)786)] = rot[2];
buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)787)] = rot[3];
buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)788)] = rot[4];
buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)789)] = rot[5];
buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)790)] = rot[6];
buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)791)] = rot[7];
buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)792)] = rot[8];
buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("buffi", i__1,
"tkfram_", (ftnlen)794)] = *frame;
/* If these were not previously buffered, we need to set */
/* a watch on the various items that might be used to define */
/* this frame. */
if (! buffrd) {
/* Immediately check for an update so that we will */
/* not redundantly look for this item the next time this */
/* routine is called. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 160, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 192, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 224, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 256, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 288, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 320, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 352, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 384, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 416, a__1, i__2, &c__2, (ftnlen)32);
swpool_(agent, &c__14, item, (ftnlen)32, (ftnlen)32);
cvpool_(agent, &update, (ftnlen)32);
}
}
if (failed_()) {
lnkini_(&c__20, pool);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* All errors cause the routine to exit before we get to this */
/* point. If we reach this point we didn't have an error and */
/* hence did find the rotation from ID to FRAME. */
*found = TRUE_;
/* That's it */
chkout_("TKFRAM", (ftnlen)6);
return 0;
} /* tkfram_ */
/* $Procedure BODMAT ( Return transformation matrix for a body ) */
/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm)
{
/* Initialized data */
static logical first = TRUE_;
static logical found = FALSE_;
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_dnnt(doublereal *);
double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *)
;
/* Local variables */
integer cent;
char item[32];
doublereal j2ref[9] /* was [3][3] */;
extern integer zzbodbry_(integer *);
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
doublereal d__;
integer i__, j;
doublereal dcoef[3], t, w;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
doublereal delta;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal theta;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, errdp_(char *, doublereal *, ftnlen);
doublereal costh[100];
extern doublereal vdotg_(doublereal *, doublereal *, integer *);
char dtype[1];
doublereal sinth[100], tsipm[36] /* was [6][6] */;
extern doublereal twopi_(void);
static integer j2code;
doublereal ac[100], dc[100];
integer na, nd;
doublereal ra, wc[100];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern logical bodfnd_(integer *, char *, ftnlen);
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern doublereal halfpi_(void);
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
integer nw;
doublereal conepc, conref;
extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *,
doublereal *, logical *);
integer ntheta;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char fixfrm[32], errmsg[1840];
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen), errint_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
irfrot_(integer *, integer *, doublereal *);
extern logical return_(void);
char timstr[35];
extern doublereal j2000_(void);
doublereal dec;
integer dim, ref;
doublereal phi;
extern doublereal rpd_(void), spd_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return the J2000 to body Equator and Prime Meridian coordinate */
/* transformation matrix for a specified body. */
/* $ 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 */
/* PCK */
/* NAIF_IDS */
/* TIME */
/* $ Keywords */
/* CONSTANTS */
/* $ 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 File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ 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. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - 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) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation from Inertial to PM for BODY at ET. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* transformation is requested. Bodies are numbered */
/* according to the standard NAIF numbering scheme. */
/* ET is the epoch at which the transformation is */
/* requested. (This is typically the epoch of */
/* observation minus the one-way light time from */
/* the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is the transformation matrix from Inertial to body */
/* Equator and Prime Meridian. The X axis of the PM */
/* system is directed to the intersection of the */
/* equator and prime meridian. The Z axis points north. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If data required to define the body-fixed frame associated */
/* with BODY are not found in the binary PCK system or the kernel */
/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */
/* the case of IAU style body-fixed frames, the absence of */
/* prime meridian polynomial data (which are required) is used */
/* as an indicator of missing data. */
/* 2) If the test for exception (1) passes, but in fact requested */
/* data are not available in the kernel pool, the error will be */
/* signaled by routines in the call tree of this routine. */
/* 3) If the kernel pool does not contain all of the data required */
/* to define the number of nutation precession angles */
/* corresponding to the available nutation precession */
/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */
/* signaled. */
/* 4) If the reference frame REF is not recognized, a routine */
/* called by BODMAT will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 5) If the specified body code BODY is not recognized, the */
/* error is diagnosed by a routine called by BODMAT. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine is related to the more general routine TIPBOD */
/* which returns a matrix that transforms vectors from a */
/* specified inertial reference frame to body equator and */
/* prime meridian coordinates. TIPBOD accepts an input argument */
/* REF that allows the caller to specify an inertial reference */
/* frame. */
/* The transformation represented by BODMAT's output argument TIPM */
/* is defined as follows: */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If there exists high-precision binary PCK kernel information */
/* for the body at the requested time, these angles, W, DELTA */
/* and PHI are computed directly from that file. The most */
/* recently loaded binary PCK file has first priority followed */
/* by previously loaded binary PCK files in backward time order. */
/* If no binary PCK file has been loaded, the text P_constants */
/* kernel file is used. */
/* If there is only text PCK kernel information, it is */
/* expressed in terms of RA, DEC and W (same W as above), where */
/* RA = PHI - HALFPI() */
/* DEC = HALFPI() - DELTA */
/* RA, DEC, and W are defined as follows in the text PCK file: */
/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */
/* i i */
/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */
/* i i */
/* W = W0 + W1*d + W2*d*d + w sin theta */
/* i i */
/* where: */
/* d = days past J2000. */
/* T = Julian centuries past J2000. */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0 * THETA1*T are specific to each planet. */
/* i */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* In the following code fragment, BODMAT is used to rotate */
/* the position vector (POS) from a target body (BODY) to a */
/* spacecraft from inertial coordinates to body-fixed coordinates */
/* at a specific epoch (ET), in order to compute the planetocentric */
/* longitude (PCLONG) of the spacecraft. */
/* CALL BODMAT ( BODY, ET, TIPM ) */
/* CALL MXV ( TIPM, POS, POS ) */
/* CALL RECLAT ( POS, RADIUS, PCLONG, LAT ) */
/* To compute the equivalent planetographic longitude (PGLONG), */
/* it is necessary to know the direction of rotation of the target */
/* body, as shown below. */
/* CALL BODVCD ( BODY, 'PM', 3, DIM, VALUES ) */
/* IF ( VALUES(2) .GT. 0.D0 ) THEN */
/* PGLONG = PCLONG */
/* ELSE */
/* PGLONG = TWOPI() - PCLONG */
/* END IF */
/* Note that the items necessary to compute the transformation */
/* TIPM must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the NAIF_IDS required reading file for a complete */
/* list of the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 4.1.1, 01-FEB-2008 (NJB) */
/* The routine was updated to improve the error messages created */
/* when required PCK data are not found. Now in most cases the */
/* messages are created locally rather than by the kernel pool */
/* access routines. In particular missing binary PCK data will */
/* be indicated with a reasonable error message. */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Implementation changes were made to improve robustness */
/* of the code. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* Gets TSIPM matrix from PCKMAT (instead of Euler angles */
/* from PCKEUL.) */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* Ability to get Euler angles from binary PCK file added. */
/* This uses the new routine PCKEUL. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* fetch transformation matrix for a body */
/* transformation from j2000 position to bodyfixed */
/* transformation from j2000 to bodyfixed coordinates */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Calls to deprecated kernel pool access routine RTPOOL */
/* were replaced by calls to GDPOOL. */
/* Calls to BODVAR have been replaced with calls to */
/* ZZBODVCD. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* BODMAT now get the TSIPM matrix from PCKMAT, and */
/* unpacks TIPM from it. Also the calculated but unused */
/* variable LAMBDA was removed. */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* BODMAT now uses new software to check for the */
/* existence of binary PCK files, search the for */
/* data corresponding to the requested body and time, */
/* and return the appropriate Euler angles, using the */
/* new routine PCKEUL. Otherwise the code calculates */
/* the Euler angles from the P_constants kernel file. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* BODMAT now checks the kernel pool for presence of the */
/* variables */
/* BODY#_CONSTANTS_REF_FRAME */
/* and */
/* BODY#_CONSTANTS_JED_EPOCH */
/* where # is the NAIF integer code of the barycenter of a */
/* planetary system or of a body other than a planet or */
/* satellite. If either or both of these variables are */
/* present, the P_constants for BODY are presumed to be */
/* referenced to the specified inertial frame or epoch. */
/* If the epoch of the constants is not J2000, the input */
/* time ET is converted to seconds past the reference epoch. */
/* If the frame of the constants is not J2000, the rotation from */
/* the P_constants' frame to body-fixed coordinates is */
/* transformed to the rotation from J2000 coordinates to */
/* body-fixed coordinates. */
/* For efficiency reasons, this routine now duplicates much */
/* of the code of BODEUL so that it doesn't have to call BODEUL. */
/* In some cases, BODEUL must covert Euler angles to a matrix, */
/* rotate the matrix, and convert the result back to Euler */
/* angles. If this routine called BODEUL, then in such cases */
/* this routine would convert the transformed angles back to */
/* a matrix. That would be a bit much.... */
/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */
/* Examples section completed. Declaration of unused variable */
/* FOUND removed. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODMAT", (ftnlen)6);
}
/* Get the code for the J2000 frame, if we don't have it yet. */
if (first) {
irfnum_("J2000", &j2code, (ftnlen)5);
first = FALSE_;
}
/* Get Euler angles from high precision data file. */
pckmat_(body, et, &ref, tsipm, &found);
if (found) {
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 :
s_rnge("tipm", i__1, "bodmat_", (ftnlen)485)] = tsipm[
(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("tsipm", i__2, "bodmat_", (ftnlen)485)];
}
}
} else {
/* The data for the frame of interest are not available in a */
/* loaded binary PCK file. This is not an error: the data may be */
/* present in the kernel pool. */
/* Conduct a non-error-signaling check for the presence of a */
/* kernel variable that is required to implement an IAU style */
/* body-fixed reference frame. If the data aren't available, we */
/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */
/* we want to issue the error signal locally, with a better error */
/* message. */
s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1);
if (! found) {
/* Now we do have an error. */
/* We don't have the data we'll need to produced the requested */
/* state transformation matrix. In order to create an error */
/* message understandable to the user, find, if possible, the */
/* name of the reference frame associated with the input body. */
/* Note that the body is really identified by a PCK frame class */
/* ID code, though most of the documentation just calls it a */
/* body ID code. */
ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32);
etcal_(et, timstr, (ftnlen)35);
s_copy(errmsg, "PCK data required to compute the orientation of "
"the # # for epoch # TDB were not found. If these data we"
"re to be provided by a binary PCK file, then it is possi"
"ble that the PCK file does not have coverage for the spe"
"cified body-fixed frame at the time of interest. If the "
"data were to be provided by a text PCK file, then possib"
"ly the file does not contain data for the specified body"
"-fixed frame. In either case it is possible that a requi"
"red PCK file was not loaded at all.", (ftnlen)1840, (
ftnlen)475);
/* Fill in the variable data in the error message. */
if (found) {
/* The frame system knows the name of the body-fixed frame. */
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16);
errch_("#", fixfrm, (ftnlen)1, (ftnlen)32);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
} else {
/* The frame system doesn't know the name of the */
/* body-fixed frame, most likely due to a missing */
/* frame kernel. */
suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840);
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame associated with the ID code", (
ftnlen)1, (ftnlen)44);
errint_("#", body, (ftnlen)1);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
errch_("#", "Also, a frame kernel defining the body-fixed fr"
"ame associated with body # may need to be loaded.", (
ftnlen)1, (ftnlen)96);
errint_("#", body, (ftnlen)1);
}
sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Find the body code used to label the reference frame and epoch */
/* specifiers for the orientation constants for BODY. */
/* For planetary systems, the reference frame and epoch for the */
/* orientation constants is associated with the system */
/* barycenter, not with individual bodies in the system. For any */
/* other bodies, (the Sun or asteroids, for example) the body's */
/* own code is used as the label. */
refid = zzbodbry_(body);
/* Look up the epoch of the constants. The epoch is specified */
/* as a Julian ephemeris date. The epoch defaults to J2000. */
s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32);
if (found) {
/* The reference epoch is returned as a JED. Convert to */
/* ephemeris seconds past J2000. Then convert the input ET to */
/* seconds past the reference epoch. */
conepc = spd_() * (conepc - j2000_());
epoch = *et - conepc;
} else {
epoch = *et;
}
/* Look up the reference frame of the constants. The reference */
/* frame is specified by a code recognized by CHGIRF. The */
/* default frame is J2000, symbolized by the code J2CODE. */
s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32);
if (found) {
ref = i_dnnt(&conref);
} else {
ref = j2code;
}
/* Whatever the body, it has quadratic time polynomials for */
/* the RA and Dec of the pole, and for the rotation of the */
/* Prime Meridian. */
s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7);
cleard_(&c__3, rcoef);
bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32);
s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8);
cleard_(&c__3, dcoef);
bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32);
s_copy(item, "PM", (ftnlen)32, (ftnlen)2);
cleard_(&c__3, wcoef);
bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32);
/* There may be additional nutation and libration (THETA) terms. */
ntheta = 0;
na = 0;
nd = 0;
nw = 0;
s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15);
if (bodfnd_(&refid, item, (ftnlen)32)) {
bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32);
ntheta /= 2;
}
s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32);
}
s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32);
}
s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32);
}
/* Computing MAX */
i__1 = max(na,nd);
if (max(i__1,nw) > ntheta) {
setmsg_("Insufficient number of nutation/precession angles for b"
"ody * at time #.", (ftnlen)71);
errint_("*", body, (ftnlen)1);
errdp_("#", et, (ftnlen)1);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Evaluate the time polynomials at EPOCH. */
d__ = epoch / spd_();
t = d__ / 36525.;
ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]);
dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]);
w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]);
/* Add nutation and libration as appropriate. */
i__1 = ntheta;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 :
s_rnge("tcoef", i__2, "bodmat_", (ftnlen)700)] + t *
tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 :
s_rnge("tcoef", i__3, "bodmat_", (ftnlen)700)]) * rpd_();
sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth",
i__2, "bodmat_", (ftnlen)702)] = sin(theta);
costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh",
i__2, "bodmat_", (ftnlen)703)] = cos(theta);
}
ra += vdotg_(ac, sinth, &na);
dec += vdotg_(dc, costh, &nd);
w += vdotg_(wc, sinth, &nw);
/* Convert from degrees to radians and mod by two pi. */
ra *= rpd_();
dec *= rpd_();
w *= rpd_();
d__1 = twopi_();
ra = d_mod(&ra, &d__1);
d__1 = twopi_();
dec = d_mod(&dec, &d__1);
d__1 = twopi_();
w = d_mod(&w, &d__1);
/* Convert to Euler angles. */
phi = ra + halfpi_();
delta = halfpi_() - dec;
/* Produce the rotation matrix defined by the Euler angles. */
eul2m_(&w, &delta, &phi, &c__3, &c__1, &c__3, tipm);
}
/* Convert TIPM to the J2000-to-bodyfixed rotation, if is is not */
/* already referenced to J2000. */
if (ref != j2code) {
/* Find the transformation from the J2000 frame to the frame */
/* designated by REF. Form the transformation from `REF' */
/* coordinates to body-fixed coordinates. Compose the */
/* transformations to obtain the J2000-to-body-fixed */
/* transformation. */
irfrot_(&j2code, &ref, j2ref);
mxm_(tipm, j2ref, tmpmat);
moved_(tmpmat, &c__9, tipm);
}
/* TIPM now gives the transformation from J2000 to */
/* body-fixed coordinates at epoch ET seconds past J2000, */
/* regardless of the epoch and frame of the orientation constants */
/* for the specified body. */
chkout_("BODMAT", (ftnlen)6);
return 0;
} /* bodmat_ */
/* $Procedure VERSION ( Print library version information ) */
/* Main program */ MAIN__(void)
{
/* System generated locals */
address a__1[2], a__2[4];
integer i__1[2], i__2, i__3[4], i__4;
doublereal d__1;
char ch__1[25], ch__2[99];
/* Builtin functions */
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
char line[80], vrsn[6];
extern /* Subroutine */ int zzplatfm_(char *, char *, ftnlen, ftnlen);
integer i__;
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
extern doublereal dpmin_(void);
extern /* Subroutine */ int repmd_(char *, char *, doublereal *, integer *
, char *, ftnlen, ftnlen, ftnlen);
extern doublereal dpmax_(void);
char fform[80];
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
char cmplr[80];
extern integer wdcnt_(char *, ftnlen);
char tform[80];
extern integer rtrim_(char *, ftnlen);
char os[80];
extern /* Subroutine */ int getcml_(char *, ftnlen), byebye_(char *,
ftnlen);
extern integer intmin_(void), intmax_(void);
char linout[80*6];
extern /* Subroutine */ int tostdo_(char *, ftnlen), tkvrsn_(char *, char
*, ftnlen, ftnlen);
extern integer pos_(char *, char *, integer *, ftnlen, ftnlen);
char sys[80];
/* $ Abstract */
/* This program prints to standard output the current SPICE */
/* distribution version number, hardware system ID, operating */
/* system ID, compiler name, the format of double precision */
/* numbers for the hardware architecture, and the max and min */
/* values for double precision and integer numbers. */
/* $ 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. */
/* $ Keyword */
/* VERSION */
/* UTILITY */
/* $ Parameters */
/* LINELN length of line output string, set to 80. */
/* DATEID update version time string, set to 20. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The version utility may use 3 different command line arguments. */
/* The default (no arguments) returns the Toolkit version string. */
/* Usage: $ version [OPTION] */
/* $ Description */
/* None. */
/* $ Examples */
/* Default behavior: */
/* $ version */
/* N0051 */
/* Display all (-a) information: */
/* $version -a */
/* Toolkit version : N0051 */
/* System : PC */
/* Operating System : LINUX */
/* Compiler : LINUX G77 */
/* File Format : LTL-IEEE */
/* MAX DP : 1.7976931348623E+308 */
/* MIN DP : -1.7976931348623E+308 */
/* MAX INT : 2147483647 */
/* MIN INT : -2147483647 */
/* Display version (-v) information: */
/* $version -v */
/* Version Utility for SPICE Toolkit edition N0051, */
/* last update: 1.1.0, 05-OCT-2001 */
/* Display help (-h) information: */
/* $version -h */
/* Usage: version [OPTION] */
/* no arguments output only the SPICE toolkit version string. */
/* -a(ll) output all environment variables; SPICE toolkit */
/* version, system ID, operating system, compiler, */
/* binary file format, max and min values for */
/* double precision and integer numbers. */
/* -v(ersion) output the version of the utility. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* SPICELIB Version 1.1.0 26-SEP-2001 (FST) (EDW) */
/* Added TEXT_FORMAT output. */
/* Included options for SYSTEM, O/S, COMPILER, FILE_FORMAT, */
/* max/min DPs & integers, outputs, version, and help. */
/* Added proper SPICE header. */
/* SPICELIB Version 1.0.0 13-NOV-2001 (WLT) */
/* First version, Thu NOV 13 10:04:41 PST 1997 W.L. Taber */
/* -& */
/* SPICELIB functions. */
/* Local Parameters. */
/* Local Variables. */
/* Get command line. */
getcml_(line, (ftnlen)80);
ucase_(line, line, (ftnlen)80, (ftnlen)80);
tkvrsn_("TOOLKIT", vrsn, (ftnlen)7, (ftnlen)6);
/* Parse the command line for arguments. Appropriately respond. */
if (wdcnt_(line, (ftnlen)80) == 0) {
/* No arguments, default to the toolkit version string. */
tostdo_(vrsn, rtrim_(vrsn, (ftnlen)6));
} else if (pos_(line, "-A", &c__1, (ftnlen)80, (ftnlen)2) == 1) {
/* All. Output everything. */
tostdo_(" ", (ftnlen)1);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Toolkit version : ";
i__1[1] = 6, a__1[1] = vrsn;
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)25);
tostdo_(ch__1, (ftnlen)25);
zzplatfm_("SYSTEM", sys, (ftnlen)6, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "System : ";
i__1[1] = 80, a__1[1] = sys;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("O/S", os, (ftnlen)3, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Operating System : ";
i__1[1] = 80, a__1[1] = os;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("COMPILER", cmplr, (ftnlen)8, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Compiler : ";
i__1[1] = 80, a__1[1] = cmplr;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("FILE_FORMAT", fform, (ftnlen)11, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "File Format : ";
i__1[1] = 80, a__1[1] = fform;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("TEXT_FORMAT", tform, (ftnlen)11, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Text File Format : ";
i__1[1] = 80, a__1[1] = tform;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
s_copy(linout, "MAX DP : #", (ftnlen)80, (ftnlen)21);
d__1 = dpmax_();
repmd_(linout, "#", &d__1, &c__23, linout, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
tostdo_(linout, (ftnlen)80);
s_copy(linout + 80, "MIN DP : #", (ftnlen)80, (ftnlen)20);
d__1 = dpmin_();
repmd_(linout + 80, "#", &d__1, &c__23, linout + 80, (ftnlen)80, (
ftnlen)1, (ftnlen)80);
tostdo_(linout + 80, (ftnlen)80);
s_copy(linout + 160, "MAX INT : #", (ftnlen)80, (ftnlen)21);
i__2 = intmax_();
repmi_(linout + 160, "#", &i__2, linout + 160, (ftnlen)80, (ftnlen)1,
(ftnlen)80);
tostdo_(linout + 160, (ftnlen)80);
s_copy(linout + 240, "MIN INT : #", (ftnlen)80, (ftnlen)20);
i__2 = intmin_();
repmi_(linout + 240, "#", &i__2, linout + 240, (ftnlen)80, (ftnlen)1,
(ftnlen)80);
tostdo_(linout + 240, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
} else if (pos_(line, "-V", &c__1, (ftnlen)80, (ftnlen)2) == 1) {
/* Version. Output the utility version string. */
/* Writing concatenation */
i__3[0] = 42, a__2[0] = "Version Utility for SPICE Toolkit edition ";
i__3[1] = rtrim_(vrsn, (ftnlen)6), a__2[1] = vrsn;
i__3[2] = 15, a__2[2] = ", last update: ";
i__3[3] = 18, a__2[3] = "1.1.0, 07-JAN-2002 ";
s_cat(linout, a__2, i__3, &c__4, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
tostdo_(linout, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
} else if (pos_(line, "-H", &c__1, (ftnlen)80, (ftnlen)2) == 1) {
/* Help. How does does one use this perplexing routine? */
s_copy(linout, "Usage: version [OPTION]", (ftnlen)80, (ftnlen)23);
s_copy(linout + 80, " no arguments output only the SPICE toolkit v"
"ersion string.", (ftnlen)80, (ftnlen)61);
s_copy(linout + 160, " -a(ll) output all environment variabl"
"es; SPICE toolkit version, system", (ftnlen)80, (ftnlen)79);
s_copy(linout + 240, " ID, operating system, compiler"
", and binary file format, ", (ftnlen)80, (ftnlen)72);
s_copy(linout + 320, " max and min values for double "
"precision and integer numbers.", (ftnlen)80, (ftnlen)76);
s_copy(linout + 400, " -v(ersion) output the version of the util"
"ity.", (ftnlen)80, (ftnlen)50);
tostdo_(" ", (ftnlen)1);
for (i__ = 1; i__ <= 6; ++i__) {
tostdo_(linout + ((i__2 = i__ - 1) < 6 && 0 <= i__2 ? i__2 :
s_rnge("linout", i__2, "version_", (ftnlen)272)) * 80,
rtrim_(linout + ((i__4 = i__ - 1) < 6 && 0 <= i__4 ? i__4
: s_rnge("linout", i__4, "version_", (ftnlen)272)) * 80, (
ftnlen)80));
}
tostdo_(" ", (ftnlen)1);
} else {
/* The user put something on the command line, but nothing */
/* known. Return the toolkit version string. */
tostdo_(vrsn, rtrim_(vrsn, (ftnlen)6));
}
/* Done. Indicate as much. Say bye. */
byebye_("SUCCESS", (ftnlen)7);
s_stop("", (ftnlen)0);
return 0;
} /* MAIN__ */
/* $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_ */
/* $Procedure DRDPGR ( Derivative of rectangular w.r.t. planetographic ) */
/* Subroutine */ int drdpgr_(char *body, doublereal *lon, doublereal *lat,
doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi,
ftnlen body_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
integer i__, n;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer sense;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen), bods2c_(char *, integer *, logical *,
ftnlen), drdgeo_(doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
integer bodyid;
doublereal geolon;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen);
char kvalue[80];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
char pmkvar[32], pgrlon[4];
extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
extern integer plnsns_(integer *);
extern logical return_(void);
char tmpstr[32];
/* $ Abstract */
/* This routine computes the Jacobian matrix of the transformation */
/* from planetographic to rectangular coordinates. */
/* $ 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 */
/* COORDINATES */
/* DERIVATIVES */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* BODY I Name of body with which coordinates are associated. */
/* LON I Planetographic longitude of a point (radians). */
/* LAT I Planetographic latitude of a point (radians). */
/* ALT I Altitude of a point above reference spheroid. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* JACOBI O Matrix of partial derivatives. */
/* $ Detailed_Input */
/* BODY Name of the body with which the planetographic */
/* coordinate system is associated. */
/* BODY is used by this routine to look up from the */
/* kernel pool the prime meridian rate coefficient giving */
/* the body's spin sense. See the Files and Particulars */
/* header sections below for details. */
/* LON Planetographic longitude of the input point. This is */
/* the angle between the prime meridian and the meridian */
/* containing the input point. For bodies having */
/* prograde (aka direct) rotation, the direction of */
/* increasing longitude is positive west: from the +X */
/* axis of the rectangular coordinate system toward the */
/* -Y axis. For bodies having retrograde rotation, the */
/* direction of increasing longitude is positive east: */
/* from the +X axis toward the +Y axis. */
/* The earth, moon, and sun are exceptions: */
/* planetographic longitude is measured positive east for */
/* these bodies. */
/* The default interpretation of longitude by this */
/* and the other planetographic coordinate conversion */
/* routines can be overridden; see the discussion in */
/* Particulars below for details. */
/* Longitude is measured in radians. On input, the range */
/* of longitude is unrestricted. */
/* LAT Planetographic latitude of the input point. For a */
/* point P on the reference spheroid, this is the angle */
/* between the XY plane and the outward normal vector at */
/* P. For a point P not on the reference spheroid, the */
/* planetographic latitude is that of the closest point */
/* to P on the spheroid. */
/* Latitude is measured in radians. On input, the */
/* range of latitude is unrestricted. */
/* ALT Altitude of point above the reference spheroid. */
/* Units of ALT must match those of RE. */
/* RE Equatorial radius of a reference spheroid. This */
/* spheroid is a volume of revolution: its horizontal */
/* cross sections are circular. The shape of the */
/* spheroid is defined by an equatorial radius RE and */
/* a polar radius RP. Units of RE must match those of */
/* ALT. */
/* F Flattening coefficient = */
/* (RE-RP) / RE */
/* where RP is the polar radius of the spheroid, and the */
/* units of RP match those of RE. */
/* $ Detailed_Output */
/* JACOBI is the matrix of partial derivatives of the conversion */
/* from planetographic to rectangular coordinates. It */
/* has the form */
/* .- -. */
/* | DX/DLON DX/DLAT DX/DALT | */
/* | DY/DLON DY/DLAT DY/DALT | */
/* | DZ/DLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* evaluated at the input values of LON, LAT and ALT. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */
/* and if BODY is not a string representation of an integer, */
/* the error SPICE(IDCODENOTFOUND) will be signaled. */
/* 2) If the kernel variable */
/* BODY<ID code>_PGR_POSITIVE_LON */
/* is present in the kernel pool but has a value other */
/* than one of */
/* 'EAST' */
/* 'WEST' */
/* the error SPICE(INVALIDOPTION) will be signaled. Case */
/* and blanks are ignored when these values are interpreted. */
/* 3) If polynomial coefficients for the prime meridian of BODY */
/* are not available in the kernel pool, and if the kernel */
/* variable BODY<ID code>_PGR_POSITIVE_LON is not present in */
/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */
/* 4) If the equatorial radius is non-positive, the error */
/* SPICE(VALUEOUTOFRANGE) is signaled. */
/* 5) If the flattening coefficient is greater than or equal to one, */
/* the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* $ Files */
/* This routine expects a kernel variable giving BODY's prime */
/* meridian angle as a function of time to be available in the */
/* kernel pool. Normally this item is provided by loading a PCK */
/* file. The required kernel variable is named */
/* BODY<body ID>_PM */
/* where <body ID> represents a string containing the NAIF integer */
/* ID code for BODY. For example, if BODY is 'JUPITER', then */
/* the name of the kernel variable containing the prime meridian */
/* angle coefficients is */
/* BODY599_PM */
/* See the PCK Required Reading for details concerning the prime */
/* meridian kernel variable. */
/* The optional kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* also is normally defined via loading a text kernel. When this */
/* variable is present in the kernel pool, the prime meridian */
/* coefficients for BODY are not required by this routine. See the */
/* Particulars section below for details. */
/* $ Particulars */
/* It is often convenient to describe the motion of an object in the */
/* planetographic coordinate system. However, when performing */
/* vector computations it's hard to beat rectangular coordinates. */
/* To transform states given with respect to planetographic */
/* coordinates to states with respect to rectangular coordinates, */
/* one makes use of the Jacobian of the transformation between the */
/* two systems. */
/* Given a state in planetographic coordinates */
/* ( lon, lat, alt, dlon, dlat, dalt ) */
/* the velocity in rectangular coordinates is given by the matrix */
/* equation: */
/* t | t */
/* (dx, dy, dz) = JACOBI| * (dlon, dlat, dalt) */
/* |(lon,lat,alt) */
/* This routine computes the matrix */
/* | */
/* JACOBI| */
/* |(lon,lat,alt) */
/* In the planetographic coordinate system, longitude is defined */
/* using the spin sense of the body. Longitude is positive to the */
/* west if the spin is prograde and positive to the east if the spin */
/* is retrograde. The spin sense is given by the sign of the first */
/* degree term of the time-dependent polynomial for the body's prime */
/* meridian Euler angle "W": the spin is retrograde if this term is */
/* negative and prograde otherwise. For the sun, planets, most */
/* natural satellites, and selected asteroids, the polynomial */
/* expression for W may be found in a SPICE PCK kernel. */
/* The earth, moon, and sun are exceptions: planetographic longitude */
/* is measured positive east for these bodies. */
/* If you wish to override the default sense of positive longitude */
/* for a particular body, you can do so by defining the kernel */
/* variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* where <body ID> represents the NAIF ID code of the body. This */
/* variable may be assigned either of the values */
/* 'WEST' */
/* 'EAST' */
/* For example, you can have this routine treat the longitude */
/* of the earth as increasing to the west using the kernel */
/* variable assignment */
/* BODY399_PGR_POSITIVE_LON = 'WEST' */
/* Normally such assignments are made by placing them in a text */
/* kernel and loading that kernel via FURNSH. */
/* The definition of this kernel variable controls the behavior of */
/* the SPICELIB planetographic routines */
/* PGRREC */
/* RECPGR */
/* DPGRDR */
/* DRDPGR */
/* It does not affect the other SPICELIB coordinate conversion */
/* routines. */
/* $ Examples */
/* Numerical results shown for this example may differ between */
/* platforms as the results depend on the SPICE kernels used as */
/* input and the machine specific arithmetic implementation. */
/* Find the planetographic state of the earth as seen from */
/* Mars in the J2000 reference frame at January 1, 2005 TDB. */
/* Map this state back to rectangular coordinates as a check. */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION RPD */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION ALT */
/* DOUBLE PRECISION DRECTN ( 3 ) */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION F */
/* DOUBLE PRECISION JACOBI ( 3, 3 ) */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION PGRVEL ( 3 ) */
/* DOUBLE PRECISION RADII ( 3 ) */
/* DOUBLE PRECISION RE */
/* DOUBLE PRECISION RECTAN ( 3 ) */
/* DOUBLE PRECISION RP */
/* DOUBLE PRECISION STATE ( 6 ) */
/* INTEGER N */
/* C */
/* C Load a PCK file containing a triaxial */
/* C ellipsoidal shape model and orientation */
/* C data for Mars. */
/* C */
/* CALL FURNSH ( 'pck00008.tpc' ) */
/* C */
/* C Load an SPK file giving ephemerides of earth and Mars. */
/* C */
/* CALL FURNSH ( 'de405.bsp' ) */
/* C */
/* C Load a leapseconds kernel to support time conversion. */
/* C */
/* CALL FURNSH ( 'naif0007.tls' ) */
/* C */
/* C Look up the radii for Mars. Although we */
/* C omit it here, we could first call BADKPV */
/* C to make sure the variable BODY499_RADII */
/* C has three elements and numeric data type. */
/* C If the variable is not present in the kernel */
/* C pool, BODVRD will signal an error. */
/* C */
/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */
/* C */
/* C Compute flattening coefficient. */
/* C */
/* RE = RADII(1) */
/* RP = RADII(3) */
/* F = ( RE - RP ) / RE */
/* C */
/* C Look up the geometric state of earth as seen from Mars at */
/* C January 1, 2005 TDB, relative to the J2000 reference */
/* C frame. */
/* C */
/* CALL STR2ET ( 'January 1, 2005 TDB', ET ) */
/* CALL SPKEZR ( 'Earth', ET, 'J2000', 'LT+S', */
/* . 'Mars', STATE, LT ) */
/* C */
/* C Convert position to planetographic coordinates. */
/* C */
/* CALL RECPGR ( 'MARS', STATE, RE, F, LON, LAT, ALT ) */
/* C */
/* C Convert velocity to planetographic coordinates. */
/* C */
/* CALL DPGRDR ( 'MARS', STATE(1), STATE(2), STATE(3), */
/* . RE, F, JACOBI ) */
/* CALL MXV ( JACOBI, STATE(4), PGRVEL ) */
/* C */
/* C As a check, convert the planetographic state back to */
/* C rectangular coordinates. */
/* C */
/* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */
/* CALL DRDPGR ( 'MARS', LON, LAT, ALT, RE, F, JACOBI ) */
/* CALL MXV ( JACOBI, PGRVEL, DRECTN ) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular coordinates:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' X (km) = ', STATE(1) */
/* WRITE(*,*) ' Y (km) = ', STATE(2) */
/* WRITE(*,*) ' Z (km) = ', STATE(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular velocity:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' dX/dt (km/s) = ', STATE(4) */
/* WRITE(*,*) ' dY/dt (km/s) = ', STATE(5) */
/* WRITE(*,*) ' dZ/dt (km/s) = ', STATE(6) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Ellipsoid shape parameters: ' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' Equatorial radius (km) = ', RE */
/* WRITE(*,*) ' Polar radius (km) = ', RP */
/* WRITE(*,*) ' Flattening coefficient = ', F */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Planetographic coordinates:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' Longitude (deg) = ', LON / RPD() */
/* WRITE(*,*) ' Latitude (deg) = ', LAT / RPD() */
/* WRITE(*,*) ' Altitude (km) = ', ALT */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Planetographic velocity:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' d Longitude/dt (deg/s) = ', PGRVEL(1)/RPD() */
/* WRITE(*,*) ' d Latitude/dt (deg/s) = ', PGRVEL(2)/RPD() */
/* WRITE(*,*) ' d Altitude/dt (km/s) = ', PGRVEL(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular coordinates from inverse ' // */
/* . 'mapping:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' X (km) = ', RECTAN(1) */
/* WRITE(*,*) ' Y (km) = ', RECTAN(2) */
/* WRITE(*,*) ' Z (km) = ', RECTAN(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular velocity from inverse mapping:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' dX/dt (km/s) = ', DRECTN(1) */
/* WRITE(*,*) ' dY/dt (km/s) = ', DRECTN(2) */
/* WRITE(*,*) ' dZ/dt (km/s) = ', DRECTN(3) */
/* WRITE(*,*) ' ' */
/* END */
/* Output from this program should be similar to the following */
/* (rounding and formatting differ across platforms): */
/* Rectangular coordinates: */
/* X (km) = 146039732. */
/* Y (km) = 278546607. */
/* Z (km) = 119750315. */
/* Rectangular velocity: */
/* dX/dt (km/s) = -47.0428824 */
/* dY/dt (km/s) = 9.07021778 */
/* dZ/dt (km/s) = 4.75656274 */
/* Ellipsoid shape parameters: */
/* Equatorial radius (km) = 3396.19 */
/* Polar radius (km) = 3376.2 */
/* Flattening coefficient = 0.00588600756 */
/* Planetographic coordinates: */
/* Longitude (deg) = 297.667659 */
/* Latitude (deg) = 20.844504 */
/* Altitude (km) = 336531825. */
/* Planetographic velocity: */
/* d Longitude/dt (deg/s) = -8.35738632E-06 */
/* d Latitude/dt (deg/s) = 1.59349355E-06 */
/* d Altitude/dt (km/s) = -11.2144327 */
/* Rectangular coordinates from inverse mapping: */
/* X (km) = 146039732. */
/* Y (km) = 278546607. */
/* Z (km) = 119750315. */
/* Rectangular velocity from inverse mapping: */
/* dX/dt (km/s) = -47.0428824 */
/* dY/dt (km/s) = 9.07021778 */
/* dZ/dt (km/s) = 4.75656274 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 26-DEC-2004 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* Jacobian of rectangular w.r.t. planetographic coordinates */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("DRDPGR", (ftnlen)6);
/* Convert the body name to an ID code. */
bods2c_(body, &bodyid, &found, body_len);
if (! found) {
setmsg_("The value of the input argument BODY is #, this is not a re"
"cognized name of an ephemeris object. The cause of this prob"
"lem may be that you need an updated version of the SPICE Too"
"lkit. ", (ftnlen)185);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* The equatorial radius must be positive. If not, signal an error */
/* and check out. */
if (*re <= 0.) {
setmsg_("Equatorial radius was #.", (ftnlen)24);
errdp_("#", re, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* If the flattening coefficient is greater than 1, the polar radius */
/* is negative. If F is equal to 1, the polar radius is zero. Either */
/* case is a problem, so signal an error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was #.", (ftnlen)29);
errdp_("#", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* Look up the longitude sense override variable from the */
/* kernel pool. */
repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, (
ftnlen)1, (ftnlen)32);
gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80);
if (found) {
/* Make sure we recognize the value of PGRLON. */
cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32)
;
ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4);
if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) {
sense = 1;
} else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) {
sense = -1;
} else {
setmsg_("Kernel variable # may have the values EAST or WEST. Ac"
"tual value was #.", (ftnlen)72);
errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
errch_("#", kvalue, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
} else {
/* Look up the spin sense of the body's prime meridian. */
sense = plnsns_(&bodyid);
/* If the required prime meridian rate was not available, */
/* PLNSNS returns the code 0. Here we consider this situation */
/* to be an error. */
if (sense == 0) {
repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, (
ftnlen)32);
setmsg_("Prime meridian rate coefficient defined by kernel varia"
"ble # is required but not available for body #. ", (
ftnlen)103);
errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(MISSINGDATA)", (ftnlen)18);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* Handle the special cases: earth, moon, and sun. */
if (bodyid == 399 || bodyid == 301 || bodyid == 10) {
sense = 1;
}
}
/* At this point, SENSE is set to +/- 1. */
/* Adjust the longitude according to the sense of the body's */
/* spin, or according to the override value if one is provided. */
/* We want positive east longitude. */
geolon = sense * *lon;
/* Now that we have geodetic longitude in hand, use the */
/* geodetic equivalent of the input coordinates to find the */
/* Jacobian matrix of rectangular coordinates with respect */
/* to geodetic coordinates. */
drdgeo_(&geolon, lat, alt, re, f, jacobi);
/* The matrix JACOBI is */
/* .- -. */
/* | DX/DGEOLON DX/DLAT DX/DALT | */
/* | DY/DGEOLON DY/DLAT DY/DALT | */
/* | DZ/DGEOLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* which, applying the chain rule to D(*)/DGEOLON, is equivalent to */
/* .- -. */
/* | (1/SENSE) * DX/DLON DX/DLAT DX/DALT | */
/* | (1/SENSE) * DY/DLON DY/DLAT DY/DALT | */
/* | (1/SENSE) * DZ/DLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* So, multiplying the first column of JACOBI by SENSE gives us the */
/* matrix we actually want to compute: the Jacobian matrix of */
/* rectangular coordinates with respect to planetographic */
/* coordinates. */
for (i__ = 1; i__ <= 3; ++i__) {
jacobi[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("jacobi",
i__1, "drdpgr_", (ftnlen)736)] = sense * jacobi[(i__2 = i__ -
1) < 9 && 0 <= i__2 ? i__2 : s_rnge("jacobi", i__2, "drdpgr_",
(ftnlen)736)];
}
chkout_("DRDPGR", (ftnlen)6);
return 0;
} /* drdpgr_ */
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
char oname[40];
doublereal descr[5];
integer ctarg[20];
char ident[40], tname[40];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
moved_(doublereal *, integer *, doublereal *);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal starg[120] /* was [6][20] */;
logical nofrm;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
extern doublereal clight_(void);
integer tframe[20];
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer tmpfrm;
extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *),
spksfs_(integer *, doublereal *, integer *, doublereal *, char *,
logical *, ftnlen);
extern integer frstnp_(char *, ftnlen);
extern logical return_(void);
doublereal psxfrm[9] /* was [3][3] */;
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), intstr_(integer *, char *,
ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ Abstract */
/* Compute the geometric position of a target body relative to an */
/* observing body. */
/* $ 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 */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ 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 include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ 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 */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* POS O Position of target. */
/* LT O Light time. */
/* $ Detailed_Input */
/* TARG is the standard NAIF ID code for a target body. */
/* ET is the epoch (ephemeris time) at which the position */
/* of the target body is to be computed. */
/* REF is the name of the reference frame to */
/* which the vectors returned by the routine should */
/* be rotated. This may be any frame supported by */
/* the SPICELIB subroutine REFCHG. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* POS contains the position of the target */
/* body, relative to the observing body. This vector is */
/* rotated into the specified reference frame. Units */
/* are always km. */
/* LT is the one-way light time from the observing body */
/* to the geometric position of the target body at the */
/* specified epoch. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If insufficient ephemeris data has been loaded to compute */
/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/* signalled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* SPKGPS computes the geometric position, T(t), of the target */
/* body and the geometric position, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric position of the target */
/* body relative to the observer. */
/* CENTER ----- O(t) */
/* | / */
/* | / */
/* | / */
/* | / T(t) - O(t) */
/* | / */
/* T(t) */
/* The one-way light time, tau, is given by */
/* | T(t) - O(t) | */
/* tau = ----------------- */
/* c */
/* For example, if the observing body is -94, the Mars Observer */
/* spacecraft, and the target body is 401, Phobos, then the */
/* first common center is probably 4, the Mars Barycenter. */
/* O(t) is the position of -94 relative to 4 and T(t) is the */
/* position of 401 relative to 4. */
/* The center could also be the Solar System Barycenter, body 0. */
/* For example, if the observer is 399, Earth, and the target */
/* is 299, Venus, then O(t) would be the position of 399 relative */
/* to 0 and T(t) would be the position of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the positions of the target body and observer */
/* relative to a common center. SPKGPS reads as many segments */
/* as necessary, from as many files as necessary, using files */
/* that have been loaded by previous calls to SPKLEF (load */
/* ephemeris file). */
/* SPKGPS is similar to SPKGEO but returns geometric positions */
/* only. */
/* $ Examples */
/* The following code example computes the geometric */
/* position of the moon with respect to the earth and */
/* then prints the distance of the moon from the */
/* the earth at a number of epochs. */
/* Assume the SPK file SAMPLE.BSP contains ephemeris data */
/* for the moon relative to earth over the time interval */
/* from BEGIN to END. */
/* INTEGER EARTH */
/* PARAMETER ( EARTH = 399 ) */
/* INTEGER MOON */
/* PARAMETER ( MOON = 301 ) */
/* INTEGER N */
/* PARAMETER ( N = 100 ) */
/* INTEGER I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the position, and */
/* C print out the epoch in UTC time and position norm. */
/* C */
/* DELTA = ( END - BEGIN ) / N */
/* DO I = 0, N */
/* ET = BEGIN + I*DELTA */
/* CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( POS ) */
/* END DO */
/* $ Restrictions */
/* 1) The ephemeris files to be used by SPKGPS must be loaded */
/* by SPKLEF before SPKGPS is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */
/* -& */
/* $ Index_Entries */
/* geometric position of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* -& */
/* This is the idea: */
/* Every body moves with respect to some center. The center */
/* is itself a body, which in turn moves about some other */
/* center. If we begin at the target body (T), follow */
/* the chain, */
/* T */
/* \ */
/* SSB \ */
/* \ C[1] */
/* \ / */
/* \ / */
/* \ / */
/* \ / */
/* C[3]-----------C[2] */
/* and avoid circular definitions (A moves about B, and B moves */
/* about A), eventually we get the position relative to the solar */
/* system barycenter (which, for our purposes, doesn't move). */
/* Thus, */
/* T = T + C[1] + C[2] + ... + C[n] */
/* SSB C[1] C[2] [C3] SSB */
/* where */
/* X */
/* Y */
/* is the position of body X relative to body Y. */
/* However, we don't want to follow each chain back to the SSB */
/* if it isn't necessary. Instead we will just follow the chain */
/* of the target body and follow the chain of the observing body */
/* until we find a common node in the tree. */
/* In the example below, C is the first common node. We compute */
/* the position of TARG relative to C and the position of OBS */
/* relative to C, then subtract the two positions. */
/* TARG */
/* \ */
/* SSB \ */
/* \ A */
/* \ / OBS */
/* \ / | */
/* \ / | */
/* \ / | */
/* B-------------C-----------------D */
/* SPICELIB functions */
/* Local parameters */
/* CHLEN is the maximum length of a chain. That is, */
/* it is the maximum number of bodies in the chain from */
/* the target or observer to the SSB. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKGPS", (ftnlen)6);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* We take care of the obvious case first. It TARG and OBS are the */
/* same we can just fill in zero. */
if (*targ == *obs) {
*lt = 0.;
cleard_(&c__3, pos);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* CTARG contains the integer codes of the bodies in the */
/* target body chain, beginning with TARG itself and then */
/* the successive centers of motion. */
/* STARG(1,I) is the position of the target body relative */
/* to CTARG(I). The id-code of the frame of this position is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and positions of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and position of the */
/* observer relative to it.) */
/* First, we construct CTARG and STARG. CTARG(1) is */
/* just the target itself, and STARG(1,1) is just a zero */
/* vector, that is, the position of the target relative */
/* to itself. */
/* Then we follow the chain, filling up CTARG and STARG */
/* as we go. We use SPKSFS to search through loaded */
/* files to find the first segment applicable to CTARG(1) */
/* and time ET. Then we use SPKPVN to compute the position */
/* of the body CTARG(1) at ET in the segment that was found */
/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */
/* We repeat the process for CTARG(2) and so on, until */
/* there is no data found for some CTARG(I) or until we */
/* reach the SSB. */
/* Next, we find centers and positions in a similar manner */
/* for the observer. It's a similar construction as */
/* described above, but I is always 1. COBS and SOBS */
/* are overwritten with each new center and position, */
/* beginning at OBS. However, we stop when we encounter */
/* a common center of motion, that is when COBS is equal */
/* to CTARG(I) for some I. */
/* Finally, we compute the desired position of the target */
/* relative to the observer by subtracting the position of */
/* the observing body relative to the common node from */
/* the position of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(ref, &refid, ref_len);
}
if (refid == 0) {
if (frstnp_(ref, ref_len) > 0) {
setmsg_("The string supplied to specify the reference frame, ('#"
"') contains non-printing characters. The two most commo"
"n causes for this kind of error are: 1. an error in the "
"call to SPKGPS; 2. an uninitialized variable. ", (ftnlen)
213);
errch_("#", ref, (ftnlen)1, ref_len);
} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
setmsg_("The string supplied to specify the reference frame is b"
"lank. The most common cause for this kind of error is a"
"n uninitialized variable. ", (ftnlen)137);
} else {
setmsg_("The string supplied to specify the reference frame was "
"'#'. This frame is not recognized. Possible causes for "
"this error are: 1. failure to load the frame definition "
"into the kernel pool; 2. An out-of-date edition of the t"
"oolkit. ", (ftnlen)231);
errch_("#", ref, (ftnlen)1, ref_len);
}
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
/* Fill in CTARG and STARG until no more data is found */
/* or until we reach the SSB. If the chain gets too */
/* long to fit in CTARG, that is if I equals CHLEN, */
/* then overwrite the last elements of CTARG and STARG. */
/* Note the check for FAILED in the loop. If SPKSFS */
/* or SPKPVN happens to fail during execution, and the */
/* current error handling action is to NOT abort, then */
/* FOUND may be stuck at TRUE, CTARG(I) will never */
/* become zero, and the loop will execute indefinitely. */
/* Construct CTARG and STARG. Begin by assigning the */
/* first elements: TARG and the position of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"spkgps_", (ftnlen)603)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)606)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "spkgps_", (ftnlen)608)] != 0) {
/* Find a file and segment that has position */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "spkgps_", (ftnlen)617)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the position of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the position is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "spkgps_", (ftnlen)627)]);
/* Here's what we have. STARG is the position of CTARG(I-1) */
/* relative to CTARG(I) in reference frame TFRAME(I) */
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
tframe[0] = tframe[1];
/* If the loop above ended because we ran out of */
/* room in the arrays CTARG and STARG, then we */
/* continue finding positions but we overwrite the */
/* last elements of CTARG and STARG. */
/* If, as a result, the first common node is */
/* overwritten, we'll just have to settle for */
/* the last common node. This will cause a small */
/* loss of precision, but it's better than other */
/* alternatives. */
if (i__ == 20) {
while(found && ctarg[19] != 0 && ctarg[19] != *obs) {
/* Find a file and segment that has position */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the position of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The position is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the position of TARG relative to */
/* the old center to get the position of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__3, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
} else {
refchg_(&tframe[19], &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[114], vtemp);
}
vadd_(vtemp, stemp, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...3,K) position of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...3,1) = ( 0, 0, 0 ) */
/* TFRAME(1) = TFRAME(2) */
/* Now follow the observer's chain. Assign */
/* the first values for COBS and SOBS. */
cobs = *obs;
cleard_(&c__6, sobs);
/* Perhaps we have a common node already. */
/* If so it will be the last node on the */
/* list CTARG. */
/* We let CTPOS will be the position of the common */
/* node in CTARG if one is found. It will */
/* be zero if COBS is not found in CTARG. */
if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg",
i__1, "spkgps_", (ftnlen)762)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)764)];
} else {
ctpos = 0;
}
/* Repeat the same loop as above, but each time */
/* we encounter a new center of motion, check to */
/* see if it is a common node. (When CTPOS is */
/* not zero, CTARG(CTPOS) is the first common node.) */
/* Note that we don't need a centers array nor a */
/* positions array, just a single center and position */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and position */
/* (SOBS-position of the target relative to COBS). */
found = TRUE_;
nofrm = TRUE_;
legs = 0;
while(found && cobs != 0 && ctpos == 0) {
/* Find a file and segment that has position */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the position of COBS; call it STEMP. */
/* The center of motion of COBS becomes the */
/* new COBS. */
if (legs == 0) {
spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
} else {
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
}
if (nofrm) {
nofrm = FALSE_;
cframe = tmpfrm;
}
/* Add STEMP to the position of OBS relative to */
/* the old COBS to get the position of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the position of the observer, we */
/* don't have to add anything, the position of the */
/* observer is already in SOBS. We only have to add when */
/* the number of legs in the observer position is one or */
/* greater. */
if (legs > 0) {
vadd_(sobs, stemp, vtemp);
vequ_(vtemp, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
} else {
refchg_(&cframe, &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* We now have one more leg of the path for OBS. Set */
/* LEGS to reflect this. Then see if the new center */
/* is a common node. If not, repeat the loop. */
++legs;
ctpos = isrchi_(&cobs, &nct, ctarg);
}
}
/* If CTPOS is zero at this point, it means we */
/* have not found a common node though we have */
/* searched through all the available data. */
if (ctpos == 0) {
bodc2n_(targ, tname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
;
} else {
intstr_(targ, tname, (ftnlen)40);
}
bodc2n_(obs, oname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
} else {
intstr_(obs, oname, (ftnlen)40);
}
setmsg_("Insufficient ephemeris data has been loaded to compute the "
"position of TARG relative to OBS at the ephemeris epoch #. ",
(ftnlen)118);
etcal_(et, tstring, (ftnlen)80);
errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
errch_("#", tstring, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The POSITION of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . N */
/* S | . O */
/* T | . I */
/* A | . T */
/* R | . I */
/* G | . S */
/* | . O */
/* | . P */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | POSITION | */
/* LT = --------- */
/* c */
/* Compute the position of the target relative to CTARG(CTPOS) */
if (ctpos == 1) {
tframe[0] = cframe;
}
i__1 = ctpos - 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
, i__2, "spkgps_", (ftnlen)960)] == tframe[(i__3 = i__) < 20
&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
ftnlen)960)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], stemp);
moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
963)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 &&
0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2
: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)967)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
970)]);
} else {
refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)974)], et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)981)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
983)]);
}
}
/* To avoid unnecessary frame transformations we'll do */
/* a bit of extra decision making here. It's a lot */
/* faster to make logical checks than it is to compute */
/* frame transformations. */
if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe",
i__1, "spkgps_", (ftnlen)996)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1000)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the position of */
/* the observer to that frame and then subtract the position */
/* of the observer from the position of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1031)], stemp, pos);
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* REFCHG to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1040)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], stemp);
vsub_(stemp, sobs, pos);
} else {
/* Use the more general routine REFCHG to make the transformation. */
refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1048)], &cframe, et,
psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1055)], stemp);
vsub_(stemp, sobs, pos);
}
/* Finally, rotate as needed into the requested frame. */
if (cframe == refid) {
/* We don't have to do anything in this case. */
} else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
/* Since both frames are inertial, we use the more direct */
/* routine IRFROT to get the transformation to REFID. */
irfrot_(&cframe, &refid, rot);
mxv_(rot, pos, stemp);
moved_(stemp, &c__3, pos);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, pos, stemp);
moved_(stemp, &c__3, pos);
}
*lt = vnorm_(pos) / clight_();
chkout_("SPKGPS", (ftnlen)6);
return 0;
} /* spkgps_ */
/* $Procedure ET2LST ( ET to Local Solar Time ) */
/* Subroutine */ int et2lst_(doublereal *et, integer *body, doublereal *
long__, char *type__, integer *hr, integer *mn, integer *sc, char *
time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len)
{
/* System generated locals */
address a__1[5], a__2[7];
integer i__1[5], i__2[7];
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
/* Local variables */
doublereal rate, slat, mins;
char h__[2], m[2];
integer n;
doublereal q;
char s[2];
doublereal angle;
char frame[32];
doublereal range;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), dpfmt_(
doublereal *, char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal state[6], slong;
extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
doublereal hours;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
extern doublereal twopi_(void);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
extern doublereal pi_(void);
char bodnam[36];
doublereal lt;
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *), rmaind_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal secnds;
extern /* Subroutine */ int pgrrec_(char *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, ftnlen);
char bpmkwd[32];
integer hrampm;
doublereal tmpang;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char amorpm[4];
doublereal tmpsec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
doublereal mylong, spoint[3];
extern logical return_(void);
char kwtype[1];
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
char mytype[32];
doublereal lat;
/* $ Abstract */
/* Given an ephemeris epoch ET, compute the local solar time for */
/* an object on the surface of a body at a specified longitude. */
/* $ 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 */
/* TIME */
/* $ Keywords */
/* TIME */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ET I Epoch in seconds past J2000 epoch */
/* BODY I ID-code of the body of interest */
/* LONG I Longitude of surface point (RADIANS) */
/* TYPE I Type of longitude 'PLANETOCENTRIC', etc. */
/* HR O Local hour on a "24 hour" clock */
/* MN O Minutes past the hour */
/* SC O Seconds past the minute */
/* TIME O String giving local time on 24 hour clock */
/* AMPM O String giving time on A.M./ P.M. scale */
/* $ Detailed_Input */
/* ET is the epoch expressed in TDB seconds past */
/* the J2000 epoch at which a local time is desired. */
/* BODY is the NAIF ID-code of a body on which local */
/* time is to be measured. */
/* LONG is the longitude (either planetocentric or */
/* planetographic) in radians of the site on the */
/* surface of body for which local time should be */
/* computed. */
/* TYPE is the form of longitude supplied by the variable */
/* LONG. Allowed values are 'PLANETOCENTRIC' and */
/* 'PLANETOGRAPHIC'. Note the case of the letters */
/* in TYPE is insignificant. Both 'PLANETOCENTRIC' */
/* and 'planetocentric' are recognized. */
/* $ Detailed_Output */
/* HR is the local "hour" of the site specified at the */
/* epoch ET. Note that an "hour" of local time does not */
/* have the same duration as an hour measured by */
/* conventional clocks. It is simply a representation */
/* of an angle. See the "Particulars" section for a more */
/* complete discussion of the meaning of local time. */
/* MN is the number of "minutes" past the hour of the */
/* local time of the site at the epoch ET. Again note */
/* that a "local minute" is not the same as a minute */
/* you would measure with conventional clocks. */
/* SC is the number of "seconds" past the minute of the */
/* local time of the site at the epoch ET. Again note */
/* that a "local second" is not the same as a second */
/* you would measure with conventional clocks. */
/* TIME is a string expressing the local time */
/* on a "24 hour" local clock. */
/* AMPM is a string expressing the local time on a "12 hour" */
/* local clock together with the traditional AM/PM */
/* label to indicate whether the sun has crossed */
/* the local zenith meridian. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This routine defines local solar time for any point on the */
/* surface of the Sun to be 12:00:00 noon. */
/* 2) If the TYPE of the coordinates is not recognized, the */
/* error 'SPICE(UNKNOWNSYSTEM)' will be signaled. */
/* 3) If the body-fixed frame to associate with BODY cannot be */
/* determined, the error 'SPICE(CANTFINDFRAME)' is signaled. */
/* 4) If insufficient data is available to compute the */
/* location of the sun in body-fixed coordinates, the */
/* error will be diagnosed by a routine called by this one. */
/* 5) If the BODY#_PM keyword required to determine the body */
/* rotation sense is not found in the POOL or if it is found but */
/* is not a numeric keyword with at least two elements, the error */
/* 'SPICE(CANTGETROTATIONTYPE)' is signaled. */
/* $ Files */
/* Suitable SPK and PCK files must be loaded prior to calling this */
/* routine so that the body-fixed position of the sun relative to */
/* BODY can be computed. The PCK files must contain the standard */
/* BODY#_PM keyword need by this routine to determine the body */
/* rotation sense. */
/* When the input longitude is planetographic, the default */
/* interpretation of this value can be overridden using the optional */
/* kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* which is normally defined via loading a text kernel. */
/* $ Particulars */
/* This routine returns the local solar time at a user */
/* specified location on a user specified body. */
/* Let SUNLNG be the planetocentric longitude (in degrees) of */
/* the sun as viewed from the center of the body of interest. */
/* Let SITLNG be the planetocentric longitude (in degrees) of */
/* the site for which local time is desired. */
/* We define local time to be 12 + (SITLNG - SUNLNG)/15 */
/* (where appropriate care is taken to map ( SITLNG - SUNLNG ) */
/* into the range from -180 to 180). */
/* Using this definition, we see that from the point of view */
/* of this routine, local solar time is simply a measure of angles */
/* between meridians on the surface of a body. Consequently, */
/* this routine is not appropriate for computing "local times" */
/* in the sense of Pacific Standard Time. For computing times */
/* relative to standard time zones on earth, see the routines */
/* TIMOUT and STR2ET. */
/* Regarding planetographic longitude */
/* ---------------------------------- */
/* In the planetographic coordinate system, longitude is defined */
/* using the spin sense of the body. Longitude is positive to the */
/* west if the spin is prograde and positive to the east if the spin */
/* is retrograde. The spin sense is given by the sign of the first */
/* degree term of the time-dependent polynomial for the body's prime */
/* meridian Euler angle "W": the spin is retrograde if this term is */
/* negative and prograde otherwise. For the sun, planets, most */
/* natural satellites, and selected asteroids, the polynomial */
/* expression for W may be found in a SPICE PCK kernel. */
/* The earth, moon, and sun are exceptions: planetographic longitude */
/* is measured positive east for these bodies. */
/* If you wish to override the default sense of positive */
/* planetographic longitude for a particular body, you can do so by */
/* defining the kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* where <body ID> represents the NAIF ID code of the body. This */
/* variable may be assigned either of the values */
/* 'WEST' */
/* 'EAST' */
/* For example, you can have this routine treat the longitude */
/* of the earth as increasing to the west using the kernel */
/* variable assignment */
/* BODY399_PGR_POSITIVE_LON = 'WEST' */
/* Normally such assignments are made by placing them in a text */
/* kernel and loading that kernel via FURNSH. */
/* $ Examples */
/* The following code fragment illustrates how you */
/* could print the local time at a site on Mars with */
/* planetographic longitude 326.17 deg E at epoch ET. */
/* (This example assumes all required SPK and PCK files have */
/* been loaded). */
/* Convert the longitude to radians, set the type of the longitude */
/* and make up a mnemonic for Mars' ID-code. */
/* LONG = 326.17 * RPD() */
/* TYPE = 'PLANETOGRAPHIC' */
/* MARS = 499 */
/* CALL ET2LST ( ET, MARS, LONG, TYPE, HR, MN, SC, TIME, AMPM ) */
/* WRITE (*,*) 'The local time at Mars 326.17 degrees E ' */
/* WRITE (*,*) 'planetographic longitude is: ', AMPM */
/* $ Restrictions */
/* This routine relies on being able to determine the name */
/* of the body-fixed frame associated with BODY through the */
/* frames subsystem. If the BODY specified is NOT one of the */
/* nine planets or their satellites, you will need to load */
/* an appropriate frame definition kernel that contains */
/* the relationship between the body id and the body-fixed frame */
/* name. See the FRAMES required reading for more details */
/* on specifying this relationship. */
/* The routine determines the body rotation sense using the PCK */
/* keyword BODY#_PM. Therefore, you will need to a text PCK file */
/* defining the complete set of the standard PCK body rotation */
/* keywords for the body of interest. The text PCK file must be */
/* loaded independently of whether a binary PCK file providing */
/* rotation data for the same body is loaded or not. */
/* Although it is not currently the case for any of the Solar System */
/* bodies, it is possible that the retrograde rotation rate of a */
/* body would be slower than the orbital rate of the body rotation */
/* around the Sun. The routine does not account for such cases; for */
/* them it will compute incorrect the local time progressing */
/* backwards. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.2, 18-APR-2014 (BVS) */
/* Minor edits to long error messages. */
/* - SPICELIB Version 3.0.1, 09-SEP-2009 (EDW) */
/* Header edits: deleted a spurious C$ marker from the */
/* "Detailed_Output" section. The existence of the marker */
/* caused a failure in the HTML documentation creation script. */
/* Deleted the "Revisions" section as it contained several */
/* identical entries from the "Version" section. */
/* Corrected order of header sections. */
/* - SPICELIB Version 3.0.0, 28-OCT-2006 (BVS) */
/* Bug fix: incorrect computation of the local time for the */
/* bodies with the retrograde rotation causing the local time to */
/* flow backwards has been fixed. The local time for all types of */
/* bodies now progresses as expected -- midnight, increasing AM */
/* hours, noon, increasing PM hours, next midnight, and so on. */
/* - SPICELIB Version 2.0.0, 03-NOV-2005 (NJB) */
/* Bug fix: treatment of planetographic longitude has been */
/* updated to be consistent with the SPICE planetographic/ */
/* rectangular coordinate conversion routines. The effect of */
/* this change is that the default sense of positive longitude */
/* for the moon is now east; also, the default sense of positive */
/* planetographic longitude now may be overridden for any body */
/* (see Particulars above). */
/* Updated to remove non-standard use of duplicate arguments */
/* in RMAIND calls. */
/* - SPICELIB Version 1.1.0, 24-MAR-1998 (WLT) */
/* The integer variable SUN was never initialized in the */
/* previous version of the routine. Now it is set to */
/* the proper value of 10. */
/* - SPICELIB Version 1.0.0, 9-JUL-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Compute the local time for a point on a body. */
/* -& */
/* SPICELIB Functions */
/* Local parameters */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ET2LST", (ftnlen)6);
ljust_(type__, mytype, type_len, (ftnlen)32);
ucase_(mytype, mytype, (ftnlen)32, (ftnlen)32);
if (s_cmp(mytype, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) {
/* Find planetocentric longitude corresponding to the input */
/* longitude. We first represent in rectangular coordinates */
/* a surface point having zero latitude, zero altitude, and */
/* the input planetographic longitude. We then find the */
/* planetocentric longitude of this point. */
/* Since PGRREC accepts a body name, map the input code to */
/* a name, if possible. Otherwise, just convert the input code */
/* to a string. */
bodc2n_(body, bodnam, &found, (ftnlen)36);
if (! found) {
intstr_(body, bodnam, (ftnlen)36);
}
/* Convert planetographic coordinates to rectangular coordinates. */
/* All we care about here is longitude. Set the other inputs */
/* as follows: */
/* Latitude = 0 */
/* Altitude = 0 */
/* Equatorial radius = 1 */
/* Flattening factor = 0 */
pgrrec_(bodnam, long__, &c_b4, &c_b4, &c_b6, &c_b4, spoint, (ftnlen)
36);
/* The output MYLONG is planetocentric longitude. The other */
/* outputs are not used. Note that the variable RANGE appears */
/* later in another RECLAT call; it's not used after that. */
reclat_(spoint, &range, &mylong, &lat);
} else if (s_cmp(mytype, "PLANETOCENTRIC", (ftnlen)32, (ftnlen)14) == 0) {
mylong = *long__;
} else {
setmsg_("The coordinate system '#' is not a recognized system of lon"
"gitude. The recognized systems are 'PLANETOCENTRIC' and 'PL"
"ANETOGRAPHIC'. ", (ftnlen)134);
errch_("#", type__, (ftnlen)1, type_len);
sigerr_("SPICE(UNKNOWNSYSTEM)", (ftnlen)20);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
/* It's always noon on the surface of the sun. */
if (*body == 10) {
*hr = 12;
*mn = 0;
*sc = 0;
s_copy(time, "12:00:00", time_len, (ftnlen)8);
s_copy(ampm, "12:00:00 P.M.", ampm_len, (ftnlen)13);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
/* Get the body-fixed position of the sun. */
cidfrm_(body, &frcode, frame, &found, (ftnlen)32);
if (! found) {
setmsg_("The body-fixed frame associated with body # could not be de"
"termined. This information needs to be \"loaded\" via a fra"
"mes definition kernel. See frames.req for more details. ", (
ftnlen)174);
errint_("#", body, (ftnlen)1);
sigerr_("SPICE(CANTFINDFRAME)", (ftnlen)20);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
spkez_(&c__10, et, frame, "LT+S", body, state, <, (ftnlen)32, (ftnlen)4)
;
reclat_(state, &range, &slong, &slat);
angle = mylong - slong;
/* Force the angle into the region from -PI to PI */
d__1 = twopi_();
rmaind_(&angle, &d__1, &q, &tmpang);
angle = tmpang;
if (angle > pi_()) {
angle -= twopi_();
}
/* Get the rotation sense of the body and invert the angle if the */
/* rotation sense is retrograde. Use the BODY#_PM PCK keyword to */
/* determine the sense of the body rotation. */
s_copy(bpmkwd, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(bpmkwd, "#", body, bpmkwd, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(bpmkwd, &found, &n, kwtype, (ftnlen)32, (ftnlen)1);
if (! found || *(unsigned char *)kwtype != 'N' || n < 2) {
setmsg_("The rotation type for the body # could not be determined be"
"cause the # keyword was either not found in the POOL or or i"
"t was not of the expected type and/or dimension. This keywor"
"d is usually provided via a planetary constants kernel. See "
"pck.req for more details. ", (ftnlen)265);
errint_("#", body, (ftnlen)1);
errch_("#", bpmkwd, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(CANTGETROTATIONTYPE)", (ftnlen)26);
chkout_("ET2LST", (ftnlen)6);
return 0;
} else {
/* If the rotation rate is negative, invert the angle. */
gdpool_(bpmkwd, &c__2, &c__1, &n, &rate, &found, (ftnlen)32);
if (rate < 0.) {
angle = -angle;
}
}
/* Convert the angle to "angle seconds" before or after local noon. */
secnds = angle * 86400. / twopi_();
secnds = brcktd_(&secnds, &c_b32, &c_b33);
/* Get the hour, and minutes components of the local time. */
rmaind_(&secnds, &c_b34, &hours, &tmpsec);
rmaind_(&tmpsec, &c_b35, &mins, &secnds);
/* Construct the integer components of the local time. */
*hr = (integer) hours + 12;
*mn = (integer) mins;
*sc = (integer) secnds;
/* Set the A.M./P.M. components of local time. */
if (*hr == 24) {
*hr = 0;
hrampm = 12;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr > 12) {
hrampm = *hr - 12;
s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr == 12) {
hrampm = 12;
s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr == 0) {
hrampm = 12;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
} else {
hrampm = *hr;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
}
/* Now construct the two strings we need. */
hours = (doublereal) (*hr);
mins = (doublereal) (*mn);
secnds = (doublereal) (*sc);
dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
dpfmt_(&mins, "0x", m, (ftnlen)2, (ftnlen)2);
dpfmt_(&secnds, "0x", s, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
i__1[0] = 2, a__1[0] = h__;
i__1[1] = 1, a__1[1] = ":";
i__1[2] = 2, a__1[2] = m;
i__1[3] = 1, a__1[3] = ":";
i__1[4] = 2, a__1[4] = s;
s_cat(time, a__1, i__1, &c__5, time_len);
hours = (doublereal) hrampm;
dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
i__2[0] = 2, a__2[0] = h__;
i__2[1] = 1, a__2[1] = ":";
i__2[2] = 2, a__2[2] = m;
i__2[3] = 1, a__2[3] = ":";
i__2[4] = 2, a__2[4] = s;
i__2[5] = 1, a__2[5] = " ";
i__2[6] = 4, a__2[6] = amorpm;
s_cat(ampm, a__2, i__2, &c__7, ampm_len);
chkout_("ET2LST", (ftnlen)6);
return 0;
} /* et2lst_ */
/* $Procedure SCPART ( Spacecraft Clock Partition Information ) */
/* Subroutine */ int scpart_(integer *sc, integer *nparts, doublereal *pstart,
doublereal *pstop)
{
/* Initialized data */
static logical first = TRUE_;
static logical nodata = TRUE_;
static integer oldsc = 0;
/* 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);
double d_nint(doublereal *);
/* Local variables */
extern /* Subroutine */ int zzcvpool_(char *, integer *, logical *,
ftnlen), zzctruin_(integer *);
integer i__;
extern /* Subroutine */ int scld01_(char *, integer *, integer *, integer
*, doublereal *, ftnlen), chkin_(char *, ftnlen), repmi_(char *,
char *, integer *, char *, ftnlen, ftnlen, ftnlen);
static doublereal prtsa[9999], prtso[9999];
extern logical failed_(void);
char kvname[60*2];
logical update;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer nprtsa;
extern logical return_(void);
static integer usrctr[2];
extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen,
ftnlen);
integer nprtso;
static integer lstprt;
/* $ Abstract */
/* Get spacecraft clock partition information from a spacecraft */
/* clock kernel 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 */
/* SCLK */
/* $ Keywords */
/* TIME */
/* $ Declarations */
/* $ Abstract */
/* Include file sclk.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 below define sizes and limits used by */
/* the SCLK system. */
/* $ 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 */
/* See the declaration section below. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */
/* Increased value of maximum coefficient record count */
/* parameter MXCOEF from 10K to 50K. */
/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */
/* -& */
/* Number of supported SCLK field delimiters: */
/* Supported SCLK string field delimiters: */
/* Maximum number of partitions: */
/* Partition string length. */
/* Since the maximum number of partitions is given by MXPART is */
/* 9999, PRTSTR needs at most 4 characters for the partition number */
/* and one character for the slash. */
/* Maximum number of coefficient records: */
/* Maximum number of fields in an SCLK string: */
/* Length of strings used to represent D.P. */
/* numbers: */
/* Maximum number of supported parallel time systems: */
/* End of include file sclk.inc */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ 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 */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SC I NAIF spacecraft identification code. */
/* NPARTS O The number of spacecraft clock partitions. */
/* PSTART O Array of partition start times. */
/* PSTOP O Array of partition stop times. */
/* MXPART P Maximum number of partitions. */
/* $ Detailed_Input */
/* SC is the NAIF ID for the spacecraft whose clock partition */
/* information is being requested. */
/* $ Detailed_Output */
/* NPARTS is the number of spacecraft clock time partitions */
/* described in the kernel file for spacecraft SC. */
/* PSTART is an array containing NPARTS partition start times */
/* represented as double precision, encoded SCLK */
/* ("ticks"). The values contained in PSTART are whole */
/* numbers. */
/* PSTOP is an array containing NPARTS partition end times */
/* represented as double precision, encoded SCLK */
/* ("ticks"). The values contained in PSTOP are whole */
/* numbers. */
/* $ Parameters */
/* MXPART is the maximum number of partitions for any spacecraft */
/* clock. SCLK kernels contain start and stop times for */
/* each partition. See the INCLUDE file sclk.inc for this */
/* parameter's value. */
/* $ Exceptions */
/* 1) If the kernel variables containing the spacecraft clock */
/* partition start and stop times have not been loaded in the */
/* kernel pool, the error will be diagnosed by routines called */
/* by this routine. */
/* 2) If the number of start and stop times are different then */
/* the error SPICE(NUMPARTSUNEQUAL) is signaled. */
/* $ Files */
/* An SCLK kernel containing spacecraft clock partition start */
/* and stop times for the spacecraft clock indicated by SC must */
/* be loaded into the kernel pool. */
/* $ Particulars */
/* SCPART looks for two variables in the kernel pool for each */
/* spacecraft's partition information. If SC = -nn, then the names of */
/* the variables are */
/* 'SCLK_PARTITION_START_nn' and */
/* 'SCLK_PARTITION_END_nn'. */
/* The start and stop times returned are in units of "ticks". */
/* $ Examples */
/* 1) The following program fragment finds and prints out partition */
/* start and stop times in clock format for the Galileo mission. */
/* In this example, Galileo partition times are assumed to be */
/* in the kernel file SCLK.KER. */
/* CHARACTER*(30) START */
/* CHARACTER*(30) STOP */
/* CALL FURNSH ( 'SCLK.KER' ) */
/* SC = -77 */
/* CALL SCPART ( SC, NPARTS, PSTART, PSTOP ) */
/* DO I = 1, NPARTS */
/* CALL SCFMT ( SC, PSTART( I ), START ) */
/* CALL SCFMT ( SC, PSTOP ( I ), STOP ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Partition ', I, ':' */
/* WRITE (*,*) 'Start = ', START */
/* WRITE (*,*) 'Stop = ', STOP */
/* END DO */
/* $ Restrictions */
/* 1) This routine assumes that an SCLK kernel appropriate to the */
/* spacecraft identified by SC has been loaded into the kernel */
/* pool. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* J.M. Lynch (JPL) */
/* B.V. Semenov (JPL) */
/* R.E. Thurman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.3.1, 19-MAR-2014 (NJB) */
/* Minor header comment updates were made. */
/* - SPICELIB Version 2.3.0, 09-SEP-2013 (BVS) */
/* Updated to keep track of the POOL counter and call ZZCVPOOL. */
/* - SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */
/* Bug fix: this routine now keeps track of whether its */
/* kernel pool look-up succeeded. If not, a kernel pool */
/* lookup is attempted on the next call to this routine. */
/* - SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */
/* The values of the parameter MXPART is now */
/* provided by the INCLUDE file sclk.inc. */
/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 1.1.0, 22-MAR-1993 (JML) */
/* The routine now uses the kernel pool watch capability. */
/* - 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, 03-SEP-1990 (NJB) (JML) (RET) */
/* -& */
/* $ Index_Entries */
/* spacecraft_clock partition information */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SCPART", (ftnlen)6);
/* On the first pass through the subroutine, or if the */
/* spacecraft code changes, set watches on the SCLK kernel */
/* variables for the current clock. */
if (first || *sc != oldsc) {
/* Make up a list of names of kernel variables that we'll use. */
s_copy(kvname, "SCLK_PARTITION_START", (ftnlen)60, (ftnlen)20);
s_copy(kvname + 60, "SCLK_PARTITION_END", (ftnlen)60, (ftnlen)18);
for (i__ = 1; i__ <= 2; ++i__) {
suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("kvname", i__1, "scpart_", (ftnlen)284)) *
60, (ftnlen)2, (ftnlen)60);
i__3 = -(*sc);
repmi_(kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("kvname", i__1, "scpart_", (ftnlen)285)) * 60,
"#", &i__3, kvname + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ?
i__2 : s_rnge("kvname", i__2, "scpart_", (ftnlen)285)) *
60, (ftnlen)60, (ftnlen)1, (ftnlen)60);
}
/* Set a watch on all of the kernel variables used. */
swpool_("SCPART", &c__2, kvname, (ftnlen)6, (ftnlen)60);
/* Keep track of the last spacecraft ID encountered. */
oldsc = *sc;
/* Initialize the local POOL counter to user value. */
zzctruin_(usrctr);
first = FALSE_;
}
/* If any of the kernel pool variables that this routine uses */
/* have been updated, or if the spacecraft ID changes, look up */
/* the new values from the kernel pool. */
zzcvpool_("SCPART", usrctr, &update, (ftnlen)6);
if (update || nodata) {
/* Read the values from the kernel pool. */
scld01_("SCLK_PARTITION_START", sc, &c__9999, &nprtsa, prtsa, (ftnlen)
20);
scld01_("SCLK_PARTITION_END", sc, &c__9999, &nprtso, prtso, (ftnlen)
18);
if (failed_()) {
nodata = TRUE_;
chkout_("SCPART", (ftnlen)6);
return 0;
}
/* Error checking. */
if (nprtsa != nprtso) {
nodata = TRUE_;
setmsg_("The number of partition start and stop times are unequa"
"l for spacecraft #. ", (ftnlen)78);
errint_("#", sc, (ftnlen)1);
sigerr_("SPICE(NUMPARTSUNEQUAL)", (ftnlen)22);
chkout_("SCPART", (ftnlen)6);
return 0;
}
/* At this point we have the data we sought. We need not */
/* perform another kernel pool look-up unless there's */
/* a kernel pool update or change in the SCLK ID. */
nodata = FALSE_;
/* Buffer the number of partitions and the partition start */
/* and stop times. */
lstprt = nprtsa;
/* The partition start and stop times must be whole numbers. */
i__1 = lstprt;
for (i__ = 1; i__ <= i__1; ++i__) {
prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtsa"
, i__2, "scpart_", (ftnlen)360)] = d_nint(&prtsa[(i__3 =
i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtsa",
i__3, "scpart_", (ftnlen)360)]);
prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtso"
, i__2, "scpart_", (ftnlen)361)] = d_nint(&prtso[(i__3 =
i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtso",
i__3, "scpart_", (ftnlen)361)]);
}
}
/* Copy the values in local buffers to the output arguments. */
*nparts = lstprt;
i__1 = *nparts;
for (i__ = 1; i__ <= i__1; ++i__) {
pstart[i__ - 1] = prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 :
s_rnge("prtsa", i__2, "scpart_", (ftnlen)372)];
pstop[i__ - 1] = prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 :
s_rnge("prtso", i__2, "scpart_", (ftnlen)373)];
}
chkout_("SCPART", (ftnlen)6);
return 0;
} /* scpart_ */
/* $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_ */
/* $Procedure RDCMD (Read command file) */
/* Subroutine */ int rdcmd_(char *cmdfil, char *cmdsym, integer *cmdptr, char
*cmdval, ftnlen cmdfil_len, ftnlen cmdsym_len, ftnlen cmdval_len)
{
/* Initialized data */
static char kwds1[32*2] = "LEAPSECONDS_KERNEL 1 1 " "SPK_KERNEL"
" 1 1000 ";
static char kwds2[32*5] = "SOURCE_SPK_KERNEL 1 1000 " "LOG_FILE "
" 0 1 " "BODIES 0 1 " "BEGI"
"N_TIME 0 1000 " "INCLUDE_TEXT_FILE 0 1000 ";
static char kwds3[32*3] = "BODIES 0 1 " "BEGIN_TIME"
" 0 1000 " "INCLUDE_COMMENTS 0 1 ";
static char kwds4[32*1] = "END_TIME 1 1 ";
/* System generated locals */
cilist ci__1;
/* Builtin functions */
integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void);
/* Local variables */
static char line[350];
static integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen), cperr_(char *,
integer *, ftnlen), repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
static char tabval[32*26];
extern /* Subroutine */ int evalcp_(char *, logical *, char *, integer *,
char *, logical *, ftnlen, ftnlen, ftnlen), initcp_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
static char reason[160];
extern /* Subroutine */ int sigerr_(char *, ftnlen);
static integer tabptr[26];
extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen,
ftnlen);
static char tabsym[32*26];
extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen), chkout_(
char *, ftnlen);
static integer linnum, iostat;
extern /* Subroutine */ int setmsg_(char *, ftnlen), ssizei_(integer *,
integer *);
extern logical return_(void);
extern /* Subroutine */ int syputc_(char *, char *, integer *, char *,
integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen), txtopr_(char *
, integer *, ftnlen);
static logical eof, err;
/* $ Abstract */
/* Parse the command 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 */
/* None. */
/* $ Keywords */
/* None. */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CMDFIL I Name of command file. */
/* CMDSYM, */
/* CMDPTR, */
/* CMDVAL O Command symbol table. */
/* $ Detailed_Input */
/* CMDFIL is the name of the command file. */
/* $ Detailed_Output */
/* CMDSYM, */
/* CMDPTR, */
/* CMDVAL is the command symbol table. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) An error is signaled if the file cannot be parsed */
/* successfully. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* M.J. Spencer (JPL) */
/* $ Version */
/* - Beta Version 1.1.0, 17-JAN-2014 (BVS) */
/* Increased LINLEN from 120 to 350 (350 = 300 characters for */
/* value consistent with VALLEN in CPARSE_2 and the main program */
/* + 50 more characters for the keyword name, =, and blanks.) */
/* Increased maximum counts of child values in KWDS* from 300 to */
/* 1000 for all values. */
/* Saved all variables. */
/* - Beta Version 1.0.0, 26-JAN-1994 (MJS) */
/* -& */
/* SPICELIB functions */
/* Other functions */
/* Local parameters */
/* Local variables */
/* Save all. */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("RDCMD", (ftnlen)5);
}
/* Initialize the parser. */
ssizec_(&c__20, tabsym, (ftnlen)32);
ssizei_(&c__20, tabptr);
ssizec_(&c__20, tabval, (ftnlen)32);
syputc_("HEAD", kwds1, &c__2, tabsym, tabptr, tabval, (ftnlen)4, (ftnlen)
32, (ftnlen)32, (ftnlen)32);
syputc_("SPK_KERNEL", kwds2, &c__5, tabsym, tabptr, tabval, (ftnlen)10, (
ftnlen)32, (ftnlen)32, (ftnlen)32);
syputc_("SOURCE_SPK_KERNEL", kwds3, &c__3, tabsym, tabptr, tabval, (
ftnlen)17, (ftnlen)32, (ftnlen)32, (ftnlen)32);
syputc_("BEGIN_TIME", kwds4, &c__1, tabsym, tabptr, tabval, (ftnlen)10, (
ftnlen)32, (ftnlen)32, (ftnlen)32);
initcp_(tabsym, tabptr, tabval, "HEAD", (ftnlen)32, (ftnlen)32, (ftnlen)4)
;
/* Open the command file, and parse its contents */
txtopr_(cmdfil, &unit, cmdfil_len);
eof = FALSE_;
err = FALSE_;
while(! eof && ! err) {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = unit;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100001;
}
iostat = do_fio(&c__1, line, (ftnlen)350);
if (iostat != 0) {
goto L100001;
}
iostat = e_rsfe();
L100001:
eof = iostat != 0;
evalcp_(line, &eof, cmdsym, cmdptr, cmdval, &err, (ftnlen)350,
cmdsym_len, cmdval_len);
}
if (err) {
cperr_(reason, &linnum, (ftnlen)160);
repmi_(reason, "#", &linnum, reason, (ftnlen)160, (ftnlen)1, (ftnlen)
160);
prefix_(":", &c__1, reason, (ftnlen)1, (ftnlen)160);
prefix_(cmdfil, &c__0, reason, cmdfil_len, (ftnlen)160);
setmsg_(reason, (ftnlen)160);
sigerr_("SPICE(CMDPARSEERROR)", (ftnlen)20);
chkout_("RDCMD", (ftnlen)5);
return 0;
}
chkout_("RDCMD", (ftnlen)5);
return 0;
} /* rdcmd_ */
/* $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_ */
/* $Procedure PLNSNS ( Planetographic Longitude Sense ) */
integer plnsns_(integer *bodid)
{
/* System generated locals */
integer ret_val;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublereal rate;
char item[32], type__[1];
integer n;
logical found;
integer value;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen), gdpool_(char *, integer *, integer *,
integer *, doublereal *, logical *, ftnlen), dtpool_(char *,
logical *, integer *, char *, ftnlen, ftnlen);
/* $ Abstract */
/* This function returns the quotient of the planetographic */
/* and planetocentric longitude for a user specified body. */
/* $ 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 */
/* PCK */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODID I is the NAIF id-code of some solar system object. */
/* Function returns planetographic/planetocentric */
/* $ Detailed_Input */
/* BODID is the NAIF id-code of some planet, asteroid, comet */
/* or natural satellite of a planet. */
/* $ Detailed_Output */
/* Based upon loaded PCK values in the kernel pool, the function */
/* returns the quotient */
/* planetographic longitude */
/* ------------------------ */
/* planetocentric longitude */
/* for the body specified by BODID. I.e. 1 if planetographic */
/* and planetocentric longitude are the same for the input body, */
/* -1 if the planetographic and planetocentric longitude are */
/* opposite for the specified body. If PCK information for */
/* the specified body can not be located in the kernel pool */
/* the function returns the value 0. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If sufficient orientation information for the object */
/* specified by BODID is not available in the kernel pool, */
/* the function returns the value 0. */
/* $ Files */
/* A text PCK kernel must be loaded via the routine FURNSH */
/* that contains the orientation information for the body specified */
/* by BODID. */
/* $ Particulars */
/* This routine returns the multiplicative factor needed */
/* to convert planetographic longitude to planetocentric */
/* longitude. */
/* This routine relies on the proper orientation for the */
/* specified body having been loaded in the kernel pool. */
/* $ Examples */
/* Suppose that you have the planetographic coordinates */
/* of some point on the surface of an object and that you */
/* need to convert these coordinates to bodyfixed rectangular */
/* coordinates. This conversion requires knowledge of the */
/* sense of planetographic longitude. The code fragment below */
/* shows how you go about using this routine to perform the */
/* conversion. */
/* We assume that the variables LAT, LONG, HEIGHT contain the */
/* planetographic latitude, longitude and height above the */
/* reference surface of some point. Moreover, let F be the */
/* flattening factor for the reference spheroid. */
/* ( F = (Equatorial Radius - Polar Radius ) / Equatorial Radius ) */
/* Finally, let EQRAD be the equatorial radius. */
/* We first need to convert planetographic longitude to */
/* planetocentric longitude. */
/* FACTOR = PLNSNS(BODID) */
/* IF ( FACTOR .EQ. 0 ) THEN */
/* WRITE (*,*) 'Sorry, we don''t have data available.' */
/* STOP */
/* END IF */
/* Compute the planetocentric longitude */
/* PCLONG = FACTOR * LONG */
/* Now convert the planetographic coordinates with */
/* planetographic longitude replaced by planetocentric */
/* longitude rectangular coordinates. (Note the conversion */
/* to planetocentric longitude is required because GEOREC */
/* assumes that the ordering latitude, longitude, altitude */
/* is a right handed ordering. Replacing planetographic */
/* longitude by planetocentric longitude ensures that we */
/* have a right handed coordinate system.) */
/* CALL GEOREC ( LAT, PCLONG, HEIGHT, EQRAD, F, REC ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 11-MAY-2009 (BVS) */
/* Replaced LDPOOL with FURNSN in the header. Re-ordered header */
/* sections. */
/* - SPICELIB Version 1.0.0, 7-JAN-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Determine the sense of planetographic longitude. */
/* -& */
/* The earth is a special case so we just handle it here. */
if (*bodid == 399) {
ret_val = 1;
return ret_val;
}
/* Create the name of the item to look up in the kernel pool. */
s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(item, "#", bodid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
/* See if this item exists in the kernel pool. */
dtpool_(item, &found, &n, type__, (ftnlen)32, (ftnlen)1);
if (! found || *(unsigned char *)type__ != 'N' || n < 2) {
value = 0;
} else {
gdpool_(item, &c__2, &c__1, &n, &rate, &found, (ftnlen)32);
/* If the rate of change of the prime meridian is negative */
/* the planetocentric and planetographic longitude are the */
/* same... */
if (rate < 0.) {
value = 1;
} else {
/* ...otherwise they have opposite signs. */
value = -1;
}
}
ret_val = value;
return ret_val;
} /* plnsns_ */
void repmi_c ( ConstSpiceChar * in,
ConstSpiceChar * marker,
SpiceInt value,
SpiceInt lenout,
SpiceChar * out )
/*
-Brief_I/O
VARIABLE I/O DESCRIPTION
-------- --- --------------------------------------------------
in I Input string.
marker I Marker to be replaced.
value I Replacement value.
lenout I Available space in output string.
out O Output string.
MAXLI P Maximum length of an integer.
-Detailed_Input
in is an arbitrary character string.
marker is an arbitrary character string. The first occurrence
of marker in the input string is to be replaced by value.
Leading and trailing blanks in marker are NOT significant.
In particular, no substitution is performed if marker
is blank.
value is an arbitrary integer.
lenout is the allowed length of the output string. This length
must large enough to hold the output string plus the
terminator. If the output string is expected to have x
characters, lenout should be at least x + 1.
-Detailed_Output
out is the string obtained by substituting the text
representation of value for the first occurrence
of marker in the input string.
out and in must be identical or disjoint.
-Parameters
MAXLI is the maximum expected length of the text
representation of an integer. 11 characters are
sufficient to hold any integer whose absolute
value is less than 10 billion.
This routine assumes that the input integer
is such that its string representation contains
no more than MAXLI characters.
-Files
None.
-Exceptions
1) The error SPICE(NULLPOINTER) is signaled if any of
the input or output string pointers is null.
2) If the marker string is blank or empty, this routine leaves
the input string unchanged, except that trailing blanks
will be trimmed. This case is not considered an error.
3) If the output string is too short to accommodate a terminating
null character, the error SPICE(STRINGTOOSHORT) is signaled.
4) If out does not have sufficient length to accommodate the
result of the substitution, the result will be truncated on
the right.
-Particulars
This is one of a family of related routines for inserting values
into strings. They are typically to construct messages that
are partly fixed, and partly determined at run time. For example,
a message like
"Fifty-one pictures were found in directory [USER.DATA]."
might be constructed from the fixed string
"#1 pictures were found in directory #2."
by the calls
#include "SpiceUsr.h"
.
.
.
#define LENOUT 81
.
.
.
repmct_c ( string, "#1", 51, 'c', LENOUT, string );
repmc_c ( string, "#2", "[USER.DATA]", LENOUT, string );
which substitute the cardinal text "Fifty-one" and the character
string "[USER.DATA]" for the markers "#1" and "#2" respectively.
The complete list of routines is shown below.
repmc_c ( Replace marker with character string value )
repmd_c ( Replace marker with double precision value )
repmf_c ( Replace marker with formatted d.p. value )
repmi_c ( Replace marker with integer value )
repmct_c ( Replace marker with cardinal text )
repmot_c ( Replace marker with ordinal text )
-Examples
1. Let
in == "Invalid operation value. The value was <opcode>."
Then following the call,
#include "SpiceUsr.h"
.
.
.
#define LENOUT 201
.
.
.
repmi_c ( in, "<opcode>", 5, LENOUT, outstr );
outstr contains the string:
"Invalid operation value. The value was 5."
2. Let
in == "Left endpoint exceeded right endpoint. "
"The left endpoint was: XX. The right "
"endpoint was: XX."
Then following the call,
#include "SpiceUsr.h"
.
.
.
#define LENOUT 201
.
.
.
repmi_c ( in, " XX ", 5, LENOUT, out );
out is
"Left endpoint exceeded right endpoint. The left "
"endpoint was: 5. The right endpoint was: XX."
3. Let
num == 23
chance == "fair"
score == 4.665
Then following the sequence of calls,
#include "SpiceUsr.h"
.
.
.
#define LENOUT 201
.
.
.
repmi_c ( "There are & routines that have a "
"& chance of meeting your needs."
"The maximum score was &.",
"&",
num,
LENOUT,
msg );
repmc_c ( msg, marker, chance, LENOUT, msg );
repmf_c ( msg, marker, score, 4, 'f', LENOUT, msg );
msg is
"There are 23 routines that have a fair chance of "
"meeting your needs. The maximum score was 4.665."
-Restrictions
None.
-Literature_References
None.
-Author_and_Institution
N.J. Bachman (JPL)
I.M. Underwood (JPL)
-Version
-CSPICE Version 1.0.0, 14-AUG-2002 (NJB) (IMU)
-Index_Entries
replace marker with integer
-&
*/
{ /* Begin repmi_c */
/*
Local variables
*/
ConstSpiceChar * markPtr;
/*
Use discovery check-in.
Make sure no string argument pointers are null.
*/
CHKPTR( CHK_DISCOVER, "repmi_c", in );
CHKPTR( CHK_DISCOVER, "repmi_c", marker );
CHKPTR( CHK_DISCOVER, "repmi_c", out );
/*
If the output string can't hold a terminating null character,
we can't proceed.
*/
if ( lenout < 1 )
{
chkin_c ( "repmi_c" );
setmsg_c ( "String length lenout must be >= 1; actual "
"value = #." );
errint_c ( "#", lenout );
sigerr_c ( "SPICE(STRINGTOOSHORT)" );
chkout_c ( "repmi_c" );
return;
}
/*
If the output string has no room for data characters, we simply
terminate the string.
*/
if ( lenout == 1 )
{
out[0] = NULLCHAR;
return;
}
/*
If the input string has zero length, the output is empty as well.
*/
if ( in[0] == NULLCHAR )
{
out[0] = NULLCHAR;
return;
}
/*
If the marker is empty, pass a blank marker to the f2c'd routine.
Otherwise, pass in the marker.
*/
if ( marker[0] == NULLCHAR )
{
markPtr = " ";
}
else
{
markPtr = marker;
}
/*
Simply call the f2c'd routine.
*/
repmi_ ( ( char * ) in,
( char * ) markPtr,
( integer * ) &value,
( char * ) out,
( ftnlen ) strlen(in),
( ftnlen ) strlen(markPtr),
( ftnlen ) lenout-1 );
/*
Convert the output string from Fortran to C style.
*/
F2C_ConvertStr ( lenout, out );
} /* End repmi_c */
/* $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_ */
/* $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_ */
/* $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_ */
/* $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_ */
