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