/* $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 CKW01 ( C-Kernel, write segment to C-kernel, data type 1 ) */
/* Subroutine */ int ckw01_(integer *handle, doublereal *begtim, doublereal *
endtim, integer *inst, char *ref, logical *avflag, char *segid,
integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *
avvs, ftnlen ref_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Local variables */
integer ndir, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
integer index, value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_(
doublereal *, integer *), dafbna_(integer *, doublereal *, char *,
ftnlen), dafena_(void);
extern logical failed_(void);
integer refcod;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
doublereal dirent;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical vzerog_(doublereal *, integer *), return_(void);
doublereal dcd[2];
integer icd[6];
/* $ Abstract */
/* Add a type 1 segment to a C-kernel. */
/* $ 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 */
/* CK */
/* DAF */
/* SCLK */
/* $ Keywords */
/* POINTING */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an open CK file. */
/* BEGTIM I The beginning encoded SCLK of the segment. */
/* ENDTIM I The ending encoded SCLK of the segment. */
/* INST I The NAIF instrument ID code. */
/* REF I The reference frame of the segment. */
/* AVFLAG I True if the segment will contain angular velocity. */
/* SEGID I Segment identifier. */
/* NREC I Number of pointing records. */
/* SCLKDP I Encoded SCLK times. */
/* QUATS I SPICE quaternions representing instrument pointing. */
/* AVVS I Angular velocity vectors. */
/* $ Detailed_Input */
/* HANDLE is the handle of the CK file to which the segment will */
/* be written. The file must have been opened with write */
/* access. */
/* BEGTIM is the beginning encoded SCLK time of the segment. This */
/* value should be less than or equal to the first time in */
/* the segment. */
/* ENDTIM is the encoded SCLK time at which the segment ends. */
/* This value should be greater than or equal to the last */
/* time in the segment. */
/* INST is the NAIF integer ID code for the instrument. */
/* REF is a character string which specifies the */
/* reference frame of the segment. This should be one of */
/* the frames supported by the SPICELIB routine NAMFRM */
/* which is an entry point of FRAMEX. */
/* AVFLAG is a logical flag which indicates whether or not the */
/* segment will contain angular velocity. */
/* SEGID is the segment identifier. A CK segment identifier may */
/* contain up to 40 characters. */
/* NREC is the number of pointing instances in the segment. */
/* SCLKDP are the encoded spacecraft clock times associated with */
/* each pointing instance. These times must be strictly */
/* increasing. */
/* QUATS is an array of SPICE-style quaternions representing a */
/* sequence of C-matrices. See the discussion of */
/* quaternion styles in Particulars below. */
/* AVVS are the angular velocity vectors ( optional ). */
/* If AVFLAG is FALSE then this array is ignored by the */
/* routine, however it still must be supplied as part of */
/* the calling sequence. */
/* $ Detailed_Output */
/* None. See Files section. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is not the handle of a C-kernel opened for writing */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* 2) If SEGID is more than 40 characters long, the error */
/* SPICE(SEGIDTOOLONG) is signalled. */
/* 3) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signalled. */
/* 4) If the first encoded SCLK time is negative then the error */
/* SPICE(INVALIDSCLKTIME) is signalled. If any subsequent times */
/* are negative the error SPICE(TIMESOUTOFORDER) is signalled. */
/* 5) If the encoded SCLK times are not strictly increasing, */
/* the error SPICE(TIMESOUTOFORDER) is signalled. */
/* 6) If BEGTIM is greater than SCLKDP(1) or ENDTIM is less than */
/* SCLKDP(NREC), the error SPICE(INVALIDDESCRTIME) is */
/* signalled. */
/* 7) If the name of the reference frame is not one of those */
/* supported by the routine NAMFRM, the error */
/* SPICE(INVALIDREFFRAME) is signalled. */
/* 8) If NREC, the number of pointing records, is less than or */
/* equal to 0, the error SPICE(INVALIDNUMRECS) is signalled. */
/* 9) If the squared length of any quaternion differes from 1 */
/* by more than 1.0D-2, the error SPICE(NONUNITQUATERNION) is */
/* signalled. */
/* $ Files */
/* This routine adds a type 1 segment to a C-kernel. The C-kernel */
/* may be either a new one or an existing one opened for writing. */
/* $ Particulars */
/* For a detailed description of a type 1 CK segment please see the */
/* CK Required Reading. */
/* This routine relieves the user from performing the repetitive */
/* calls to the DAF routines necessary to construct a CK segment. */
/* Quaternion Styles */
/* ----------------- */
/* There are different "styles" of quaternions used in */
/* science and engineering applications. Quaternion styles */
/* are characterized by */
/* - The order of quaternion elements */
/* - The quaternion multiplication formula */
/* - The convention for associating quaternions */
/* with rotation matrices */
/* Two of the commonly used styles are */
/* - "SPICE" */
/* > Invented by Sir William Rowan Hamilton */
/* > Frequently used in mathematics and physics textbooks */
/* - "Engineering" */
/* > Widely used in aerospace engineering applications */
/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */
/* Quaternions of any other style must be converted to SPICE */
/* quaternions before they are passed to SPICELIB routines. */
/* Relationship between SPICE and Engineering Quaternions */
/* ------------------------------------------------------ */
/* Let M be a rotation matrix such that for any vector V, */
/* M*V */
/* is the result of rotating V by theta radians in the */
/* counterclockwise direction about unit rotation axis vector A. */
/* Then the SPICE quaternions representing M are */
/* (+/-) ( cos(theta/2), */
/* sin(theta/2) A(1), */
/* sin(theta/2) A(2), */
/* sin(theta/2) A(3) ) */
/* while the engineering quaternions representing M are */
/* (+/-) ( -sin(theta/2) A(1), */
/* -sin(theta/2) A(2), */
/* -sin(theta/2) A(3), */
/* cos(theta/2) ) */
/* For both styles of quaternions, if a quaternion q represents */
/* a rotation matrix M, then -q represents M as well. */
/* Given an engineering quaternion */
/* QENG = ( q0, q1, q2, q3 ) */
/* the equivalent SPICE quaternion is */
/* QSPICE = ( q3, -q0, -q1, -q2 ) */
/* Associating SPICE Quaternions with Rotation Matrices */
/* ---------------------------------------------------- */
/* Let FROM and TO be two right-handed reference frames, for */
/* example, an inertial frame and a spacecraft-fixed frame. Let the */
/* symbols */
/* V , V */
/* FROM TO */
/* denote, respectively, an arbitrary vector expressed relative to */
/* the FROM and TO frames. Let M denote the transformation matrix */
/* that transforms vectors from frame FROM to frame TO; then */
/* V = M * V */
/* TO FROM */
/* where the expression on the right hand side represents left */
/* multiplication of the vector by the matrix. */
/* Then if the unit-length SPICE quaternion q represents M, where */
/* q = (q0, q1, q2, q3) */
/* the elements of M are derived from the elements of q as follows: */
/* +- -+ */
/* | 2 2 | */
/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */
/* | | */
/* | | */
/* | 2 2 | */
/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */
/* | | */
/* | | */
/* | 2 2 | */
/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */
/* | | */
/* +- -+ */
/* Note that substituting the elements of -q for those of q in the */
/* right hand side leaves each element of M unchanged; this shows */
/* that if a quaternion q represents a matrix M, then so does the */
/* quaternion -q. */
/* To map the rotation matrix M to a unit quaternion, we start by */
/* decomposing the rotation matrix as a sum of symmetric */
/* and skew-symmetric parts: */
/* 2 */
/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */
/* symmetric skew-symmetric */
/* OMEGA is a skew-symmetric matrix of the form */
/* +- -+ */
/* | 0 -n3 n2 | */
/* | | */
/* OMEGA = | n3 0 -n1 | */
/* | | */
/* | -n2 n1 0 | */
/* +- -+ */
/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */
/* of M and theta is M's rotation angle. Note that N and theta */
/* are not unique. */
/* Let */
/* C = cos(theta/2) */
/* S = sin(theta/2) */
/* Then the unit quaternions Q corresponding to M are */
/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */
/* The mappings between quaternions and the corresponding rotations */
/* are carried out by the SPICELIB routines */
/* Q2M {quaternion to matrix} */
/* M2Q {matrix to quaternion} */
/* M2Q always returns a quaternion with scalar part greater than */
/* or equal to zero. */
/* SPICE Quaternion Multiplication Formula */
/* --------------------------------------- */
/* Given a SPICE quaternion */
/* Q = ( q0, q1, q2, q3 ) */
/* corresponding to rotation axis A and angle theta as above, we can */
/* represent Q using "scalar + vector" notation as follows: */
/* s = q0 = cos(theta/2) */
/* v = ( q1, q2, q3 ) = sin(theta/2) * A */
/* Q = s + v */
/* Let Q1 and Q2 be SPICE quaternions with respective scalar */
/* and vector parts s1, s2 and v1, v2: */
/* Q1 = s1 + v1 */
/* Q2 = s2 + v2 */
/* We represent the dot product of v1 and v2 by */
/* <v1, v2> */
/* and the cross product of v1 and v2 by */
/* v1 x v2 */
/* Then the SPICE quaternion product is */
/* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */
/* If Q1 and Q2 represent the rotation matrices M1 and M2 */
/* respectively, then the quaternion product */
/* Q1*Q2 */
/* represents the matrix product */
/* M1*M2 */
/* $ Examples */
/* C */
/* C This example writes a type 1 C-kernel segment for the */
/* C Galileo scan platform to a previously opened file attached to */
/* C HANDLE. */
/* C */
/* C Assume arrays of quaternions, angular velocities, and the */
/* C associated SCLK times are produced elsewhere. */
/* C */
/* . */
/* . */
/* . */
/* C */
/* C The subroutine CKW01 needs the following items for the */
/* C segment descriptor: */
/* C */
/* C 1) SCLK limits of the segment. */
/* C 2) Instrument code. */
/* C 3) Reference frame. */
/* C 4) The angular velocity flag. */
/* C */
/* BEGTIM = SCLK ( 1 ) */
/* ENDTIM = SCLK ( NREC ) */
/* INST = -77001 */
/* REF = 'J2000' */
/* AVFLAG = .TRUE. */
/* SEGID = 'GLL SCAN PLT - DATA TYPE 1' */
/* C */
/* C Write the segment. */
/* C */
/* CALL CKW01 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */
/* . SEGID, NREC, SCLKDP, QUATS, AVVS ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.0, 01-JUN-2010 (NJB) */
/* The check for non-unit quaternions has been replaced */
/* with a check for zero-length quaternions. */
/* - SPICELIB Version 2.2.0, 26-FEB-2008 (NJB) */
/* Updated header; added information about SPICE */
/* quaternion conventions. */
/* Minor typo in a long error message was corrected. */
/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */
/* Added check to make sure that all quaternions are unit */
/* length to single precision. */
/* - SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) */
/* The routine was upgraded to support non-inertial reference */
/* frames. */
/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */
/* Removed all references to a specific method of opening the CK */
/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */
/* $ Files, and $ Examples sections of the header. It is assumed */
/* that a person using this routine has some knowledge of the DAF */
/* system and the methods for obtaining file handles. */
/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */
/* If the number of pointing records is not positive an error */
/* is now signalled. */
/* FAILED is checked after the call to DAFBNA. */
/* The variable HLDCLK was removed from the loop where the times */
/* were checked. */
/* - 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, 30-AUG-1991 (JML) (NJB) */
/* -& */
/* $ Index_Entries */
/* write ck type_1 pointing data segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */
/* Removed all references to a specific method of opening the CK */
/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */
/* $ Files, and $ Examples sections of the header. It is assumed */
/* that a person using this routine has some knowledge of the DAF */
/* system and the methods for obtaining file handles. */
/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */
/* If the number of pointing records is not positive an error */
/* is now signalled. */
/* FAILED is checked after the call to DAFBNA. */
/* The variable HLDCLK was removed from the loop where the times */
/* were checked. */
/* - 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, 30-AUG-1991 (JML) (NJB) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* SIDLEN is the maximum number of characters allowed in a CK */
/* segment identifier. */
/* NDC is the size of a packed CK segment descriptor. */
/* ND is the number of double precision components in a CK */
/* segment descriptor. */
/* NI is the number of integer components in a CK segment */
/* descriptor. */
/* DTYPE is the data type of the segment that this routine */
/* operates on. */
/* FPRINT is the integer value of the first printable ASCII */
/* character. */
/* LPRINT is the integer value of the last printable ASCII */
/* character. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKW01", (ftnlen)5);
/* The first thing that we will do is create the segment descriptor. */
/* The structure of the segment descriptor is as follows. */
/* DCD( 1 ) and DCD( 2 ) -- SCLK limits of the segment. */
/* ICD( 1 ) -- Instrument code. */
/* ICD( 2 ) -- Reference frame ID. */
/* ICD( 3 ) -- Data type of the segment. */
/* ICD( 4 ) -- Angular rates flag. */
/* ICD( 5 ) -- Beginning address of segment. */
/* ICD( 6 ) -- Ending address of segment. */
/* Make sure that there is a positive number of pointing records. */
if (*nrec <= 0) {
setmsg_("# is an invalid number of pointing instances for type 1.", (
ftnlen)56);
errint_("#", nrec, (ftnlen)1);
sigerr_("SPICE(INVALIDNUMREC)", (ftnlen)20);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Check that the SCLK bounds on the segment are reasonable. */
if (*begtim > sclkdp[0]) {
setmsg_("The first d.p. component of the descriptor is invalid. DCD("
"1) = # and SCLKDP(1) = # ", (ftnlen)84);
errdp_("#", begtim, (ftnlen)1);
errdp_("#", sclkdp, (ftnlen)1);
sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23);
chkout_("CKW01", (ftnlen)5);
return 0;
}
if (*endtim < sclkdp[*nrec - 1]) {
setmsg_("The second d.p. component of the descriptor is invalid. DCD"
"(2) = # and SCLKDP(NREC) = # ", (ftnlen)88);
errdp_("#", endtim, (ftnlen)1);
errdp_("#", &sclkdp[*nrec - 1], (ftnlen)1);
sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23);
chkout_("CKW01", (ftnlen)5);
return 0;
}
dcd[0] = *begtim;
dcd[1] = *endtim;
/* Get the NAIF integer code for the reference frame. */
namfrm_(ref, &refcod, ref_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Assign values to the integer components of the segment descriptor. */
icd[0] = *inst;
icd[1] = refcod;
icd[2] = 1;
if (*avflag) {
icd[3] = 1;
} else {
icd[3] = 0;
}
/* Now pack the segment descriptor. */
dafps_(&c__2, &c__6, dcd, icd, descr);
/* Check that all the characters in the segid can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
value = *(unsigned char *)&segid[i__ - 1];
if (value < 32 || value > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("CKW01", (ftnlen)5);
return 0;
}
}
/* Also check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Now check that the encoded SCLK times are positive and strictly */
/* increasing. */
/* Check that the first time is nonnegative. */
if (sclkdp[0] < 0.) {
setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37);
errdp_("#", sclkdp, (ftnlen)1);
sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Now check that the times are ordered properly. */
i__1 = *nrec;
for (i__ = 2; i__ <= i__1; ++i__) {
if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) {
setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)"
" = # and SCLKDP(#) = #.", (ftnlen)78);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 1], (ftnlen)1);
i__2 = i__ - 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("CKW01", (ftnlen)5);
return 0;
}
}
/* Make sure that the quaternions are non-zero. This is just */
/* a check for uninitialized data. */
i__1 = *nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
if (vzerog_(&quats[(i__ << 2) - 4], &c__4)) {
setmsg_("The quaternion at index # has magnitude zero.", (ftnlen)
45);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21);
chkout_("CKW01", (ftnlen)5);
return 0;
}
}
/* No more checks, begin writing the segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Now add the quaternions and optionally, the angular velocity */
/* vectors. */
if (*avflag) {
i__1 = *nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&quats[(i__ << 2) - 4], &c__4);
dafada_(&avvs[i__ * 3 - 3], &c__3);
}
} else {
i__1 = *nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&quats[(i__ << 2) - 4], &c__4);
}
}
/* Add the SCLK times. */
dafada_(sclkdp, nrec);
/* The time tag directory. The Ith element is defined to be the */
/* average of the (I*100)th and the (I*100+1)st SCLK time. */
ndir = (*nrec - 1) / 100;
index = 100;
i__1 = ndir;
for (i__ = 1; i__ <= i__1; ++i__) {
dirent = (sclkdp[index - 1] + sclkdp[index]) / 2.;
dafada_(&dirent, &c__1);
index += 100;
}
/* Finally, the number of records. */
d__1 = (doublereal) (*nrec);
dafada_(&d__1, &c__1);
/* End the segment. */
dafena_();
chkout_("CKW01", (ftnlen)5);
return 0;
} /* ckw01_ */
/* $Procedure ZZSPKZP0 ( S/P Kernel, easy position ) */
/* Subroutine */ int zzspkzp0_(integer *targ, doublereal *et, char *ref, char
*abcorr, integer *obs, doublereal *ptarg, doublereal *lt, ftnlen
ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Local variables */
static integer fj2000;
extern /* Subroutine */ int zzrefch0_(integer *, integer *, doublereal *,
doublereal *), zzspkpa0_(integer *, doublereal *, char *,
doublereal *, char *, doublereal *, doublereal *, ftnlen, ftnlen);
static doublereal temp[3], sobs[6];
extern /* Subroutine */ int zzspkgp0_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), zzspksb0_(integer
*, doublereal *, char *, doublereal *, ftnlen);
static integer type__;
static logical xmit;
static integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern logical eqchr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
static logical found;
extern integer ltrim_(char *, ftnlen);
static doublereal xform[9] /* was [3][3] */;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
static doublereal postn[3];
extern logical failed_(void);
static integer center;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_(
integer *, integer *, integer *, integer *, logical *);
static doublereal ltcent;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
static integer reqfrm, typeid;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Return the position of a target body relative to an observing */
/* body, optionally corrected for light time (planetary aberration) */
/* and stellar aberration. */
/* $ 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 */
/* NAIF_IDS */
/* FRAMES */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* $ 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. */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body NAIF ID code. */
/* ET I Observer epoch. */
/* REF I Reference frame of output position vector. */
/* ABCORR I Aberration correction flag. */
/* OBS I Observing body NAIF ID code. */
/* PTARG O Position of target. */
/* LT O One way light time between observer and target. */
/* $ Detailed_Input */
/* TARG is the NAIF ID code for a target body. The target */
/* and observer define a position vector which points */
/* from the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past */
/* J2000 TDB, at which the position of the target body */
/* relative to the observer is to be computed. ET */
/* refers to time at the observer's location. */
/* REF is the name of the reference frame relative to which */
/* the output position vector should be expressed. This */
/* may be any frame supported by the SPICE system, */
/* including built-in frames (documented in the Frames */
/* Required Reading) and frames defined by a loaded */
/* frame kernel (FK). */
/* When REF designates a non-inertial frame, the */
/* orientation of the frame is evaluated at an epoch */
/* dependent on the selected aberration correction. See */
/* the description of the output position vector PTARG */
/* for details. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the position of the target body to account for */
/* one-way light time and stellar aberration. See the */
/* discussion in the Particulars section for */
/* recommendations on how to choose aberration */
/* corrections. */
/* ABCORR may be any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric position of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the position of the target at */
/* the moment it emitted photons arriving */
/* at the observer at ET. */
/* The light time correction uses an */
/* iterative solution of the light time */
/* equation (see Particulars for details). */
/* The solution invoked by the 'LT' option */
/* uses one iteration. */
/* 'LT+S' Correct for one-way light time and */
/* stellar aberration using a Newtonian */
/* formulation. This option modifies the */
/* position obtained with the 'LT' option */
/* to account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The result is the apparent */
/* position of the target---the position */
/* as seen by the observer. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* The 'CN' correction typically does not */
/* substantially improve accuracy because */
/* the errors made by ignoring */
/* relativistic effects may be larger than */
/* the improvement afforded by obtaining */
/* convergence of the light time solution. */
/* The 'CN' correction computation also */
/* requires a significantly greater number */
/* of CPU cycles than does the */
/* one-iteration light time correction. */
/* 'CN+S' Converged Newtonian light time */
/* and stellar aberration corrections. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* position of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XLT+S' "Transmission" case: correct for */
/* one-way light time and stellar */
/* aberration using a Newtonian */
/* formulation This option modifies the */
/* position obtained with the 'XLT' option */
/* to account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The position component of */
/* the computed target position indicates */
/* the direction that photons emitted from */
/* the observer's location must be "aimed" */
/* to hit the target. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* 'XCN+S' "Transmission" case: converged */
/* Newtonian light time and stellar */
/* aberration corrections. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* OBS is the NAIF ID code for the observing body. */
/* $ Detailed_Output */
/* PTARG is a Cartesian 3-vector representing the position of */
/* the target body relative to the specified observer. */
/* PTARG is corrected for the specified aberrations, and */
/* is expressed with respect to the reference frame */
/* specified by REF. The three components of PTARG */
/* represent the x-, y- and z-components of the target's */
/* position. */
/* PTARG points from the observer's location at ET to */
/* the aberration-corrected location of the target. */
/* Note that the sense of this position vector is */
/* independent of the direction of radiation travel */
/* implied by the aberration correction. */
/* Units are always km. */
/* Non-inertial frames are treated as follows: letting */
/* LTCENT be the one-way light time between the observer */
/* and the central body associated with the frame, the */
/* orientation of the frame is evaluated at ET-LTCENT, */
/* ET+LTCENT, or ET depending on whether the requested */
/* aberration correction is, respectively, for received */
/* radiation, transmitted radiation, or is omitted. */
/* LTCENT is computed using the method indicated by */
/* ABCORR. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target position is */
/* corrected for aberrations, then LT is the one-way */
/* light time between the observer and the light time */
/* corrected target location. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If name of target or observer cannot be translated to its */
/* NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */
/* 2) If the reference frame REF is not a recognized reference */
/* frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */
/* 3) If the loaded kernels provide insufficient data to */
/* compute the requested position vector, the deficiency will */
/* be diagnosed by a routine in the call tree of this routine. */
/* 4) If an error occurs while reading an SPK or other kernel file, */
/* the error will be diagnosed by a routine in the call tree */
/* of this routine. */
/* $ Files */
/* This routine computes positions using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. See the routine FURNSH and the SPK */
/* and KERNEL Required Reading for further information on loading */
/* (and unloading) kernels. */
/* If the output position PTARG is to be expressed relative to a */
/* non-inertial frame, or if any of the ephemeris data used to */
/* compute PTARG are expressed relative to a non-inertial frame in */
/* the SPK files providing those data, additional kernels may be */
/* needed to enable the reference frame transformations required to */
/* compute the position. Normally these additional kernels are PCK */
/* files or frame kernels. Any such kernels must already be loaded */
/* at the time this routine is called. */
/* $ Particulars */
/* This routine is part of the user interface to the SPICE ephemeris */
/* system. It allows you to retrieve position information for any */
/* ephemeris object relative to any other in a reference frame that */
/* is convenient for further computations. */
/* Aberration corrections */
/* ====================== */
/* In space science or engineering applications one frequently */
/* wishes to know where to point a remote sensing instrument, such */
/* as an optical camera or radio antenna, in order to observe or */
/* otherwise receive radiation from a target. This pointing problem */
/* is complicated by the finite speed of light: one needs to point */
/* to where the target appears to be as opposed to where it actually */
/* is at the epoch of observation. We use the adjectives */
/* "geometric," "uncorrected," or "true" to refer to an actual */
/* position or state of a target at a specified epoch. When a */
/* geometric position or state vector is modified to reflect how it */
/* appears to an observer, we describe that vector by any of the */
/* terms "apparent," "corrected," "aberration corrected," or "light */
/* time and stellar aberration corrected." The SPICE Toolkit can */
/* correct for two phenomena affecting the apparent location of an */
/* object: one-way light time (also called "planetary aberration") */
/* and stellar aberration. */
/* One-way light time */
/* ------------------ */
/* Correcting for one-way light time is done by computing, given an */
/* observer and observation epoch, where a target was when the */
/* observed photons departed the target's location. The vector from */
/* the observer to this computed target location is called a "light */
/* time corrected" vector. The light time correction depends on the */
/* motion of the target relative to the solar system barycenter, but */
/* it is independent of the velocity of the observer relative to the */
/* solar system barycenter. Relativistic effects such as light */
/* bending and gravitational delay are not accounted for in the */
/* light time correction performed by this routine. */
/* Stellar aberration */
/* ------------------ */
/* The velocity of the observer also affects the apparent location */
/* of a target: photons arriving at the observer are subject to a */
/* "raindrop effect" whereby their velocity relative to the observer */
/* is, using a Newtonian approximation, the photons' velocity */
/* relative to the solar system barycenter minus the velocity of the */
/* observer relative to the solar system barycenter. This effect is */
/* called "stellar aberration." Stellar aberration is independent */
/* of the velocity of the target. The stellar aberration formula */
/* used by this routine does not include (the much smaller) */
/* relativistic effects. */
/* Stellar aberration corrections are applied after light time */
/* corrections: the light time corrected target position vector is */
/* used as an input to the stellar aberration correction. */
/* When light time and stellar aberration corrections are both */
/* applied to a geometric position vector, the resulting position */
/* vector indicates where the target "appears to be" from the */
/* observer's location. */
/* As opposed to computing the apparent position of a target, one */
/* may wish to compute the pointing direction required for */
/* transmission of photons to the target. This also requires */
/* correction of the geometric target position for the effects of */
/* light time and stellar aberration, but in this case the */
/* corrections are computed for radiation traveling *from* the */
/* observer to the target. */
/* The "transmission" light time correction yields the target's */
/* location as it will be when photons emitted from the observer's */
/* location at ET arrive at the target. The transmission stellar */
/* aberration correction is the inverse of the traditional stellar */
/* aberration correction: it indicates the direction in which */
/* radiation should be emitted so that, using a Newtonian */
/* approximation, the sum of the velocity of the radiation relative */
/* to the observer and of the observer's velocity, relative to the */
/* solar system barycenter, yields a velocity vector that points in */
/* the direction of the light time corrected position of the target. */
/* One may object to using the term "observer" in the transmission */
/* case, in which radiation is emitted from the observer's location. */
/* The terminology was retained for consistency with earlier */
/* documentation. */
/* Below, we indicate the aberration corrections to use for some */
/* common applications: */
/* 1) Find the apparent direction of a target for a remote-sensing */
/* observation. */
/* Use 'LT+S': apply both light time and stellar */
/* aberration corrections. */
/* Note that using light time corrections alone ('LT') is */
/* generally not a good way to obtain an approximation to an */
/* apparent target vector: since light time and stellar */
/* aberration corrections often partially cancel each other, */
/* it may be more accurate to use no correction at all than to */
/* use light time alone. */
/* 2) Find the corrected pointing direction to radiate a signal */
/* to a target. This computation is often applicable for */
/* implementing communications sessions. */
/* Use 'XLT+S': apply both light time and stellar */
/* aberration corrections for transmission. */
/* 3) Compute the apparent position of a target body relative */
/* to a star or other distant object. */
/* Use 'LT' or 'LT+S' as needed to match the correction */
/* applied to the position of the distant object. For */
/* example, if a star position is obtained from a catalog, */
/* the position vector may not be corrected for stellar */
/* aberration. In this case, to find the angular */
/* separation of the star and the limb of a planet, the */
/* vector from the observer to the planet should be */
/* corrected for light time but not stellar aberration. */
/* 4) Obtain an uncorrected position vector derived directly from */
/* data in an SPK file. */
/* Use 'NONE'. */
/* 5) Use a geometric position vector as a low-accuracy estimate */
/* of the apparent position for an application where execution */
/* speed is critical. */
/* Use 'NONE'. */
/* 6) While this routine cannot perform the relativistic */
/* aberration corrections required to compute positions */
/* with the highest possible accuracy, it can supply the */
/* geometric positions required as inputs to these */
/* computations. */
/* Use 'NONE', then apply high-accuracy aberration */
/* corrections (not available in the SPICE Toolkit). */
/* Below, we discuss in more detail how the aberration corrections */
/* applied by this routine are computed. */
/* Geometric case */
/* ============== */
/* ZZSPKZP0 begins by computing the geometric position T(ET) of */
/* the target body relative to the solar system barycenter (SSB). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the geometric position of the target body relative to the */
/* observer. The one-way light time, LT, is given by */
/* | T(ET) - O(ET) | */
/* LT = ------------------- */
/* c */
/* The geometric relationship between the observer, target, and */
/* solar system barycenter is as shown: */
/* SSB ---> O(ET) */
/* | / */
/* | / */
/* | / */
/* | / T(ET) - O(ET) */
/* V V */
/* T(ET) */
/* The returned position vector is */
/* T(ET) - O(ET) */
/* Reception case */
/* ============== */
/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is selected */
/* for ABCORR, ZZSPKZP0 computes the position of the target body */
/* at epoch ET-LT, where LT is the one-way light time. Let T(t) */
/* and O(t) represent the positions of the target and observer */
/* relative to the solar system barycenter at time t; then LT is */
/* the solution of the light-time equation */
/* | T(ET-LT) - O(ET) | */
/* LT = ------------------------ (1) */
/* c */
/* The ratio */
/* | T(ET) - O(ET) | */
/* --------------------- (2) */
/* c */
/* is used as a first approximation to LT; inserting (2) into the */
/* right hand side of the light-time equation (1) yields the */
/* "one-iteration" estimate of the one-way light time ("LT"). */
/* Repeating the process until the estimates of LT converge */
/* yields the "converged Newtonian" light time estimate ("CN"). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the position of the target body relative to the observer: */
/* T(ET-LT) - O(ET). */
/* SSB ---> O(ET) */
/* | \ | */
/* | \ | */
/* | \ | T(ET-LT) - O(ET) */
/* | \ | */
/* V V V */
/* T(ET) T(ET-LT) */
/* The light time corrected position vector is */
/* T(ET-LT) - O(ET) */
/* If correction for stellar aberration is requested, the target */
/* position is rotated toward the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as follows: */
/* Let r be the light time corrected vector from the observer */
/* to the object, and v be the velocity of the observer with */
/* respect to the solar system barycenter. Let w be the angle */
/* between them. The aberration angle phi is given by */
/* sin(phi) = v sin(w) / c */
/* Let h be the vector given by the cross product */
/* h = r X v */
/* Rotate r by phi radians about h to obtain the apparent */
/* position of the object. */
/* Transmission case */
/* ================== */
/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' is */
/* selected, ZZSPKZP0 computes the position of the target body T */
/* at epoch ET+LT, where LT is the one-way light time. LT is the */
/* solution of the light-time equation */
/* | T(ET+LT) - O(ET) | */
/* LT = ------------------------ (3) */
/* c */
/* Subtracting the geometric position of the observer, O(ET), */
/* gives the position of the target body relative to the */
/* observer: T(ET-LT) - O(ET). */
/* SSB --> O(ET) */
/* / | * */
/* / | * T(ET+LT) - O(ET) */
/* / |* */
/* / *| */
/* V V V */
/* T(ET+LT) T(ET) */
/* The light-time corrected position vector is */
/* T(ET+LT) - O(ET) */
/* If correction for stellar aberration is requested, the target */
/* position is rotated away from the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as in the reception case, but the sign of the */
/* rotation angle is negated. */
/* Precision of light time corrections */
/* =================================== */
/* Corrections using one iteration of the light time solution */
/* ---------------------------------------------------------- */
/* When the requested aberration correction is 'LT', 'LT+S', */
/* 'XLT', or 'XLT+S', only one iteration is performed in the */
/* algorithm used to compute LT. */
/* The relative error in this computation */
/* | LT_ACTUAL - LT_COMPUTED | / LT_ACTUAL */
/* is at most */
/* (V/C)**2 */
/* ---------- */
/* 1 - (V/C) */
/* which is well approximated by (V/C)**2, where V is the */
/* velocity of the target relative to an inertial frame and C is */
/* the speed of light. */
/* For nearly all objects in the solar system V is less than 60 */
/* km/sec. The value of C is 300000 km/sec. Thus the one */
/* iteration solution for LT has a potential relative error of */
/* not more than 4*10**-8. This is a potential light time error */
/* of approximately 2*10**-5 seconds per astronomical unit of */
/* distance separating the observer and target. Given the bound */
/* on V cited above: */
/* As long as the observer and target are */
/* separated by less than 50 astronomical units, */
/* the error in the light time returned using */
/* the one-iteration light time corrections */
/* is less than 1 millisecond. */
/* Converged corrections */
/* --------------------- */
/* When the requested aberration correction is 'CN', 'CN+S', */
/* 'XCN', or 'XCN+S', three iterations are performed in the */
/* computation of LT. The relative error present in this */
/* solution is at most */
/* (V/C)**4 */
/* ---------- */
/* 1 - (V/C) */
/* which is well approximated by (V/C)**4. Mathematically the */
/* precision of this computation is better than a nanosecond for */
/* any pair of objects in the solar system. */
/* However, to model the actual light time between target and */
/* observer one must take into account effects due to general */
/* relativity. These may be as high as a few hundredths of a */
/* millisecond for some objects. */
/* When one considers the extra time required to compute the */
/* converged Newtonian light time (the state of the target */
/* relative to the solar system barycenter is looked up three */
/* times instead of once) together with the real gain in */
/* accuracy, it seems unlikely that you will want to request */
/* either the "CN" or "CN+S" light time corrections. However, */
/* these corrections can be useful for testing situations where */
/* high precision (as opposed to accuracy) is required. */
/* Relativistic Corrections */
/* ========================= */
/* This routine does not attempt to perform either general or */
/* special relativistic corrections in computing the various */
/* aberration corrections. For many applications relativistic */
/* corrections are not worth the expense of added computation */
/* cycles. If however, your application requires these additional */
/* corrections we suggest you consult the astronomical almanac (page */
/* B36) for a discussion of how to carry out these corrections. */
/* $ Examples */
/* 1) Load a planetary ephemeris SPK, then look up a series of */
/* geometric positions of the moon relative to the earth, */
/* referenced to the J2000 frame. */
/* IMPLICIT NONE */
/* C */
/* C Local constants */
/* C */
/* CHARACTER*(*) FRAME */
/* PARAMETER ( FRAME = 'J2000' ) */
/* CHARACTER*(*) ABCORR */
/* PARAMETER ( ABCORR = 'NONE' ) */
/* C */
/* C The name of the SPK file shown here is fictitious; */
/* C you must supply the name of an SPK file available */
/* C on your own computer system. */
/* C */
/* CHARACTER*(*) SPK */
/* PARAMETER ( SPK = 'planet.bsp' ) */
/* C */
/* C ET0 represents the date 2000 Jan 1 12:00:00 TDB. */
/* C */
/* DOUBLE PRECISION ET0 */
/* PARAMETER ( ET0 = 0.0D0 ) */
/* C */
/* C Use a time step of 1 hour; look up 100 positions. */
/* C */
/* DOUBLE PRECISION STEP */
/* PARAMETER ( STEP = 3600.0D0 ) */
/* INTEGER MAXITR */
/* PARAMETER ( MAXITR = 100 ) */
/* C */
/* C The NAIF IDs of the earth and moon are 399 and 301 */
/* C respectively. */
/* C */
/* INTEGER OBSRVR */
/* PARAMETER ( OBSRVR = 399 ) */
/* INTEGER TARGET */
/* PARAMETER ( TARGET = 301 ) */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION POS ( 3 ) */
/* INTEGER I */
/* C */
/* C Load the SPK file. */
/* C */
/* CALL FURNSH ( SPK ) */
/* C */
/* C Step through a series of epochs, looking up a */
/* C position vector at each one. */
/* C */
/* DO I = 1, MAXITR */
/* ET = ET0 + (I-1)*STEP */
/* CALL ZZSPKZP0 ( TARGET, ET, FRAME, ABCORR, OBSRVR, */
/* . POS, LT ) */
/* WRITE (*,*) 'ET = ', ET */
/* WRITE (*,*) 'J2000 x-position (km): ', POS(1) */
/* WRITE (*,*) 'J2000 y-position (km): ', POS(2) */
/* WRITE (*,*) 'J2000 z-position (km): ', POS(3) */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) SPICE Private routine. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* B.V. Semenov (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */
/* Based on SPICELIB Version 3.1.0, 05-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* using body names get position relative to an observer */
/* get position relative observer corrected for aberrations */
/* read ephemeris data */
/* read trajectory data */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKZP0", (ftnlen)8);
}
/* Get the frame id for J2000 on the first call to this routine. */
if (first) {
first = FALSE_;
namfrm_("J2000", &fj2000, (ftnlen)5);
}
/* Decide whether the aberration correction is for received or */
/* transmitted radiation. */
i__ = ltrim_(abcorr, abcorr_len);
xmit = eqchr_(abcorr + (i__ - 1), "X", (ftnlen)1, (ftnlen)1);
/* If we only want geometric positions, then compute just that. */
/* Otherwise, compute the state of the observer relative to */
/* the SSB. Then feed that position into ZZSPKPA0 to compute the */
/* apparent position of the target body relative to the observer */
/* with the requested aberration corrections. */
if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
zzspkgp0_(targ, et, ref, obs, ptarg, lt, ref_len);
} else {
/* Get the auxiliary information about the requested output */
/* frame. */
namfrm_(ref, &reqfrm, ref_len);
if (reqfrm == 0) {
setmsg_("The requested output frame '#' is not recognized by the"
" reference frame subsystem. Please check that the appro"
"priate kernels have been loaded and that you have correc"
"tly entered the name of the output frame. ", (ftnlen)209);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
frinfo_(&reqfrm, ¢er, &type__, &typeid, &found);
/* If we are dealing with an inertial frame, we can simply */
/* call ZZSPKSB0, ZZSPKPA0 and return. */
if (type__ == 1) {
zzspksb0_(obs, et, ref, sobs, ref_len);
zzspkpa0_(targ, et, ref, sobs, abcorr, ptarg, lt, ref_len,
abcorr_len);
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
/* Still here? */
/* We are dealing with a non-inertial frame. But we need to */
/* do light time and stellar aberration in an inertial frame. */
/* Get the "apparent" position of TARG in the intermediary */
/* inertial reference frame J2000. */
/* We also need the light time to the center of the frame. */
zzspksb0_(obs, et, "J2000", sobs, (ftnlen)5);
zzspkpa0_(targ, et, "J2000", sobs, abcorr, postn, lt, (ftnlen)5,
abcorr_len);
if (failed_()) {
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
if (center == *obs) {
ltcent = 0.;
} else if (center == *targ) {
ltcent = *lt;
} else {
zzspkpa0_(¢er, et, "J2000", sobs, abcorr, temp, <cent, (
ftnlen)5, abcorr_len);
}
/* If something went wrong (like we couldn't get the position of */
/* the center relative to the observer) now it is time to quit. */
if (failed_()) {
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
/* If the aberration corrections are for transmission, negate */
/* the light time, since we wish to compute the orientation */
/* of the non-inertial frame at an epoch later than ET by */
/* the one-way light time. */
if (xmit) {
ltcent = -ltcent;
}
/* Get the rotation from J2000 to the requested frame */
/* and convert the position. */
d__1 = *et - ltcent;
zzrefch0_(&fj2000, &reqfrm, &d__1, xform);
if (failed_()) {
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
}
mxv_(xform, postn, ptarg);
}
chkout_("ZZSPKZP0", (ftnlen)8);
return 0;
} /* zzspkzp0_ */
/* $Procedure CKW05 ( Write CK segment, type 5 ) */
/* Subroutine */ int ckw05_(integer *handle, integer *subtyp, integer *degree,
doublereal *begtim, doublereal *endtim, integer *inst, char *ref,
logical *avflag, char *segid, integer *n, doublereal *sclkdp,
doublereal *packts, doublereal *rate, integer *nints, doublereal *
starts, ftnlen ref_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Local variables */
integer addr__, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *,
integer *);
doublereal dc[2];
extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *,
ftnlen);
integer ic[6];
extern /* Subroutine */ int dafena_(void);
extern logical failed_(void);
integer chrcod, refcod;
extern integer bsrchd_(doublereal *, integer *, doublereal *);
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
integer packsz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
extern logical vzerog_(doublereal *, integer *), return_(void);
integer winsiz;
extern logical odd_(integer *);
/* $ Abstract */
/* Write a type 5 segment to 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. */
/* $ Required_Reading */
/* CK */
/* NAIF_IDS */
/* ROTATION */
/* TIME */
/* $ Keywords */
/* POINTING */
/* FILES */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to CK type 05. */
/* $ 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 */
/* CK */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */
/* -& */
/* CK type 5 subtype codes: */
/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */
/* and quaternion derivatives only, no angular velocity */
/* vector provided. Quaternion elements are listed */
/* first, followed by derivatives. Angular velocity is */
/* derived from the quaternions and quaternion */
/* derivatives. */
/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */
/* only. Angular velocity is derived by differentiating */
/* the interpolating polynomials. */
/* Subtype 2: Hermite interpolation, 14-element packets. */
/* Quaternion and angular angular velocity vector, as */
/* well as derivatives of each, are provided. The */
/* quaternion comes first, then quaternion derivatives, */
/* then angular velocity and its derivatives. */
/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */
/* and angular velocity vector provided. The quaternion */
/* comes first. */
/* Packet sizes associated with the various subtypes: */
/* End of file ck05.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an CK file open for writing. */
/* SUBTYP I CK type 5 subtype code. */
/* DEGREE I Degree of interpolating polynomials. */
/* BEGTIM I Start time of interval covered by segment. */
/* ENDTIM I End time of interval covered by segment. */
/* INST I NAIF code for a s/c instrument or structure. */
/* REF I Reference frame name. */
/* AVFLAG I True if the segment will contain angular velocity. */
/* SEGID I Segment identifier. */
/* N I Number of packets. */
/* SCLKDP I Encoded SCLK times. */
/* PACKTS I Array of packets. */
/* RATE I Nominal SCLK rate in seconds per tick. */
/* NINTS I Number of intervals. */
/* STARTS I Encoded SCLK interval start times. */
/* MAXDEG P Maximum allowed degree of interpolating polynomial. */
/* $ Detailed_Input */
/* HANDLE is the file handle of a CK file that has been */
/* opened for writing. */
/* SUBTYP is an integer code indicating the subtype of the */
/* the segment to be created. */
/* DEGREE is the degree of the polynomials used to */
/* interpolate the quaternions contained in the input */
/* packets. All components of the quaternions are */
/* interpolated by polynomials of fixed degree. */
/* BEGTIM, */
/* ENDTIM are the beginning and ending encoded SCLK times */
/* for which the segment provides pointing */
/* information. BEGTIM must be less than or equal to */
/* ENDTIM, and at least one data packet must have a */
/* time tag T such that */
/* BEGTIM < T < ENDTIM */
/* - - */
/* INST is the NAIF integer code for the instrument or */
/* structure for which a segment is to be created. */
/* REF is the NAIF name for a reference frame relative to */
/* which the pointing information for INST is */
/* specified. */
/* AVFLAG is a logical flag which indicates whether or not */
/* the segment will contain angular velocity. */
/* SEGID is the segment identifier. A CK segment */
/* identifier may contain up to 40 characters. */
/* N is the number of packets in the input packet */
/* array. */
/* SCLKDP are the encoded spacecraft clock times associated */
/* with each pointing instance. These times must be */
/* strictly increasing. */
/* PACKTS contains a time-ordered array of data packets */
/* representing the orientation of INST relative to */
/* the frame REF. Each packet contains a SPICE-style */
/* quaternion and optionally, depending on the */
/* segment subtype, attitude derivative data, from */
/* which a C-matrix and an angular velocity vector */
/* may be derived. */
/* See the discussion of quaternion styles in */
/* Particulars below. */
/* The C-matrix represented by the Ith data packet is */
/* a rotation matrix that transforms the components */
/* of a vector expressed in the base frame specified */
/* by REF to components expressed in the instrument */
/* fixed frame at the time SCLKDP(I). */
/* Thus, if a vector V has components x, y, z in the */
/* base frame, then V has components x', y', z' */
/* in the instrument fixed frame where: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* The attitude derivative information in PACKTS(I) */
/* gives the angular velocity of the instrument fixed */
/* frame at time SCLKDP(I) with respect to the */
/* reference frame specified by REF. */
/* The direction of an angular velocity vector gives */
/* the right-handed axis about which the instrument */
/* fixed reference frame is rotating. The magnitude */
/* of the vector is the magnitude of the */
/* instantaneous velocity of the rotation, in radians */
/* per second. */
/* Packet contents and the corresponding */
/* interpolation methods depend on the segment */
/* subtype, and are as follows: */
/* Subtype 0: Hermite interpolation, 8-element */
/* packets. Quaternion and quaternion */
/* derivatives only, no angular */
/* velocity vector provided. */
/* Quaternion elements are listed */
/* first, followed by derivatives. */
/* Angular velocity is derived from */
/* the quaternions and quaternion */
/* derivatives. */
/* Subtype 1: Lagrange interpolation, 4-element */
/* packets. Quaternion only. Angular */
/* velocity is derived by */
/* differentiating the interpolating */
/* polynomials. */
/* Subtype 2: Hermite interpolation, 14-element */
/* packets. Quaternion and angular */
/* angular velocity vector, as well as */
/* derivatives of each, are provided. */
/* The quaternion comes first, then */
/* quaternion derivatives, then */
/* angular velocity and its */
/* derivatives. */
/* Subtype 3: Lagrange interpolation, 7-element */
/* packets. Quaternion and angular */
/* velocity vector provided. The */
/* quaternion comes first. */
/* Angular velocity is always specified relative to */
/* the base frame. */
/* RATE is the nominal rate of the spacecraft clock */
/* associated with INST. Units are seconds per */
/* tick. RATE is used to scale angular velocity */
/* to radians/second. */
/* NINTS is the number of intervals that the pointing */
/* instances are partitioned into. */
/* STARTS are the start times of each of the interpolation */
/* intervals. These times must be strictly increasing */
/* and must coincide with times for which the segment */
/* contains pointing. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* MAXDEG is the maximum allowed degree of the interpolating */
/* polynomial. If the value of MAXDEG is increased, */
/* the SPICELIB routine CKPFS must be changed */
/* accordingly. In particular, the size of the */
/* record passed to CKRnn and CKEnn must be */
/* increased, and comments describing the record size */
/* must be changed. */
/* $ Exceptions */
/* If any of the following exceptions occur, this routine will return */
/* without creating a new segment. */
/* 1) If HANDLE is not the handle of a C-kernel opened for writing */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* 2) If the last non-blank character of SEGID occurs past index 40, */
/* the error SPICE(SEGIDTOOLONG) is signaled. */
/* 3) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signaled. */
/* 4) If the first encoded SCLK time is negative then the error */
/* SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times */
/* are negative the error will be detected in exception (5). */
/* 5) If the encoded SCLK times are not strictly increasing, */
/* the error SPICE(TIMESOUTOFORDER) is signaled. */
/* 6) If the name of the reference frame is not one of those */
/* supported by the routine FRAMEX, the error */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 7) If the number of packets N is not at least 1, the error */
/* SPICE(TOOFEWPACKETS) will be signaled. */
/* 8) If NINTS, the number of interpolation intervals, is less than */
/* or equal to 0, the error SPICE(INVALIDNUMINTS) is signaled. */
/* 9) If the encoded SCLK interval start times are not strictly */
/* increasing, the error SPICE(TIMESOUTOFORDER) is signaled. */
/* 10) If an interval start time does not coincide with a time for */
/* which there is an actual pointing instance in the segment, */
/* then the error SPICE(INVALIDSTARTTIME) is signaled. */
/* 11) This routine assumes that the rotation between adjacent */
/* quaternions that are stored in the same interval has a */
/* rotation angle of THETA radians, where */
/* 0 < THETA < pi. */
/* _ */
/* The routines that evaluate the data in the segment produced */
/* by this routine cannot distinguish between rotations of THETA */
/* radians, where THETA is in the interval [0, pi), and */
/* rotations of */
/* THETA + 2 * k * pi */
/* radians, where k is any integer. These "large" rotations will */
/* yield invalid results when interpolated. You must ensure that */
/* the data stored in the segment will not be subject to this */
/* sort of ambiguity. */
/* 12) If any quaternion has magnitude zero, the error */
/* SPICE(ZEROQUATERNION) is signaled. */
/* 13) If the interpolation window size implied by DEGREE is not */
/* even, the error SPICE(INVALIDDEGREE) is signaled. The window */
/* size is DEGREE+1 for Lagrange subtypes and is (DEGREE+1)/2 */
/* for Hermite subtypes. */
/* 14) If an unrecognized subtype code is supplied, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 15) If DEGREE is not at least 1 or is greater than MAXDEG, the */
/* error SPICE(INVALIDDEGREE) is signaled. */
/* 16) If the segment descriptor bounds are out of order, the */
/* error SPICE(BADDESCRTIMES) is signaled. */
/* 17) If there is no element of SCLKDP that lies between BEGTIM and */
/* ENDTIM inclusive, the error SPICE(EMPTYSEGMENT) is signaled. */
/* 18) If RATE is zero, the error SPICE(INVALIDVALUE) is signaled. */
/* $ Files */
/* A new type 5 CK segment is written to the CK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes a CK type 5 data segment to the open CK */
/* file according to the format described in the type 5 section of */
/* the CK Required Reading. The CK file must have been opened with */
/* write access. */
/* Quaternion Styles */
/* ----------------- */
/* There are different "styles" of quaternions used in */
/* science and engineering applications. Quaternion styles */
/* are characterized by */
/* - The order of quaternion elements */
/* - The quaternion multiplication formula */
/* - The convention for associating quaternions */
/* with rotation matrices */
/* Two of the commonly used styles are */
/* - "SPICE" */
/* > Invented by Sir William Rowan Hamilton */
/* > Frequently used in mathematics and physics textbooks */
/* - "Engineering" */
/* > Widely used in aerospace engineering applications */
/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */
/* Quaternions of any other style must be converted to SPICE */
/* quaternions before they are passed to SPICELIB routines. */
/* Relationship between SPICE and Engineering Quaternions */
/* ------------------------------------------------------ */
/* Let M be a rotation matrix such that for any vector V, */
/* M*V */
/* is the result of rotating V by theta radians in the */
/* counterclockwise direction about unit rotation axis vector A. */
/* Then the SPICE quaternions representing M are */
/* (+/-) ( cos(theta/2), */
/* sin(theta/2) A(1), */
/* sin(theta/2) A(2), */
/* sin(theta/2) A(3) ) */
/* while the engineering quaternions representing M are */
/* (+/-) ( -sin(theta/2) A(1), */
/* -sin(theta/2) A(2), */
/* -sin(theta/2) A(3), */
/* cos(theta/2) ) */
/* For both styles of quaternions, if a quaternion q represents */
/* a rotation matrix M, then -q represents M as well. */
/* Given an engineering quaternion */
/* QENG = ( q0, q1, q2, q3 ) */
/* the equivalent SPICE quaternion is */
/* QSPICE = ( q3, -q0, -q1, -q2 ) */
/* Associating SPICE Quaternions with Rotation Matrices */
/* ---------------------------------------------------- */
/* Let FROM and TO be two right-handed reference frames, for */
/* example, an inertial frame and a spacecraft-fixed frame. Let the */
/* symbols */
/* V , V */
/* FROM TO */
/* denote, respectively, an arbitrary vector expressed relative to */
/* the FROM and TO frames. Let M denote the transformation matrix */
/* that transforms vectors from frame FROM to frame TO; then */
/* V = M * V */
/* TO FROM */
/* where the expression on the right hand side represents left */
/* multiplication of the vector by the matrix. */
/* Then if the unit-length SPICE quaternion q represents M, where */
/* q = (q0, q1, q2, q3) */
/* the elements of M are derived from the elements of q as follows: */
/* +- -+ */
/* | 2 2 | */
/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */
/* | | */
/* | | */
/* | 2 2 | */
/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */
/* | | */
/* | | */
/* | 2 2 | */
/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */
/* | | */
/* +- -+ */
/* Note that substituting the elements of -q for those of q in the */
/* right hand side leaves each element of M unchanged; this shows */
/* that if a quaternion q represents a matrix M, then so does the */
/* quaternion -q. */
/* To map the rotation matrix M to a unit quaternion, we start by */
/* decomposing the rotation matrix as a sum of symmetric */
/* and skew-symmetric parts: */
/* 2 */
/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */
/* symmetric skew-symmetric */
/* OMEGA is a skew-symmetric matrix of the form */
/* +- -+ */
/* | 0 -n3 n2 | */
/* | | */
/* OMEGA = | n3 0 -n1 | */
/* | | */
/* | -n2 n1 0 | */
/* +- -+ */
/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */
/* of M and theta is M's rotation angle. Note that N and theta */
/* are not unique. */
/* Let */
/* C = cos(theta/2) */
/* S = sin(theta/2) */
/* Then the unit quaternions Q corresponding to M are */
/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */
/* The mappings between quaternions and the corresponding rotations */
/* are carried out by the SPICELIB routines */
/* Q2M {quaternion to matrix} */
/* M2Q {matrix to quaternion} */
/* M2Q always returns a quaternion with scalar part greater than */
/* or equal to zero. */
/* SPICE Quaternion Multiplication Formula */
/* --------------------------------------- */
/* Given a SPICE quaternion */
/* Q = ( q0, q1, q2, q3 ) */
/* corresponding to rotation axis A and angle theta as above, we can */
/* represent Q using "scalar + vector" notation as follows: */
/* s = q0 = cos(theta/2) */
/* v = ( q1, q2, q3 ) = sin(theta/2) * A */
/* Q = s + v */
/* Let Q1 and Q2 be SPICE quaternions with respective scalar */
/* and vector parts s1, s2 and v1, v2: */
/* Q1 = s1 + v1 */
/* Q2 = s2 + v2 */
/* We represent the dot product of v1 and v2 by */
/* <v1, v2> */
/* and the cross product of v1 and v2 by */
/* v1 x v2 */
/* Then the SPICE quaternion product is */
/* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */
/* If Q1 and Q2 represent the rotation matrices M1 and M2 */
/* respectively, then the quaternion product */
/* Q1*Q2 */
/* represents the matrix product */
/* M1*M2 */
/* $ Examples */
/* Suppose that you have data packets and are prepared to produce */
/* a segment of type 5 in a CK file. */
/* The following code fragment could be used to add the new segment */
/* to a previously opened CK file attached to HANDLE. The file must */
/* have been opened with write access. */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_CK_TYPE_5_SEGMENT' */
/* C */
/* C Write the segment. */
/* C */
/* CALL CKW05 ( HANDLE, SUBTYP, DEGREE, BEGTIM, ENDTIM, */
/* . INST, REF, AVFLAG, SEGID, N, */
/* . SCLKDP, PACKTS, RATE, NINTS, STARTS ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */
/* The check for non-unit quaternions has been replaced */
/* with a check for zero-length quaternions. */
/* - SPICELIB Version 1.1.0, 26-FEB-2008 (NJB) */
/* Updated header; added information about SPICE */
/* quaternion conventions. */
/* Minor typo in a long error message was corrected. */
/* - SPICELIB Version 1.0.1, 07-JAN-2005 (NJB) */
/* Description in Detailed_Input header section of */
/* constraints on BEGTIM and ENDTIM was corrected. */
/* - SPICELIB Version 1.0.0, 30-AUG-2002 (NJB) (KRG) (JML) (WLT) */
/* -& */
/* $ Index_Entries */
/* write ck type_5 data segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */
/* The check for non-unit quaternions has been replaced */
/* with a check for zero-length quaternions. */
/* This change was made to accommodate CK generation, */
/* via the non-SPICE utility MEX2KER, for European missions. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Packet structure parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKW05", (ftnlen)5);
}
/* Make sure that the number of packets is positive. */
if (*n < 1) {
setmsg_("At least 1 packet is required for CK type 5. Number of pack"
"ets supplied: #", (ftnlen)75);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that there is a positive number of interpolation */
/* intervals. */
if (*nints <= 0) {
setmsg_("# is an invalid number of interpolation intervals for type "
"5.", (ftnlen)61);
errint_("#", nints, (ftnlen)1);
sigerr_("SPICE(INVALIDNUMINTS)", (ftnlen)21);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
namfrm_(ref, &refcod, ref_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Now check that all the characters in the segment identifier */
/* can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
chrcod = *(unsigned char *)&segid[i__ - 1];
if (chrcod < 32 || chrcod > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Now check that the encoded SCLK times are positive and strictly */
/* increasing. */
/* Check that the first time is nonnegative. */
if (sclkdp[0] < 0.) {
setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37);
errdp_("#", sclkdp, (ftnlen)1);
sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Now check that the times are ordered properly. */
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) {
setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)"
" = # and SCLKDP(#) = #.", (ftnlen)78);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 1], (ftnlen)1);
i__2 = i__ - 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Now check that the interval start times are ordered properly. */
i__1 = *nints;
for (i__ = 2; i__ <= i__1; ++i__) {
if (starts[i__ - 1] <= starts[i__ - 2]) {
setmsg_("The interval start times are not strictly increasing. S"
"TARTS(#) = # and STARTS(#) = #.", (ftnlen)86);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &starts[i__ - 1], (ftnlen)1);
i__2 = i__ - 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &starts[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Now make sure that all of the interval start times coincide with */
/* one of the times associated with the actual pointing. */
i__1 = *nints;
for (i__ = 1; i__ <= i__1; ++i__) {
/* We know the SCLKDP array is ordered, so a binary search is */
/* ok. */
if (bsrchd_(&starts[i__ - 1], n, sclkdp) == 0) {
setmsg_("Interval start time number # is invalid. STARTS(#) = *",
(ftnlen)54);
errint_("#", &i__, (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
errdp_("*", &starts[i__ - 1], (ftnlen)1);
sigerr_("SPICE(INVALIDSTARTTIME)", (ftnlen)23);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Set the window, packet size and angular velocity flag, all of */
/* which are functions of the subtype. */
if (*subtyp == 0) {
winsiz = (*degree + 1) / 2;
packsz = 8;
} else if (*subtyp == 1) {
winsiz = *degree + 1;
packsz = 4;
} else if (*subtyp == 2) {
winsiz = (*degree + 1) / 2;
packsz = 14;
} else if (*subtyp == 3) {
winsiz = *degree + 1;
packsz = 7;
} else {
setmsg_("CK type 5 subtype <#> is not supported.", (ftnlen)39);
errint_("#", subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that the quaternions are non-zero. This is just */
/* a check for uninitialized data. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* We have to address the quaternion explicitly, since the shape */
/* of the packet array is not known at compile time. */
addr__ = packsz * (i__ - 1) + 1;
if (vzerog_(&packts[addr__ - 1], &c__4)) {
setmsg_("The quaternion at index # has magnitude zero.", (ftnlen)
45);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Make sure that the degree of the interpolating polynomials is */
/* in range. */
if (*degree < 1 || *degree > 15) {
setmsg_("The interpolating polynomials have degree #; the valid degr"
"ee range is [1, #]", (ftnlen)77);
errint_("#", degree, (ftnlen)1);
errint_("#", &c__15, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that the window size is even. If not, the input */
/* DEGREE is incompatible with the subtype. */
if (odd_(&winsiz)) {
setmsg_("The interpolating polynomials have degree #; for CK type 5,"
" the degree must be equivalent to 3 mod 4 for Hermite interp"
"olation and odd for for Lagrange interpolation.", (ftnlen)166)
;
errint_("#", degree, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* If we made it this far, we're ready to start writing the segment. */
/* Create the segment descriptor. */
/* Assign values to the integer components of the segment descriptor. */
ic[0] = *inst;
ic[1] = refcod;
ic[2] = 5;
if (*avflag) {
ic[3] = 1;
} else {
ic[3] = 0;
}
dc[0] = *begtim;
dc[1] = *endtim;
/* Make sure the descriptor times are in increasing order. */
if (*endtim < *begtim) {
setmsg_("Descriptor bounds are non-increasing: #:#", (ftnlen)41);
errdp_("#", begtim, (ftnlen)1);
errdp_("#", endtim, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that at least one time tag lies between BEGTIM and */
/* ENDTIM. The first time tag not less than BEGTIM must exist */
/* and must be less than or equal to ENDTIM. */
i__ = lstltd_(begtim, n, sclkdp);
if (i__ == *n) {
setmsg_("All time tags are less than segment start time #.", (ftnlen)
49);
errdp_("#", begtim, (ftnlen)1);
sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
} else if (sclkdp[i__] > *endtim) {
setmsg_("No time tags lie between the segment start time # and segme"
"nt end time #", (ftnlen)72);
errdp_("#", begtim, (ftnlen)1);
errdp_("#", endtim, (ftnlen)1);
sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* The clock rate must be non-zero. */
if (*rate == 0.) {
setmsg_("The SCLK rate RATE was zero.", (ftnlen)28);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Now pack the segment descriptor. */
dafps_(&c__2, &c__6, dc, ic, descr);
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* The type 5 segment structure is eloquently described by this */
/* diagram from the CK Required Reading: */
/* +-----------------------+ */
/* | Packet 1 | */
/* +-----------------------+ */
/* | Packet 2 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Packet N | */
/* +-----------------------+ */
/* | Epoch 1 | */
/* +-----------------------+ */
/* | Epoch 2 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Epoch N | */
/* +----------------------------+ */
/* | Epoch 100 | (First directory) */
/* +----------------------------+ */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Epoch ((N-1)/100)*100 | (Last directory) */
/* +----------------------------+ */
/* | Start time 1 | */
/* +----------------------------+ */
/* | Start time 2 | */
/* +----------------------------+ */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Start time M | */
/* +----------------------------+ */
/* | Start time 100 | (First interval start */
/* +----------------------------+ time directory) */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Start time ((M-1)/100)*100 | (Last interval start */
/* +----------------------------+ time directory) */
/* | Seconds per tick | */
/* +----------------------------+ */
/* | Subtype code | */
/* +----------------------------+ */
/* | Window size | */
/* +----------------------------+ */
/* | Number of interp intervals | */
/* +----------------------------+ */
/* | Number of packets | */
/* +----------------------------+ */
i__1 = *n * packsz;
dafada_(packts, &i__1);
dafada_(sclkdp, n);
i__1 = (*n - 1) / 100;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&sclkdp[i__ * 100 - 1], &c__1);
}
/* Now add the interval start times. */
dafada_(starts, nints);
/* And the directory of interval start times. The directory of */
/* start times will simply be every (DIRSIZ)th start time. */
i__1 = (*nints - 1) / 100;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&starts[i__ * 100 - 1], &c__1);
}
/* Add the SCLK rate, segment subtype, window size, interval */
/* count, and packet count. */
dafada_(rate, &c__1);
d__1 = (doublereal) (*subtyp);
dafada_(&d__1, &c__1);
d__1 = (doublereal) winsiz;
dafada_(&d__1, &c__1);
d__1 = (doublereal) (*nints);
dafada_(&d__1, &c__1);
d__1 = (doublereal) (*n);
dafada_(&d__1, &c__1);
/* As long as nothing went wrong, end the segment. */
if (! failed_()) {
dafena_();
}
chkout_("CKW05", (ftnlen)5);
return 0;
} /* ckw05_ */
/* $Procedure ZZSPKGO0 ( S/P Kernel, geometric state ) */
/* Subroutine */ int zzspkgo0_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *state, doublereal *lt, ftnlen ref_len)
{
/* 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 zzfrmch0_(integer *, integer *, doublereal *,
doublereal *);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *);
integer i__;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *), 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;
extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern doublereal clight_(void);
integer tframe[20];
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), prefix_(char *, integer *, char *, ftnlen, ftnlen),
irfnum_(char *, integer *, 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);
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
doublereal stxfrm[36] /* was [6][6] */;
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ 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. */
/* Compute the geometric state (position and velocity) 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) */
/* -& */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* STATE O State 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 state */
/* 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 ZZFRMCH0. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* STATE contains the position and velocity of the target */
/* body, relative to the observing body, corrected */
/* for the specified aberrations, at epoch ET. STATE */
/* has six elements: the first three contain the */
/* target's position; the last three contain the target's */
/* velocity. These vectors are rotated into the */
/* specified reference frame. Units are always */
/* km and km/sec. */
/* LT is the one-way light time in seconds 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 states, the error SPICE(SPKINSUFFDATA) is */
/* signaled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* ZZSPKGO0 computes the geometric state, T(t), of the target */
/* body and the geometric state, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric state 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 state of -94 relative to 4 and T(t) is the */
/* state 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 state of 399 relative */
/* to 0 and T(t) would be the state of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the states of the target body and observer */
/* relative to a common center. ZZSPKGO0 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). */
/* ZZSPKGO0 is similar to SPKEZ but returns geometric states */
/* only, with no option to make planetary (light-time) nor */
/* stellar aberration corrections. The geometric states */
/* returned by SPKEZ and ZZSPKGO0 are the same. */
/* $ Examples */
/* The following code example computes the geometric */
/* state 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 HANDLE */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION STATE ( 6 ) */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL SPKLEF ( 'SAMPLE.BSP', HANDLE ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the state, 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 ZZSPKGO0 ( MOON, ET, 'J2000', EARTH, STATE, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( STATE ) */
/* END DO */
/* $ Restrictions */
/* 1) SPICE Private routine. */
/* 2) The ephemeris files to be used by ZZSPKGO0 must be loaded */
/* by SPKLEF before ZZSPKGO0 is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.E. McLean (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADDG calls. */
/* - SPICELIB Version 1.0.0, 05-JAN-2005 (NJB) */
/* Based on SPICELIB Version 2.3.0, 05-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* geometric state of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 06-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADDG 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 state 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 state 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 state of TARG relative to C and the state of OBS relative */
/* to C, then subtract the two states. */
/* 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. */
/* Local variables */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKGO0", (ftnlen)8);
}
/* 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__6, state);
chkout_("ZZSPKGO0", (ftnlen)8);
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 state of the target body relative */
/* to CTARG(I). The id-code of the frame of this state is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and states of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and state 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 state 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 state */
/* 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 states 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 state, */
/* 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 state of the target */
/* relative to the observer by subtracting the state of */
/* the observing body relative to the common node from */
/* the state of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since Inertial frames are the most extensively used frames */
/* we use the more restrictive routine IRFNUM to attempt to */
/* look up the id-code for REF. If IRFNUM comes up empty handed */
/* we then call the more general routine NAMFRM. */
irfnum_(ref, &refid, ref_len);
if (refid == 0) {
namfrm_(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 ZZSPKGO0; 2. an uninitialized variable. ", (
ftnlen)215);
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_("ZZSPKGO0", (ftnlen)8);
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 state of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"zzspkgo0_", (ftnlen)532)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)535)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "zzspkgo0_", (ftnlen)537)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "zzspkgo0_", (ftnlen)537)] != 0) {
/* Find a file and segment that has state */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "zzspkgo0_", (ftnlen)546)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the state of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the state is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen)
556)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)556)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "zzspkgo0_", (ftnlen)556)]);
/* Here's what we have. STARG is the state 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_("ZZSPKGO0", (ftnlen)8);
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 states 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 state */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the state of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The state is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the state of TARG relative to */
/* the old center to get the state of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__6, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
mxv_(rot, &starg[117], &vtemp[3]);
} else {
zzfrmch0_(&tframe[19], &tmpfrm, et, stxfrm);
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
mxvg_(stxfrm, &starg[114], &c__6, &c__6, vtemp);
}
vaddg_(vtemp, stemp, &c__6, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...6,K) state of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...6,1) = ( 0, 0, 0, 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, "zzspkgo0_", (ftnlen)692)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "zzspkgo0_", (ftnlen)694)];
} 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 */
/* states array, just a single center and state */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and state */
/* (SOBS-state 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 state */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the state 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 state of OBS relative to */
/* the old COBS to get the state of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the state of the observer, we */
/* don't have to add anything, the state of the observer */
/* is already in SOBS. We only have to add when the */
/* number of legs in the observer state is one or greater. */
if (legs > 0) {
vaddg_(sobs, stemp, &c__6, vtemp);
moved_(vtemp, &c__6, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
mxv_(rot, &sobs[3], &vtemp[3]);
vaddg_(vtemp, stemp, &c__6, sobs);
cframe = tmpfrm;
} else {
zzfrmch0_(&cframe, &tmpfrm, et, stxfrm);
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
mxvg_(stxfrm, sobs, &c__6, &c__6, vtemp);
vaddg_(vtemp, stemp, &c__6, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
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 "
"state of TARG relative to OBS at the ephemeris epoch #. ", (
ftnlen)115);
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_("ZZSPKGO0", (ftnlen)8);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The STATE of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . */
/* S | . E */
/* T | . T */
/* A | . A */
/* R | . T */
/* G | . S */
/* | . */
/* | . */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | STATE | */
/* LT = --------- */
/* c */
/* Compute the state 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, "zzspkgo0_", (ftnlen)890)] == tframe[(i__3 = i__) <
20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "zzspkgo0_", (
ftnlen)890)]) {
vaddg_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)892)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "zzspkgo0_", (ftnlen)892)], &c__6,
vtemp);
moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (
ftnlen)893)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "zzspkgo0_", (ftnlen)895)] > 0 && tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3,
"zzspkgo0_", (ftnlen)895)] <= 21 && tframe[(i__2 = i__ - 1) <
20 && 0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "zzspkgo0_", (
ftnlen)895)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2
? i__2 : s_rnge("tframe", i__2, "zzspkgo0_", (ftnlen)895)] <=
21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "zzspkgo0_", (ftnlen)897)], &
tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "zzspkgo0_", (ftnlen)897)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)898)], stemp);
mxv_(rot, &starg[(i__2 = i__ * 6 - 3) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)899)], &stemp[
3]);
vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <=
i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)
900)], &c__6, vtemp);
moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (
ftnlen)901)]);
} else {
zzfrmch0_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "zzspkgo0_", (ftnlen)905)], &
tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "zzspkgo0_", (ftnlen)905)], et, stxfrm);
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
mxvg_(stxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)912)], &
c__6, &c__6, stemp);
vaddg_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <=
i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (ftnlen)
913)], &c__6, vtemp);
moved_(vtemp, &c__6, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "zzspkgo0_", (
ftnlen)914)]);
}
}
/* 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, "zzspkgo0_", (ftnlen)927)] == cframe) {
vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)929)], sobs, &c__6,
state);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "zzspkgo0_", (ftnlen)931)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the state of */
/* the observer to that frame and then subtract the state */
/* of the observer from the state of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
mxv_(rot, &sobs[3], &stemp[3]);
} else {
zzfrmch0_(&cframe, &refid, et, stxfrm);
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
mxvg_(stxfrm, sobs, &c__6, &c__6, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsubg_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)963)], stemp, &
c__6, state);
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen)
966)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen)966)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* ZZFRMCH0 to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "zzspkgo0_", (ftnlen)972)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)973)], stemp);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 3) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)974)], &stemp[3]);
vsubg_(stemp, sobs, &c__6, state);
} else {
/* Use the more general routine ZZFRMCH0 to make the */
/* transformation. */
zzfrmch0_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "zzspkgo0_", (ftnlen)982)], &cframe,
et, stxfrm);
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
mxvg_(stxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1
: s_rnge("starg", i__1, "zzspkgo0_", (ftnlen)989)], &c__6, &
c__6, stemp);
vsubg_(stemp, sobs, &c__6, state);
}
/* 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, state, stemp);
mxv_(rot, &state[3], &stemp[3]);
moved_(stemp, &c__6, state);
} else {
zzfrmch0_(&cframe, &refid, et, stxfrm);
if (failed_()) {
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
}
mxvg_(stxfrm, state, &c__6, &c__6, stemp);
moved_(stemp, &c__6, state);
}
*lt = vnorm_(state) / clight_();
chkout_("ZZSPKGO0", (ftnlen)8);
return 0;
} /* zzspkgo0_ */
/* $Procedure ZZDYNFID ( Fetch frame ID kernel variable ) */
/* Subroutine */ int zzdynfid_(char *frname, integer *frcode, char *item,
integer *idcode, ftnlen frname_len, ftnlen item_len)
{
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern logical beint_(char *, ftnlen);
extern /* Subroutine */ int 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 logical failed_(void);
integer codeln, nameln;
char kvname[32], cdestr[32];
integer itemln, reqnam;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
char outnam[32];
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), namfrm_(char *, integer *, ftnlen),
prsint_(char *, integer *, 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 frame name or frame ID code. The returned value is */
/* always an ID code. The kernel variable name can refer to */
/* the frame being defined by either name or ID code. */
/* If the kernel variable is not present, or if the variable */
/* is not a frame 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 */
/* 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 Output kernel variable. */
/* $ Detailed_Input */
/* FRNAME is the name of the reference frame with which */
/* the requested variable is associated. This frame */
/* may be thought of as the frame associated with */
/* "left hand side" of the kernel variable */
/* assignment. */
/* FRCODE is the frame ID code of the reference frame with */
/* which the requested variable is associated. This */
/* is the ID code corresponding to FRNAME. */
/* 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 reference frame ID code */
/* - a string representation of an integer, */
/* for example '5' */
/* - a reference frame name */
/* $ Detailed_Output */
/* IDCODE is the frame ID code associated with the value of */
/* the requested kernel variable. This frame may be */
/* regarded as being associated with the "right hand */
/* side." of the kernel variable assignment. 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 frame 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 */
/* frame 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 */
/* None. */
/* $ 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, */
/* the excessively long name will not be searched for. A search */
/* will still be done using the alternative form of the name if */
/* that form has length less than or equal to KVNMLN. */
/* 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 one */
/* 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 */
/* frame ID code or an integer, the error SPICE(NOTRANSLATION) */
/* is 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 */
/* data structure, 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 */
/* frames associated with velocity vectors or constant vectors */
/* 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 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* 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_("ZZDYNFID", (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_("ZZDYNFID", (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_("ZZDYNFID", (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 parameterized dynamic frame #. Usually this typ"
"e of problem is due to a missing keyword assignment in a"
" frame kernel. Another, less likely, possibility is tha"
"t other errors in a frame kernel have confused the frame"
" subsystem into wrongly deciding these variables are nee"
"ded.", (ftnlen)563);
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_("ZZDYNFID", (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 parameterized dynamic frame #. Usually this typ"
"e of problem is due to a missing keyword assignment in a"
" frame kernel. Another, less likely, possibility is tha"
"t other errors in a frame kernel have confused the frame"
" subsystem into wrongly deciding these variables are nee"
"ded.", (ftnlen)563);
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_("ZZDYNFID", (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 parameterized dynamic frame #. Usually this ty"
"pe of problem is due to a missing keyword assignment in "
"a frame kernel. Another, less likely, possibility is th"
"at other errors in a frame kernel have confused the fram"
"e subsystem into wrongly deciding these variables are ne"
"eded.", (ftnlen)452);
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_("ZZDYNFID", (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_("ZZDYNFID", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gcpool_(kvname, &c__1, &c__1, &n, outnam, &found, (ftnlen)32, (ftnlen)
32);
if (! found) {
setmsg_("The kernel variable # has used to define frame # was no"
"t found after DTPOOL indicated it was present in pool.", (
ftnlen)109);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNFID", (ftnlen)8);
return 0;
}
/* Convert the output frame name to a frame code. */
namfrm_(outnam, idcode, (ftnlen)32);
if (*idcode == 0) {
/* If IDCODE is zero, that means NAMFRM couldn't translate */
/* the name. Perhaps the name is an integer? */
if (beint_(outnam, (ftnlen)32)) {
prsint_(outnam, idcode, (ftnlen)32);
} else {
/* We're outta aces. */
setmsg_("The kernel variable # used to define frame # is ass"
"igned the character value #. This value was expecte"
"d to be a reference frame name, but NAMFRM cannot tr"
"anslate this name to a frame ID code.", (ftnlen)192);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
errch_("#", outnam, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20);
chkout_("ZZDYNFID", (ftnlen)8);
return 0;
}
}
/* IDCODE has been assigned a value at this point. */
} 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_("ZZDYNFID", (ftnlen)8);
return 0;
}
/* Look up the kernel variable. */
gipool_(kvname, &c__1, &c__1, &n, idcode, &found, (ftnlen)32);
if (! found) {
setmsg_("The kernel variable # has used to define frame # was no"
"t found after DTPOOL indicated it was present in pool.", (
ftnlen)109);
errch_("#", kvname, (ftnlen)1, (ftnlen)32);
errch_("#", frname, (ftnlen)1, frname_len);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDYNFID", (ftnlen)8);
return 0;
}
}
chkout_("ZZDYNFID", (ftnlen)8);
return 0;
} /* zzdynfid_ */
/* $Procedure SPKW21 ( Write SPK segment, type 21 ) */
/* Subroutine */ int spkw21_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
integer *n, integer *dlsize, doublereal *dlines, doublereal *epochs,
ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer dlines_dim1, dlines_offset, i__1, i__2, i__3;
doublereal d__1;
/* Local variables */
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *,
integer *), dafbna_(integer *, doublereal *, char *, ftnlen),
dafena_(void);
extern logical failed_(void);
integer chrcod, refcod, maxdim;
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen);
doublereal prvepc;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
integer maxdsz;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen), spkpds_(
integer *, integer *, char *, integer *, doublereal *, doublereal
*, doublereal *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Write a type 21 segment to an SPK 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 */
/* NAIF_IDS */
/* SPK */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* FILES */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 21. */
/* $ 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 */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 25-DEC-2013 (NJB) */
/* -& */
/* MAXTRM is the maximum number of terms allowed in each */
/* component of the difference table contained in a type */
/* 21 SPK difference line. MAXTRM replaces the fixed */
/* table parameter value of 15 used in SPK type 1 */
/* segments. */
/* Type 21 segments have variable size. Let MAXDIM be */
/* the dimension of each component of the difference */
/* table within each difference line. Then the size */
/* DLSIZE of the difference line is */
/* ( 4 * MAXDIM ) + 11 */
/* MAXTRM is the largest allowed value of MAXDIM. */
/* End of include file spk21.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I NAIF code for an ephemeris object. */
/* CENTER I NAIF code for center of motion of BODY. */
/* FRAME I Reference frame name. */
/* FIRST I Start time of interval covered by segment. */
/* LAST I End time of interval covered by segment. */
/* SEGID I Segment identifier. */
/* N I Number of difference lines in segment. */
/* DLSIZE I Difference line size. */
/* DLINES I Array of difference lines. */
/* EPOCHS I Coverage end times of difference lines. */
/* MAXTRM P Maximum number of terms per difference table */
/* component. */
/* $ Detailed_Input */
/* HANDLE is the file handle of an SPK file that has been */
/* opened for writing. */
/* BODY is the NAIF integer code for an ephemeris object */
/* whose state relative to another body is described */
/* by the segment to be created. */
/* CENTER is the NAIF integer code for the center of motion */
/* of the object identified by BODY. */
/* FRAME is the NAIF name for a reference frame relative to */
/* which the state information for BODY is specified. */
/* FIRST, */
/* LAST are, respectively, the start and stop times of */
/* the time interval over which the segment defines */
/* the state of BODY. */
/* SEGID is the segment identifier. An SPK segment */
/* identifier may contain up to 40 characters. */
/* N is the number of difference lines in the input */
/* difference line array. */
/* DLSIZE is the size of each difference line data structure */
/* in the difference line array input DLINES. Let */
/* MAXDIM be the dimension of each component of the */
/* difference table within each difference line. Then */
/* the size DLSIZE of the difference line is */
/* ( 4 * MAXDIM ) + 11 */
/* DLINES contains a time-ordered array of difference lines. */
/* The Ith difference line occupies elements (1,I) */
/* through (MAXDIM,I) of DLINES, where MAXDIM is */
/* as described above in the description of DLSIZE. */
/* Each difference line represents the state (x, y, */
/* z, dx/dt, dy/dt, dz/dt, in kilometers and */
/* kilometers per second) of BODY relative to CENTER, */
/* specified relative to FRAME, for an interval of */
/* time. The time interval covered by the Ith */
/* difference line ends at the Ith element of the */
/* array EPOCHS (described below). The interval */
/* covered by the first difference line starts at the */
/* segment start time. */
/* The contents of a difference line are as shown */
/* below: */
/* Dimension Description */
/* --------- ---------------------------------- */
/* 1 Reference epoch of difference line */
/* MAXDIM Stepsize function vector */
/* 1 Reference position vector, x */
/* 1 Reference velocity vector, x */
/* 1 Reference position vector, y */
/* 1 Reference velocity vector, y */
/* 1 Reference position vector, z */
/* 1 Reference velocity vector, z */
/* MAXDIM,3 Modified divided difference */
/* arrays (MDAs) */
/* 1 Maximum integration order plus 1 */
/* 3 Integration order array */
/* The reference position and velocity are those of */
/* BODY relative to CENTER at the reference epoch. */
/* (A difference line is essentially a polynomial */
/* expansion of acceleration about the reference */
/* epoch.) */
/* EPOCHS is an array of epochs corresponding to the members */
/* of the difference line array. The epochs are */
/* specified as seconds past J2000 TDB. */
/* The first difference line covers the time interval */
/* from the segment start time to EPOCHS(1). For */
/* I > 1, the Ith difference line covers the half-open */
/* time interval from, but not including, EPOCHS(I-1) */
/* through EPOCHS(I). */
/* The elements of EPOCHS must be strictly increasing. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* MAXTRM is the maximum number of terms allowed in */
/* each component of the difference table */
/* contained in the input argument RECORD. */
/* See the INCLUDE file spk21.inc for the value */
/* of MAXTRM. */
/* $ Exceptions */
/* If any of the following exceptions occur, this routine will return */
/* without creating a new segment. */
/* 1) If FRAME is not a recognized name, the error */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 2) If the last non-blank character of SEGID occurs past index 40, */
/* the error SPICE(SEGIDTOOLONG) is signaled. */
/* 3) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signaled. */
/* 4) If the number of difference lines N is not at least one, */
/* the error SPICE(INVALIDCOUNT) will be signaled. */
/* 5) If FIRST is greater than LAST then the error */
/* SPICE(BADDESCRTIMES) will be signaled. */
/* 6) If the elements of the array EPOCHS are not in strictly */
/* increasing order, the error SPICE(TIMESOUTOFORDER) will be */
/* signaled. */
/* 7) If the last epoch EPOCHS(N) is less than LAST, the error */
/* SPICE(COVERAGEGAP) will be signaled. */
/* 8) If DLSIZE is greater than the limit */
/* ( 4 * MAXTRM ) + 11 */
/* the error SPICE(DIFFLINETOOLARGE) will be signaled. If */
/* DLSIZE is less than 71, the error SPICE(DIFFLINETOOSMALL) */
/* will be signaled. */
/* 9) If any value in the step size array of any difference */
/* line is zero, the error SPICE(ZEROSTEP) will be signaled. */
/* $ Files */
/* A new type 21 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 21 data segment to the open SPK */
/* file according to the format described in the type 21 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* $ Examples */
/* Suppose that you have difference lines and are prepared to */
/* produce a segment of type 21 in an SPK file. */
/* The following code fragment could be used to add the new segment */
/* to a previously opened SPK file attached to HANDLE. The file must */
/* have been opened with write access. */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_SPK_TYPE_21_SEGMENT' */
/* C */
/* C Write the segment. */
/* C */
/* CALL SPKW21 ( HANDLE, BODY, CENTER, FRAME, */
/* . FIRST, LAST, SEGID, N, */
/* . DLSIZE, DLINES, EPOCHS ) */
/* $ Restrictions */
/* 1) The validity of the difference lines is not checked by */
/* this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-FEB-2014 (NJB) */
/* -& */
/* $ Index_Entries */
/* write spk type_21 ephemeris data segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* MINDSZ is the minimum MDA size; this is the size */
/* of type 1 MDAs. */
/* Local variables */
/* Local variables */
/* Standard SPICE error handling. */
/* Parameter adjustments */
dlines_dim1 = *dlsize;
dlines_offset = dlines_dim1 + 1;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("SPKW21", (ftnlen)6);
/* Make sure the difference line size is within limits. */
maxdsz = 111;
if (*dlsize > maxdsz) {
setmsg_("The input difference line size is #, while the maximum supp"
"orted by this routine is #. It is possible that this problem"
" is due to your SPICE Toolkit being out of date.", (ftnlen)
167);
errint_("#", dlsize, (ftnlen)1);
errint_("#", &maxdsz, (ftnlen)1);
sigerr_("SPICE(DIFFLINETOOLARGE)", (ftnlen)23);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
if (*dlsize < 71) {
setmsg_("The input difference line size is #, while the minimum supp"
"orted by this routine is #. It is possible that this problem"
" is due to your SPICE Toolkit being out of date.", (ftnlen)
167);
errint_("#", dlsize, (ftnlen)1);
errint_("#", &c__71, (ftnlen)1);
sigerr_("SPICE(DIFFLINETOOSMALL)", (ftnlen)23);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
namfrm_(frame, &refcod, frame_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", frame, (ftnlen)1, frame_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Now check that all the characters in the segment identifier */
/* can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
chrcod = *(unsigned char *)&segid[i__ - 1];
if (chrcod < 32 || chrcod > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
}
/* The difference line count must be at least one. */
if (*n < 1) {
setmsg_("The difference line count was #; the count must be at least"
" one.", (ftnlen)64);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* The segment stop time should be greater than or equal to */
/* the begin time. */
if (*first > *last) {
setmsg_("The segment start time: # is greater than the segment end t"
"ime: #", (ftnlen)65);
errdp_("#", first, (ftnlen)1);
errdp_("#", last, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Make sure the epochs form a strictly increasing sequence. */
prvepc = epochs[0];
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
if (epochs[i__ - 1] <= prvepc) {
setmsg_("EPOCH # having index # is not greater than its predeces"
"sor #.", (ftnlen)61);
errdp_("#", &epochs[i__ - 1], (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &epochs[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
prvepc = epochs[i__ - 1];
}
/* Make sure there's no gap between the last difference line */
/* epoch and the end of the time interval defined by the segment */
/* descriptor. */
if (epochs[*n - 1] < *last) {
setmsg_("Segment has coverage gap: segment end time # follows last e"
"poch #.", (ftnlen)66);
errdp_("#", last, (ftnlen)1);
errdp_("#", &epochs[*n - 1], (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Check the step size vectors in the difference lines. */
maxdim = (*dlsize - 11) / 4;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = maxdim + 1;
for (j = 2; j <= i__2; ++j) {
if (dlines[j + i__ * dlines_dim1 - dlines_offset] == 0.) {
setmsg_("Step size was zero at step size vector index # with"
"in difference line #.", (ftnlen)72);
i__3 = j - 1;
errint_("#", &i__3, (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROSTEP)", (ftnlen)15);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
}
}
/* If we made it this far, we're ready to start writing the segment. */
/* Create the segment descriptor. */
spkpds_(body, center, frame, &c__21, first, last, descr, frame_len);
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* The type 21 segment structure is shown below: */
/* +-----------------------+ */
/* | Difference line 1 | */
/* +-----------------------+ */
/* | Difference line 2 | */
/* +-----------------------+ */
/* ... */
/* +-----------------------+ */
/* | Difference line N | */
/* +-----------------------+ */
/* | Epoch 1 | */
/* +-----------------------+ */
/* | Epoch 2 | */
/* +-----------------------+ */
/* ... */
/* +-----------------------+ */
/* | Epoch N | */
/* +-----------------------+ */
/* | Epoch 100 | (First directory) */
/* +-----------------------+ */
/* ... */
/* +-----------------------+ */
/* | Epoch (N/100)*100 | (Last directory) */
/* +-----------------------+ */
/* | Max diff table size | */
/* +-----------------------+ */
/* | Number of diff lines | */
/* +-----------------------+ */
i__1 = *n * *dlsize;
dafada_(dlines, &i__1);
dafada_(epochs, n);
i__1 = *n / 100;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&epochs[i__ * 100 - 1], &c__1);
}
d__1 = (doublereal) maxdim;
dafada_(&d__1, &c__1);
d__1 = (doublereal) (*n);
dafada_(&d__1, &c__1);
/* As long as nothing went wrong, end the segment. */
if (! failed_()) {
dafena_();
}
chkout_("SPKW21", (ftnlen)6);
return 0;
} /* spkw21_ */
/* $Procedure CKGP ( C-kernel, get pointing ) */
/* Subroutine */ int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol,
char *ref, doublereal *cmat, doublereal *clkout, logical *found,
ftnlen ref_len)
{
logical pfnd, sfnd;
integer sclk;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer type1, type2;
char segid[40];
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), ckbss_(integer *, doublereal *,
doublereal *, logical *), ckpfs_(integer *, doublereal *,
doublereal *, doublereal *, logical *, doublereal *, doublereal *,
doublereal *, logical *), moved_(doublereal *, integer *,
doublereal *), cksns_(integer *, doublereal *, char *, logical *,
ftnlen);
logical gotit;
extern logical failed_(void);
doublereal av[3], et;
integer handle;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
logical needav;
extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen);
integer refseg, center;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_(
integer *, integer *, integer *, integer *, logical *);
integer refreq, typeid;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern logical return_(void);
doublereal dcd[2];
integer icd[6];
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
doublereal rot[9] /* was [3][3] */;
/* $ Abstract */
/* Get pointing (attitude) for a specified spacecraft clock time. */
/* $ 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 */
/* CK */
/* SCLK */
/* $ Keywords */
/* POINTING */
/* $ 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. */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* INST I NAIF ID of instrument, spacecraft, or structure. */
/* SCLKDP I Encoded spacecraft clock time. */
/* TOL I Time tolerance. */
/* REF I Reference frame. */
/* CMAT O C-matrix pointing data. */
/* CLKOUT O Output encoded spacecraft clock time. */
/* FOUND O True when requested pointing is available. */
/* $ Detailed_Input */
/* INST is the NAIF integer ID for the instrument, spacecraft, */
/* or other structure for which pointing is requested. */
/* For brevity we will refer to this object as the */
/* "instrument," and the frame fixed to this object as */
/* the "instrument frame" or "instrument-fixed" frame. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is requested. */
/* The SPICELIB routines SCENCD and SCE2C respectively */
/* convert spacecraft clock strings and ephemeris time to */
/* encoded spacecraft clock. The inverse conversions are */
/* performed by SCDECD and SCT2E. */
/* TOL is a time tolerance in ticks, the units of encoded */
/* spacecraft clock time. */
/* The SPICELIB routine SCTIKS converts a spacecraft */
/* clock tolerance duration from its character string */
/* representation to ticks. SCFMT performs the inverse */
/* conversion. */
/* The C-matrix returned by CKGP is the one whose time */
/* tag is closest to SCLKDP and within TOL units of */
/* SCLKDP. (More in Particulars, below.) */
/* In general, because using a non-zero tolerance */
/* affects selection of the segment from which the */
/* data is obtained, users are strongly discouraged */
/* from using a non-zero tolerance when reading CKs */
/* with continuous data. Using a non-zero tolerance */
/* should be reserved exclusively to reading CKs with */
/* discrete data because in practice obtaining data */
/* from such CKs using a zero tolerance is often not */
/* possible due to time round off. */
/* REF is the desired reference frame for the returned */
/* pointing. The returned C-matrix CMAT gives the */
/* orientation of the instrument designated by INST */
/* relative to the frame designated by REF. When a */
/* vector specified relative to frame REF is left- */
/* multiplied by CMAT, the vector is rotated to the */
/* frame associated with INST. See the discussion of */
/* CMAT below for details. */
/* Consult the SPICE document "Frames" for a discussion */
/* of supported reference frames. */
/* $ Detailed_Output */
/* CMAT is a rotation matrix that transforms the components of */
/* a vector expressed in the reference frame specified by */
/* REF to components expressed in the frame tied to the */
/* instrument, spacecraft, or other structure at time */
/* CLKOUT (see below). */
/* Thus, if a vector v has components x,y,z in the REF */
/* reference frame, then v has components x',y',z' in the */
/* instrument fixed frame at time CLKOUT: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* If you know x', y', z', use the transpose of the */
/* C-matrix to determine x, y, z as follows: */
/* [ x ] [ ]T [ x' ] */
/* | y | = | CMAT | | y' | */
/* [ z ] [ ] [ z' ] */
/* (Transpose of CMAT) */
/* CLKOUT is the encoded spacecraft clock time associated with */
/* the returned C-matrix. This value may differ from the */
/* requested time, but never by more than the input */
/* tolerance TOL. */
/* The particulars section below describes the search */
/* algorithm used by CKGP to satisfy a pointing */
/* request. This algorithm determines the pointing */
/* instance (and therefore the associated time value) */
/* that is returned. */
/* FOUND is true if a record was found to satisfy the pointing */
/* request. FOUND will be false otherwise. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If a C-kernel file has not been loaded using FURNSH prior to */
/* a call to this routine, an error is signaled by a routine in */
/* the call tree of this routine. */
/* 2) If TOL is negative, found is set to .FALSE. */
/* 3) If REF is not a supported reference frame, an error is */
/* signaled by a routine in the call tree of this routine and */
/* FOUND is set to .FALSE. */
/* $ Files */
/* CKGP searches through files loaded by FURNSH to locate a */
/* segment that can satisfy the request for pointing for instrument */
/* INST at time SCLKDP. You must load a C-kernel file using FURNSH */
/* prior to calling this routine. */
/* $ Particulars */
/* How the tolerance argument is used */
/* ================================== */
/* Reading a type 1 CK segment (discrete pointing instances) */
/* --------------------------------------------------------- */
/* In the diagram below */
/* - "0" is used to represent discrete pointing instances */
/* (quaternions and associated time tags). */
/* - "( )" are used to represent the end points of the time */
/* interval covered by a segment in a CK file. */
/* - SCLKDP is the time at which you requested pointing. */
/* The location of SCLKDP relative to the time tags of the */
/* pointing instances is indicated by the "+" sign. */
/* - TOL is the time tolerance specified in the pointing */
/* request. The square brackets "[ ]" represent the */
/* endpoints of the time interval */
/* SCLKDP-TOL : SCLKDP+TOL */
/* - The quaternions occurring in the segment need not be */
/* evenly spaced in time. */
/* Case 1: pointing is available */
/* ------------------------------ */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) */
/* ^ */
/* | */
/* CKGP returns this instance. */
/* Case 2: pointing is not available */
/* ---------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) */
/* CKGP returns no pointing; the output */
/* FOUND flag is set to .FALSE. */
/* Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) */
/* ------------------------------------------------------------- */
/* In the diagrams below */
/* - "==" is used to represent periods of continuous pointing. */
/* - "--" is used to represent gaps in the pointing coverage. */
/* - "( )" are used to represent the end points of the time */
/* interval covered by a segment in a CK file. */
/* - SCLKDP is the time at which you requested pointing. */
/* The location of SCLKDP relative to the time tags of the */
/* pointing instances is indicated by the "+" sign. */
/* - TOL is the time tolerance specified in the pointing */
/* request. The square brackets "[ ]" represent the */
/* endpoints of the time interval */
/* SCLKDP-TOL : SCLKDP+TOL */
/* - The quaternions occurring in the periods of continuous */
/* pointing need not be evenly spaced in time. */
/* Case 1: pointing is available at the request time */
/* -------------------------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* . . . */
/* Segment (==---===========---=======----------===--) */
/* ^ */
/* | */
/* The request time lies within an interval where */
/* continuous pointing is available. CKGP returns */
/* pointing at the requested epoch. */
/* Case 2: pointing is available "near" the request time */
/* ------------------------------------------------------ */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (==---===========----=======---------===--) */
/* ^ */
/* | */
/* The request time lies in a gap: an interval where */
/* continuous pointing is *not* available. CKGP */
/* returns pointing for the epoch closest to the */
/* request time SCLKDP. */
/* Case 3: pointing is not available */
/* ---------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (==---===========----=======---------===--) */
/* CKGP returns no pointing; the output */
/* FOUND flag is set to .FALSE. */
/* Tolerance and segment priority */
/* ============================== */
/* CKGP searches through loaded C-kernels to satisfy a pointing */
/* request. Last-loaded files are searched first. Individual files */
/* are searched in backwards order, so that between competing */
/* segments (segments containing data for the same object, for */
/* overlapping time ranges), the one closest to the end of the file */
/* has highest priority. */
/* The search ends when a segment is found that can provide pointing */
/* for the specified instrument at a time falling within the */
/* specified tolerance on either side of the request time. Within */
/* that segment, the instance closest to the input time is located */
/* and returned. */
/* The following four cases illustrate this search procedure. */
/* Segments A and B are in the same file, with segment A located */
/* further towards the end of the file than segment B. Both segments */
/* A and B contain discrete pointing data, indicated by the number */
/* 0. */
/* Case 1: Pointing is available in the first segment searched. */
/* Because segment A has the highest priority and can */
/* satisfy the request, segment B is not searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* ^ */
/* | */
/* | */
/* CKGP returns this instance */
/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/* Case 2: Pointing is not available in the first segment searched. */
/* Because segment A cannot satisfy the request, segment B */
/* is searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* . . . */
/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segments that contain continuous pointing data are searched in */
/* the same manner as segments containing discrete pointing data. */
/* For request times that fall within the bounds of continuous */
/* intervals, CKGP will return pointing at the request time. When */
/* the request time does not fall within an interval, then a time at */
/* an endpoint of an interval may be returned if it is the closest */
/* time in the segment to the user request time and is also within */
/* the tolerance. */
/* In the following examples, segment A is located further towards */
/* the end of the file than segment C. Segment A contains discrete */
/* pointing data and segment C contains continuous data, indicated */
/* by the "=" character. */
/* Case 3: Pointing is not available in the first segment searched. */
/* Because segment A cannot satisfy the request, segment C */
/* is searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* . . . */
/* . . . */
/* Segment C (---=============-----====--------==--) */
/* ^ */
/* | */
/* | */
/* CKGP returns this instance */
/* In the next case, assume that the order of segments A and C in the */
/* file is reversed: A is now closer to the front, so data from */
/* segment C are considered first. */
/* Case 4: Pointing is available in the first segment searched. */
/* Because segment C has the highest priority and can */
/* satisfy the request, segment A is not searched. */
/* SCLKDP */
/* / */
/* | TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment C (---=============-----====--------==--) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segment A (0-----------------0--------0--0-----0) */
/* ^ */
/* | */
/* "Best" answer */
/* The next case illustrates an unfortunate side effect of using */
/* a non-zero tolerance when reading multi-segment CKs with */
/* continuous data. In all cases when the look-up interval */
/* formed using tolerance overlaps a segment boundary and */
/* the request time falls within the coverage of the lower */
/* priority segment, the data at the end of the higher priority */
/* segment will be picked instead of the data from the lower */
/* priority segment. */
/* Case 5: Pointing is available in the first segment searched. */
/* Because segment C has the highest priority and can */
/* satisfy the request, segment A is not searched. */
/* SCLKDP */
/* / */
/* | TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment C (===============) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segment A (=====================) */
/* ^ */
/* | */
/* "Best" answer */
/* $ Examples */
/* Suppose you have two C-kernel files containing data for the */
/* Voyager 2 narrow angle camera. One file contains predict values, */
/* and the other contains corrected pointing for a selected group */
/* of images, that is, for a subset of images from the first file. */
/* The following example program uses CKGP to get C-matrices for a */
/* set of images whose SCLK counts (un-encoded character string */
/* versions) are contained in the array SCLKCH. */
/* If available, the program will get the corrected pointing values. */
/* Otherwise, predict values will be used. */
/* For each C-matrix, a unit pointing vector is constructed */
/* and printed. */
/* C */
/* C Constants for this program. */
/* C */
/* C -- The code for the Voyager 2 spacecraft clock is -32 */
/* C */
/* C -- The code for the narrow angle camera on the Voyager 2 */
/* C spacecraft is -32001. */
/* C */
/* C -- Spacecraft clock times for successive Voyager images */
/* C always differ by more than 0:0:400. This is an */
/* C acceptable tolerance, and must be converted to "ticks" */
/* C (units of encoded SCLK) for input to CKGP. */
/* C */
/* C -- The reference frame we want is FK4. */
/* C */
/* C -- The narrow angle camera boresight defines the third */
/* C axis of the instrument-fixed coordinate system. */
/* C Therefore, the vector ( 0, 0, 1 ) represents */
/* C the boresight direction in the camera-fixed frame. */
/* C */
/* IMPLICIT NONE */
/* INTEGER FILEN */
/* PARAMETER ( FILEN = 255 ) */
/* INTEGER NPICS */
/* PARAMETER ( NPICS = 2 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 30 ) */
/* INTEGER REFLEN */
/* PARAMETER ( REFLEN = 32 ) */
/* CHARACTER*(TIMLEN) CLKCH */
/* CHARACTER*(FILEN) CKPRED */
/* CHARACTER*(FILEN) CKCORR */
/* CHARACTER*(REFLEN) REF */
/* CHARACTER*(FILEN) SCLK */
/* CHARACTER*(TIMLEN) SCLKCH ( NPICS ) */
/* CHARACTER*(TIMLEN) TOLVGR */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOLTIK */
/* DOUBLE PRECISION VCFIX ( 3 ) */
/* DOUBLE PRECISION VINERT ( 3 ) */
/* INTEGER SC */
/* INTEGER I */
/* INTEGER INST */
/* LOGICAL FOUND */
/* CKPRED = 'voyager2_predict.bc' */
/* CKCORR = 'voyager2_corrected.bc' */
/* SCLK = 'voyager2_sclk.tsc' */
/* SC = -32 */
/* INST = -32001 */
/* SCLKCH(1) = '4/08966:30:768' */
/* SCLKCH(2) = '4/08970:58:768' */
/* TOLVGR = '0:0:400' */
/* REF = 'FK4' */
/* VCFIX( 1 ) = 0.D0 */
/* VCFIX( 2 ) = 0.D0 */
/* VCFIX( 3 ) = 1.D0 */
/* C */
/* C Loading the files in this order ensures that the */
/* C corrected file will get searched first. */
/* C */
/* CALL FURNSH ( CKPRED ) */
/* CALL FURNSH ( CKCORR ) */
/* C */
/* C Need to load a Voyager 2 SCLK kernel to convert from */
/* C clock strings to ticks. */
/* C */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Convert tolerance from VGR formatted character string */
/* C SCLK to ticks which are units of encoded SCLK. */
/* C */
/* CALL SCTIKS ( SC, TOLVGR, TOLTIK ) */
/* DO I = 1, NPICS */
/* C */
/* C CKGP requires encoded spacecraft clock. */
/* C */
/* CALL SCENCD ( SC, SCLKCH( I ), SCLKDP ) */
/* CALL CKGP ( INST, SCLKDP, TOLTIK, REF, CMAT, */
/* . CLKOUT, FOUND ) */
/* IF ( FOUND ) THEN */
/* C */
/* C Use the transpose of the C-matrix to transform the */
/* C boresight vector from camera-fixed to reference */
/* C coordinates. */
/* C */
/* CALL MTXV ( CMAT, VCFIX, VINERT ) */
/* CALL SCDECD ( SC, CLKOUT, CLKCH ) */
/* WRITE (*,*) 'VGR 2 SCLK Time: ', CLKCH */
/* WRITE (*,*) 'VGR 2 NA ISS boresight ' */
/* . // 'pointing vector: ', VINERT */
/* ELSE */
/* WRITE (*,*) 'Pointing not found for time ', SCLKCH(I) */
/* END IF */
/* END DO */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* J.M. Lynch (JPL) */
/* B.V. Semenov (JPL) */
/* M.J. Spencer (JPL) */
/* R.E. Thurman (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 5.3.1, 09-JUN-2010 (BVS) */
/* Header update: description of the tolerance and Particulars */
/* section were expanded to address some problems arising from */
/* using a non-zero tolerance. */
/* - SPICELIB Version 5.3.0, 23-APR-2010 (NJB) */
/* Bug fix: this routine now obtains the rotation */
/* from the request frame to the applicable CK segment's */
/* base frame via a call to REFCHG. Formerly the routine */
/* used FRMCHG, which required that angular velocity data */
/* be available for this transformation. */
/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* - SPICELIB Version 5.1.2, 29-JAN-2004 (NJB) */
/* Header update: description of input argument REF was */
/* expanded. */
/* - SPICELIB Version 5.1.1, 27-JUL-2003 (CHA) (NJB) */
/* Various header corrections were made. */
/* - SPICELIB Version 3.2.0, 23-FEB-1999 (WLT) */
/* The previous editions of this routine did not properly handle */
/* the case when TOL was negative. The routine now returns a */
/* value of .FALSE. for FOUND as is advertised above. */
/* - SPICELIB Version 3.1.0, 13-APR-1998 (WLT) */
/* The call to CHKOUT in the case when FAILED returned the */
/* value TRUE used to check out with the name 'CKGPAV'. This */
/* has been changed to a CKGP. */
/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */
/* The routine was upgraded to support non-inertial frames. */
/* - 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, 30-AUG-1991 (JML) */
/* The Particulars section was updated to show how the */
/* search algorithm processes segments with continuous */
/* pointing data. */
/* The example program now loads an SCLK kernel. */
/* FAILED is checked after the call to IRFROT to handle the */
/* case where the reference frame is invalid and the error */
/* handling is not set to abort. */
/* FAILED is checked in the DO WHILE loop to handle the case */
/* where an error is detected by a SPICELIB routine inside the */
/* loop and the error handling is not set to abort. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */
/* -& */
/* $ Index_Entries */
/* get ck pointing */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* - SPICELIB Version 3.1.0, 20-DEC-1995 (WLT) */
/* A call to FRINFO did not have enough arguments and */
/* went undetected until Howard Taylor of ACT. Many */
/* thanks go out to Howard for tracking down this error. */
/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */
/* The routine was upgraded to support non-inertial frames. */
/* Calls to NAMIRF and IRFROT were replaced with calls to */
/* NAMFRM and FRMCHG respectively. */
/* - SPICELIB Version 1.0.2, 30-AUG-1991 (JML) */
/* 1) The Particulars section was updated to show how the */
/* search algorithm processes segments with continuous */
/* pointing data. */
/* 2) The example program now loads an SCLK kernel. */
/* 3) FAILED is checked after the call to IRFROT to handle the */
/* case where the reference frame is invalid and the error */
/* handling is not set to abort. */
/* 4) FAILED is checked in the DO WHILE loop to handle the case */
/* where an error is detected by a SPICELIB routine inside the */
/* loop and the error handling is not set to abort. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* 1) The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* 2) Minor changes were made to the wording of the header. */
/* - Beta Version 1.1.0, 29-AUG-1990 (MJS) */
/* The following changes were made as a result of the */
/* NAIF CK Code and Documentation Review: */
/* 1) The variable SCLK was changed to SCLKDP. */
/* 2) The variable INSTR was changed to INST. */
/* 3) The variable IDENT was changed to SEGID. */
/* 4) The declarations for the parameters NDC, NIC, NC, and */
/* IDLEN were moved from the "Declarations" section of the */
/* header to the "Local parameters" section of the code below */
/* the header. These parameters are not meant to modified by */
/* users. */
/* 5) The header was updated to reflect the changes. */
/* - Beta Version 1.0.0, 04-MAY-1990 (RET) (IMU) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* NDC is the number of double precision components in an */
/* unpacked C-kernel segment descriptor. */
/* NIC is the number of integer components in an unpacked */
/* C-kernel segment descriptor. */
/* NC is the number of components in a packed C-kernel */
/* descriptor. All DAF summaries have this formulaic */
/* relationship between the number of its integer and */
/* double precision components and the number of packed */
/* components. */
/* IDLEN is the length of the C-kernel segment identifier. */
/* All DAF names have this formulaic relationship */
/* between the number of summary components and */
/* the length of the name (You will notice that */
/* a name and a summary have the same length in bytes.) */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKGP", (ftnlen)4);
}
/* Don't need angular velocity data. */
/* Assume the segment won't be found until it really is. */
needav = FALSE_;
*found = FALSE_;
/* If the tolerance is less than zero, we go no further. */
if (*tol < 0.) {
chkout_("CKGP", (ftnlen)4);
return 0;
}
/* Begin a search for this instrument and time, and get the first */
/* applicable segment. */
ckbss_(inst, sclkdp, tol, &needav);
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
/* Keep trying candidate segments until a segment can produce a */
/* pointing instance within the specified time tolerance of the */
/* input time. */
/* Check FAILED to prevent an infinite loop if an error is detected */
/* by a SPICELIB routine and the error handling is not set to abort. */
while(sfnd && ! failed_()) {
ckpfs_(&handle, descr, sclkdp, tol, &needav, cmat, av, clkout, &pfnd);
if (pfnd) {
/* Found one. If the C-matrix doesn't already rotate from the */
/* requested frame, convert it to one that does. */
dafus_(descr, &c__2, &c__6, dcd, icd);
refseg = icd[1];
/* Look up the id code for the requested reference frame. */
namfrm_(ref, &refreq, ref_len);
if (refreq != refseg) {
/* We may need to convert the output ticks CLKOUT to ET */
/* so that we can get the needed state transformation */
/* matrix. This is the case if either of the frames */
/* is non-inertial. */
frinfo_(&refreq, ¢er, &type1, &typeid, &gotit);
frinfo_(&refseg, ¢er, &type2, &typeid, &gotit);
if (type1 == 1 && type2 == 1) {
/* Any old value of ET will do in this case. We'll */
/* use zero. */
et = 0.;
} else {
/* Look up the spacecraft clock id to use to convert */
/* the output CLKOUT to ET. */
ckmeta_(inst, "SCLK", &sclk, (ftnlen)4);
sct2e_(&sclk, clkout, &et);
}
/* Get the transformation from the requested frame to */
/* the segment frame at ET. */
refchg_(&refreq, &refseg, &et, rot);
/* If REFCHG detects that the reference frame is invalid */
/* then return from this routine with FOUND equal to false. */
if (failed_()) {
chkout_("CKGP", (ftnlen)4);
return 0;
}
/* Transform the attitude information: convert CMAT so that */
/* it maps from request frame to C-matrix frame. */
mxm_(cmat, rot, tmpmat);
moved_(tmpmat, &c__9, cmat);
}
*found = TRUE_;
chkout_("CKGP", (ftnlen)4);
return 0;
}
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
}
/* $Procedure ZZGFSSOB ( GF, state of sub-observer point ) */
/* Subroutine */ int zzgfssob_(char *method, integer *trgid, doublereal *et,
char *fixref, char *abcorr, integer *obsid, doublereal *radii,
doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen
abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer prvobs = 0;
static integer prvtrg = 0;
static char svobs[36] = " ";
static char svtarg[36] = " ";
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal dalt[2];
logical near__, geom;
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_(
doublereal *, doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
logical xmit;
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *);
doublereal upos[3];
extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal
*, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *,
doublereal *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen);
doublereal t;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal savel[3];
logical found;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vsubg_(doublereal *, doublereal *, integer *, doublereal *);
doublereal stemp[6];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal xform[36] /* was [6][6] */;
logical uselt;
extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen);
doublereal ssbtg0[6];
extern logical failed_(void);
doublereal sa[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal lt;
integer frcode;
extern doublereal clight_(void);
extern logical return_(void);
doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6]
*/, fxosta[6], fxpsta[6], fxpvel[3], fxtsta[6], obspnt[6], obssta[
12] /* was [6][2] */, obstrg[6], acc[3], pntsta[6], raysta[6],
sastat[6], spoint[3], srfvec[3], ssbobs[6], ssbtrg[6], trgepc;
integer center, clssid, frclss;
logical attblk[6], usestl;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
logical fnd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *,
integer *, integer *, integer *, logical *), errint_(char *,
integer *, ftnlen), spkgeo_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), vminug_(
doublereal *, integer *, doublereal *), dnearp_(doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, logical *), surfpv_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, logical *)
, subpnt_(char *, char *, doublereal *, char *, char *, char *,
doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen, ftnlen), spkssb_(integer *, doublereal *, char *,
doublereal *, ftnlen);
doublereal dlt;
extern /* Subroutine */ int sxform_(char *, char *, doublereal *,
doublereal *, ftnlen, ftnlen), qderiv_(integer *, doublereal *,
doublereal *, doublereal *, doublereal *), invstm_(doublereal *,
doublereal *);
/* $ Abstract */
/* SPICE private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due to the */
/* volatile nature of this routine. */
/* Return the state of a sub-observer point used to define */
/* coordinates referenced in a GF search. */
/* $ 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 */
/* GF */
/* SPK */
/* TIME */
/* NAIF_IDS */
/* FRAMES */
/* $ Keywords */
/* GEOMETRY */
/* PRIVATE */
/* SEARCH */
/* $ Declarations */
/* $ Abstract */
/* This file contains public, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) 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. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.E. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.3.0, 01-OCT-2011 (NJB) */
/* Added NWILUM parameter. */
/* - SPICELIB Version 1.2.0, 14-SEP-2010 (EDW) */
/* Added NWPA parameter. */
/* - SPICELIB Version 1.1.0, 08-SEP-2009 (EDW) */
/* Added NWRR parameter. */
/* Added NWUDS parameter. */
/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */
/* -& */
/* Root finding parameters: */
/* CNVTOL is the default convergence tolerance used by the */
/* high-level GF search API routines. This tolerance is */
/* used to terminate searches for binary state transitions: */
/* when the time at which a transition occurs is bracketed */
/* by two times that differ by no more than CNVTOL, the */
/* transition time is considered to have been found. */
/* Units are TDB seconds. */
/* NWMAX is the maximum number of windows allowed for user-defined */
/* workspace array. */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */
/* Currently no more than twelve windows are required; the three */
/* extra windows are spares. */
/* Callers of GFEVNT can include this file and use the parameter */
/* NWMAX to declare the second dimension of the workspace array */
/* if necessary. */
/* Callers of GFIDST should declare their workspace window */
/* count using NWDIST. */
/* Callers of GFSEP should declare their workspace window */
/* count using NWSEP. */
/* Callers of GFRR should declare their workspace window */
/* count using NWRR. */
/* Callers of GFUDS should declare their workspace window */
/* count using NWUDS. */
/* Callers of GFPA should declare their workspace window */
/* count using NWPA. */
/* Callers of GFILUM should declare their workspace window */
/* count using NWILUM. */
/* ADDWIN is a parameter used to expand each interval of the search */
/* (confinement) window by a small amount at both ends in order to */
/* accommodate searches using equality constraints. The loaded */
/* kernel files must accommodate these expanded time intervals. */
/* FRMNLN is a string length for frame names. */
/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */
/* FOVTLN -- maximum length for FOV string. */
/* Specify the character strings that are allowed in the */
/* specification of field of view shapes. */
/* Character strings that are allowed in the */
/* specification of occultation types: */
/* Occultation target shape specifications: */
/* Specify the number of supported occultation types and occultation */
/* type string length: */
/* Instrument field-of-view (FOV) parameters */
/* Maximum number of FOV boundary vectors: */
/* FOV shape parameters: */
/* circle */
/* ellipse */
/* polygon */
/* rectangle */
/* End of file gf.inc. */
/* $ Abstract */
/* SPICE private include file intended solely for the support of */
/* SPICE routines. Users should not include this routine in their */
/* source code due to the volatile nature of this file. */
/* This file contains private, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) 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. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */
/* -& */
/* The set of supported coordinate systems */
/* System Coordinates */
/* ---------- ----------- */
/* Rectangular X, Y, Z */
/* Latitudinal Radius, Longitude, Latitude */
/* Spherical Radius, Colatitude, Longitude */
/* RA/Dec Range, Right Ascension, Declination */
/* Cylindrical Radius, Longitude, Z */
/* Geodetic Longitude, Latitude, Altitude */
/* Planetographic Longitude, Latitude, Altitude */
/* Below we declare parameters for naming coordinate systems. */
/* User inputs naming coordinate systems must match these */
/* when compared using EQSTR. That is, user inputs must */
/* match after being left justified, converted to upper case, */
/* and having all embedded blanks removed. */
/* Below we declare names for coordinates. Again, user */
/* inputs naming coordinates must match these when */
/* compared using EQSTR. */
/* Note that the RA parameter value below matches */
/* 'RIGHT ASCENSION' */
/* when extra blanks are compressed out of the above value. */
/* Parameters specifying types of vector definitions */
/* used for GF coordinate searches: */
/* All string parameter values are left justified, upper */
/* case, with extra blanks compressed out. */
/* POSDEF indicates the vector is defined by the */
/* position of a target relative to an observer. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the sub-observer point on */
/* that body, for a given observer and target. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the surface intercept point on */
/* that body, for a given observer, ray, and target. */
/* Number of workspace windows used by ZZGFREL: */
/* Number of additional workspace windows used by ZZGFLONG: */
/* Index of "existence window" used by ZZGFCSLV: */
/* Progress report parameters: */
/* MXBEGM, */
/* MXENDM are, respectively, the maximum lengths of the progress */
/* report message prefix and suffix. */
/* Note: the sum of these lengths, plus the length of the */
/* "percent complete" substring, should not be long enough */
/* to cause wrap-around on any platform's terminal window. */
/* Total progress report message length upper bound: */
/* End of file zzgf.inc. */
/* $ Abstract */
/* Include file zzabcorr.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 the structure of an aberration */
/* correction attribute block. */
/* $ 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 */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TRGID I Target ID code. */
/* ET I Computation epoch. */
/* FIXREF I Reference frame name. */
/* ABCORR I Aberration correction. */
/* OBSID I Observer ID code. */
/* RADII I Target radii. */
/* STATE O State used to define coordinates. */
/* $ Detailed_Input */
/* METHOD is a short string providing parameters defining */
/* the computation method to be used. Any value */
/* supported by SUBPNT may be used. */
/* TRGID is the NAIF ID code of the target object. */
/* *This routine assumes that the target is modeled */
/* as a tri-axial ellipsoid.* */
/* ET is the time, expressed as ephemeris seconds past J2000 */
/* TDB, at which the specified state is to be computed. */
/* FIXREF is the name of the reference frame relative to which */
/* the state of interest is specified. */
/* FIXREF must be centered on the target body. */
/* Case, leading and trailing blanks are not significant */
/* in the string FIXREF. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the state of the target body to account for one-way */
/* light time and stellar aberration. The orientation */
/* of the target body will also be corrected for one-way */
/* light time when light time corrections are requested. */
/* Supported aberration correction options for */
/* observation (case where radiation is received by */
/* observer at ET) are: */
/* NONE No correction. */
/* LT Light time only. */
/* LT+S Light time and stellar aberration. */
/* CN Converged Newtonian (CN) light time. */
/* CN+S CN light time and stellar aberration. */
/* Supported aberration correction options for */
/* transmission (case where radiation is emitted from */
/* observer at ET) are: */
/* XLT Light time only. */
/* XLT+S Light time and stellar aberration. */
/* XCN Converged Newtonian (CN) light time. */
/* XCN+S CN light time and stellar aberration. */
/* For detailed information, see the geometry finder */
/* required reading, gf.req. Also see the header of */
/* SPKEZR, which contains a detailed discussion of */
/* aberration corrections. */
/* Case, leading and trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSID is the NAIF ID code of the observer. */
/* RADII is an array containing three radii defining */
/* a reference ellipsoid for the target body. */
/* $ Detailed_Output */
/* STATE is the state of the sub-observer point at ET. */
/* The first three components of STATE contain the */
/* sub-observer point itself; the last three */
/* components contain the derivative with respect to */
/* time of the position. The state is expressed */
/* relative to the body-fixed frame designated by */
/* FIXREF. */
/* Units are km and km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the aberration correction ABCORR is not recognized, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 2) If the frame FIXREF is not recognized by the frames */
/* subsystem, the error will be diagnosed by routines in the */
/* call tree of this routine. */
/* 3) FIXREF must be centered on the target body; if it isn't, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 4) Any error that occurs while look up the state of the target */
/* or observer will be diagnosed by routines in the call tree of */
/* this routine. */
/* 5) Any error that occurs while look up the orientation of */
/* the target will be diagnosed by routines in the call tree of */
/* this routine. */
/* 6) If the input method is not recognized, the error */
/* SPICE(NOTSUPPORTED) will be signaled. */
/* $ Files */
/* Appropriate kernels must be loaded by the calling program before */
/* this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - PCK data: if the target body shape is modeled as an */
/* ellipsoid, triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must be */
/* loaded. These may be provided in a text or binary PCK file. */
/* - Frame data: if a frame definition is required to convert the */
/* observer and target states to the body-fixed frame of the */
/* target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine isolates the computation of the sub-observer state */
/* (that is, the sub-observer point and its derivative with respect */
/* to time). */
/* This routine is used by the GF coordinate utility routines in */
/* order to solve for time windows on which specified mathematical */
/* conditions involving coordinates are satisfied. The role of */
/* this routine is to provide Cartesian state vectors enabling */
/* the GF coordinate utilities to determine the signs of the */
/* derivatives with respect to time of coordinates of interest. */
/* $ Examples */
/* See ZZGFCOST. */
/* $ Restrictions */
/* 1) This routine is restricted to use with ellipsoidal target */
/* shape models. */
/* 2) The computations performed by this routine are intended */
/* to be compatible with those performed by the SPICE */
/* routine SUBPNT. If that routine changes, this routine */
/* may need to be updated. */
/* 3) This routine presumes that error checking of inputs */
/* has, where possible, already been performed by the */
/* GF coordinate utility initialization routine. */
/* 4) The interface and functionality of this set of routines may */
/* change without notice. These routines should be called only */
/* by SPICELIB routines. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */
/* Upgraded to support targets and observers having */
/* no names associated with their ID codes. */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* sub-observer state */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSSOB", (ftnlen)8);
if (first || *trgid != prvtrg) {
bodc2s_(trgid, svtarg, (ftnlen)36);
prvtrg = *trgid;
}
if (first || *obsid != prvobs) {
bodc2s_(obsid, svobs, (ftnlen)36);
prvobs = *obsid;
}
first = FALSE_;
/* Parse the aberration correction specifier. */
zzprscor_(abcorr, attblk, abcorr_len);
geom = attblk[0];
uselt = attblk[1];
usestl = attblk[2];
xmit = attblk[4];
/* Decide whether the sub-observer point is computed using */
/* the "near point" or "surface intercept" method. Only */
/* ellipsoids may be used a shape models for this computation. */
if (eqstr_(method, "Near point: ellipsoid", method_len, (ftnlen)21)) {
near__ = TRUE_;
} else if (eqstr_(method, "Intercept: ellipsoid", method_len, (ftnlen)20))
{
near__ = FALSE_;
} else {
setmsg_("Sub-observer point computation method # is not supported by"
" this routine.", (ftnlen)73);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (geom) {
/* This is the geometric case. */
/* We need to check the body-fixed reference frame here. */
namfrm_(fixref, &frcode, fixref_len);
frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (! fnd) {
setmsg_("Input reference frame # was not recognized.", (ftnlen)43)
;
errch_("#", fixref, (ftnlen)1, fixref_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (center != *trgid) {
setmsg_("Input reference frame # is centered on body # instead o"
"f body #.", (ftnlen)64);
errch_("#", fixref, (ftnlen)1, fixref_len);
errint_("#", ¢er, (ftnlen)1);
errint_("#", trgid, (ftnlen)1);
sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Get the state of the target with respect to the observer, */
/* expressed relative to the target body-fixed frame. We don't */
/* need to propagate states to the solar system barycenter in */
/* this case. */
spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the state of the observer with respect to the target */
/* in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the sub-observer */
/* point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &found)
;
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. DNEARP re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface */
/* intercept point." The ray direction is simply */
/* the negative of the observer's position relative */
/* to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to */
/* be unable to compute an intercept state, it *is* */
/* an error in this case, since the ray points toward */
/* the center of the target. */
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. SURFPV re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
} else if (uselt) {
/* Light time and possibly stellar aberration corrections are */
/* applied. */
/* Most our work consists of getting ready to call either of the */
/* SPICELIB routines DNEARP or SURFPV. In order to make this */
/* call, we'll need the velocity of the observer relative to the */
/* target body's center in the target body-fixed frame. We must */
/* evaluate the rotation state of the target at the correct */
/* epoch, and account for the rate of change of light time, if */
/* light time corrections are used. The algorithm we use depends */
/* on the algorithm used in SUBPNT, since we're computing the */
/* derivative with respect to time of the solution found by that */
/* routine. */
/* In this algorithm, we must take into account the fact that */
/* SUBPNT performs light time and stellar aberration corrections */
/* for the sub-observer point, not for the center of the target */
/* body. */
/* If light time and stellar aberration corrections are used, */
/* - Find the aberration corrected sub-observer point and the */
/* light time-corrected epoch TRGEPC associated with the */
/* sub-observer point. */
/* - Use TRGEPC to find the position of the target relative to */
/* the solar system barycenter. */
/* - Use TRGEPC to find the orientation of the target relative */
/* to the J2000 reference frame. */
/* - Find the light-time corrected position of the */
/* sub-observer point; use this to compute the stellar */
/* aberration offset that applies to the sub-observer point, */
/* as well as the velocity of this offset. */
/* - Find the corrected state of the target center as seen */
/* from the observer, where the corrections are those */
/* applicable to the sub-observer point. */
/* - Negate the corrected target center state to obtain the */
/* state of the observer relative to the target. */
/* - Express the state of the observer relative to the target */
/* in the target body fixed frame at TRGEPC. */
/* Below, we'll use the convention that vectors expressed */
/* relative to the body-fixed frame have names of the form */
/* FX* */
/* Note that SUBPNT will signal an error if FIXREF is not */
/* actually centered on the target body. */
subpnt_(method, svtarg, et, fixref, abcorr, svobs, spoint, &trgepc,
srfvec, method_len, (ftnlen)36, fixref_len, abcorr_len, (
ftnlen)36);
/* Get J2000-relative states of observer and target with respect */
/* to the solar system barycenter at their respective epochs of */
/* participation. */
spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5);
spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5);
/* Get the uncorrected J2000 to body-fixed to state */
/* transformation at TRGEPC. */
sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Initialize the state of the sub-observer point in the */
/* body-fixed frame. At this point we don't know the */
/* point's velocity; set it to zero. */
moved_(spoint, &c__3, fxpsta);
cleard_(&c__3, &fxpsta[3]);
if (usestl) {
/* We're going to need the acceleration of the observer */
/* relative to the SSB. Compute this now. */
for (i__ = 1; i__ <= 2; ++i__) {
/* The epoch is ET -/+ TDELTA. */
t = *et + ((i__ << 1) - 3) * 1.;
spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12
&& 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss"
"ob_", (ftnlen)652)], (ftnlen)5);
}
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the observer's acceleration using a quadratic */
/* approximation. */
qderiv_(&c__3, &obssta[3], &obssta[9], &c_b40, acc);
}
/* The rest of the algorithm is iterative. On the first */
/* iteration, we don't have a good estimate of the velocity */
/* of the sub-observer point relative to the body-fixed */
/* frame. Since we're using this velocity as an input */
/* to the aberration velocity computations, we */
/* expect that treating this velocity as zero on the first */
/* pass yields a reasonable estimate. On the second pass, */
/* we'll use the velocity derived on the first pass. */
cleard_(&c__3, fxpvel);
/* We'll also estimate the rate of change of light time */
/* as zero on the first pass. */
dlt = 0.;
for (i__ = 1; i__ <= 2; ++i__) {
/* Correct the target's velocity for the rate of */
/* change of light time. */
if (xmit) {
scale = dlt + 1.;
} else {
scale = 1. - dlt;
}
/* Scale the velocity portion of the target state to */
/* correct the velocity for the rate of change of light */
/* time. */
moved_(ssbtg0, &c__3, ssbtrg);
vscl_(&scale, &ssbtg0[3], &ssbtrg[3]);
/* Get the state of the target with respect to the observer. */
vsubg_(ssbtrg, ssbobs, &c__6, obstrg);
/* Correct the J2000 to body-fixed state transformation matrix */
/* for the rate of change of light time. */
zzcorsxf_(&xmit, &dlt, xform, corxfm);
/* Invert CORXFM to obtain the corrected */
/* body-fixed to J2000 state transformation. */
invstm_(corxfm, corxfi);
/* Convert the sub-observer point state to the J2000 frame. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
/* Find the J2000-relative state of the sub-observer */
/* point with respect to the target. */
vaddg_(obstrg, pntsta, &c__6, obspnt);
if (usestl) {
/* Now compute the stellar aberration correction */
/* applicable to OBSPNT. We need the velocity of */
/* this correction as well. */
zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel);
moved_(sa, &c__3, sastat);
moved_(savel, &c__3, &sastat[3]);
/* Adding the stellar aberration state to the target center */
/* state gives us the state of the target center with */
/* respect to the observer, corrected for the aberrations */
/* applicable to the sub-observer point. */
vaddg_(obstrg, sastat, &c__6, stemp);
} else {
moved_(obstrg, &c__6, stemp);
}
/* Convert STEMP to the body-fixed reference frame. */
mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta);
/* At long last, compute the state of the observer */
/* with respect to the target in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the */
/* sub-observer point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &
found);
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. "
"DNEARP returned \"not found.\"", (ftnlen)123);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface intercept */
/* point." The ray direction is simply the negative of the */
/* observer's position relative to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to be */
/* unable to compute an intercept state, it *is* an error */
/* in this case, since the ray points toward the center of */
/* the target. */
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. S"
"URFPV returned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
/* At this point we can update the surface point */
/* velocity and light time derivative estimates. */
/* In order to compute the light time rate, we'll */
/* need the J2000-relative velocity of the sub-observer */
/* point with respect to the observer. First convert */
/* the sub-observer state to the J2000 frame, then */
/* add the result to the state of the target center */
/* with respect to the observer. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
vaddg_(obstrg, pntsta, &c__6, obspnt);
/* Now that we have an improved estimate of the */
/* sub-observer state, we can estimate the rate of */
/* change of light time as */
/* range rate */
/* ---------- */
/* c */
/* If we're correcting for stellar aberration, *ideally* we */
/* should remove that correction now, since the light time */
/* rate is based on light time between the observer and the */
/* light-time corrected sub-observer point. But the error made */
/* by including stellar aberration is too small to make it */
/* worthwhile to make this adjustment. */
vhat_(obspnt, upos);
dlt = vdot_(&obspnt[3], upos) / clight_();
/* With FXPVEL and DLT updated, we'll repeat our */
/* computations. */
}
} else {
/* We should never get here. */
setmsg_("Aberration correction # was not recognized.", (ftnlen)43);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Copy the computed state to the output argument STATE. */
moved_(fxpsta, &c__6, state);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
} /* zzgfssob_ */
/* $Procedure SPKW20 ( SPK, write segment, type 20 ) */
/* Subroutine */ int spkw20_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
doublereal *intlen, integer *n, integer *polydg, doublereal *cdata,
doublereal *dscale, doublereal *tscale, doublereal *initjd,
doublereal *initfr, ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
/* Local variables */
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), dafps_(integer *, integer *, doublereal *,
integer *, doublereal *);
doublereal btime, descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal ltime;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
char etstr[40];
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
integer *, doublereal *, char *, ftnlen), dafena_(void);
extern logical failed_(void);
extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen,
ftnlen);
integer refcod, ninrec;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
doublereal numrec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
char netstr[40];
doublereal dcd[2];
extern doublereal j2000_(void);
integer icd[6];
extern doublereal spd_(void);
doublereal tol;
/* $ Abstract */
/* Write a type 20 segment to an SPK 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 */
/* DAF */
/* NAIF_IDS */
/* TIME */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 20. */
/* $ 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 */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 30-DEC-2013 (NJB) */
/* -& */
/* MAXDEG is the maximum allowed degree of the input */
/* Chebyshev expansions. If the value of MAXDEG is */
/* increased, the SPICELIB routine SPKPVN must be */
/* changed accordingly. In particular, the size of */
/* the record passed to SPKRnn and SPKEnn must be */
/* increased, and comments describing the record size */
/* must be changed. */
/* The record size requirement is */
/* MAXREC = 3 * ( MAXDEG + 3 ) */
/* TOLSCL is a tolerance scale factor (also called a */
/* "relative tolerance") used for time coverage */
/* bound checking. TOLSCL is unitless. TOLSCL */
/* produces a tolerance value via the formula */
/* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */
/* where FIRST and LAST are the coverage time bounds */
/* of a type 20 segment, expressed as seconds past */
/* J2000 TDB. */
/* The resulting parameter TOL is used as a tolerance */
/* for comparing the input segment descriptor time */
/* bounds to the first and last epoch covered by the */
/* sequence of time intervals defined by the inputs */
/* to SPKW20: */
/* INITJD */
/* INITFR */
/* INTLEN */
/* N */
/* Tolerance scale for coverage gap at the endpoints */
/* of the segment coverage interval: */
/* End of include file spk20.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of SPK file open for writing. */
/* BODY I NAIF code for ephemeris object. */
/* CENTER I NAIF code for the center of motion of the body. */
/* FRAME I Reference frame name. */
/* FIRST I Start time of interval covered by segment. */
/* LAST I End time of interval covered by segment. */
/* SEGID I Segment identifier. */
/* INTLEN I Length of time covered by logical record (days). */
/* N I Number of logical records in segment. */
/* POLYDG I Chebyshev polynomial degree. */
/* CDATA I Array of Chebyshev coefficients and positions. */
/* DSCALE I Distance scale of data. */
/* TSCALE I Time scale of data. */
/* INITJD I Integer part of begin time (TDB Julian date) of */
/* first record. */
/* INITFR I Fractional part of begin time (TDB Julian date) of */
/* first record. */
/* MAXDEG P Maximum allowed degree of Chebyshev expansions. */
/* TOLSCL P Tolerance scale for coverage bound checking. */
/* $ Detailed_Input */
/* HANDLE is the DAF handle of an SPK file to which a type 20 */
/* segment is to be added. The SPK file must be open */
/* for writing. */
/* BODY is the NAIF integer code for an ephemeris object */
/* whose state relative to another body is described */
/* by the segment to be created. */
/* CENTER is the NAIF integer code for the center of motion */
/* of the object identified by BODY. */
/* FRAME is the NAIF name for a reference frame relative to */
/* which the state information for BODY is specified. */
/* FIRST, */
/* LAST are the start and stop times of the time interval */
/* over which the segment defines the state of the */
/* object identified by BODY. */
/* SEGID is a segment identifier. An SPK segment identifier */
/* may contain up to 40 characters. */
/* INTLEN is the length of time, in TDB Julian days, covered */
/* by each set of Chebyshev polynomial coefficients */
/* (each logical record). */
/* N is the number of logical records to be stored in */
/* the segment. There is one logical record for each */
/* time period. Each logical record contains three */
/* sets of Chebyshev coefficients---one for each */
/* coordinate---and three position vector components. */
/* POLYDG is the degree of each set of Chebyshev */
/* polynomials, i.e. the number of Chebyshev */
/* coefficients per coordinate minus one. POLYDG must */
/* be less than or equal to the parameter MAXDEG. */
/* CDATA is an array containing all the sets of Chebyshev */
/* polynomial coefficients and position components to */
/* be placed in the new segment of the SPK file. */
/* There are three sets of coefficients and position */
/* components for each time interval covered by the */
/* segment. */
/* The coefficients and position components are */
/* stored in CDATA in order as follows: */
/* the (POLYDG + 1) coefficients for the first */
/* coordinate of the first logical record, */
/* followed by the X component of position at the */
/* first interval midpoint. The first coefficient */
/* is that of the constant term of the expansion. */
/* the coefficients for the second coordinate, */
/* followed by the Y component of position at the */
/* first interval midpoint. */
/* the coefficients for the third coordinate, */
/* followed by the Z component of position at the */
/* first interval midpoint. */
/* the coefficients for the first coordinate for */
/* the second logical record, followed by the X */
/* component of position at the second interval */
/* midpoint. */
/* and so on. */
/* The logical data records are stored contiguously: */
/* +----------+ */
/* | Record 1 | */
/* +----------+ */
/* | Record 2 | */
/* +----------+ */
/* ... */
/* +----------+ */
/* | Record N | */
/* +----------+ */
/* The contents of an individual record are: */
/* +--------------------------------------+ */
/* | Coeff set for X velocity component | */
/* +--------------------------------------+ */
/* | X position component | */
/* +--------------------------------------+ */
/* | Coeff set for Y velocity component | */
/* +--------------------------------------+ */
/* | Y position component | */
/* +--------------------------------------+ */
/* | Coeff set for Z velocity component | */
/* +--------------------------------------+ */
/* | Z position component | */
/* +--------------------------------------+ */
/* Each coefficient set has the structure: */
/* +--------------------------------------+ */
/* | Coefficient of T_0 | */
/* +--------------------------------------+ */
/* | Coefficient of T_1 | */
/* +--------------------------------------+ */
/* ... */
/* +--------------------------------------+ */
/* | Coefficient of T_POLYDG | */
/* +--------------------------------------+ */
/* Where T_n represents the Chebyshev polynomial */
/* of the first kind of degree n. */
/* DSCALE, */
/* TSCALE are, respectively, the distance scale of the input */
/* position and velocity data in km, and the time */
/* scale of the input velocity data in TDB seconds. */
/* For example, if the input distance data have units */
/* of astronomical units (AU), DSCALE should be set */
/* to the number of km in one AU. If the input */
/* velocity data have time units of Julian days, then */
/* TSCALE should be set to the number of seconds per */
/* Julian day (86400). */
/* INITJD is the integer part of the Julian ephemeris date */
/* of initial epoch of the first record. INITJD may */
/* be less than, equal to, or greater than the */
/* initial epoch. */
/* INITFR is the fractional part of the Julian ephemeris date */
/* of initial epoch of the first record. INITFR has */
/* units of Julian days. INITFR has magnitude */
/* strictly less than 1 day. The sum */
/* INITJD + INITFR */
/* equals the Julian ephemeris date of the initial */
/* epoch of the first record. */
/* $ Detailed_Output */
/* None. This routine writes data to an SPK file. */
/* $ Parameters */
/* The parameters described in this section are declared in the */
/* Fortran INCLUDE file spk20.inc */
/* MAXDEG is the maximum allowed degree of the input */
/* Chebyshev expansions. */
/* TOLSCL is a tolerance scale factor (also called a */
/* "relative tolerance") used for time coverage */
/* bound checking. TOLSCL is unitless. TOLSCL */
/* produces a tolerance value via the formula */
/* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */
/* where FIRST and LAST are the coverage time bounds */
/* of a type 20 segment, expressed as seconds past */
/* J2000 TDB. */
/* The resulting parameter TOL is used as a tolerance */
/* for comparing the input segment descriptor time */
/* bounds to the first and last epoch covered by the */
/* sequence of time intervals defined by the inputs */
/* INITJD */
/* INITFR */
/* INTLEN */
/* N */
/* See the Exceptions section below for a description */
/* of the error check using this tolerance. */
/* $ Exceptions */
/* 1) If the number of sets of coefficients is not positive */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If the interval length is not positive, SPICE(INTLENNOTPOS) */
/* is signaled. */
/* 3) If the name of the reference frame is not recognized, */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 4) If segment stop time is not greater than or equal to */
/* the begin time, SPICE(BADDESCRTIMES) is signaled. */
/* 5) If the start time of the first record exceeds the descriptor */
/* begin time by more than a computed tolerance, or if the end */
/* time of the last record precedes the descriptor end time by */
/* more than a computed tolerance, the error SPICE(COVERAGEGAP) */
/* is signaled. See the Parameters section above for a */
/* description of the tolerance. */
/* 6) If the input degree POLYDG is less than 0 or greater than */
/* MAXDEG, the error SPICE(INVALIDDEGREE) is signaled. */
/* 7) If the last non-blank character of SEGID occurs past index */
/* 40, or if SEGID contains any nonprintable characters, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* 8) If either the distance or time scale is non-positive, the */
/* error SPICE(NONPOSITIVESCALE) will be signaled. */
/* $ Files */
/* A new type 20 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 20 data segment to the designated */
/* SPK file, according to the format described in the SPK Required */
/* Reading. */
/* Each segment can contain data for only one target, central body, */
/* and reference frame. The Chebyshev polynomial degree and length */
/* of time covered by each logical record are also fixed. However, */
/* an arbitrary number of logical records of Chebyshev polynomial */
/* coefficients can be written in each segment. Minimizing the */
/* number of segments in an SPK file will help optimize how the */
/* SPICE system accesses the file. */
/* $ Examples */
/* Suppose that you have in an array CDATA sets of Chebyshev */
/* polynomial coefficients and position vectors representing the */
/* state of the moon (NAIF ID = 301), relative to the Earth-moon */
/* barycenter (NAIF ID = 3), in the J2000 reference frame, and you */
/* want to put these into a type 20 segment in an existing SPK file. */
/* The following code could be used to add one new type 20 segment. */
/* To add multiple segments, put the call to SPKW20 in a loop. */
/* C */
/* C First open the SPK file and get a handle for it. */
/* C */
/* CALL DAFOPW ( SPKNAM, HANDLE ) */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_SPK_TYPE_20_SEGMENT' */
/* C */
/* C Note that the interval length INTLEN has units */
/* C of Julian days. The start time of the first record */
/* C is expressed using two inputs: integer and fractional */
/* C portions of the Julian ephemeris date of the start */
/* C time. */
/* C */
/* C Write the segment. */
/* C */
/* CALL SPKW20 ( HANDLE, 301, 3, 'J2000', */
/* . FIRST, LAST, SEGID, INTLEN, */
/* . N, POLYDG, CDATA, DSCALE, */
/* . TSCALE, INITJD, INITFR ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DAFCLS ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-JAN-2017 (NJB) (KSZ) */
/* -& */
/* $ Index_Entries */
/* write spk type_20 data segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* DTYPE is the SPK data type. */
/* ND is the number of double precision components in an SPK */
/* segment descriptor. SPK uses ND = 2. */
/* NI is the number of integer components in an SPK segment */
/* descriptor. SPK uses NI = 6. */
/* NS is the size of a packed SPK segment descriptor. */
/* SIDLEN is the maximum number of characters allowed in an */
/* SPK segment identifier. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW20", (ftnlen)6);
/* The number of sets of coefficients must be positive. */
if (*n <= 0) {
setmsg_("The number of sets of coordinate coefficients is not positi"
"ve. N = # ", (ftnlen)69);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Make sure that the degree of the interpolating polynomials is */
/* in range. */
if (*polydg < 0 || *polydg > 50) {
setmsg_("The interpolating polynomials have degree #; the valid degr"
"ee range is [0, #].", (ftnlen)78);
errint_("#", polydg, (ftnlen)1);
errint_("#", &c__50, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The interval length must be positive. */
if (*intlen <= 0.) {
setmsg_("The interval length is not positive.N = #", (ftnlen)41);
errdp_("#", intlen, (ftnlen)1);
sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
namfrm_(frame, &refcod, frame_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", frame, (ftnlen)1, frame_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The segment stop time must be greater than or equal to the begin */
/* time. */
if (*first > *last) {
setmsg_("The segment start time: # (# TDB) is greater than the segme"
"nt end time: (# TDB).", (ftnlen)80);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
errdp_("#", first, (ftnlen)1);
etcal_(last, netstr, (ftnlen)40);
errch_("#", netstr, (ftnlen)1, (ftnlen)40);
errdp_("#", last, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The distance and time scales must be positive. */
if (*dscale <= 0.) {
setmsg_("The distance scale is not positive.DSCALE = #", (ftnlen)45);
errdp_("#", dscale, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
if (*tscale <= 0.) {
setmsg_("The time scale is not positive.TSCALE = #", (ftnlen)41);
errdp_("#", tscale, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The begin time of the first record must be less than or equal */
/* to the begin time of the segment. Convert the two-part input */
/* epoch to seconds past J2000 for the purpose of this check. */
btime = spd_() * (*initjd - j2000_() + *initfr);
ltime = btime + *n * *intlen * spd_();
/* Compute the tolerance to use for descriptor time bound checks. */
/* Computing MAX */
d__1 = abs(btime), d__2 = abs(ltime);
tol = max(d__1,d__2) * 1e-13;
if (*first < btime - tol) {
setmsg_("The segment descriptor start time # is too much less than t"
"he beginning time of the segment data # (in seconds past J20"
"00: #). The difference is # seconds; the tolerance is # seco"
"nds.", (ftnlen)183);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(&btime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
errdp_("#", first, (ftnlen)1);
d__1 = btime - *first;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &tol, (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The end time of the final record must be greater than or */
/* equal to the end time of the segment. */
if (*last > ltime + tol) {
setmsg_("The segment descriptor end time # is too much greater than "
"the end time of the segment data # (in seconds past J2000: #"
"). The difference is # seconds; the tolerance is # seconds.",
(ftnlen)178);
etcal_(last, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(<ime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
errdp_("#", last, (ftnlen)1);
d__1 = *last - ltime;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &tol, (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Now check the validity of the segment identifier. */
chckid_("SPK segment identifier", &c__40, segid, (ftnlen)22, segid_len);
if (failed_()) {
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Store the start and end times to be associated */
/* with this segment. */
dcd[0] = *first;
dcd[1] = *last;
/* Create the integer portion of the descriptor. */
icd[0] = *body;
icd[1] = *center;
icd[2] = refcod;
icd[3] = 20;
/* Pack the segment descriptor. */
dafps_(&c__2, &c__6, dcd, icd, descr);
/* Begin a new segment of SPK type 20 form: */
/* Record 1 */
/* Record 2 */
/* ... */
/* Record N */
/* DSCALE ( distance scale in km ) */
/* TSCALE ( time scale in seconds ) */
/* INITJD ( integer part of initial epoch of first record, */
/* expressed as a TDB Julian date ) */
/* INITFR ( fractional part of initial epoch, in units of */
/* TDB Julian days ) */
/* INTLEN ( length of interval covered by each record, in */
/* units of TDB Julian days ) */
/* RSIZE ( number of data elements in each record ) */
/* N ( number of records in segment ) */
/* Each record will have the form: */
/* X coefficients */
/* X position component at interval midpoint */
/* Y coefficients */
/* Y position component at interval midpoint */
/* Z coefficients */
/* Z position component at interval midpoint */
dafbna_(handle, descr, segid, segid_len);
/* Calculate the number of entries in a record. */
ninrec = (*polydg + 2) * 3;
/* Fill segment with N records of data. */
i__1 = *n * ninrec;
dafada_(cdata, &i__1);
/* Store the distance and time scales. */
dafada_(dscale, &c__1);
dafada_(tscale, &c__1);
/* Store the integer and fractional parts of the initial epoch of */
/* the first record. */
dafada_(initjd, &c__1);
dafada_(initfr, &c__1);
/* Store the length of interval covered by each record. */
dafada_(intlen, &c__1);
/* Store the size of each record (total number of array elements). */
/* Note that this size is smaller by 2 than the size of a type 2 */
/* record of the same degree, since the record coverage midpoint */
/* and radius are not stored. */
d__1 = (doublereal) ninrec;
dafada_(&d__1, &c__1);
/* Store the number of records contained in the segment. */
numrec = (doublereal) (*n);
dafada_(&numrec, &c__1);
/* End this segment. */
dafena_();
chkout_("SPKW20", (ftnlen)6);
return 0;
} /* spkw20_ */
/* $Procedure SPKW19 ( Write SPK segment, type 19 ) */
/* Subroutine */ int spkw19_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
integer *nintvl, integer *npkts, integer *subtps, integer *degres,
doublereal *packts, doublereal *epochs, doublereal *ivlbds, logical *
sellst, ftnlen frame_len, ftnlen segid_len)
{
/* Initialized data */
static integer pktszs[2] = { 12,6 };
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer isel, ndir, i__, j, k;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
integer bepix, eepix;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_(
doublereal *, integer *);
doublereal dc[2];
extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *,
ftnlen);
integer ic[6];
extern /* Subroutine */ int dafena_(void);
extern logical failed_(void);
integer segbeg, chrcod, refcod, segend, pktbeg;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
integer pktend;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
integer minisz;
extern logical return_(void);
integer pktdsz, winsiz, pktsiz, subtyp;
extern logical odd_(integer *);
/* $ Abstract */
/* Write a type 19 segment to an SPK 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 */
/* DAF */
/* NAIF_IDS */
/* SPC */
/* SPK */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* FILES */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 19. */
/* $ 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 */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 07-MAR-2014 (NJB) (BVS) */
/* -& */
/* Maximum polynomial degree supported by the current */
/* implementation of this SPK type. */
/* The degree is compatible with the maximum degrees */
/* supported by types 13 and 21. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* SPK type 19 subtype codes: */
/* Subtype 0: Hermite interpolation, 12-element packets. */
/* Subtype 1: Lagrange interpolation, 6-element packets. */
/* Packet sizes associated with the various subtypes: */
/* Number of subtypes: */
/* Maximum packet size for type 19: */
/* Minimum packet size for type 19: */
/* The SPKPVN record size declared in spkrec.inc must be at least as */
/* large as the maximum possible size of an SPK type 19 record. */
/* The largest possible SPK type 19 record has subtype 1 (note that */
/* records of subtype 0 have half as many epochs as those of subtype */
/* 1, for a given polynomial degree). A type 1 record contains */
/* - The subtype and packet count */
/* - MAXDEG+1 packets of size S19PS1 */
/* - MAXDEG+1 time tags */
/* End of include file spk19.inc. */
/* $ Abstract */
/* Declare SPK data record size. This record is declared in */
/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */
/* (SPKExx) routines. */
/* $ 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 */
/* SPK */
/* $ Restrictions */
/* 1) If new SPK types are added, it may be necessary to */
/* increase the size of this record. The header of SPKPVN */
/* should be updated as well to show the record size */
/* requirement for each data type. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 05-OCT-2012 (NJB) */
/* Updated to support increase of maximum degree to 27 for types */
/* 2, 3, 8, 9, 12, 13, 18, and 19. See SPKPVN for a list */
/* of record size requirements as a function of data type. */
/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */
/* -& */
/* End include file spkrec.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I NAIF ID code for an ephemeris object. */
/* CENTER I NAIF ID code for center of motion of BODY. */
/* FRAME I Reference frame name. */
/* FIRST I Start time of interval covered by segment. */
/* LAST I End time of interval covered by segment. */
/* SEGID I Segment identifier. */
/* NINTVL I Number of mini-segments and interpolation */
/* intervals. */
/* NPKTS I Array of packet counts of mini-segments. */
/* SUBTPS I Array of segment subtypes of mini-segments. */
/* DEGRES I Array of polynomial degrees of mini-segments. */
/* PACKTS I Array of data packets of mini-segments. */
/* EPOCHS I Array of epochs of mini-segments. */
/* IVLBDS I Interpolation interval bounds. */
/* SELLST I Interval selection flag. */
/* MAXDEG P Maximum allowed degree of interpolating polynomial. */
/* $ Detailed_Input */
/* HANDLE is the handle of an SPK file that has been opened */
/* for writing. */
/* BODY is the NAIF integer code for an ephemeris object */
/* whose state relative to another body is described */
/* by the segment to be created. */
/* CENTER is the NAIF integer code for the center of motion */
/* of the object identified by BODY. */
/* FRAME is the NAIF name for a reference frame */
/* relative to which the state information for BODY */
/* is specified. */
/* FIRST, */
/* LAST are, respectively, the bounds of the time interval */
/* over which the segment defines the state of BODY. */
/* FIRST must be greater than or equal to the first */
/* interpolation interval start time; LAST must be */
/* less than or equal to the last interpolation */
/* interval stop time. See the description of IVLBDS */
/* below. */
/* SEGID is the segment identifier. An SPK segment */
/* identifier may contain up to 40 characters. */
/* NINTVL is the number of interpolation intervals */
/* associated with the input data. The interpolation */
/* intervals are associated with data sets referred */
/* to as "mini-segments." */
/* The input data comprising each mini-segment are: */
/* - a packet count */
/* - a type 19 subtype */
/* - an interpolating polynomial degree */
/* - a sequence of type 19 data packets */
/* - a sequence of packet epochs */
/* These inputs are described below. */
/* NPKTS is an array of packet counts. The Ith element of */
/* NPKTS is the packet count of the Ith interpolation */
/* interval/mini-segment. */
/* NPKTS has dimension NINTVL. */
/* SUBTPS is an array of type 19 subtypes. The Ith element */
/* of SUBTPS is the subtype of the packets associated */
/* with the Ith interpolation interval/mini-segment. */
/* SUBTPS has dimension NINTVL. */
/* DEGRES is an array of interpolating polynomial degrees. */
/* The Ith element of DEGRES is the polynomial degree */
/* of the packets associated with the Ith */
/* interpolation interval/mini-segment. */
/* For subtype 0, interpolation degrees must be */
/* equivalent to 3 mod 4, that is, they must be in */
/* the set */
/* { 3, 7, 11, ..., MAXDEG } */
/* For subtype 1, interpolation degrees must be odd */
/* and must be in the range 1:MAXDEG. */
/* DEGRES has dimension NINTVL. */
/* PACKTS is an array containing data packets for all input */
/* mini-segments. The packets for a given */
/* mini-segment are stored contiguously in increasing */
/* time order. The order of the sets of packets for */
/* different mini-segments is the same as the order */
/* of their corresponding interpolation intervals. */
/* Each packet represents geometric states of BODY */
/* relative to CENTER, specified relative to FRAME. */
/* The packet structure depends on the segment */
/* subtype as follows: */
/* Type 0 (indicated by code S19TP0): */
/* x, y, z, dx/dt, dy/dt, dz/dt, */
/* vx, vy, vz, dvx/dt, dvy/dt, dvz/dt */
/* where x, y, z represent Cartesian position */
/* components and vx, vy, vz represent Cartesian */
/* velocity components. Note well: vx, vy, and */
/* vz *are not necessarily equal* to the time */
/* derivatives of x, y, and z. This packet */
/* structure mimics that of the Rosetta/MEX orbit */
/* file. */
/* Type 1 (indicated by code S19TP1): */
/* x, y, z, dx/dt, dy/dt, dz/dt */
/* where x, y, z represent Cartesian position */
/* components and vx, vy, vz represent Cartesian */
/* velocity components. */
/* Position units are kilometers, velocity units */
/* are kilometers per second, and acceleration units */
/* are kilometers per second per second. */
/* EPOCHS is an array containing epochs for all input */
/* mini-segments. Each epoch is expressed as seconds */
/* past J2000 TDB. The epochs have a one-to-one */
/* relationship with the packets in the input packet */
/* array. */
/* The epochs for a given mini-segment are stored */
/* contiguously in increasing order. The order of the */
/* sets of epochs for different mini-segments is the */
/* same as the order of their corresponding */
/* interpolation intervals. */
/* For each mini-segment, "padding" is allowed: the */
/* sequence of epochs for that mini-segment may start */
/* before the corresponding interpolation interval */
/* start time and end after the corresponding */
/* interpolation interval stop time. Padding is used */
/* to control behavior of interpolating polynomials */
/* near interpolation interval boundaries. */
/* Due to possible use of padding, the elements of */
/* EPOCHS, taken as a whole, may not be in increasing */
/* order. */
/* IVLBDS is an array of interpolation interval boundary */
/* times. This array is an ordered list of the */
/* interpolation interval start times, to which the */
/* the end time for the last interval is appended. */
/* The Ith interpolation interval is the time */
/* coverage interval of the Ith mini-segment (see the */
/* description of NPKTS above). */
/* For each mini-segment, the corresponding */
/* interpolation interval's start time is greater */
/* than or equal to the mini-segment's first epoch, */
/* and the interval's stop time is less than or equal */
/* to the mini-segment's last epoch. */
/* For each interpolation interval other than the */
/* last, the interval's coverage stop time coincides */
/* with the coverage start time of the next interval. */
/* There are no coverage gaps, and coverage overlap */
/* for adjacent intervals consists of a single epoch. */
/* IVLBDS has dimension NINTVL+1. */
/* SELLST is a logical flag indicating to the SPK type 19 */
/* segment reader SPKR19 how to select the */
/* interpolation interval when a request time */
/* coincides with a time boundary shared by two */
/* interpolation intervals. When SELLST ("select */
/* last") is .TRUE., the later interval is selected; */
/* otherwise the earlier interval is selected. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* MAXDEG is the maximum allowed degree of the interpolating */
/* polynomial. */
/* See the INCLUDE file spk19.inc for the value of */
/* MAXDEG. */
/* $ Exceptions */
/* If any of the following exceptions occur, this routine will return */
/* without creating a new segment. */
/* 1) If FIRST is greater than LAST then the error */
/* SPICE(BADDESCRTIMES) will be signaled. */
/* 2) If FRAME is not a recognized name, the error */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 3) If the last non-blank character of SEGID occurs past index */
/* 40, the error SPICE(SEGIDTOOLONG) is signaled. */
/* 4) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signaled. */
/* 5) If NINTVL is not at least 1, the error SPICE(INVALIDCOUNT) */
/* is signaled. */
/* 6) If the elements of the array IVLBDS are not in strictly */
/* increasing order, the error SPICE(BOUNDSOUTOFORDER) will be */
/* signaled. */
/* 7) If the first interval start time IVLBDS(1) is greater than */
/* FIRST, or if the last interval end time IVLBDS(N+1) is less */
/* than LAST, the error SPICE(COVERAGEGAP) will be signaled. */
/* 8) If any packet count in the array NPKTS is not at least 2, the */
/* error SPICE(TOOFEWPACKETS) will be signaled. */
/* 9) If any subtype code in the array SUBTPS is not recognized, */
/* the error SPICE(INVALIDSUBTYPE) will be signaled. */
/* 10) If any interpolation degree in the array DEGRES */
/* is not at least 1 or is greater than MAXDEG, the */
/* error SPICE(INVALIDDEGREE) is signaled. */
/* 11) If the window size implied by any element of the array DEGRES */
/* is odd, the error SPICE(BADWINDOWSIZE) is signaled. */
/* 12) If the elements of the array EPOCHS corresponding to a given */
/* mini-segment are not in strictly increasing order, the error */
/* SPICE(TIMESOUTOFORDER) will be signaled. */
/* 13) If the first epoch of a mini-segment exceeds the start */
/* time of the associated interpolation interval, or if the */
/* last epoch of the mini-segment precedes the end time of the */
/* interpolation interval, the error SPICE(BOUNDSDISAGREE) */
/* is signaled. */
/* 14) Any error that occurs while writing the output segment will */
/* be diagnosed by routines in the call tree of this routine. */
/* $ Files */
/* A new type 19 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 19 data segment to the open SPK */
/* file according to the format described in the type 19 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* $ Examples */
/* Suppose that you have states and are prepared to produce */
/* a segment of type 19 in an SPK file. */
/* The following code fragment could be used to add the new segment */
/* to a previously opened SPK file attached to HANDLE. The file must */
/* have been opened with write access. */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_SPK_TYPE_19_SEGMENT' */
/* C */
/* C Write the segment. */
/* C */
/* CALL SPKW19 ( HANDLE, BODY, CENTER, FRAME, */
/* . FIRST, LAST, SEGID, NINTVL, */
/* . NPKTS, SUBTPS, DEGRES, PACKTS, */
/* . EPOCHS, IVLBDS, SELLST ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 05-FEB-2014 (NJB) (BVS) */
/* -& */
/* $ Index_Entries */
/* write spk type_19 ephemeris data segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved values */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW19", (ftnlen)6);
/* Start with a parameter compatibility check. */
if (FALSE_) {
setmsg_("SPK type 19 record size may be as large as #, but SPKPVN re"
"cord size is #.", (ftnlen)74);
errint_("#", &c__198, (ftnlen)1);
errint_("#", &c__198, (ftnlen)1);
sigerr_("SPICE(BUG0)", (ftnlen)11);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure the segment descriptor bounds are */
/* correctly ordered. */
if (*last < *first) {
setmsg_("Segment start time is #; stop time is #; bounds must be in "
"nondecreasing order.", (ftnlen)79);
errdp_("#", first, (ftnlen)1);
errdp_("#", last, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
namfrm_(frame, &refcod, frame_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", frame, (ftnlen)1, frame_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Now check that all the characters in the segment identifier */
/* can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
chrcod = *(unsigned char *)&segid[i__ - 1];
if (chrcod < 32 || chrcod > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* The mini-segment/interval count must be positive. */
if (*nintvl < 1) {
setmsg_("Mini-segment/interval count was #; this count must be posit"
"ive.", (ftnlen)63);
errint_("#", nintvl, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure the interval bounds form a strictly */
/* increasing sequence. */
/* Note that there are NINTVL+1 bounds. */
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
if (ivlbds[i__ - 1] >= ivlbds[i__]) {
setmsg_("Interval bounds at indices # and # are # and # respecti"
"vely. The difference is #. The bounds are required to be"
" strictly increasing.", (ftnlen)132);
errint_("#", &i__, (ftnlen)1);
i__2 = i__ + 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
errdp_("#", &ivlbds[i__], (ftnlen)1);
d__1 = ivlbds[i__] - ivlbds[i__ - 1];
errdp_("#", &d__1, (ftnlen)1);
sigerr_("SPICE(BOUNDSOUTOFORDER)", (ftnlen)23);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* Make sure the time span of the descriptor doesn't extend */
/* beyond the span of the interval bounds. */
if (*first < ivlbds[0] || *last > ivlbds[*nintvl]) {
setmsg_("First interval start time is #; segment start time is #; se"
"gment stop time is #; last interval stop time is #. This seq"
"uence of times is required to be non-decreasing: segment cov"
"erage must be contained within the union of the interpolatio"
"n intervals.", (ftnlen)251);
errdp_("#", ivlbds, (ftnlen)1);
errdp_("#", first, (ftnlen)1);
errdp_("#", last, (ftnlen)1);
errdp_("#", &ivlbds[*nintvl], (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Check the input data before writing to the file. */
/* This order of operations entails some redundant */
/* calculations, but it allows for rapid error */
/* detection. */
/* Initialize the mini-segment packet array indices, */
/* and those of the mini-segment epoch array as well. */
pktbeg = 0;
pktend = 0;
bepix = 0;
eepix = 0;
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
/* First, just make sure the packet count for the current */
/* mini-segment is at least two. This check reduces our chances */
/* of a subscript range violation. */
/* Check the number of packets. */
if (npkts[i__ - 1] < 2) {
setmsg_("At least 2 packets are required for SPK type 19. Number"
" of packets supplied was # in mini-segment at index #.", (
ftnlen)109);
errint_("#", &npkts[i__ - 1], (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Set the packet size, which is a function of the subtype. Also */
/* set the window size. First check the subtype, which will be */
/* used as an array index. */
subtyp = subtps[i__ - 1];
if (subtyp < 0 || subtyp > 1) {
setmsg_("Unexpected SPK type 19 subtype # found in mini-segment "
"#.", (ftnlen)57);
errint_("#", &subtyp, (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(INVALIDSUBTYPE)", (ftnlen)21);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
pktsiz = pktszs[(i__2 = subtyp) < 2 && 0 <= i__2 ? i__2 : s_rnge(
"pktszs", i__2, "spkw19_", (ftnlen)689)];
if (odd_(&subtyp)) {
winsiz = degres[i__ - 1] + 1;
} else {
winsiz = (degres[i__ - 1] + 1) / 2;
}
/* Make sure that the degree of the interpolating polynomials is */
/* in range. */
if (degres[i__ - 1] < 1 || degres[i__ - 1] > 27) {
setmsg_("The interpolating polynomials of mini-segment # have de"
"gree #; the valid degree range is [1, #]", (ftnlen)95);
errint_("#", &i__, (ftnlen)1);
errint_("#", °res[i__ - 1], (ftnlen)1);
errint_("#", &c__27, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure that the window size is even. */
if (odd_(&winsiz)) {
setmsg_("The interpolating polynomials of mini-segment # have wi"
"ndow size # and degree # for SPK type 19. The mini-segme"
"nt subtype is #. The degree must be equivalent to 3 mod "
"4 for subtype 0 (Hermite interpolation) and be odd for s"
"ubtype 1 (Lagrange interpolation).", (ftnlen)257);
errint_("#", &i__, (ftnlen)1);
errint_("#", &winsiz, (ftnlen)1);
errint_("#", °res[i__ - 1], (ftnlen)1);
errint_("#", &subtps[i__ - 1], (ftnlen)1);
sigerr_("SPICE(BADWINDOWSIZE)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure the epochs of the Ith mini-segment form a */
/* strictly increasing sequence. */
/* To start out, determine the indices of the epoch sequence */
/* of the Ith mini-segment. We'll call the begin and end */
/* epoch indices BEPIX and EEPIX respectively. */
bepix = eepix + 1;
eepix = bepix - 1 + npkts[i__ - 1];
i__2 = npkts[i__ - 1] - 1;
for (j = 1; j <= i__2; ++j) {
k = bepix + j - 1;
if (epochs[k - 1] >= epochs[k]) {
setmsg_("In mini-segment #, epoch # having index # in array "
"EPOCHS and index # in the mini-segment is greater th"
"an or equal to its successor #.", (ftnlen)134);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &epochs[k - 1], (ftnlen)1);
errint_("#", &k, (ftnlen)1);
errint_("#", &j, (ftnlen)1);
errdp_("#", &epochs[k], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* Make sure that the span of the input epochs of the Ith */
/* mini-segment includes the Ith interpolation interval. */
if (epochs[bepix - 1] > ivlbds[i__ - 1]) {
setmsg_("Interpolation interval # start time # precedes mini-seg"
"ment's first epoch #.", (ftnlen)76);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
errdp_("#", &epochs[bepix - 1], (ftnlen)1);
sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21);
chkout_("SPKW19", (ftnlen)6);
return 0;
} else if (epochs[eepix - 1] < ivlbds[i__]) {
setmsg_("Interpolation interval # end time # exceeds mini-segmen"
"t's last epoch #.", (ftnlen)72);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &ivlbds[i__], (ftnlen)1);
errdp_("#", &epochs[eepix - 1], (ftnlen)1);
sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* If we made it this far, we're ready to start writing the segment. */
/* The type 19 segment structure is eloquently described by this */
/* diagram from the SPK Required Reading: */
/* +--------------------------------+ */
/* | Interval 1 mini-segment | */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval N mini-segment | */
/* +--------------------------------+ */
/* | Interval 1 start time | */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval N start time | */
/* +--------------------------------+ */
/* | Interval N stop time | */
/* +--------------------------------+ */
/* | Interval start 100 | (First interval directory) */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval start (N/100)*100 | (Last interval directory) */
/* +--------------------------------+ */
/* | Interval 1 start pointer | */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval N start pointer | */
/* +--------------------------------+ */
/* | Interval N stop pointer + 1 | */
/* +--------------------------------+ */
/* | Boundary choice flag | */
/* +--------------------------------+ */
/* | Number of intervals | */
/* +--------------------------------+ */
/* SPK type 19 mini-segments have the following structure: */
/* +-----------------------+ */
/* | Packet 1 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Packet M | */
/* +-----------------------+ */
/* | Epoch 1 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Epoch M | */
/* +-----------------------+ */
/* | Epoch 100 | (First time tag directory) */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Epoch ((M-1)/100)*100 | (Last time tag directory) */
/* +-----------------------+ */
/* | Subtype code | */
/* +-----------------------+ */
/* | Window size | */
/* +-----------------------+ */
/* | Number of packets | */
/* +-----------------------+ */
/* Create the segment descriptor. We don't use SPKPDS because */
/* that routine doesn't allow creation of a singleton segment. */
ic[0] = *body;
ic[1] = *center;
ic[2] = refcod;
ic[3] = 19;
dc[0] = *first;
dc[1] = *last;
dafps_(&c__2, &c__6, dc, ic, descr);
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Re-initialize the mini-segment packet array indices, */
/* and those of the mini-segment epoch array as well. */
pktbeg = 0;
pktend = 0;
bepix = 0;
eepix = 0;
/* Write data for each mini-segment to the file. */
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Set the packet size, which is a function of the subtype. */
subtyp = subtps[i__ - 1];
pktsiz = pktszs[(i__2 = subtyp) < 2 && 0 <= i__2 ? i__2 : s_rnge(
"pktszs", i__2, "spkw19_", (ftnlen)931)];
if (odd_(&subtyp)) {
winsiz = degres[i__ - 1] + 1;
} else {
winsiz = (degres[i__ - 1] + 1) / 2;
}
/* Now that we have the packet size, we can compute */
/* mini-segment packet index range. We'll let PKTDSZ */
/* be the total count of packet data entries for this */
/* mini-segment. */
pktdsz = npkts[i__ - 1] * pktsiz;
pktbeg = pktend + 1;
pktend = pktbeg - 1 + pktdsz;
/* At this point, we're read to start writing the */
/* current mini-segment to the file. Start with the */
/* packet data. */
dafada_(&packts[pktbeg - 1], &pktdsz);
/* Write the epochs for this mini-segment. */
bepix = eepix + 1;
eepix = bepix - 1 + npkts[i__ - 1];
dafada_(&epochs[bepix - 1], &npkts[i__ - 1]);
/* Compute the number of epoch directories for the */
/* current mini-segment. */
ndir = (npkts[i__ - 1] - 1) / 100;
/* Write the epoch directories to the segment. */
i__2 = ndir;
for (j = 1; j <= i__2; ++j) {
k = bepix - 1 + j * 100;
dafada_(&epochs[k - 1], &c__1);
}
/* Write the mini-segment's subtype, window size, and packet */
/* count to the segment. */
d__1 = (doublereal) subtps[i__ - 1];
dafada_(&d__1, &c__1);
d__1 = (doublereal) winsiz;
dafada_(&d__1, &c__1);
d__1 = (doublereal) npkts[i__ - 1];
dafada_(&d__1, &c__1);
if (failed_()) {
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* We've finished writing the mini-segments. */
/* Next write the interpolation interval bounds. */
i__1 = *nintvl + 1;
dafada_(ivlbds, &i__1);
/* Create and write directories for the interval */
/* bounds. */
/* The directory count is the interval bound count */
/* (N+1), minus 1, divided by the directory size. */
ndir = *nintvl / 100;
i__1 = ndir;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&ivlbds[i__ * 100 - 1], &c__1);
}
/* Now we compute and write the start/stop pointers */
/* for each mini-segment. */
/* The pointers are relative to the DAF address */
/* preceding the segment. For example, a pointer */
/* to the first DAF address in the segment has */
/* value 1. */
segend = 0;
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Set the packet size, which is a function of the subtype. */
pktsiz = pktszs[(i__2 = subtps[i__ - 1]) < 2 && 0 <= i__2 ? i__2 :
s_rnge("pktszs", i__2, "spkw19_", (ftnlen)1033)];
/* In order to compute the end pointer of the current */
/* mini-segment, we must compute the size, in terms */
/* of DAF addresses, of this mini-segment. The formula */
/* for the size is */
/* size = n_packets * packet_size */
/* + n_epochs */
/* + n_epoch_directories */
/* + 3 */
/* = n_packets * ( packet_size + 1 ) */
/* + ( n_packets - 1 ) / DIRSIZ */
/* + 3 */
minisz = npkts[i__ - 1] * (pktsiz + 1) + (npkts[i__ - 1] - 1) / 100 +
3;
segbeg = segend + 1;
segend = segbeg + minisz - 1;
/* Write the mini-segment begin pointer. */
/* After the loop terminates, the final end pointer, incremented */
/* by 1, will be written. */
d__1 = (doublereal) segbeg;
dafada_(&d__1, &c__1);
}
/* Write the last mini-segment end pointer, incremented by one. */
/* SEGEND was computed on the last iteration of the above loop. */
d__1 = (doublereal) (segend + 1);
dafada_(&d__1, &c__1);
/* Write out the interval selection flag. The input */
/* boolean value is represented by a numeric constant. */
if (*sellst) {
isel = 1;
} else {
isel = -1;
}
d__1 = (doublereal) isel;
dafada_(&d__1, &c__1);
/* Write the mini-segment/interpolation interval count. */
d__1 = (doublereal) (*nintvl);
dafada_(&d__1, &c__1);
/* End the segment. */
dafena_();
chkout_("SPKW19", (ftnlen)6);
return 0;
} /* spkw19_ */
/* $Procedure SPKPV ( S/P Kernel, position and velocity ) */
/* Subroutine */ int spkpv_(integer *handle, doublereal *descr, doublereal *
et, char *ref, doublereal *state, integer *center, ftnlen ref_len)
{
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *), chkin_(char *, ftnlen), dafus_(
doublereal *, integer *, integer *, doublereal *, integer *),
errch_(char *, char *, ftnlen, ftnlen);
doublereal xform[36] /* was [6][6] */, dc[2];
integer ic[6];
extern /* Subroutine */ int frmchg_(integer *, integer *, doublereal *,
doublereal *), namfrm_(char *, integer *, ftnlen);
integer irfreq;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
doublereal tstate[6];
extern logical return_(void);
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
integer irf;
/* $ Abstract */
/* Return the state (position and velocity) of a target body */
/* relative to some center of motion in a specified 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 */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* STATE O Position, velocity. */
/* CENTER O Center of state. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle assigned to a SPK file, and the */
/* descriptor for a segment within the file. Together */
/* they determine the ephemeris data from which the */
/* state of the body is to be computed. */
/* ET is the epoch (ephemeris time) at which the state */
/* 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 FRMCHG. */
/* $ Detailed_Output */
/* STATE contains the position and velocity, at epoch ET, */
/* for whatever body is covered by the specified segment. */
/* STATE has six elements: the first three contain the */
/* body's position; the last three contain the body's */
/* velocity. These vectors are rotated into the */
/* specified reference frame, the origin of */
/* which is located at the center of motion for the */
/* body (see CENTER, below). Units are always km and */
/* km/sec. */
/* CENTER is the integer ID code of the center of motion for */
/* the state. */
/* $ Parameters */
/* NONE. */
/* $ Files */
/* See argument HANDLE. */
/* $ Exceptions */
/* 1) If the requested reference frame is not supported by the */
/* current version of CHGIRF, the error 'SPICE(SPKREFNOTSUPP)' */
/* is signalled. */
/* $ Particulars */
/* Once SPKPV was the most basic of the SPK readers, the reader upon */
/* which SPKSSB, SPKAPP, and SPKEZ were built. However, its function */
/* has now largely been replaced by SPKPVN. SPKPV should not normally */
/* be called except by old software written before the release of */
/* SPKPVN. This routine should be considered obsolete. */
/* $ Examples */
/* In the following code fragment, an entire SPK file is searched */
/* for segments containing a particular epoch. For each one found, */
/* the body, center, segment identifier, and range at the epoch */
/* are printed out. */
/* CALL DAFOPR ( 'TEST.SPK', HANDLE ) */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( FOUND ) */
/* DO WHILE ( FOUND ) */
/* CALL DAFGS ( DESCR ) */
/* CALL DAFUS ( DESCR, 2, 6, DC, IC ) */
/* IF ( DC(1) .LE. ET .AND. ET .LE. DC(2) ) THEN */
/* CALL SPKPV ( HANDLE, DESCR, ET, 'J2000', STATE, CENTER ) */
/* CALL DAFGN ( IDENT ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Body = ', IC(1) */
/* WRITE (*,*) 'Center = ', CENTER, */
/* WRITE (*,*) 'ID = ', IDENT */
/* WRITE (*,*) 'Range = ', VNORM ( STATE ) */
/* END IF */
/* CALL DAFFNA ( FOUND ) */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* J.M. Lynch (JPL) */
/* R.E. Thurman (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 6.0.0, 19-SEP-1995 (WLT) */
/* The routine was updated to handle non-inertial frames. */
/* - SPICELIB Version 5.0.0, 13-MAR-1995 (KRG) */
/* The routine was updated to handle type 14. */
/* A new exception, 3, was also added. */
/* - SPICELIB Version 4.0.0, 04-NOV-1994 (WLT) */
/* The routine was updated to handle type 15. */
/* - SPICELIB Version 3.0.0, 04-AUG-1993 (NJB) */
/* The routine was updated to handle types 08 and 09. */
/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */
/* The routine was updated to handle type 05. */
/* - SPICELIB Version 1.0.2, 18-JUL-1991 (NJB) */
/* The description of the output STATE was expanded slightly. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (RET) */
/* -& */
/* $ Index_Entries */
/* position and velocity from ephemeris */
/* spk file position and velocity */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 6.0.0, 6-OCT-1994 (WLT) */
/* The routine was updated to handle non-inertial frames. */
/* - SPICELIB Version 5.0.0, 13-MAR-1995 (KRG) */
/* The routine was updated to handle type 14. */
/* A new exception, 3, was also added. */
/* - SPICELIB Version 4.0.0, 04-NOV-1994 (WLT) */
/* The routine was updated to handle type 15. */
/* - SPICELIB Version 3.0.0, 04-AUG-1993 (NJB) */
/* The routine was updated to handle types 08 and 09. */
/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */
/* The routine was updated to handle type 05. */
/* -& */
/* SPICELIB functions */
/* Some local space is needed in which to return records, and */
/* into which to unpack the segment descriptor. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKPV", (ftnlen)5);
}
dafus_(descr, &c__2, &c__6, dc, ic);
*center = ic[1];
irf = ic[2];
/* Rotate the raw state from its native frame to the only if the */
/* native frame differs from the one requested by the user. */
namfrm_(ref, &irfreq, ref_len);
if (irfreq == 0) {
setmsg_("No support for frame #.", (ftnlen)23);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(SPKREFNOTSUPP)", (ftnlen)20);
} else if (irfreq != irf) {
spkpvn_(handle, descr, et, &irf, tstate, center);
frmchg_(&irf, &irfreq, et, xform);
mxvg_(xform, tstate, &c__6, &c__6, state);
} else {
spkpvn_(handle, descr, et, &irf, state, center);
}
chkout_("SPKPV", (ftnlen)5);
return 0;
} /* spkpv_ */
