/* $Procedure CKR04 ( C-kernel, read pointing record, data type 4 ) */
/* Subroutine */ int ckr04_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
*found)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer nrec, ends, indx;
doublereal lbnd1, lbnd2, rbnd1;
integer k;
extern /* Subroutine */ int chkin_(char *, ftnlen), cknr04_(integer *,
doublereal *, integer *), dafus_(doublereal *, integer *, integer
*, doublereal *, integer *);
doublereal value;
logical exist;
doublereal midpt1, midpt2;
extern logical failed_(void);
integer numall;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numcft[7];
extern /* Subroutine */ int chkout_(char *, ftnlen), sgfpkt_(integer *,
doublereal *, integer *, integer *, doublereal *, integer *),
sgfrvi_(integer *, doublereal *, doublereal *, doublereal *,
integer *, logical *);
doublereal clkout;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
doublereal dcd[2];
integer icd[6];
extern /* Subroutine */ int zzck4d2i_(doublereal *, integer *, doublereal
*, integer *);
doublereal rad1, rad2;
/* $ Abstract */
/* Read a single data record from a type 4 CK segment. */
/* $ 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 */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* Declarations of the CK data type specific and general CK low */
/* level routine parameters. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK.REQ */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* 1) If new CK types are added, the size of the record passed */
/* between CKRxx and CKExx must be registered as separate */
/* parameter. If this size will be greater than current value */
/* of the CKMRSZ parameter (which specifies the maximum record */
/* size for the record buffer used inside CKPFS) then it should */
/* be assigned to CKMRSZ as a new value. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* CK Required Reading. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 27-JAN-2014 (NJB) */
/* Updated to support CK type 6. Maximum degree for */
/* type 5 was updated to be consistent with the */
/* maximum degree for type 6. */
/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
/* Updated to support CK type 5. */
/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
/* -& */
/* Number of quaternion components and number of quaternion and */
/* angular rate components together. */
/* CK Type 1 parameters: */
/* CK1DTP CK data type 1 ID; */
/* CK1RSZ maximum size of a record passed between CKR01 */
/* and CKE01. */
/* CK Type 2 parameters: */
/* CK2DTP CK data type 2 ID; */
/* CK2RSZ maximum size of a record passed between CKR02 */
/* and CKE02. */
/* CK Type 3 parameters: */
/* CK3DTP CK data type 3 ID; */
/* CK3RSZ maximum size of a record passed between CKR03 */
/* and CKE03. */
/* CK Type 4 parameters: */
/* CK4DTP CK data type 4 ID; */
/* CK4PCD parameter defining integer to DP packing schema that */
/* is applied when seven number integer array containing */
/* polynomial degrees for quaternion and angular rate */
/* components packed into a single DP number stored in */
/* actual CK records in a file; the value of must not be */
/* changed or compatibility with existing type 4 CK files */
/* will be lost. */
/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
/* records; the value of this parameter must never exceed */
/* value of the CK4PCD; */
/* CK4SFT number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 4 */
/* CK record that passed between routines CKR04 and CKE04; */
/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
/* and CKE04; CK4RSZ is computed as follows: */
/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
/* CK Type 5 parameters: */
/* CK5DTP CK data type 5 ID; */
/* CK5MXD maximum polynomial degree allowed in type 5 */
/* records. */
/* CK5MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 5 */
/* CK record that passed between routines CKR05 and CKE05; */
/* CK5MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck05.inc */
/* for a description of the subtypes. */
/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
/* and CKE05; CK5RSZ is computed as follows: */
/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
/* CK Type 6 parameters: */
/* CK6DTP CK data type 6 ID; */
/* CK6MXD maximum polynomial degree allowed in type 6 */
/* records. */
/* CK6MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 6 */
/* CK record that passed between routines CKR06 and CKE06; */
/* CK6MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck06.inc */
/* for a description of the subtypes. */
/* CK6RSZ maximum size of type 6 CK record passed between CKR06 */
/* and CKE06; CK6RSZ is computed as follows: */
/* CK6RSZ = CK6MET + ( CK6MXD + 1 ) * ( CK6PS3 + 1 ) */
/* where CK6PS3 is equal to the parameter CK06PS3 defined */
/* in ck06.inc. Note that the subtype having the largest */
/* packet size (subtype 2) does not give rise to the */
/* largest record size, because that type is Hermite and */
/* requires half the window size used by subtype 3 for a */
/* given polynomial degree. */
/* The parameter CK6PS3 must be in sync with C06PS3 defined in */
/* ck06.inc. */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK5RSZ.) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Pointing request time. */
/* TOL I Time tolerance. */
/* NEEDAV I Angular velocity request flag. */
/* RECORD O Pointing data record. */
/* FOUND O True when a record covering SCLKDP is found. */
/* $ Detailed_Input */
/* HANDLE is the integer handle of the CK file containing the */
/* segment. */
/* DESCR is the descriptor of the segment. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is being requested. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. */
/* When SCLKDP falls within the bounds of one of the */
/* interpolation intervals then the tolerance has no */
/* effect because pointing will be returned at the */
/* request time. */
/* However, if the request time is not in one of the */
/* intervals, then the tolerance is used to determine */
/* if pointing at one of the interval endpoints should */
/* be returned. */
/* NEEDAV is true if angular velocity is requested. */
/* $ Detailed_Output */
/* RECORD is the record that CKE04 will evaluate to determine */
/* the pointing and it includes parameters: */
/* --------------------------------------------------- */
/* | Encoded onboard time which is the closest | */
/* | to SCLKDP and belongs to one of approximation | */
/* | intervals | */
/* --------------------------------------------------- */
/* | encoded SCLK time of the midpoint of | */
/* | interpolation interval | */
/* --------------------------------------------------- */
/* | radii of interpolation interval | */
/* | expressed as double precision SCLK ticks | */
/* --------------------------------------------------- */
/* | Number of coefficients for q0 | */
/* --------------------------------------------------- */
/* | Number of coefficients for q1 | */
/* --------------------------------------------------- */
/* | Number of coefficients for q2 | */
/* --------------------------------------------------- */
/* | Number of coefficients for q3 | */
/* --------------------------------------------------- */
/* | Number of coefficients for AV1 | */
/* --------------------------------------------------- */
/* | Number of coefficients for AV2 | */
/* --------------------------------------------------- */
/* | Number of coefficients for AV3 | */
/* --------------------------------------------------- */
/* | q0 Cheby coefficients | */
/* --------------------------------------------------- */
/* | q1 Cheby coefficients | */
/* --------------------------------------------------- */
/* | q2 Cheby coefficients | */
/* --------------------------------------------------- */
/* | q3 Cheby coefficients | */
/* --------------------------------------------------- */
/* | AV1 Cheby coefficients (optional) | */
/* --------------------------------------------------- */
/* | AV2 Cheby coefficients (optional) | */
/* --------------------------------------------------- */
/* | AV3 Cheby coefficients (optional) | */
/* --------------------------------------------------- */
/* FOUND is true if a record was found to satisfy the pointing */
/* request. This occurs when the time for which pointing */
/* is requested falls inside one of the interpolation */
/* intervals, or when the request time is within the */
/* tolerance of an interval endpoint. */
/* $ Parameters */
/* See 'ckparam.inc'. */
/* $ Exceptions */
/* 1) If the specified handle does not belong to an open DAF file, */
/* an error is diagnosed by a routine that this routine calls. */
/* 2) If the specified descriptor does not belong a segment */
/* data in which are organized in accordance with generic */
/* segment architecture, an error is diagnosed by DAF generic */
/* segment routines that this routine calls. */
/* 3) If DESCR is not a valid descriptor of a segment in the CK */
/* file specified by HANDLE, the results of this routine are */
/* unpredictable. */
/* 4) If the segment is not of data type 4, as specified in the */
/* third integer component of the segment descriptor, then */
/* the error SPICE(WRONGDATATYPE) is signalled. */
/* 5) If angular velocity data was requested but the segment */
/* contains no such data, the error SPICE(NOAVDATA) is */
/* signalled. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the CK Required Reading file for a detailed description of */
/* the structure of a type 4 pointing segment. */
/* When the time for which pointing was requested falls within an */
/* interpolation interval, then FOUND will be true and RECORD will */
/* contain the set of Chebychev polynomial coefficients for the */
/* time interval that brackets the request time. CKE04 will */
/* evaluate RECORD to give pointing at the request time. */
/* However, when the request time is not within any of the */
/* interpolation intervals, then FOUND will be true only if the */
/* interval endpoint closest to the request time is within the */
/* tolerance specified by the user. In this case RECORD will */
/* contain the set of Chebychev polynomial coefficients for the */
/* time interval one of the ends of which was within tolerance */
/* from the request time, and CKE04 will evaluate RECORD to give */
/* pointing at the time associated with that interval end time. */
/* $ Examples */
/* The CKRnn routines are usually used in tandem with the CKEnn */
/* routines, which evaluate the record returned by CKRnn to give */
/* the pointing information and output time. */
/* The following code fragment searches through all of the segments */
/* in a file applicable to the Mars Global Surveyor spacecraft bus */
/* that are of data type 4, for a particular spacecraft clock time. */
/* It then evaluates the pointing for that epoch and prints the */
/* result. */
/* C */
/* C CK parameters include file. */
/* C */
/* INCLUDE 'ckparam.inc' */
/* C */
/* C Declarations */
/* C */
/* CHARACTER*(20) SCLKCH */
/* CHARACTER*(20) SCTIME */
/* CHARACTER*(40) IDENT */
/* DOUBLE PRECISION AV ( 3 ) */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION DCD ( 2 ) */
/* DOUBLE PRECISION DESCR ( 5 ) */
/* DOUBLE PRECISION RECORD ( CK4RSZ ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOL */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER ICD ( 6 ) */
/* INTEGER INST */
/* INTEGER SC */
/* LOGICAL FND */
/* LOGICAL NEEDAV */
/* LOGICAL SFND */
/* C */
/* C Initial values. */
/* C */
/* SC = -94 */
/* INST = -94000 */
/* NEEDAV = .FALSE. */
/* C */
/* C Load the MGS SCLK kernel and the C-kernel. */
/* C */
/* CALL FURNSH( 'MGS_SCLK.TSC' ) */
/* CALL DAFOPR( 'MGS_CK4.BC', HANDLE ) */
/* C */
/* C Get the spacecraft clock time. Then encode it for use */
/* C in the C-kernel. */
/* C */
/* CALL PROMPT( 'Enter SCLK string: ', SCLKCH ) */
/* CALL SCENCD( SC, SCLKCH, SCLKDP ) */
/* C */
/* C Use a tolerance of 2 seconds (half of the nominal */
/* C separation between MGS pointing instances ). */
/* C */
/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */
/* C */
/* C Search from the beginning of the CK file through all */
/* C of the segments. */
/* C */
/* CALL DAFBFS( HANDLE ) */
/* CALL DAFFNA( SFND ) */
/* FND = .FALSE. */
/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */
/* C */
/* C Get the segment identifier and descriptor. */
/* C */
/* CALL DAFGN( IDENT ) */
/* CALL DAFGS( DESCR ) */
/* C */
/* C Unpack the segment descriptor into its integer and */
/* C double precision components. */
/* C */
/* CALL DAFUS( DESCR, 2, 6, DCD, ICD ) */
/* C */
/* C Determine if this segment should be processed. */
/* C */
/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */
/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */
/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */
/* . ( CK4DTP .EQ. ICD( 3 ) ) ) THEN */
/* C */
/* C Find CK 4 record covering requested time. */
/* C */
/* CALL CKR04( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FND ) */
/* IF ( FND ) THEN */
/* C */
/* C Compute pointing using found CK 4 record. */
/* C */
/* CALL CKE04( NEEDAV, RECORD, CMAT, AV, CLKOUT) */
/* CALL SCDECD( SC, CLKOUT, SCTIME ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Segment identifier: ', IDENT */
/* WRITE (*,*) */
/* WRITE (*,*) 'Pointing returned for time: ', */
/* . SCTIME */
/* WRITE (*,*) */
/* WRITE (*,*) 'C-matrix:' */
/* WRITE (*,*) */
/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */
/* WRITE (*,*) */
/* END IF */
/* END IF */
/* CALL DAFFNA ( SFND ) */
/* END DO */
/* $ Restrictions */
/* 1) The file containing the segment should be opened for read */
/* or write access either by CKLPF, DAFOPR, or DAFOPW. */
/* 2) The record returned by this routine is intended to be */
/* evaluated by CKE04. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* Y.K. Zaiko (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 18-APR-2014 (BVS) */
/* Minor header edits. */
/* - SPICELIB Version 1.0.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */
/* -& */
/* $ Index_Entries */
/* read record from type_4 CK segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKR04", (ftnlen)5);
}
/* Set initial value of the found flag to "NOT FOUND". */
*found = FALSE_;
/* We need to unpack and analyze descriptor components. The */
/* unpacked descriptor contains the following information */
/* about the segment: */
/* DCD(1) Initial encoded SCLK */
/* DCD(2) Final encoded SCLK */
/* ICD(1) Instrument */
/* ICD(2) Inertial reference frame */
/* ICD(3) Data type */
/* ICD(4) Angular velocity flag */
/* ICD(5) Initial address of segment data */
/* ICD(6) Final address of segment data */
dafus_(descr, &c__2, &c__6, dcd, icd);
/* Check if the segment is type 4. Signal an error if it's not. */
if (icd[2] != 4) {
setmsg_("The segment is not a type 4 segment. Type is #", (ftnlen)47)
;
errint_("#", &icd[2], (ftnlen)1);
sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
chkout_("CKR04", (ftnlen)5);
return 0;
}
if (*needav) {
/* Signal an error if angular velocities are required but */
/* they are not present in the segment. */
if (icd[3] != 1) {
setmsg_("Segment does not contain angular velocity data.", (
ftnlen)47);
sigerr_("SPICE(NOAVDATA)", (ftnlen)15);
chkout_("CKR04", (ftnlen)5);
return 0;
}
}
/* Get number of records (packets) in the segment. */
cknr04_(handle, descr, &nrec);
/* Locate the last time in the set of reference epochs less than or */
/* equal to the input SCLKDP. */
sgfrvi_(handle, descr, sclkdp, &value, &indx, &exist);
if (failed_()) {
chkout_("CKR04", (ftnlen)5);
return 0;
}
if (! exist) {
/* We didn't find reference value with means that SCLKDP is */
/* less than the left bound of the first interpolation interval. */
/* Fetch the first record. */
indx = 1;
sgfpkt_(handle, descr, &indx, &indx, record, &ends);
if (failed_()) {
chkout_("CKR04", (ftnlen)5);
return 0;
}
midpt1 = record[0];
rad1 = record[1];
/* Check whether SCLKDP is within TOL of the left bound of the */
/* first interval. */
lbnd1 = midpt1 - rad1 - *tol;
if (*sclkdp >= lbnd1) {
*found = TRUE_;
clkout = midpt1 - rad1;
}
} else {
/* We found reference value. */
if (indx >= nrec) {
/* The SCLKDP is greater than the left bound of the last */
/* interpolation interval. Fetch the last record. */
indx = nrec;
sgfpkt_(handle, descr, &indx, &indx, record, &ends);
if (failed_()) {
chkout_("CKR04", (ftnlen)5);
return 0;
}
midpt1 = record[0];
rad1 = record[1];
/* Check whether SCLKDP is within TOL of the right bound of */
/* the last interval. */
rbnd1 = midpt1 + rad1 + *tol;
if (*sclkdp <= rbnd1) {
*found = TRUE_;
/* Check whether SCLKDP falls between right bound of the */
/* last interval and right bound + TOL. */
rbnd1 = midpt1 + rad1;
if (*sclkdp >= rbnd1) {
clkout = midpt1 + rad1;
} else {
/* SCLKDP belongs to the last interval */
clkout = *sclkdp;
}
}
} else if (indx >= 1 && indx < nrec) {
/* The SCLKDP lies between left bound of the first interval */
/* and the right bound of the interval before the last */
/* interval. Fetch the found record. */
sgfpkt_(handle, descr, &indx, &indx, record, &ends);
if (failed_()) {
chkout_("CKR04", (ftnlen)5);
return 0;
}
midpt1 = record[0];
rad1 = record[1];
/* Check whether SCLKDP belongs to current interval. */
rbnd1 = midpt1 + rad1;
if (*sclkdp <= rbnd1) {
*found = TRUE_;
clkout = *sclkdp;
} else {
/* SCLKDP doesn't belong to current interval. Fetch the */
/* next packet. */
i__1 = indx + 1;
i__2 = indx + 1;
sgfpkt_(handle, descr, &i__1, &i__2, record, &ends);
if (failed_()) {
chkout_("CKR04", (ftnlen)5);
return 0;
}
midpt2 = record[0];
rad2 = record[1];
/* Find the closest interval bound for SCLKDP. */
rbnd1 = midpt1 + rad1;
lbnd2 = midpt2 - rad2;
if (*sclkdp - rbnd1 <= lbnd2 - *sclkdp) {
/* SCLKDP is closer to the right bound of current */
/* interval. Check whether it's within TOL of it. */
rbnd1 = midpt1 + rad1 + *tol;
if (*sclkdp <= rbnd1) {
*found = TRUE_;
clkout = midpt1 + rad1;
/* At this point we need to re-read our current */
/* record because it was overwritten by the next */
/* record. No FAILED() check here -- we already */
/* fetched this packet successfully one call to */
/* SGFPKT ago. */
sgfpkt_(handle, descr, &indx, &indx, record, &ends);
}
} else {
/* SCLKDP is closer to the left bound of the next */
/* interval. Check whether it's within TOL of it. */
lbnd2 = midpt2 - rad2 - *tol;
if (*sclkdp >= lbnd2) {
*found = TRUE_;
++indx;
clkout = midpt2 - rad2;
}
}
}
}
}
/* If we found the interval on segment the SCLKDP belongs to, then */
if (*found) {
/* Decode numbers of polynomial coefficients. */
zzck4d2i_(&record[2], &c__7, &c_b18, numcft);
/* Count total number of coefficients. */
numall = 0;
for (k = 1; k <= 7; ++k) {
numall += numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge(
"numcft", i__1, "ckr04_", (ftnlen)668)];
}
/* Move coefficients to the right and insert numbers of */
/* coefficients into output RECORD. */
for (k = numall; k >= 1; --k) {
record[k + 9] = record[k + 2];
}
for (k = 1; k <= 7; ++k) {
record[k + 2] = (doublereal) numcft[(i__1 = k - 1) < 7 && 0 <=
i__1 ? i__1 : s_rnge("numcft", i__1, "ckr04_", (ftnlen)
680)];
}
record[2] = record[1];
record[1] = record[0];
/* Insert CLKOUT into output RECORD */
record[0] = clkout;
}
/* All done. */
chkout_("CKR04", (ftnlen)5);
return 0;
} /* ckr04_ */
/* $Procedure SPKCOV ( SPK coverage ) */
/* Subroutine */ int spkcov_(char *spk, integer *idcode, doublereal *cover,
ftnlen spk_len)
{
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
char arch[80];
extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
logical found;
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
integer handle;
extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *,
char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
setmsg_(char *, ftnlen), wninsd_(doublereal *, doublereal *,
doublereal *);
char kertyp[80];
extern logical return_(void);
/* $ Abstract */
/* Find the coverage window for a specified ephemeris object in a */
/* specified 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 */
/* CELLS */
/* DAF */
/* SPK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* EPHEMERIS */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SPK I Name of SPK file. */
/* IDCODE I ID code of ephemeris object. */
/* COVER I/O Window giving coverage in SPK for IDCODE. */
/* $ Detailed_Input */
/* SPK is the name of an SPK file. */
/* IDCODE is the integer ID code of an object for which */
/* ephemeris data are expected to exist in the */
/* specified SPK file. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file SPK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. This is */
/* the set of time intervals for which data for */
/* IDCODE are present in the file SPK, merged with */
/* the set of time intervals present in COVER on */
/* input. The merged coverage is represented as the */
/* union of one or more disjoint time intervals. The */
/* window COVER contains the pairs of endpoints of */
/* these intervals. */
/* The interval endpoints contained in COVER are */
/* ephemeris times, expressed as seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* SPK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the SPK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output window argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* $ Files */
/* This routine reads an SPK file. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified SPK file provides for a specified */
/* ephemeris object. */
/* $ Examples */
/* 1) This example demonstrates combined usage of SPKCOV and the */
/* related SPK utility SKOBJ. */
/* Display the coverage for each object in a specified SPK file. */
/* Find the set of objects in the file; for each object, find */
/* and display the coverage. */
/* PROGRAM IDCOV */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER CARDI */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 1000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SPK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel for output time conversion. */
/* C SPKCOV itself does not require a leapseconds kernel. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* C */
/* C Get name of SPK file. */
/* C */
/* CALL PROMPT ( 'Name of SPK file > ', SPK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the SPK file. */
/* C */
/* CALL SPKOBJ ( SPK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL SPKCOV ( SPK, IDS(I), COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD ( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the coverage for the object designated by IDCODE */
/* provided by the set of SPK files loaded via a metakernel. */
/* (The metakernel must also specify a leapseconds kernel.) */
/* PROGRAM METCOV */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the SPK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded SPK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'SPK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'SPK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL SPKCOV ( FILE, IDCODE, COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD ( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) If an error occurs while this routine is updating the window */
/* COVER, the window may be corrupted. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 01-JUL-2014 (NJB) */
/* Added new index entries. */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 30-DEC-2004 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for spk_object */
/* get coverage start and stop time for spk_object */
/* get coverage start and stop time for ephemeris_object */
/* get coverage start and stop time for body */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKCOV", (ftnlen)6);
/* See whether GETFAT thinks we've got a binary SPK file. */
/* If not, indicate the specific problem. */
getfat_(spk, arch, kertyp, spk_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"SPK file to be readable by this routine. If the input file "
"is an SPK file in transfer format, run TOBIN on the file to "
"convert it to binary format.", (ftnlen)207);
errch_("#", spk, (ftnlen)1, spk_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("SPKCOV", (ftnlen)6);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"SPK file to be readable by this routine. Binary SPK files h"
"ave DAF architecture. If you expected the file to be a bina"
"ry SPK file, the problem may be due to the file being an old"
" non-native file lacking binary file format information. It'"
"s also possible the file has been corrupted.", (ftnlen)343);
errch_("#", spk, (ftnlen)1, spk_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("SPKCOV", (ftnlen)6);
return 0;
} else if (s_cmp(kertyp, "SPK", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has file type #. The file must be a binary SPK"
" file to be readable by this routine. If you expected the fi"
"le to be a binary SPK file, the problem may be due to the fi"
"le being an old non-native file lacking binary file format i"
"nformation. It's also possible the file has been corrupted.",
(ftnlen)298);
errch_("#", spk, (ftnlen)1, spk_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("SPKCOV", (ftnlen)6);
return 0;
}
/* Open the file for reading. */
dafopr_(spk, &handle, spk_len);
if (failed_()) {
chkout_("SPKCOV", (ftnlen)6);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found && ! failed_()) {
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
if (ic[0] == *idcode) {
/* This segment is for the body of interest. Insert the */
/* coverage bounds into the coverage window. */
wninsd_(dc, &dc[1], cover);
}
daffna_(&found);
}
/* Release the file. */
dafcls_(&handle);
chkout_("SPKCOV", (ftnlen)6);
return 0;
} /* spkcov_ */
/* $Procedure SPKPVN ( S/P Kernel, position and velocity in native frame ) */
/* Subroutine */ int spkpvn_(integer *handle, doublereal *descr, doublereal *
et, integer *ref, doublereal *state, integer *center)
{
integer type__;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *), spke01_(
doublereal *, doublereal *, doublereal *), spke02_(doublereal *,
doublereal *, doublereal *), spke03_(doublereal *, doublereal *,
doublereal *), spke10_(doublereal *, doublereal *, doublereal *),
spke05_(doublereal *, doublereal *, doublereal *), spke12_(
doublereal *, doublereal *, doublereal *), spke13_(doublereal *,
doublereal *, doublereal *), spke08_(doublereal *, doublereal *,
doublereal *), spke09_(doublereal *, doublereal *, doublereal *),
spke14_(doublereal *, doublereal *, doublereal *), spke15_(
doublereal *, doublereal *, doublereal *), spke17_(doublereal *,
doublereal *, doublereal *), spke18_(doublereal *, doublereal *,
doublereal *), spkr01_(integer *, doublereal *, doublereal *,
doublereal *), spkr02_(integer *, doublereal *, doublereal *,
doublereal *), spkr03_(integer *, doublereal *, doublereal *,
doublereal *), spkr05_(integer *, doublereal *, doublereal *,
doublereal *), spkr10_(integer *, doublereal *, doublereal *,
doublereal *), spkr12_(integer *, doublereal *, doublereal *,
doublereal *), spkr08_(integer *, doublereal *, doublereal *,
doublereal *), spkr09_(integer *, doublereal *, doublereal *,
doublereal *), spkr13_(integer *, doublereal *, doublereal *,
doublereal *), spkr14_(integer *, doublereal *, doublereal *,
doublereal *), spkr15_(integer *, doublereal *, doublereal *,
doublereal *), spkr17_(integer *, doublereal *, doublereal *,
doublereal *), spkr18_(integer *, doublereal *, doublereal *,
doublereal *), spkr19_(integer *, doublereal *, doublereal *,
doublereal *), spke19_(doublereal *, doublereal *, doublereal *),
spkr20_(integer *, doublereal *, doublereal *, doublereal *),
spke20_(doublereal *, doublereal *, doublereal *), spkr21_(
integer *, doublereal *, doublereal *, doublereal *), spke21_(
doublereal *, doublereal *, doublereal *);
doublereal dc[2];
integer ic[6];
extern logical failed_(void);
doublereal record[198];
extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *,
integer *, doublereal *), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer recsiz;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Return the state (position and velocity) of a target body */
/* relative to some center of motion. */
/* $ 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 */
/* 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 File handle. */
/* DESCR I Segment descriptor. */
/* ET I Target epoch. */
/* REF O Target reference frame. */
/* STATE O Position, velocity. */
/* CENTER O Center of state. */
/* MAXREC P Maximum length of records returned by SPKRnn. */
/* $ 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. */
/* $ Detailed_Output */
/* REF is the id-code of the reference frame to */
/* which the vectors returned by the routine belong. */
/* 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 */
/* MAXREC is the maximum length of a record returned by any of */
/* data type-specific routines SPKRnn, which are called */
/* by SPKPVN (see Particulars). */
/* $ Exceptions */
/* 1) If the segment type is not supported by the current */
/* version of SPKPVN, the error 'SPICE(SPKTYPENOTSUPP)' */
/* is signaled. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* SPKPVN is the most basic of the SPK readers, the reader upon */
/* which SPKPV and SPKGEO, etc. are built. It should not normally */
/* be called directly except in cases where some optimization is */
/* required. (That is, where the calling program has prior knowledge */
/* of the center-barycenter shifts to be performed, or a non-standard */
/* method of determining the files and segments to be used when */
/* computing states.) */
/* This is the only reader which makes distinctions between the */
/* various segment types in the SPK format. The complete list */
/* of types currently supported is shown below. */
/* Type Description */
/* ---- ----------------------- */
/* 1 Difference Lines */
/* 2 Chebyshev (P) */
/* 3 Chebyshev (P,V) */
/* 5 Two body propagation between discrete states */
/* 8 Lagrange interpolation, equally spaced discrete states */
/* 9 Lagrange interpolation, unequally spaced discrete states */
/* 12 Hermite interpolation, equally spaced discrete states */
/* 13 Hermite interpolation, unequally spaced discrete states */
/* 14 Chebyshev Unequally spaced */
/* 15 Precessing Ellipse */
/* 17 Equinoctial Elements */
/* 18 ESOC/DDID Hermite/Lagrange Interpolation */
/* 19 ESOC/DDID Piecewise Interpolation */
/* 20 Chebyshev (V) */
/* 21 Extended Modified Difference Array */
/* SPKPVN is the only reader that needs to be changed in order to */
/* add a new segment type to the SPK format. If a new data type is */
/* added, the following steps should be taken: */
/* 1) Write two new routines, SPKRnn and SPKEnn, to read and */
/* evaluate, respectively, a record from a data type nn segment. */
/* 2) Insert a new case into the body of SPKPVN to accommodate the */
/* new type. */
/* 3) If necessary, adjust the parameter MAXREC, above, so that it */
/* is large enough to encompass the maximum size of a record */
/* returned by SPKRnn and passed to SPKEnn. */
/* The maximum record lengths for each data type currently */
/* supported are as follows: */
/* Data type Maximum record length */
/* --------- --------------------- */
/* 1 71 */
/* 2 87 */
/* 3 171 */
/* 5 15 */
/* 8 171 */
/* 9 197 */
/* 12 87 */
/* 13 99 */
/* 14 Variable */
/* 15 16 */
/* 17 12 */
/* 18 198 */
/* 19 198 */
/* 20 159 */
/* 21 112 */
/* $ 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 SPKPVN ( HANDLE, DESCR, ET, REF, STATE, CENTER ) */
/* CALL DAFGN ( IDENT ) */
/* CALL FRMNAM ( REF, FRAME ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Body = ', IC(1) */
/* WRITE (*,*) 'Center = ', CENTER, */
/* WRITE (*,*) 'ID = ', IDENT */
/* WRITE (*,*) 'Frame = ', FRAME */
/* WRITE (*,*) 'Range = ', VNORM ( STATE ) */
/* END IF */
/* CALL DAFFNA ( FOUND ) */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.0, 23-DEC-2013 (NJB) */
/* Added support for types 19, 20 and 21. Added header */
/* comments giving description for types 18, 19, */
/* and 21. Removed header reference to type 4. */
/* - SPICELIB Version 3.0.0, 16-AUG-2002 (NJB) */
/* Added support for type 18. This routine now uses the */
/* include file spkrec.inc to declare the record size. */
/* Corrected header comments giving record sizes for types */
/* 8, 9, 12, 13. */
/* - SPICELIB Version 2.0.0, 06-NOV-1999 (NJB) */
/* Added support for types 12 and 13. */
/* - SPICELIB Version 1.1.0, 7-JAN-1997 (WLT) */
/* Added support for type 17. */
/* - SPICELIB Version 1.0.0, 19-SEP-1995 (WLT) */
/* -& */
/* $ Index_Entries */
/* position and velocity from ephemeris */
/* spk file position and velocity */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 7-JAN-1997 (WLT) */
/* Added support for type 17. */
/* -& */
/* SPICELIB functions */
/* Some local space is needed in which to return records, and */
/* into which to unpack the segment descriptor. */
/* Local Parameters */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKPVN", (ftnlen)6);
}
/* Unpacking the segment descriptor will tell us the center, */
/* reference frame, and data type for this segment. */
dafus_(descr, &c__2, &c__6, dc, ic);
*center = ic[1];
*ref = ic[2];
type__ = ic[3];
/* Each data type has a pair of routines to read and evaluate */
/* records for that data type. These routines are the only ones */
/* that actually look inside the segments. */
/* By the time we have more than 100 data types, we should be */
/* allowed to use longer variable names. */
if (type__ == 1) {
spkr01_(handle, descr, et, record);
spke01_(et, record, state);
} else if (type__ == 2) {
spkr02_(handle, descr, et, record);
spke02_(et, record, state);
} else if (type__ == 3) {
spkr03_(handle, descr, et, record);
spke03_(et, record, state);
/* Type 04 is not officially part of the library. */
/* ELSE IF ( TYPE .EQ. 04 ) THEN */
/* CALL SPKR04 ( HANDLE, DESCR, ET, RECORD ) */
/* CALL SPKE04 ( ET, RECORD, STATE ) */
} else if (type__ == 5) {
spkr05_(handle, descr, et, record);
spke05_(et, record, state);
} else if (type__ == 8) {
spkr08_(handle, descr, et, record);
spke08_(et, record, state);
} else if (type__ == 9) {
spkr09_(handle, descr, et, record);
spke09_(et, record, state);
} else if (type__ == 10) {
spkr10_(handle, descr, et, record);
spke10_(et, record, state);
} else if (type__ == 12) {
spkr12_(handle, descr, et, record);
spke12_(et, record, state);
} else if (type__ == 13) {
spkr13_(handle, descr, et, record);
spke13_(et, record, state);
} else if (type__ == 14) {
/* Fetch the number of Chebyshev coefficients, compute the record */
/* size needed, and signal an error if there is not enough storage */
/* in RECORD. The number of coefficients is the first constant */
/* value in the generic segment. */
sgfcon_(handle, descr, &c__1, &c__1, record);
if (failed_()) {
chkout_("SPKPVN", (ftnlen)6);
return 0;
}
recsiz = (integer) record[0] * 6 + 3;
if (recsiz > 198) {
setmsg_("Storage for # double precision numbers is needed for an"
" SPK data record and only # locations were available. Up"
"date the parameter MAXREC in the subroutine SPKPVN and n"
"otify the NAIF group of this problem.", (ftnlen)204);
errint_("#", &recsiz, (ftnlen)1);
errint_("#", &c__198, (ftnlen)1);
sigerr_("SPICE(SPKRECTOOLARGE)", (ftnlen)21);
chkout_("SPKPVN", (ftnlen)6);
return 0;
}
spkr14_(handle, descr, et, record);
spke14_(et, record, state);
} else if (type__ == 15) {
spkr15_(handle, descr, et, record);
spke15_(et, record, state);
} else if (type__ == 17) {
spkr17_(handle, descr, et, record);
spke17_(et, record, state);
} else if (type__ == 18) {
spkr18_(handle, descr, et, record);
spke18_(et, record, state);
} else if (type__ == 19) {
spkr19_(handle, descr, et, record);
spke19_(et, record, state);
} else if (type__ == 20) {
spkr20_(handle, descr, et, record);
spke20_(et, record, state);
} else if (type__ == 21) {
spkr21_(handle, descr, et, record);
spke21_(et, record, state);
} else {
setmsg_("SPK type # is not supported in your version of the SPICE li"
"brary. You will need to upgrade your version of the library"
" to make use of ephemerides that contain this SPK data type. "
, (ftnlen)180);
errint_("#", &type__, (ftnlen)1);
sigerr_("SPICE(SPKTYPENOTSUPP)", (ftnlen)21);
chkout_("SPKPVN", (ftnlen)6);
return 0;
}
chkout_("SPKPVN", (ftnlen)6);
return 0;
} /* spkpvn_ */
/* $Procedure SPKS10 ( S/P Kernel, subset, type 10 ) */
/* Subroutine */ int spks10_(integer *srchan, doublereal *srcdsc, integer *
dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
char time[40];
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dtemp[2];
logical found;
integer itemp[6];
doublereal myref;
extern /* Subroutine */ int sgwes_(integer *);
integer dummy;
extern logical failed_(void);
integer begidx;
doublereal begtim, packet[14];
integer endidx, nepoch;
doublereal endtim;
extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *,
integer *, doublereal *), sgbwfs_(integer *, doublereal *, char *,
integer *, doublereal *, integer *, integer *, ftnlen), chkout_(
char *, ftnlen), sigerr_(char *, ftnlen), sgfrvi_(integer *,
doublereal *, doublereal *, doublereal *, integer *, logical *),
setmsg_(char *, ftnlen), sgmeta_(integer *, doublereal *, integer
*, integer *), sgfpkt_(integer *, doublereal *, integer *,
integer *, doublereal *, integer *), sgfref_(integer *,
doublereal *, integer *, integer *, doublereal *);
doublereal consts[8];
extern /* Subroutine */ int sgwfpk_(integer *, integer *, doublereal *,
integer *, doublereal *);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in a type 10 SPK segment into a new */
/* type 10 segment. */
/* $ 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 */
/* Parameter declarations for the generic segments subroutines. */
/* $ 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 Required Reading */
/* $ Keywords */
/* GENERIC SEGMENTS */
/* $ Particulars */
/* This include file contains the parameters used by the generic */
/* segments subroutines, SGxxxx. A generic segment is a */
/* generalization of a DAF array which places a particular structure */
/* on the data contained in the array, as described below. */
/* This file defines the mnemonics that are used for the index types */
/* allowed in generic segments as well as mnemonics for the meta data */
/* items which are used to describe a generic segment. */
/* A DAF generic segment contains several logical data partitions: */
/* 1) A partition for constant values to be associated with each */
/* data packet in the segment. */
/* 2) A partition for the data packets. */
/* 3) A partition for reference values. */
/* 4) A partition for a packet directory, if the segment contains */
/* variable sized packets. */
/* 5) A partition for a reference value directory. */
/* 6) A reserved partition that is not currently used. This */
/* partition is only for the use of the NAIF group at the Jet */
/* Propulsion Laboratory (JPL). */
/* 7) A partition for the meta data which describes the locations */
/* and sizes of other partitions as well as providing some */
/* additional descriptive information about the generic */
/* segment. */
/* +============================+ */
/* | Constants | */
/* +============================+ */
/* | Packet 1 | */
/* |----------------------------| */
/* | Packet 2 | */
/* |----------------------------| */
/* | . | */
/* | . | */
/* | . | */
/* |----------------------------| */
/* | Packet N | */
/* +============================+ */
/* | Reference Values | */
/* +============================+ */
/* | Packet Directory | */
/* +============================+ */
/* | Reference Directory | */
/* +============================+ */
/* | Reserved Area | */
/* +============================+ */
/* | Segment Meta Data | */
/* +----------------------------+ */
/* Only the placement of the meta data at the end of a generic */
/* segment is required. The other data partitions may occur in any */
/* order in the generic segment because the meta data will contain */
/* pointers to their appropriate locations within the generic */
/* segment. */
/* The meta data for a generic segment should only be obtained */
/* through use of the subroutine SGMETA. The meta data should not be */
/* written through any mechanism other than the ending of a generic */
/* segment begun by SGBWFS or SGBWVS using SGWES. */
/* $ Restrictions */
/* 1) If new reference index types are added, the new type(s) should */
/* be defined to be the consecutive integer(s) after the last */
/* defined reference index type used. In this way a value for */
/* the maximum allowed index type may be maintained. This value */
/* must also be updated if new reference index types are added. */
/* 2) If new meta data items are needed, mnemonics for them must be */
/* added to the end of the current list of mnemonics and before */
/* the NMETA mnemonic. In this way compatibility with files having */
/* a different, but smaller, number of meta data items may be */
/* maintained. See the description and example below. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* Generic Segments Required Reading. */
/* DAF Required Reading. */
/* $ Version */
/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */
/* Header update: equations for comptutations of packet indices */
/* for the cases of index types 0 and 1 were corrected. */
/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */
/* Added parameter MNMETA, the minimum number of meta data items */
/* that must be present in a generic DAF segment. */
/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */
/* -& */
/* Mnemonics for the type of reference value index. */
/* Two forms of indexing are provided: */
/* 1) An implicit form of indexing based on using two values, a */
/* starting value, which will have an index of 1, and a step */
/* size between reference values, which are used to compute an */
/* index and a reference value associated with a specified key */
/* value. See the descriptions of the implicit types below for */
/* the particular formula used in each case. */
/* 2) An explicit form of indexing based on a reference value for */
/* each data packet. */
/* Reference Index Type 0 */
/* ---------------------- */
/* Implied index. The index and reference value of a data packet */
/* associated with a specified key value are computed from the two */
/* generic segment reference values using the formula below. The two */
/* generic segment reference values, REF(1) and REF(2), represent, */
/* respectively, a starting value and a step size between reference */
/* values. The index of the data packet associated with a key value */
/* of VALUE is given by: */
/* / VALUE - REF(1) \ */
/* INDEX = 1 + INT | -------------------- | */
/* \ REF(2) / */
/* and the reference value associated with VALUE is given by: */
/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
/* Reference Index Type 1 */
/* ---------------------- */
/* Implied index. The index and reference value of a data packet */
/* associated with a specified key value are computed from the two */
/* generic segment reference values using the formula below. The two */
/* generic segment reference values, REF(1) and REF(2), represent, */
/* respectively, a starting value and a step size between reference */
/* values. The index of the data packet associated with a key value */
/* of VALUE is given by: */
/* / VALUE - REF(1) \ */
/* INDEX = 1 + INT | 0.5 + -------------------- | */
/* \ REF(2) / */
/* and the reference value associated with VALUE is given by: */
/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
/* We get the larger index in the event that VALUE is halfway between */
/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */
/* Reference Index Type 2 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the last reference item */
/* that is strictly less than VALUE. The reference values must be in */
/* ascending order, REF(I) < REF(I+1). */
/* Reference Index Type 3 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the last reference item */
/* that is less than or equal to VALUE. The reference values must be */
/* in ascending order, REF(I) < REF(I+1). */
/* Reference Index Type 4 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the reference item */
/* that is closest to the value of VALUE. In the event of a "tie" */
/* the larger index is selected. The reference values must be in */
/* ascending order, REF(I) < REF(I+1). */
/* These parameters define the valid range for the index types. An */
/* index type code, MYTYPE, for a generic segment must satisfy the */
/* relation MNIDXT <= MYTYPE <= MXIDXT. */
/* The following meta data items will appear in all generic segments. */
/* Other meta data items may be added if a need arises. */
/* 1) CONBAS Base Address of the constants in a generic segment. */
/* 2) NCON Number of constants in a generic segment. */
/* 3) RDRBAS Base Address of the reference directory for a */
/* generic segment. */
/* 4) NRDR Number of items in the reference directory of a */
/* generic segment. */
/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */
/* generic segment. */
/* 6) REFBAS Base Address of the reference items for a generic */
/* segment. */
/* 7) NREF Number of reference items in a generic segment. */
/* 8) PDRBAS Base Address of the Packet Directory for a generic */
/* segment. */
/* 9) NPDR Number of items in the Packet Directory of a generic */
/* segment. */
/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */
/* segment. */
/* 11) PKTBAS Base Address of the Packets for a generic segment. */
/* 12) NPKT Number of Packets in a generic segment. */
/* 13) RSVBAS Base Address of the Reserved Area in a generic */
/* segment. */
/* 14) NRSV Number of items in the reserved area of a generic */
/* segment. */
/* 15) PKTSZ Size of the packets for a segment with fixed width */
/* data packets or the size of the largest packet for a */
/* segment with variable width data packets. */
/* 16) PKTOFF Offset of the packet data from the start of a packet */
/* record. Each data packet is placed into a packet */
/* record which may have some bookkeeping information */
/* prepended to the data for use by the generic */
/* segments software. */
/* 17) NMETA Number of meta data items in a generic segment. */
/* Meta Data Item 1 */
/* ----------------- */
/* Meta Data Item 2 */
/* ----------------- */
/* Meta Data Item 3 */
/* ----------------- */
/* Meta Data Item 4 */
/* ----------------- */
/* Meta Data Item 5 */
/* ----------------- */
/* Meta Data Item 6 */
/* ----------------- */
/* Meta Data Item 7 */
/* ----------------- */
/* Meta Data Item 8 */
/* ----------------- */
/* Meta Data Item 9 */
/* ----------------- */
/* Meta Data Item 10 */
/* ----------------- */
/* Meta Data Item 11 */
/* ----------------- */
/* Meta Data Item 12 */
/* ----------------- */
/* Meta Data Item 13 */
/* ----------------- */
/* Meta Data Item 14 */
/* ----------------- */
/* Meta Data Item 15 */
/* ----------------- */
/* Meta Data Item 16 */
/* ----------------- */
/* If new meta data items are to be added to this list, they should */
/* be added above this comment block as described below. */
/* INTEGER NEW1 */
/* PARAMETER ( NEW1 = PKTOFF + 1 ) */
/* INTEGER NEW2 */
/* PARAMETER ( NEW2 = NEW1 + 1 ) */
/* INTEGER NEWEST */
/* PARAMETER ( NEWEST = NEW2 + 1 ) */
/* and then the value of NMETA must be changed as well to be: */
/* INTEGER NMETA */
/* PARAMETER ( NMETA = NEWEST + 1 ) */
/* Meta Data Item 17 */
/* ----------------- */
/* Maximum number of meta data items. This is always set equal to */
/* NMETA. */
/* Minimum number of meta data items that must be present in a DAF */
/* generic segment. This number is to remain fixed even if more */
/* meta data items are added for compatibility with old DAF files. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SRCHAN I Handle of the SPK file with the source segment. */
/* SRCDSC I Descriptor for the source segment. */
/* DSTHAN I Handle of the SPK file for the destination segment. */
/* DSTDSC I Descriptor for the destination segment. */
/* DSTSID I Segment identifier for the new segment. */
/* $ Detailed_Input */
/* SRCHAN The handle of the SPK file containing the source segment. */
/* SRCDSC The SPK descriptor for the source segment. */
/* DSTHAN The handle of the SPK file containing the new segment. */
/* DSTDSC The SPK descriptor for the destination segment. It */
/* contains the desired start and stop times for the */
/* requested subset. */
/* DSTSID The segment identifier for the destination segment. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* See arguments SRCHAN, DSTHAN. */
/* $ Particulars */
/* This subroutine copies a subset of the data form one SPK segment */
/* to another. */
/* The exact structure of a segment of SPK type 10 is detailed in */
/* the SPK Required Reading. Please see this document for details. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* 1) We assume that the source descriptor actually describes a */
/* segment in the source SPK file containing the time coverage */
/* that is desired for the subsetting operation. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 30-JUN-1997 (KRG) */
/* -& */
/* $ Index_Entries */
/* subset type_10 spk segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* DAF ND and NI values for SPK files. */
/* The number of geophysical constants: */
/* The number of elements per two-line set: */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKS10", (ftnlen)6);
}
/* First, unpack the destination segment descriptor and set some */
/* local variables. */
dafus_(dstdsc, &c__2, &c__6, dtemp, itemp);
begtim = dtemp[0];
endtim = dtemp[1];
/* Get the constants for the input segment and send them to the */
/* output segment by beginning a fixed packet size segment. */
sgfcon_(srchan, srcdsc, &c__1, &c__8, consts);
sgbwfs_(dsthan, dstdsc, dstsid, &c__8, consts, &c__14, &c__4, dstsid_len);
if (failed_()) {
chkout_("SPKS10", (ftnlen)6);
return 0;
}
/* Get the beginning and ending indices for the packets we need for */
/* the destination segment. Note we need to get the preceding */
/* and succeeding packets (if there are any) corresponding to the */
/* start and end times of the output segments */
sgfrvi_(srchan, srcdsc, &begtim, &myref, &begidx, &found);
if (! found) {
etcal_(&begtim, time, (ftnlen)40);
setmsg_("An error has occurred while attempting to subset the a type"
" 10 SPK segment. The error occurred while attempting to loca"
"te a packet for the epoch #. There does not appear to be su"
"ch a packet. ", (ftnlen)192);
errch_("#", time, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22);
chkout_("SPKS10", (ftnlen)6);
return 0;
}
if (myref > begtim) {
/* Computing MAX */
i__1 = 1, i__2 = begidx - 1;
begidx = max(i__1,i__2);
}
sgfrvi_(srchan, srcdsc, &endtim, &myref, &endidx, &found);
if (! found) {
etcal_(&endtim, time, (ftnlen)40);
setmsg_("An error has occurred while attempting to subset the a type"
" 10 SPK segment. The error occurred while attempting to loca"
"te a packet for the epoch #. There does not appear to be su"
"ch a packet. ", (ftnlen)192);
errch_("#", time, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22);
chkout_("SPKS10", (ftnlen)6);
return 0;
}
/* Get the total number of epochs. */
sgmeta_(srchan, srcdsc, &c__7, &nepoch);
if (myref < endtim) {
/* Computing MIN */
i__1 = nepoch, i__2 = endidx + 1;
endidx = min(i__1,i__2);
}
/* Now we get the data one record at a time from the source segment */
/* and write it out to the destination segment. */
i__1 = endidx;
for (i__ = begidx; i__ <= i__1; ++i__) {
sgfpkt_(srchan, srcdsc, &i__, &i__, packet, &dummy);
sgfref_(srchan, srcdsc, &i__, &i__, &myref);
sgwfpk_(dsthan, &c__1, packet, &c__1, &myref);
}
/* Now all we need to do is end the segment. */
sgwes_(dsthan);
chkout_("SPKS10", (ftnlen)6);
return 0;
} /* spks10_ */
/* $Procedure SPKUDS ( SPK - unpack segment descriptor ) */
/* Subroutine */ int spkuds_(doublereal *descr, integer *body, integer *
center, integer *frame, integer *type__, doublereal *first,
doublereal *last, integer *begin, integer *end)
{
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer ipart[6];
extern logical failed_(void);
doublereal dppart[2];
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Unpack the contents of an SPK segment descriptor */
/* $ 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 */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* DESCR I An SPK segment descriptor. */
/* BODY O The NAIF ID code for the body of the segment. */
/* CENTER O The center of motion for BODY. */
/* FRAME O The code for the frame of this segment. */
/* TYPE O The type of SPK segment. */
/* FIRST O The first epoch for which the segment is valid. */
/* LAST O The last epoch for which the segment is valid. */
/* BEGIN O Beginning DAF address of the segment. */
/* END O Ending DAF address of the segment. */
/* $ Detailed_Input */
/* DESCR is an SPK segment descriptor. */
/* $ Detailed_Output */
/* BODY is the NAIF ID code for the body of the segment. */
/* CENTER is the center of motion for BODY. */
/* FRAME is SPICE integer code for the frame to which states */
/* for the body are be referenced. */
/* TYPE is the type of SPK segment. */
/* FIRST is the first epoch for which the segment has */
/* ephemeris data. */
/* LAST is the last epoch for which the segment has */
/* ephemeris data. */
/* BEGIN is the starting address of the data associated */
/* with this descriptor */
/* END is the last address of the data associated with */
/* this descriptor */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* This routine extracts the contents of an SPK segment */
/* descriptor into the components needed for reading and */
/* evaluating the data stored in the segment. It serves */
/* as a macro for expanding the SPK segment descriptor. */
/* $ Examples */
/* Suppose you wished to summarize a particular SPK segment */
/* and that you have the descriptor for that segment in hand. */
/* The following code fragment shows how you might use this */
/* routine to create a summary message concerning the segment. */
/* CALL SPKUDS ( DESCR, BODY, CENTER, FRAME, */
/* . TYPE, FIRST, LAST, BADDR, EADDR ) */
/* Convert the start and stop times to ephemeris calendar strings */
/* CALL ETCAL ( FIRST, FSTCAL ) */
/* CALL ETCAL ( LAST, LSTCAL ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Body : ', BODY */
/* WRITE (*,*) 'Center : ', CENTER */
/* WRITE (*,*) 'Frame ID : ', FRAME */
/* WRITE (*,*) 'Data Type: ', TYPE */
/* WRITE (*,*) */
/* WRITE (*,*) 'Segment Start : ', FSTCAL */
/* WRITE (*,*) 'Segment Stop : ', LSTCAL */
/* $ Restrictions */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 1994-JAN-4 (WLT) (KRG) */
/* -& */
/* $ Index_Entries */
/* Unpack and SPK segment descriptor */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Values of ND and NI for SPK files. */
/* Local Variables */
/* Standard introductory error handling preparations. */
if (return_()) {
return 0;
} else {
chkin_("SPKUDS", (ftnlen)6);
}
/* No judgements are made about the descriptor when we */
/* unpack it. If things were done right when the descriptor */
/* was created, it should be fine now. */
dafus_(descr, &c__2, &c__6, dppart, ipart);
if (failed_()) {
chkout_("SPKUDS", (ftnlen)6);
return 0;
}
*body = ipart[0];
*center = ipart[1];
*frame = ipart[2];
*type__ = ipart[3];
*begin = ipart[4];
*end = ipart[5];
*first = dppart[0];
*last = dppart[1];
chkout_("SPKUDS", (ftnlen)6);
return 0;
} /* spkuds_ */
/* $Procedure SPKR03 ( SPK, read record from segment, type 3 ) */
/* Subroutine */ int spkr03_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nrec;
doublereal init;
integer begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer recno;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal dc[2];
integer ic[6], recadr;
doublereal intlen;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer recsiz;
extern logical return_(void);
integer end;
/* $ Abstract */
/* Read a single SPK data record from a segment of type 3 */
/* (Chebyshev coefficients, position and velocity). */
/* $ 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 Evaluation epoch. */
/* RECORD O Data record. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* a SPK segment of type 3. */
/* ET is an epoch for which a data record from the */
/* specified segment is required. ET is expressed as */
/* seconds past J2000 TDB. */
/* $ Detailed_Output */
/* RECORD is an array of data from the specified segment which, */
/* when evaluated at epoch ET, will give the state */
/* (position and velocity) of the target body identified */
/* by the input segment descriptor. The descriptor */
/* specifies the center of motion and reference frame of */
/* the state. */
/* The structure of the record is as follows: */
/* +--------------------------------------+ */
/* | record size (excluding this element) | */
/* +--------------------------------------+ */
/* | Coverage interval midpoint | */
/* +--------------------------------------+ */
/* | Coverage interval radius | */
/* +--------------------------------------+ */
/* | Coeffs for X position component | */
/* +--------------------------------------+ */
/* | Coeffs for Y position component | */
/* +--------------------------------------+ */
/* | Coeffs for Z position component | */
/* +--------------------------------------+ */
/* | Coeffs for X velocity component | */
/* +--------------------------------------+ */
/* | Coeffs for Y velocity component | */
/* +--------------------------------------+ */
/* | Coeffs for Z velocity component | */
/* +--------------------------------------+ */
/* In the above record */
/* - Times are expressed as seconds past J2000 TDB. */
/* - Position components have units of km. */
/* - Velocity components have units of km/s. */
/* RECORD must be declared by the caller with size large */
/* enough to accommodate the largest record that can be */
/* returned by this routine. See the INCLUDE file */
/* spkrec.inc for the correct record length. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) Any errors that occur while looking up SPK data will be */
/* diagnosed by routines in the call tree of this routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the SPK Required Reading file for a description of the */
/* structure of a data type 3 (Chebyshev polynomials, position */
/* and velocity) segment. */
/* On not so close inspection, you will see that the implementation */
/* of this routine is identical to SPKR02, which reads a type 2 */
/* (Chebyshev polynomials, position only) segment. */
/* $ Examples */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRxx */
/* routines might be used to "dump" and check segment data for a */
/* particular epoch. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 3 ) THEN */
/* CALL SPKR03 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* R.E. Thurman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 18-JAN-2014 (NJB) */
/* Enhanced header and in-line documentation. */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */
/* SPK03 was removed from the Required_Reading section of the */
/* header. The information in the SPK03 Required Reading file */
/* is now part of the SPK Required Reading file. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */
/* -& */
/* $ Index_Entries */
/* read record from type_3 spk segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKR03", (ftnlen)6);
}
/* Unpack the segment descriptor. */
dafus_(descr, &c__2, &c__6, dc, ic);
begin = ic[4];
end = ic[5];
/* The segment is made up of a number of logical records, each */
/* having the same size, and covering the same length of time. */
/* We can determine which record to return using the input epoch, */
/* the initial time of the first record's coverage interval, and the */
/* length of the interval covered by each record. These constants */
/* are located at the end of the segment, along with the size of */
/* each logical record and the total number of records. */
i__1 = end - 3;
dafgda_(handle, &i__1, &end, record);
init = record[0];
intlen = record[1];
recsiz = (integer) record[2];
nrec = (integer) record[3];
recno = (integer) ((*et - init) / intlen) + 1;
recno = min(recno,nrec);
/* Compute the address of the desired record. */
recadr = (recno - 1) * recsiz + begin;
/* Along with the record, return the size of the record. */
record[0] = record[2];
i__1 = recadr + recsiz - 1;
dafgda_(handle, &recadr, &i__1, &record[1]);
chkout_("SPKR03", (ftnlen)6);
return 0;
} /* spkr03_ */
/* $Procedure CKFROT ( C-kernel, find rotation ) */
/* Subroutine */ int ckfrot_(integer *inst, doublereal *et, doublereal *
rotate, integer *ref, logical *found)
{
logical have, pfnd, sfnd;
doublereal time;
extern /* Subroutine */ int sce2c_(integer *, doublereal *, doublereal *);
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 *), cksns_(integer *, doublereal *, char *,
logical *, ftnlen), xpose_(doublereal *, doublereal *);
extern logical failed_(void);
doublereal av[3];
integer handle;
extern /* Subroutine */ int ckhave_(logical *);
logical needav;
extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen);
integer sclkid;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal clkout;
extern logical return_(void), zzsclk_(integer *, integer *);
doublereal dcd[2];
integer icd[6];
doublereal tol, rot[9] /* was [3][3] */;
/* $ Abstract */
/* Find the rotation from a C-kernel Id to the native */
/* frame at the time requested. */
/* $ 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 */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* INST I NAIF instrument ID. */
/* ET I Epoch measured in seconds past J2000. */
/* ROTATE O rotation from CK platform to frame REF. */
/* REF O Reference frame. */
/* FOUND O True when requested pointing is available. */
/* $ Detailed_Input */
/* INST is the unique NAIF integer ID for the spacecraft */
/* instrument for which data is being requested. */
/* ET is the epoch for which the state rotation */
/* is desired. ET should be given in seconds past the */
/* epoch of J2000. */
/* $ Detailed_Output */
/* ROTATE is a rotation matrix that converts */
/* positions relative to the input frame (given by INST) */
/* to positions relative to the frame REF. */
/* Thus, if a state S has components x,y,z,dx,dy,dz */
/* in the frame of INST, frame, then S has components */
/* x', y', z', dx', dy', dz' in frame REF. */
/* [ x' ] [ ] [ x ] */
/* | y' | = | ROTATE | | y | */
/* [ z' ] [ ] [ z ] */
/* REF is the id-code reference frame to which ROTATE will */
/* transform states. */
/* 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 is not loaded using CKLPF prior to calling */
/* this routine, an error is signalled by a routine that this */
/* routine calls. */
/* $ Files */
/* CKFROT searches through files loaded by CKLPF to locate a segment */
/* that can satisfy the request for position rotation */
/* for instrument INST at time ET. You must load a C-kernel */
/* file using CKLPF before calling this routine. */
/* $ Particulars */
/* CKFROT searches through files loaded by CKLPF to satisfy a */
/* pointing request. Last-loaded files are searched first, and */
/* individual files are searched in backwards order, giving */
/* priority to segments that were added to a file later than the */
/* others. CKFROT considers only those segments that contain */
/* angular velocity data. */
/* The search ends when a segment is found that can give pointing */
/* for the specified instrument at the request time. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* A C-kernel file should have been loaded by CKLPF. */
/* In addition it is helpful to load a CK-info file into the */
/* Kernel pool. This file should have the following variables */
/* defined. */
/* CK_<INST>_SCLK = SCLK idcode that yields SCLK mapping for INST. */
/* CK_<INST>_SPK = SPK idcode that yields ephemeris for INST. */
/* where <INST> is the integer string corresponding to INST. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 17-FEB-2000 (WLT) */
/* The routine now checks to make sure convert ET to TICKS */
/* and that at least one C-kernel is loaded before trying */
/* to look up the transformation. Also the routine now calls */
/* SCE2C instead of SCE2T. */
/* - SPICELIB Version 1.0.0, 03-MAR-1999 (WLT) */
/* -& */
/* $ Index_Entries */
/* get instrument frame rotation and reference frame */
/* -& */
/* 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 */
/* Set FOUND to FALSE right now in case we end up */
/* returning before doing any work. */
*found = FALSE_;
*ref = 0;
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKFROT", (ftnlen)6);
}
/* We don't need angular velocity data. */
/* Assume the segment won't be found until it really is. */
needav = FALSE_;
tol = 0.;
/* Begin a search for this instrument and time, and get the first */
/* applicable segment. */
ckhave_(&have);
ckmeta_(inst, "SCLK", &sclkid, (ftnlen)4);
if (! have) {
chkout_("CKFROT", (ftnlen)6);
return 0;
} else if (! zzsclk_(inst, &sclkid)) {
chkout_("CKFROT", (ftnlen)6);
return 0;
}
sce2c_(&sclkid, et, &time);
ckbss_(inst, &time, &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, &time, &tol, &needav, rot, av, &clkout, &pfnd);
if (pfnd) {
/* Found one. Fetch the ID code of the reference frame */
/* from the descriptor. */
dafus_(descr, &c__2, &c__6, dcd, icd);
*ref = icd[1];
*found = TRUE_;
/* We now have the rotation matrix from */
/* REF to INS. We invert ROT to get the rotation */
/* from INST to REF. */
xpose_(rot, rotate);
chkout_("CKFROT", (ftnlen)6);
return 0;
}
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
}
chkout_("CKFROT", (ftnlen)6);
return 0;
} /* ckfrot_ */
void dafus_c ( ConstSpiceDouble sum [],
SpiceInt nd,
SpiceInt ni,
SpiceDouble dc [],
SpiceInt ic [] )
/*
-Brief_I/O
Variable I/O Description
-------- --- --------------------------------------------------
sum I Array summary.
nd I Number of double precision components.
ni I Number of integer components.
dc O Double precision components.
ic O Integer components.
-Detailed_Input
sum is an array summary. This identifies the contents and
location of a single array within a DAF.
nd is the number of double precision components in
the summary.
ni is the number of integer components in the summary.
-Detailed_Output
dc are the double precision components of the summary.
ic are the integer components of the summary.
-Parameters
None.
-Files
None.
-Exceptions
Error free.
1) If nd is zero or negative, no double precision components
are returned.
2) If ni is zero or negative, no integer components are returned.
3) If the total size of the summary is greater than 125 double
precision words, some components may not be returned.
-Particulars
The components of array summaries are packed into double
precision arrays for reasons outlined in [1]. Two routines,
DAFPS (pack summary) and dafus_c (unpack summary) are provided
for packing and unpacking summaries.
The total size of the summary is
(ni - 1)
nd + -------- + 1
2
double precision words (where nd, ni are nonnegative).
-Examples
In the following code fragment, dafopr_c is used to open a file,
which is then searched for DAFs containing data for a particular
object. dafus_c is used to unpack the summaries so the applicability
of the segments can be determined.
#include "SpiceUsr.h"
.
.
.
dafopr_c ( fname, &handle );
dafbfs_c ( handle );
daffna_c ( &found );
while ( found )
{
dafgs_c ( sum );
dafus_c ( sum, ND, NI, dc, ic );
if ( ic[0] == target_object )
{
.
.
.
}
daffna_c ( &found );
}
-Restrictions
None.
-Literature_References
NAIF Document 167.0, "Double Precision Array Files (DAF)
Specification and User's Guide"
-Author_and_Institution
N.J. Bachman (JPL)
I.M. Underwood (JPL)
-Version
-CSPICE Version 1.0.0, 01-AUG-1999 (NJB), (IMU)
-Index_Entries
unpack daf summary
-&
*/
{ /* Begin dafus_c */
/*
Participate in error tracing.
*/
chkin_c ( "dafus_c" );
dafus_ ( ( doublereal * ) sum,
( integer * ) &nd,
( integer * ) &ni,
( doublereal * ) dc,
( integer * ) ic );
chkout_c ( "dafus_c" );
} /* End dafus_c */
/* $Procedure CKCOV ( CK coverage ) */
/* Subroutine */ int ckcov_(char *ck, integer *idcode, logical *needav, char *
level, doublereal *tol, char *timsys, doublereal *cover, ftnlen
ck_len, ftnlen level_len, ftnlen timsys_len)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
char arch[80];
logical avok;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int dafgs_(doublereal *);
integer clkid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dctol[2];
logical istdb, found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer dtype;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
doublereal et;
integer handle, segbeg;
extern /* Subroutine */ int dafcls_(integer *), ckmeta_(integer *, char *,
integer *, ftnlen);
integer segend;
extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen,
ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen);
logical seglvl;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), wninsd_(doublereal *, doublereal *, doublereal *),
errint_(char *, integer *, ftnlen);
char kertyp[80];
extern logical return_(void);
extern /* Subroutine */ int zzckcv01_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv02_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv03_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv04_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv05_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, char *, doublereal *,
ftnlen);
/* $ Abstract */
/* Find the coverage window for a specified object in a specified 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 */
/* CELLS */
/* DAF */
/* CK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* POINTING */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CK I Name of CK file. */
/* IDCODE I ID code of object. */
/* NEEDAV I Flag indicating whether angular velocity is needed. */
/* LEVEL I Coverage level: 'SEGMENT' OR 'INTERVAL'. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* COVER I/O Window giving coverage for IDCODE. */
/* $ Detailed_Input */
/* CK is the name of a C-kernel. */
/* IDCODE is the integer ID code of an object, normally */
/* a spacecraft structure or instrument, for which */
/* pointing data are expected to exist in the */
/* specified CK file. */
/* NEEDAV is a logical variable indicating whether only */
/* segments having angular velocity are to be */
/* considered when determining coverage. When */
/* NEEDAV is .TRUE., segments without angular */
/* velocity don't contribute to the coverage */
/* window; when NEEDAV is .FALSE., all segments for */
/* IDCODE may contribute to the coverage window. */
/* LEVEL is the level (granularity) at which the coverage */
/* is examined. Allowed values and corresponding */
/* meanings are: */
/* 'SEGMENT' The output coverage window */
/* contains intervals defined by the */
/* start and stop times of segments */
/* for the object designated by */
/* IDCODE. */
/* 'INTERVAL' The output coverage window */
/* contains interpolation intervals */
/* of segments for the object */
/* designated by IDCODE. For type 1 */
/* segments, which don't have */
/* interpolation intervals, each */
/* epoch associated with a pointing */
/* instance is treated as a singleton */
/* interval; these intervals are */
/* added to the coverage window. */
/* All interpolation intervals are */
/* considered to lie within the */
/* segment bounds for the purpose of */
/* this summary: if an interpolation */
/* interval extends beyond the */
/* segment coverage interval, only */
/* its intersection with the segment */
/* coverage interval is considered to */
/* contribute to the total coverage. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with IDCODE. Before */
/* each interval is inserted into the coverage */
/* window, the interval is intersected with the */
/* segment coverage interval, then if the */
/* intersection is non-empty, it is expanded by TOL: */
/* the left endpoint of the intersection interval is */
/* reduced by TOL and the right endpoint is increased */
/* by TOL. Adjusted interval endpoints, when */
/* expressed as encoded SCLK, never are less than */
/* zero ticks. Any intervals that overlap as a */
/* result of the expansion are merged. */
/* The coverage window returned when TOL > 0 */
/* indicates the coverage provided by the file to the */
/* CK readers CKGPAV and CKGP when that value of TOL */
/* is passed to them as an input. */
/* TIMSYS is a string indicating the time system used */
/* in the output coverage window. TIMSYS may */
/* have the values: */
/* 'SCLK' Elements of COVER are expressed in */
/* encoded SCLK ("ticks"), where the */
/* clock is associated with the object */
/* designated by IDCODE. */
/* 'TDB' Elements of COVER are expressed as */
/* seconds past J2000 TDB. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file CK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. When */
/* the coverage level is 'INTERVAL', this is the set */
/* of time intervals for which data for IDCODE are */
/* present in the file CK, merged with the set of */
/* time intervals present in COVER on input. The */
/* merged coverage is represented as the union of one */
/* or more disjoint time intervals. The window COVER */
/* contains the pairs of endpoints of these */
/* intervals. */
/* When the coverage level is 'SEGMENT', COVER is */
/* computed in a manner similar to that described */
/* above, but the coverage intervals used in the */
/* computation are those of segments rather than */
/* interpolation intervals within segments. */
/* When TOL is > 0, the intervals comprising the */
/* coverage window for IDCODE are expanded by TOL and */
/* any intervals overlapping as a result are merged. */
/* The resulting window is returned in COVER. The */
/* expanded window in no case extends beyond the */
/* segment bounds in either direction by more than */
/* TOL. */
/* The interval endpoints contained in COVER are */
/* encoded spacecraft clock times if TIMSYS is */
/* 'SCLK'; otherwise the times are converted from */
/* encoded spacecraft clock to seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* CK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the CK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output WINDOW argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* 6) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 7) If LEVEL is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 8) If TIMSYS is not recognized, the error SPICE(NOTSUPPORTED) */
/* is signaled. */
/* 9) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 10) If the output time system is TDB, the CK subsystem must be */
/* able to map IDCODE to the ID code of the associated */
/* spacecraft clock. If this mapping cannot be performed, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* This routine reads a C-kernel. */
/* If the output time system is 'TDB', then a leapseconds kernel */
/* and an SCLK kernel for the spacecraft clock associated with */
/* IDCODE must be loaded before this routine is called. */
/* If the ID code of the clock associated with IDCODE is not */
/* equal to */
/* IDCODE / 1000 */
/* then the kernel variable */
/* CK_<IDCODE>_SCLK */
/* must be present in the kernel pool to identify the clock */
/* associated with IDCODE. This variable must contain the ID code */
/* to be used for conversion between SCLK and TDB. Normally this */
/* variable is provided in a text kernel loaded via FURNSH. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified CK file provides for a specified */
/* object. */
/* $ Examples */
/* 1) Display the interval-level coverage for each object in a */
/* specified CK file. Use tolerance of zero ticks. Do not */
/* request angular velocity. Express the results in the TDB time */
/* system. */
/* Find the set of objects in the file. Loop over the contents */
/* of the ID code set: find the coverage for each item in the */
/* set and display the coverage. */
/* PROGRAM CKCVR */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* INTEGER CARDI */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 100000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) CK */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SCLK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel and SCLK kernel for output */
/* C time conversion. Note that we assume a single spacecraft */
/* C clock is associated with all of the objects in the CK. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Get name of CK file. */
/* C */
/* CALL PROMPT ( 'Name of CK file > ', CK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the CK file. */
/* C */
/* CALL CKOBJ ( CK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL CKCOV ( CK, IDS(I), .FALSE., */
/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the segment-level coverage for the object designated by */
/* IDCODE provided by the set of CK files loaded via a */
/* metakernel. (The metakernel must also specify leapseconds and */
/* SCLK kernels.) Use tolerance of zero ticks. Do not request */
/* angular velocity. Express the results in the TDB time system. */
/* PROGRAM CKMET */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the CK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel and an SCLK */
/* C kernel for the clock associated with IDCODE. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded CK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'CK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'CK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL CKCOV ( FILE, IDCODE, .FALSE., */
/* . 'SEGMENT', 0.0, 'TDB', COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) When this routine is used to accumulate coverage for IDCODE */
/* provided by multiple CK files, the inputs NEEDAV, LEVEL, TOL, */
/* and TIMSYS must have the same values for all files in order */
/* for the result to be meaningful. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for ck object */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKCOV", (ftnlen)5);
/* Check tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative; actual value was #.", (
ftnlen)51);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Use a logical flag to indicate whether this is a segment-level */
/* coverage description. */
seglvl = eqstr_(level, "SEGMENT", level_len, (ftnlen)7);
/* Check coverage level keyword. */
if (! (seglvl || eqstr_(level, "INTERVAL", level_len, (ftnlen)8))) {
setmsg_("Allowed values of LEVEL are # and #; actual value was #.", (
ftnlen)56);
errch_("#", "SEGMENT", (ftnlen)1, (ftnlen)7);
errch_("#", "INTERVAL", (ftnlen)1, (ftnlen)8);
errch_("#", level, (ftnlen)1, level_len);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* See whether GETFAT thinks we've got a CK file. */
getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. If the input file i"
"s an CK file in transfer format, run TOBIN on the file to co"
"nvert it to binary format.", (ftnlen)205);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. Binary CK files hav"
"e DAF architecture. If you expected the file to be a binary"
" CK file, the problem may be due to the file being an old no"
"n-native file lacking binary file format information. It's a"
"lso possible the file has been corrupted.", (ftnlen)340);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) {
setmsg_("Input file # has file type #. The file must be a binary CK "
"file to be readable by this routine. If you expected the fil"
"e to be a binary CK file, the problem may be due to the file"
" being an old non-native file lacking binary file format inf"
"ormation. It's also possible the file has been corrupted.", (
ftnlen)296);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Set a logical flag indicating whether the time systm is SCLK. */
istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
/* Check time system. */
if (! istdb) {
if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
"and TDB.", (ftnlen)63);
errch_("#", timsys, (ftnlen)1, timsys_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* If the output time system is TDB, find the clock ID associated */
/* with IDCODE. */
if (istdb) {
ckmeta_(idcode, "SCLK", &clkid, (ftnlen)4);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* Open the file for reading. */
dafopr_(ck, &handle, ck_len);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* If TOL > 0, we'll apply TOL after we've found the coverage */
/* for the zero-tolerance case. */
/* If the time system is TDB, we'll convert the times to TDB */
/* at the end of this routine. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found) {
/* Note: we check FAILED() at the bottom of this loop; this */
/* routine returns if FAILED() returns .TRUE. at that point. */
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
/* Let AVOK indicate whether the segment satisfies the */
/* angular velocity restriction. */
avok = ic[3] == 1 || ! (*needav);
if (ic[0] == *idcode && avok) {
/* This segment is for the body of interest. If angular */
/* velocity is needed, this segment has it. */
if (seglvl) {
/* This is a segment-level summary. */
/* Insert the coverage bounds into the coverage window. */
/* Adjust the interval using the tolerance. */
/* Computing MAX */
d__1 = dc[0] - *tol;
dctol[0] = max(d__1,0.);
dctol[1] = dc[1] + *tol;
/* Convert the time to TDB if necessary. */
if (istdb) {
/* Convert the time bounds to TDB before inserting */
/* into the window. */
for (i__ = 1; i__ <= 2; ++i__) {
sct2e_(&clkid, &dctol[(i__1 = i__ - 1) < 2 && 0 <=
i__1 ? i__1 : s_rnge("dctol", i__1, "ckcov_",
(ftnlen)868)], &et);
dctol[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("dctol", i__1, "ckcov_", (ftnlen)869)]
= et;
}
}
if (dctol[0] <= dctol[1]) {
wninsd_(dctol, &dctol[1], cover);
}
} else {
/* We're looking for an interval-level coverage window. */
/* This information must be retrieved in a */
/* data-type-dependent fashion. The coverage routines */
/* we'll call will, if necessary, adjust intervals by TOL */
/* and convert interval times to TDB. */
dtype = ic[2];
segbeg = ic[4];
segend = ic[5];
if (dtype == 1) {
zzckcv01_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 2) {
zzckcv02_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 3) {
zzckcv03_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 4) {
zzckcv04_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 5) {
/* Note: this calling sequence is exceptional; the */
/* segment bounds are an input. */
zzckcv05_(&handle, &segbeg, &segend, &clkid, dc, tol,
timsys, cover, timsys_len);
} else {
setmsg_("Supported CK data types are 1, 2, 3, 4, 5. Dat"
"a type of segment: #. This problem may indicate "
"that you need to update your SPICE Toolkit.", (
ftnlen)138);
errint_("#", &dtype, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
}
daffna_(&found);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* COVER now represents the coverage of the entire file at the */
/* granularity indicated by LEVEL, combined with the coverage */
/* contained in COVER on input. */
/* Release the file. */
dafcls_(&handle);
chkout_("CKCOV", (ftnlen)5);
return 0;
} /* ckcov_ */
/* $Procedure CKGR04 ( C-kernel, get record, type 04 ) */
/* Subroutine */ int ckgr04_(integer *handle, doublereal *descr, integer *
recno, doublereal *record)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer nrec, ends[1], k;
extern /* Subroutine */ int chkin_(char *, ftnlen), cknr04_(integer *,
doublereal *, integer *), dafus_(doublereal *, integer *, integer
*, doublereal *, integer *);
integer numall;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numcft[7];
extern /* Subroutine */ int chkout_(char *, ftnlen), sgfpkt_(integer *,
doublereal *, integer *, integer *, doublereal *, integer *),
setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen);
extern logical return_(void);
doublereal dcd[2];
integer icd[6];
extern /* Subroutine */ int zzck4d2i_(doublereal *, integer *, doublereal
*, integer *);
/* $ Abstract */
/* Given the handle and descriptor of a type 4 segment in */
/* a CK file, return a specified pointing record from that */
/* segment. */
/* $ 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 */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* Declarations of the CK data type specific and general CK low */
/* level routine parameters. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK.REQ */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* 1) If new CK types are added, the size of the record passed */
/* between CKRxx and CKExx must be registered as separate */
/* parameter. If this size will be greater than current value */
/* of the CKMRSZ parameter (which specifies the maximum record */
/* size for the record buffer used inside CKPFS) then it should */
/* be assigned to CKMRSZ as a new value. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* CK Required Reading. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 27-JAN-2014 (NJB) */
/* Updated to support CK type 6. Maximum degree for */
/* type 5 was updated to be consistent with the */
/* maximum degree for type 6. */
/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
/* Updated to support CK type 5. */
/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
/* -& */
/* Number of quaternion components and number of quaternion and */
/* angular rate components together. */
/* CK Type 1 parameters: */
/* CK1DTP CK data type 1 ID; */
/* CK1RSZ maximum size of a record passed between CKR01 */
/* and CKE01. */
/* CK Type 2 parameters: */
/* CK2DTP CK data type 2 ID; */
/* CK2RSZ maximum size of a record passed between CKR02 */
/* and CKE02. */
/* CK Type 3 parameters: */
/* CK3DTP CK data type 3 ID; */
/* CK3RSZ maximum size of a record passed between CKR03 */
/* and CKE03. */
/* CK Type 4 parameters: */
/* CK4DTP CK data type 4 ID; */
/* CK4PCD parameter defining integer to DP packing schema that */
/* is applied when seven number integer array containing */
/* polynomial degrees for quaternion and angular rate */
/* components packed into a single DP number stored in */
/* actual CK records in a file; the value of must not be */
/* changed or compatibility with existing type 4 CK files */
/* will be lost. */
/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
/* records; the value of this parameter must never exceed */
/* value of the CK4PCD; */
/* CK4SFT number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 4 */
/* CK record that passed between routines CKR04 and CKE04; */
/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
/* and CKE04; CK4RSZ is computed as follows: */
/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
/* CK Type 5 parameters: */
/* CK5DTP CK data type 5 ID; */
/* CK5MXD maximum polynomial degree allowed in type 5 */
/* records. */
/* CK5MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 5 */
/* CK record that passed between routines CKR05 and CKE05; */
/* CK5MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck05.inc */
/* for a description of the subtypes. */
/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
/* and CKE05; CK5RSZ is computed as follows: */
/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
/* CK Type 6 parameters: */
/* CK6DTP CK data type 6 ID; */
/* CK6MXD maximum polynomial degree allowed in type 6 */
/* records. */
/* CK6MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 6 */
/* CK record that passed between routines CKR06 and CKE06; */
/* CK6MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck06.inc */
/* for a description of the subtypes. */
/* CK6RSZ maximum size of type 6 CK record passed between CKR06 */
/* and CKE06; CK6RSZ is computed as follows: */
/* CK6RSZ = CK6MET + ( CK6MXD + 1 ) * ( CK6PS3 + 1 ) */
/* where CK6PS3 is equal to the parameter CK06PS3 defined */
/* in ck06.inc. Note that the subtype having the largest */
/* packet size (subtype 2) does not give rise to the */
/* largest record size, because that type is Hermite and */
/* requires half the window size used by subtype 3 for a */
/* given polynomial degree. */
/* The parameter CK6PS3 must be in sync with C06PS3 defined in */
/* ck06.inc. */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK5RSZ.) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I The handle of the file containing the segment. */
/* DESCR I The segment descriptor. */
/* RECNO I The number of the pointing record to be returned. */
/* RECORD O The pointing record. */
/* $ Detailed_Input */
/* HANDLE is the handle of the binary CK file containing the */
/* desired segment. The file should have been opened */
/* for read or write access, either by CKLPF, DAFOPR, */
/* or DAFOPW. */
/* DESCR is the packed descriptor of the data type 4 segment. */
/* RECNO is the number of the pointing record to be returned */
/* from the data type 4 segment. */
/* $ Detailed_Output */
/* RECORD is the pointing record indexed by RECNO in the */
/* segment. The contents of the record are as follows: */
/* --------------------------------------------------- */
/* | The midpoint of the approximation interval | */
/* --------------------------------------------------- */
/* | The radius of the approximation interval | */
/* --------------------------------------------------- */
/* | Number of coefficients for q0 | */
/* --------------------------------------------------- */
/* | Number of coefficients for q1 | */
/* --------------------------------------------------- */
/* | Number of coefficients for q2 | */
/* --------------------------------------------------- */
/* | Number of coefficients for q3 | */
/* --------------------------------------------------- */
/* | Number of coefficients for AV1 | */
/* --------------------------------------------------- */
/* | Number of coefficients for AV2 | */
/* --------------------------------------------------- */
/* | Number of coefficients for AV3 | */
/* --------------------------------------------------- */
/* | q0 Cheby coefficients | */
/* --------------------------------------------------- */
/* | q1 Cheby coefficients | */
/* --------------------------------------------------- */
/* | q2 Cheby coefficients | */
/* --------------------------------------------------- */
/* | q3 Cheby coefficients | */
/* --------------------------------------------------- */
/* | AV1 Cheby coefficients (optional) | */
/* --------------------------------------------------- */
/* | AV2 Cheby coefficients (optional) | */
/* --------------------------------------------------- */
/* | AV3 Cheby coefficients (optional) | */
/* --------------------------------------------------- */
/* $ Parameters */
/* See 'ckparam.inc'. */
/* $ Exceptions */
/* 1) If the segment is not of data type 4, the error */
/* SPICE(CKWRONGDATATYPE) is signalled. */
/* 2) If RECNO is less than one or greater than the number of */
/* records in the specified segment, the error */
/* SPICE(CKNONEXISTREC) is signalled. */
/* 3) If the specified handle does not belong to any DAF file that */
/* is currently known to be open, an error is diagnosed by a */
/* routine that this routine calls. */
/* 4) If DESCR is not a valid descriptor of a segment in the CK */
/* file specified by HANDLE, the results of this routine are */
/* unpredictable. */
/* $ Files */
/* The file specified by HANDLE should be open for read or */
/* write access. */
/* $ Particulars */
/* For a detailed description of the structure of a type 4 segment, */
/* see the CK required reading. */
/* This is a utility routine that may be used to read the individual */
/* pointing records that make up a type 4 segment. It is normally */
/* used in conjunction with CKNR04, which gives the number of */
/* pointing records stored in a segment. */
/* $ Examples */
/* Suppose that DATA.BC is a CK file that contains segments of */
/* data type 4. Then the following code fragment extracts the */
/* data packets contained in the segment. */
/* C */
/* C CK parameters include file. */
/* C */
/* INCLUDE 'ckparam.inc' */
/* C */
/* C Declarations. */
/* C */
/* DOUBLE PRECISION DCD ( 2 ) */
/* DOUBLE PRECISION DESCR ( 5 ) */
/* DOUBLE PRECISION PKTDAT ( CK4RSZ ) */
/* INTEGER AVFLAG */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER ICD ( 6 ) */
/* INTEGER K */
/* INTEGER LASTAD */
/* INTEGER NCOEF ( QAVSIZ ) */
/* INTEGER NREC */
/* LOGICAL FOUND */
/* C */
/* C First load the file. (The file may also be opened by using */
/* C CKLPF.) */
/* C */
/* CALL DAFOPR ( 'DATA.BC', HANDLE ) */
/* C */
/* C Begin forward search. Find the first array. */
/* C */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( FOUND ) */
/* C */
/* C Get segment descriptor. */
/* C */
/* CALL DAFGS ( DESCR ) */
/* C */
/* C Unpack the segment descriptor into its double precision */
/* C and integer components. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* IF ( ICD( 3 ) .EQ. 4 ) THEN */
/* C */
/* C How many records does this segment contain? */
/* C */
/* CALL CKNR04 ( HANDLE, DESCR, NREC ) */
/* DO I = 1, NREC */
/* C */
/* C Get the data records stored in the segment. */
/* C */
/* CALL CKGR04 ( HANDLE, DESCR, I, PKTDAT ) */
/* C */
/* C Print data packet contents. Print coverage interval */
/* C midpoint & radii first. */
/* C */
/* WRITE (2,*) PKTDAT (1) */
/* WRITE (2,*) PKTDAT (2) */
/* C */
/* C Decode numbers of coefficients. */
/* C */
/* CALL ZZCK4D2I ( PKTDAT(3), QAVSIZ, CK4PCD, NCOEF ) */
/* C */
/* C Print number of coefficients for Q0, Q1, Q2 and Q3. */
/* C */
/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 1 ), NCOEF( 2 ) */
/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 3 ), NCOEF( 4 ) */
/* C */
/* C Print number coefficients for AV1, AV2 and AV3. */
/* C */
/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 5 ), NCOEF( 6 ) */
/* WRITE (2,FMT='(I2,6X,I2)') NCOEF( 7 ) */
/* C */
/* C Print Cheby coefficients. */
/* C */
/* LASTAD = 0 */
/* DO K = 1, QAVSIZ */
/* LASTAD = LASTAD + NCOEF( K ) */
/* END DO */
/* DO K = 4, LASTAD + 4 */
/* WRITE (2,*) PKTDAT (K) */
/* END DO */
/* END DO */
/* END IF */
/* $ Restrictions */
/* 1) The binary CK file containing the segment whose descriptor */
/* was passed to this routine must be opened for read or write */
/* access by either CKLPF, DAFOPR, or DAFOPW. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* Y.K. Zaiko (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 18-APR-2014 (BVS) */
/* Minor header edits. */
/* - SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */
/* -& */
/* $ Index_Entries */
/* get CK type_4 record */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Length (in DPs) of non-coefficient front part of RECORD when */
/* it contains decoded numbers of coefficients. It is one less */
/* than the length of the same part in a record exchanged between */
/* CKR04 and CKE04 because it doesn't contain time at which */
/* pointing has to be evaluated. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKGR04", (ftnlen)6);
}
/* Unpack descriptor and check segment data type. Signal an error */
/* if it's not 4. */
dafus_(descr, &c__2, &c__6, dcd, icd);
if (icd[2] != 4) {
setmsg_("Data type of the segment should be 4: Passed descriptor sh"
"ows type = #.", (ftnlen)72);
errint_("#", &icd[2], (ftnlen)1);
sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22);
chkout_("CKGR04", (ftnlen)6);
return 0;
}
/* If a request was made for a data record which doesn't */
/* exist, then signal an error and leave. */
cknr04_(handle, descr, &nrec);
if (*recno < 1 || *recno > nrec) {
setmsg_("Requested record number (#) does not exist. There are # rec"
"ords in the segment.", (ftnlen)79);
errint_("#", recno, (ftnlen)1);
errint_("#", &nrec, (ftnlen)1);
sigerr_("SPICE(CKNONEXISTREC)", (ftnlen)20);
chkout_("CKGR04", (ftnlen)6);
return 0;
}
/* Get the data record indexed by RECNO. */
sgfpkt_(handle, descr, recno, recno, record, ends);
/* Decode 7 numbers of coefficients from double precision value. */
zzck4d2i_(&record[2], &c__7, &c_b15, numcft);
/* Compute total number of coefficients in the fetched packet. */
numall = 0;
for (k = 1; k <= 7; ++k) {
numall += numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ? i__1 : s_rnge(
"numcft", i__1, "ckgr04_", (ftnlen)369)];
}
/* Move polynomial coefficients to the right to free space for */
/* decoded numbers of coefficients and insert these numbers */
/* starting from the third position. */
for (k = numall; k >= 1; --k) {
record[k + 8] = record[k + 2];
}
for (k = 1; k <= 7; ++k) {
record[k + 1] = (doublereal) numcft[(i__1 = k - 1) < 7 && 0 <= i__1 ?
i__1 : s_rnge("numcft", i__1, "ckgr04_", (ftnlen)382)];
}
/* All done. */
chkout_("CKGR04", (ftnlen)6);
return 0;
} /* ckgr04_ */
/* $Procedure PCKMAT ( PCK, get transformation matrix at time ) */
/* Subroutine */ int pckmat_(integer *body, doublereal *et, integer *ref,
doublereal *tsipm, logical *found)
{
integer type__;
extern /* Subroutine */ int pcke02_(doublereal *, doublereal *,
doublereal *), pcke03_(doublereal *, doublereal *, doublereal *),
pcke20_(doublereal *, doublereal *, doublereal *), chkin_(char *,
ftnlen);
doublereal descr[5];
extern /* Subroutine */ int pckr02_(integer *, doublereal *, doublereal *,
doublereal *), dafus_(doublereal *, integer *, integer *,
doublereal *, integer *);
char ident[40];
extern /* Subroutine */ int pckr03_(integer *, doublereal *, doublereal *,
doublereal *), pckr20_(integer *, doublereal *, doublereal *,
doublereal *), eul2xf_(doublereal *, integer *, integer *,
integer *, doublereal *);
extern logical failed_(void);
integer handle;
doublereal eulang[6], record[130];
extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *,
integer *, doublereal *);
doublereal estate[6];
extern /* Subroutine */ int pcksfs_(integer *, doublereal *, integer *,
doublereal *, char *, logical *, ftnlen), sigerr_(char *, ftnlen),
chkout_(char *, ftnlen);
integer recsiz;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
doublereal dcd[2];
integer icd[5];
/* $ Abstract */
/* Given a body and epoch, return the name of an inertial */
/* reference frame and the 6 x 6 state transformation matrix */
/* from that frame to the body fixed 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 */
/* NAIF_IDS */
/* ROTATION */
/* TIME */
/* PCK */
/* $ Keywords */
/* TRANSFORMATION */
/* ROTATION */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of some body. */
/* ET I Epoch of transformation. */
/* REF O Integer code for inertial reference frame. */
/* TSIPM O Transformation from Inertial to PM for BODY at ET. */
/* FOUND O True if data for BODY and ET are found. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* state transformation matrix is requested. Bodies */
/* are numbered according to the standard NAIF */
/* numbering scheme. The numbering scheme is */
/* explained in the NAIF_IDS required reading file. */
/* ET is the epoch at which the state transformation */
/* matrix is requested. */
/* $ Detailed_Output */
/* REF is the integer code for the inertial reference frame */
/* of the state transformation matrix TSIPM. (See the */
/* routine CHGIRF for a full list of inertial reference */
/* frame names.) */
/* TSIPM is a 6x6 transformation matrix. It is used to */
/* transform states from inertial coordinates to body */
/* fixed (also called equator and prime meridian --- PM) */
/* coordinates. */
/* Given a state S in the inertial reference frame */
/* specified by REF, the corresponding state in the body */
/* fixed reference frame is given by the matrix vector */
/* product: */
/* TSIPM * S */
/* See the PCK required reading for further details */
/* concerning PCK reference frames. */
/* NOTE: The inverse of TSIPM is NOT its transpose. The */
/* matrix, TSIPM, has the structure shown below: */
/* - - */
/* | : | */
/* | R : 0 | */
/* | ......:......| */
/* | : | */
/* | dR_dt : R | */
/* | : | */
/* - - */
/* where R is a time varying rotation matrix and dR_dt */
/* is its derivative. The inverse of this matrix is: */
/* - - */
/* | T : | */
/* | R : 0 | */
/* | .......:.......| */
/* | : | */
/* | T : T | */
/* | dR_dt : R | */
/* | : | */
/* - - */
/* The SPICE routine INVSTM is available for producing */
/* this inverse. */
/* FOUND if the data allowing the computation of a state */
/* transformation matrix for the requested time and body */
/* are found in a binary PCK file, FOUND will have the */
/* value .TRUE., otherwise it will have the value */
/* .FALSE.. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the size of the type 20 PCK record to be retrieved is too */
/* large to fit into RECORD, the error SPICE(PCKRECTOOLARGE) */
/* will be signaled. */
/* 2) Any error that occurs while reading PCK data will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 3) If the requested transformation matrix cannot be computed */
/* using data from loaded binary PCK files, FOUND is returned */
/* with the value .FALSE.. This is not a SPICE error. */
/* $ Files */
/* This routine computes transformation matrices using data */
/* provided by a loaded binary PCK kernel. */
/* $ Particulars */
/* The matrix for transforming an inertial state into a body fixed */
/* states is the 6x6 matrix shown below as a block structured */
/* matrix. */
/* - - */
/* | : | */
/* | TIPM : 0 | */
/* | ......:......| */
/* | : | */
/* | DTIPM : TIPM | */
/* | : | */
/* - - */
/* If a binary PCK file record can be found for the time and body */
/* requested, it will be used. The most recently loaded binary PCK */
/* file has first priority, followed by previously loaded binary PCK */
/* files in backward time order. If no binary PCK file has been */
/* loaded, the text P_constants kernel file is used. */
/* $ Examples */
/* Here we load a binary PCK files and use PCKEUL to get the */
/* Euler angles. */
/* C */
/* C Load binary PCK file. */
/* C */
/* CALL PCKLOF ('example.pck', HANDLE) */
/* C Call routine to get transformation matrix. */
/* CALL PCKMAT ( BODY, ET, REF, TIPM, FOUND ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K. S. Zukor (JPL) */
/* K. R. Gehringer (JPL) */
/* N. J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.0, 03-JAN-2014 (NJB) (EDW) */
/* Minor edits to Procedure; clean trailing whitespace. */
/* Removed unneeded Revisions section. */
/* Updated to support type 20. Changed long error message */
/* for the case of RECORD having insufficient room: the */
/* user is no longer advised to modify the record size. */
/* - SPICELIB Version 2.0.0, 22-MAR-1995 (KRG) (KSZ) */
/* Added PCK type 03. Added a new exception. Made some minor */
/* comment changes. */
/* - SPICELIB Version 1.0.0, 21-MAR-1995 (KSZ) */
/* Replaces PCKEUL and returns the transformation */
/* matrix rather than the Euler angles. */
/* -& */
/* $ Index_Entries */
/* get state transformation matrix from binary PCK file */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* ND and NI values for a PCK file. */
/* Index for the reference frame code in the integer summary. */
/* Length of the descriptor for a PCK file. */
/* Index for the data type code in the integer summary. */
/* Maximum size allowed for a record in a segment of a binary PCK */
/* file. */
/* Number of components in a state vector. */
/* Local Variables */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
}
chkin_("PCKMAT", (ftnlen)6);
/* Get a segment applicable to a specified body and epoch. */
pcksfs_(body, et, &handle, descr, ident, found, (ftnlen)40);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
if (*found) {
/* Look at parts of the descriptor. */
dafus_(descr, &c__2, &c__5, dcd, icd);
type__ = icd[2];
*ref = icd[1];
if (type__ == 2) {
/* Read in Chebyshev coefficients from segment. */
pckr02_(&handle, descr, et, record);
/* Call evaluation routine to get Euler angles */
/* phi, delta, w. */
pcke02_(et, record, eulang);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
/* From the PCK type two file the Euler angles are */
/* retrieved in a particular order. The routine to */
/* get the TSIPM matrix from expects them in another */
/* order. Here we change from EULANG to ESTATE, which */
/* has this proper order. */
estate[0] = eulang[2];
estate[1] = eulang[1];
estate[2] = eulang[0];
estate[3] = eulang[5];
estate[4] = eulang[4];
estate[5] = eulang[3];
/* Call routine which takes Euler angles to transformation */
/* matrix. */
eul2xf_(estate, &c__3, &c__1, &c__3, tsipm);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
} else if (type__ == 3) {
/* Fetch the number of Chebyshev coefficients, compute the */
/* record size needed, and signal an error if there is not */
/* enough storage in RECORD. The number of coefficients is the */
/* first constant value in the generic segment. */
sgfcon_(&handle, descr, &c__1, &c__1, record);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
recsiz = (integer) record[0] * 6 + 2;
if (recsiz > 130) {
setmsg_("Storage for # double precision numbers is needed fo"
"r a PCK data record and only # locations were availa"
"ble. Notify the NAIF group of this problem.", (ftnlen)
146);
errint_("#", &recsiz, (ftnlen)1);
errint_("#", &c__130, (ftnlen)1);
sigerr_("SPICE(PCKKRECTOOLARGE)", (ftnlen)22);
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
pckr03_(&handle, descr, et, record);
pcke03_(et, record, tsipm);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
} else if (type__ == 20) {
/* Read in Chebyshev coefficients from segment. */
pckr20_(&handle, descr, et, record);
/* Call evaluation routine to get Euler angles */
/* phi, delta, w. */
pcke20_(et, record, eulang);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
/* From the PCK type 20 file the Euler angles are */
/* retrieved in a particular order. The routine to */
/* get the TSIPM matrix from expects them in another */
/* order. Here we change from EULANG to ESTATE, which */
/* has this proper order. */
estate[0] = eulang[2];
estate[1] = eulang[1];
estate[2] = eulang[0];
estate[3] = eulang[5];
estate[4] = eulang[4];
estate[5] = eulang[3];
/* Call routine which takes Euler angles to transformation */
/* matrix. */
eul2xf_(estate, &c__3, &c__1, &c__3, tsipm);
if (failed_()) {
*found = FALSE_;
chkout_("PCKMAT", (ftnlen)6);
return 0;
}
} else {
/* If data matching the requested body and time was not */
/* found, FOUND is false. */
*found = FALSE_;
}
}
chkout_("PCKMAT", (ftnlen)6);
return 0;
} /* pckmat_ */
/* $Procedure SPKR17 ( Read SPK record from segment, type 17 ) */
/* Subroutine */ int spkr17_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer type__, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *), dafgda_(integer *,
integer *, integer *, doublereal *);
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
integer end;
/* $ Abstract */
/* This routine reads a single spk data record from a segment of */
/* type 17 (Precessing Conic Propagation). */
/* $ 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. */
/* RECORD O Data record. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* a SPK segment of type 17. */
/* ET is a target epoch, for which a data record from */
/* a specific segment is required. */
/* $ Detailed_Output */
/* RECORD is the record from the specified segment which, */
/* when evaluated at epoch ET, will give the state */
/* (position and velocity) of some body, relative */
/* to some center, in some inertial reference frame. */
/* $ Parameters */
/* None. */
/* $ Files */
/* See argument HANDLE. */
/* $ Exceptions */
/* 1) If the segment specified by DESCR is not a type 17 segment */
/* the error 'SPICE(WRONGSPKTYPE)' will be signalled. */
/* 2) A type 17 segment should have exactly 16 values. If this */
/* is not the case the error 'SPICE(MALFORMEDSEGMENT)' is */
/* signalled. */
/* $ Particulars */
/* This routine reads all of the data from a type 17 SPK segment. */
/* The structure of the data retrieved in RECORD is: */
/* RECORD(1) is the epoch of the orbit elements at */
/* in ephemeris seconds past J2000. */
/* RECORD(2) is the semi-major axis (A) of the orbit. */
/* RECORD(3) is the value of H at the specified epoch. */
/* ( E*SIN(ARGP+NODE) ). */
/* RECORD(4) is the value of K at the specified epoch */
/* ( E*COS(ARGP+NODE) ). */
/* RECORD(5) is the mean longitude (MEAN0+ARGP+NODE)at */
/* the epoch of the elements. */
/* RECORD(6) is the value of P (TAN(INC/2)*SIN(NODE))at */
/* the specified epoch. */
/* RECORD(7) is the value of Q (TAN(INC/2)*COS(NODE))at */
/* the specified epoch. */
/* RECORD(8) is the rate of the longitude of periapse */
/* (dARGP/dt + dNODE/dt ) at the epoch of */
/* the elements. This rate is assumed to hold */
/* for all time. */
/* RECORD(9) is the derivative of the mean longitude */
/* ( dM/dt + dARGP/dt + dNODE/dt ). This */
/* rate is assumed to be constant. */
/* RECORD(10) is the rate of the longitude of the ascending */
/* node ( dNODE/dt). */
/* RECORD(11) Right Ascension of the pole of the */
/* orbital reference system relative to the */
/* reference frame of the associated SPK segment. */
/* RECORD(12) Declination of the pole of the */
/* orbital reference system relative to the */
/* reference frame of the associated SPK segment. */
/* Units are km, radians and radians/second. */
/* $ Examples */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRnn */
/* routines might be used to "dump" and check segment data for a */
/* particular epoch. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 17 ) THEN */
/* CALL SPKR17 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.0, 3-JAN-1997 (WLT) (SS) */
/* -& */
/* $ Index_Entries */
/* read record from type_17 spk segment */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* The difference between the first and last address of a type 17 */
/* segment should be 11. */
/* Standard Spice Error Handling. */
if (return_()) {
return 0;
}
chkin_("SPKR17", (ftnlen)6);
/* Unpack the segment descriptor. */
dafus_(descr, &c__2, &c__6, dc, ic);
type__ = ic[3];
begin = ic[4];
end = ic[5];
/* Make sure that this really is a type 17 data segment. */
if (type__ != 17) {
setmsg_("You are attempting to locate type 17 data in a type # data "
"segment.", (ftnlen)67);
errint_("#", &type__, (ftnlen)1);
sigerr_("SPICE(WRONGSPKTYPE)", (ftnlen)19);
chkout_("SPKR17", (ftnlen)6);
return 0;
}
/* Since it doesn't cost much we make sure that the segment has */
/* the correct amount of data. */
if (end - begin != 11) {
setmsg_("A type 17 segment should contain exactly # double precision"
" values. The segment supplied had #. The segment is badly "
"formed. ", (ftnlen)127);
i__1 = end - begin + 1;
errint_("#", &i__1, (ftnlen)1);
errint_("#", &c__12, (ftnlen)1);
sigerr_("SPICE(MALFORMEDSEGMENT)", (ftnlen)23);
chkout_("SPKR17", (ftnlen)6);
return 0;
}
/* Read the data for the record. */
dafgda_(handle, &begin, &end, record);
chkout_("SPKR17", (ftnlen)6);
return 0;
} /* spkr17_ */
/* $Procedure CKPFS ( C-kernel, get pointing from segment ) */
/* Subroutine */ int ckpfs_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *cmat,
doublereal *av, doublereal *clkout, logical *found)
{
extern /* Subroutine */ int cke01_(logical *, doublereal *, doublereal *,
doublereal *, doublereal *), cke02_(logical *, doublereal *,
doublereal *, doublereal *, doublereal *), cke03_(logical *,
doublereal *, doublereal *, doublereal *, doublereal *), cke04_(
logical *, doublereal *, doublereal *, doublereal *, doublereal *)
, cke05_(logical *, doublereal *, doublereal *, doublereal *,
doublereal *), ckr01_(integer *, doublereal *, doublereal *,
doublereal *, logical *, doublereal *, logical *), ckr02_(integer
*, doublereal *, doublereal *, doublereal *, doublereal *,
logical *), ckr03_(integer *, doublereal *, doublereal *,
doublereal *, logical *, doublereal *, logical *), ckr04_(integer
*, doublereal *, doublereal *, doublereal *, logical *,
doublereal *, logical *), ckr05_(integer *, doublereal *,
doublereal *, doublereal *, logical *, doublereal *, logical *);
integer type__;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
doublereal record[228];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
doublereal dcd[2];
integer icd[6];
/* $ Abstract */
/* Evaluate pointing data from a segment for a given 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 */
/* DAF */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* Declarations of the CK data type specific and general CK low */
/* level routine parameters. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK.REQ */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* 1) If new CK types are added, the size of the record passed */
/* between CKRxx and CKExx must be registered as separate */
/* parameter. If this size will be greater than current value */
/* of the CKMRSZ parameter (which specifies the maximum record */
/* size for the record buffer used inside CKPFS) then it should */
/* be assigned to CKMRSZ as a new value. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* CK Required Reading. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
/* Updated to support CK type 5. */
/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
/* -& */
/* Number of quaternion components and number of quaternion and */
/* angular rate components together. */
/* CK Type 1 parameters: */
/* CK1DTP CK data type 1 ID; */
/* CK1RSZ maximum size of a record passed between CKR01 */
/* and CKE01. */
/* CK Type 2 parameters: */
/* CK2DTP CK data type 2 ID; */
/* CK2RSZ maximum size of a record passed between CKR02 */
/* and CKE02. */
/* CK Type 3 parameters: */
/* CK3DTP CK data type 3 ID; */
/* CK3RSZ maximum size of a record passed between CKR03 */
/* and CKE03. */
/* CK Type 4 parameters: */
/* CK4DTP CK data type 4 ID; */
/* CK4PCD parameter defining integer to DP packing schema that */
/* is applied when seven number integer array containing */
/* polynomial degrees for quaternion and angular rate */
/* components packed into a single DP number stored in */
/* actual CK records in a file; the value of must not be */
/* changed or compatibility with existing type 4 CK files */
/* will be lost. */
/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
/* records; the value of this parameter must never exceed */
/* value of the CK4PCD; */
/* CK4SFT number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 4 */
/* CK record that passed between routines CKR04 and CKE04; */
/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
/* and CKE04; CK4RSZ is computed as follows: */
/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
/* CK Type 5 parameters: */
/* CK5DTP CK data type 5 ID; */
/* CK5MXD maximum polynomial degree allowed in type 5 */
/* records. */
/* CK5MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 5 */
/* CK record that passed between routines CKR05 and CKE05; */
/* CK5MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck05.inc */
/* for a description of the subtypes. */
/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
/* and CKE05; CK5RSZ is computed as follows: */
/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK4RSZ.) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I CK file handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Spacecraft clock time. */
/* TOL I Time tolerance. */
/* NEEDAV I True when angular velocity data is requested. */
/* CMAT O C-matrix. */
/* AV O Angular velocity vector. */
/* CLKOUT O Output spacecraft clock time. */
/* FOUND O True when requested pointing is available. */
/* $ Detailed_Input */
/* HANDLE is the handle of the binary CK file containing the */
/* desired segment. The file should have been opened */
/* for read access, either by CKLPF or DAFOPR. */
/* DESCR is the packed descriptor of the segment. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is desired. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. The C-matrix returned by */
/* CKPFS is the one whose time is closest to SCLKDP and */
/* within TOL units of SCLKDP. */
/* NEEDAV is true when angular velocity data is requested. */
/* $ Detailed_Output */
/* CMAT is a rotation matrix that transforms the components of */
/* of a vector expressed in the inertial frame given in */
/* the segment to components expressed in the instrument */
/* fixed frame at time CLKOUT. */
/* Thus, if a vector v has components x, y, z in the */
/* inertial frame, then v has components x', y', z' in */
/* the instrument fixed frame at time CLKOUT: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* If the x', y', z' components are known, 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) */
/* AV is the angular velocity vector. This is returned only */
/* if it has been requested, as indicated by NEEDAV. In */
/* other words, if NEEDAV is true, then the pointing */
/* records in the segment must contain AV data. */
/* The angular velocity vector is the right-handed axis */
/* about which the reference frame tied to the instrument */
/* is instantaneously rotating at time CLKOUT. The */
/* magnitude of AV is the magnitude of the instantaneous */
/* velocity of the rotation, in radians per second. */
/* The components of AV are given relative to the */
/* reference frame specified in the segment descriptor. */
/* CLKOUT is the encoded spacecraft clock time associated with */
/* the returned C-matrix and, optionally, the returned */
/* angular velocity vector. */
/* FOUND is true if a C-matrix and an angular velocity vector */
/* (if requested) were found to satisfy the pointing */
/* request. FOUND will be false otherwise. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the data type of the segment is not one of those supported */
/* by this routine, the error SPICE(CKUNKNOWNDATATYPE) is */
/* signalled. */
/* 2) If the specified handle does not belong to any file that is */
/* currently known to be open, an error is diagnosed by a */
/* routine that this routine calls. */
/* 3) If DESCR is not a valid, packed descriptor of a segment in */
/* the CK file specified by HANDLE, the results of this routine */
/* are unpredictable. */
/* 4) If TOL is negative, FOUND is false. */
/* 5) If NEEDAV is true, but the segment doesn't contain AV data, */
/* an error is signalled by a routine that this routine calls. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The structure of this routine is just a big case statement. Each */
/* segment data type is supported by two routines: */
/* CKRnn which reads a single logical pointing record from a */
/* segment of type nn. (A logical record is defined as */
/* a collection of numbers sufficient to determine the */
/* C-matrix, and optionally the angular velocity vector, */
/* at the input time.) */
/* CKEnn which evaluates the pointing record returned by CKRnn */
/* to give the C-matrix and optionally the angular */
/* velocity vector at the input time. */
/* The data type is determined from the segment descriptor, and the */
/* appropriate routines are called. */
/* $ Examples */
/* CKPFS allows you to be more selective than CKGP or CKGPAV about */
/* choosing segments to satisfy CK pointing requests. */
/* Suppose MOC.BC is a CK file consisting of several segments */
/* containing Mars Observer Camera pointing data. Each segment */
/* covers the same time period, but produces different pointing */
/* values (one segment may contain predict values, another may */
/* contain telemetry-based values, and others may contain different */
/* corrected versions). */
/* The following code fragment shows how different the results are */
/* for each segment. The program steps through the file segment by */
/* segment and requests pointing for the same time from each */
/* segment. The results are printed to the screen. */
/* GETIME is an imaginary routine used to get an encoded SCLK time */
/* (SCLKDP) and time tolerance from the user. */
/* SC = -94 */
/* INST = -94001 */
/* NEEDAV = .TRUE. */
/* CALL CKLPF ( 'MOC.BC', HANDLE ) */
/* CALL GETIME ( SCLKDP, TOL, QUIT ) */
/* C */
/* C For each time, begin a forward search through the file, and */
/* C for each segment found, get its descriptor, identifier, and */
/* C evaluate the pointing. */
/* C */
/* DO WHILE ( .NOT. QUIT ) */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( FOUND ) */
/* DO WHILE ( FOUND ) */
/* CALL DAFGS ( DESCR ) */
/* CALL DAFGN ( IDENT ) */
/* CALL CKPFS ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . CMAT, AV, CLKOUT, PFOUND ) */
/* IF ( PFOUND ) THEN */
/* WRITE (*,*) 'Segment: ', IDENT */
/* WRITE (*,*) 'C-Matrix: ', CMAT */
/* WRITE (*,*) 'Angular velocity: ', AV */
/* ELSE */
/* CALL SCDECD ( SC, SCLKDP, SCLKCH ) */
/* WRITE (*,*) 'Data not found at time ', SCLKCH */
/* END IF */
/* CALL DAFFNA ( FOUND ) */
/* END DO */
/* CALL GETIME ( SCLKDP, TOL, QUIT ) */
/* END DO */
/* $ Restrictions */
/* A C-kernel file should have been loaded by either CKLPF */
/* or DAFOPR. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.M. Lynch (JPL) */
/* B.V. Semenov (JPL) */
/* M.J. Spencer (JPL) */
/* R.E. Thurman (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 5.0.0, 19-AUG-2002 (NJB) */
/* The routine was updated to handle data type 5 segments. */
/* - SPICELIB Version 4.0.0, 02-MAY-1999 (BVS) */
/* The routine was updated to handle data type 4 segments. */
/* The RECSIZ size parameter was eliminated. The dimension */
/* of the RECORD buffer is now defined by the CKMRSZ parameter */
/* specified in the 'ckparam.inc' include file. */
/* - SPICELIB Version 3.0.0, 11-SEP-1992 (JML) */
/* The routine was updated to handle data type 3 segments. */
/* - 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 routine was updated to handle data type 2 segments. */
/* FOUND is now initialized to false. */
/* - 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 pointing from ck segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 5.0.0, 19-AUG-2002 (NJB) */
/* The routine was updated to handle data type 5 segments. */
/* - SPICELIB Version 4.0.0, 02-MAY-1999 (BVS) */
/* The routine was updated to handle data type 4 segments. */
/* a) 'ckparam.inc' include file was included. */
/* b) RECSIZ size parameter was eliminated. */
/* c) Size of the RECORD was reset to CKMRSZ, parameter */
/* defined in the 'ckparam.inc' include file. */
/* d) Calls to CKR04 and CKE04 were added to the case */
/* statement. */
/* - SPICELIB Version 3.0.0, 11-SEP-1992 (JML) */
/* The routine was updated to handle data type 3 segments. */
/* a) RECSIZ was increased to 17. */
/* b) Calls to CKR03 and CKE03 were added to the case */
/* statement. */
/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */
/* 1) The routine was updated to handle data type 2 segments. */
/* 2) FOUND is initialized to false to guard against it being */
/* left unchanged from its previous value when an error is */
/* detected. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* 1) The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* - Beta Version 1.1.0, 30-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 declarations for the parameters RECSIZ, NDC, and NIC */
/* 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. */
/* 3) The header was updated. */
/* 4) The comments in the code were improved. */
/* - Beta Version 1.0.0, 07-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. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKPFS", (ftnlen)5);
}
/* Start off with FOUND set to false. This guards against FOUND */
/* being left unchanged from a previous call if any errors are */
/* detected. */
*found = FALSE_;
/* Upgrading CKPFS to accommodate new data types involves following */
/* these steps: */
/* 1) Write the two new routines CKRnn and CKEnn. (You may need to */
/* add or subtract from the arguments used in the existing CKRnn */
/* and CKEnn calling sequences, but should not have to change */
/* the inputs or outputs to CKPFS.) */
/* 2) Insert a new case into the code of CKPFS. */
/* 3) Depending on the size of RECORD returned from CKRnn, modify */
/* the parameter RECSIZ. (You will only need to change it if */
/* RECSIZ is not large enough for the new CKRnn's RECORD.) */
/* Unpack the descriptor to see what the data type of the segment is, */
/* and call the appropriate read-and-evaluate routines. */
dafus_(descr, &c__2, &c__6, dcd, icd);
type__ = icd[2];
if (type__ == 1) {
ckr01_(handle, descr, sclkdp, tol, needav, record, found);
if (*found) {
cke01_(needav, record, cmat, av, clkout);
}
} else if (type__ == 2) {
ckr02_(handle, descr, sclkdp, tol, record, found);
if (*found) {
cke02_(needav, record, cmat, av, clkout);
}
} else if (type__ == 3) {
ckr03_(handle, descr, sclkdp, tol, needav, record, found);
if (*found) {
cke03_(needav, record, cmat, av, clkout);
}
} else if (type__ == 4) {
ckr04_(handle, descr, sclkdp, tol, needav, record, found);
if (*found) {
cke04_(needav, record, cmat, av, clkout);
}
} else if (type__ == 5) {
ckr05_(handle, descr, sclkdp, tol, needav, record, found);
if (*found) {
cke05_(needav, record, cmat, av, clkout);
}
} else {
setmsg_("The data type # is not currently supported.", (ftnlen)43);
errint_("#", &type__, (ftnlen)1);
sigerr_("SPICE(CKUNKNOWNDATATYPE)", (ftnlen)24);
}
chkout_("CKPFS", (ftnlen)5);
return 0;
} /* ckpfs_ */
/* $Procedure SPKSUB ( S/P Kernel, subset ) */
/* Subroutine */ int spksub_(integer *handle, doublereal *descr, char *ident,
doublereal *begin, doublereal *end, integer *newh, ftnlen ident_len)
{
logical okay;
integer type__, baddr, eaddr;
doublereal alpha, omega;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *), dafus_(
doublereal *, integer *, integer *, doublereal *, integer *);
doublereal ndscr[5];
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), spks01_(
integer *, integer *, integer *, doublereal *, doublereal *),
spks02_(integer *, integer *, integer *, doublereal *, doublereal
*), spks03_(integer *, integer *, integer *, doublereal *,
doublereal *), spks10_(integer *, doublereal *, integer *,
doublereal *, char *, ftnlen), spks05_(integer *, integer *,
integer *, doublereal *, doublereal *), spks12_(integer *,
integer *, integer *, doublereal *, doublereal *), spks13_(
integer *, integer *, integer *, doublereal *, doublereal *),
spks08_(integer *, integer *, integer *, doublereal *, doublereal
*), spks09_(integer *, integer *, integer *, doublereal *,
doublereal *), spks14_(integer *, doublereal *, integer *,
doublereal *, char *, ftnlen), spks15_(integer *, integer *,
integer *, doublereal *, doublereal *), spks17_(integer *,
integer *, integer *, doublereal *, doublereal *), spks18_(
integer *, integer *, integer *, doublereal *, doublereal *),
spks19_(integer *, integer *, integer *, doublereal *, doublereal
*), spks20_(integer *, integer *, integer *, doublereal *,
doublereal *), spks21_(integer *, integer *, integer *,
doublereal *, doublereal *);
doublereal dc[2];
extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *,
ftnlen);
integer ic[6];
extern /* Subroutine */ int dafena_(void), sigerr_(char *, ftnlen),
chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in an SPK segment into a */
/* separate segment. */
/* $ 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 */
/* DAF */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of source segment. */
/* DESCR I Descriptor of source segment. */
/* IDENT I Identifier of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* NEWH I Handle of new segment. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR, */
/* IDENT are the file handle assigned to a SPK file, the */
/* descriptor for a segment within the file, and the */
/* identifier for that segment. Together they determine */
/* a complete set of ephemeris data, from which a */
/* subset is to be extracted. */
/* BEGIN, */
/* END are the initial and final epochs (ephemeris time) */
/* of the subset. */
/* NEWH is the file handle assigned to the file in which */
/* the new segment is to be written. The file must */
/* be open for write access. NEWH and HANDLE may refer */
/* to the same file. */
/* $ Detailed_Output */
/* See $Files section. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the condition */
/* ALPHA < BEGIN < END < OMEGA */
/* - - - */
/* is not satisfied (where ALPHA and OMEGA are the initial */
/* and final epochs of the segment respectively), the error */
/* 'SPICE(SPKNOTASUBSET)' is signaled. */
/* 2) If the segment type is not supported by the current */
/* version of SPKSUB, the error 'SPICE(SPKTYPENOTSUPP)' */
/* is signaled. */
/* $ Files */
/* A new segment, which contains a subset of the data in the */
/* segment specified by DESCR and HANDLE, is written to the SPK */
/* file attached to NEWH. */
/* $ Particulars */
/* Sometimes, the segments in official source files---planetary */
/* Developmental Ephemeris (DE) files, archival spacecraft */
/* ephemeris files, and so on---contain more data than is needed */
/* by a particular user. SPKSUB allows a user to extract from a */
/* segment the smallest amount of ephemeris data sufficient to */
/* cover a specific interval. */
/* The new segment is written with the same identifier as the */
/* original segment, and with the same descriptor, with the */
/* following components changed: */
/* 1) ALPHA and OMEGA (DCD(1) and DCD(2)) are assigned the values */
/* specified by BEGIN and END. */
/* 2) The beginning and ending segment addresses (ICD(5) and ICD(6)) */
/* are changed to reflect the location of the new segment. */
/* $ Examples */
/* In the following code fragment, the descriptor for each segment */
/* in a source SPK file is examined. For each segment that covers a */
/* specified time interval, the smallest possible subset of data */
/* from that segment, sufficient to cover the interval, is extracted */
/* into a custom SPK file. */
/* Assume that the source and custom files have been opened, for */
/* read and write access, with handles SRC and CUST respectively. */
/* CALL DAFBFS ( SRC ) */
/* CALL DAFFNA ( FOUND ) */
/* DO WHILE ( FOUND ) */
/* CALL DAFGS ( DESCR ) */
/* CALL DAFUS ( DESCR, 2, 6, DC, IC ) */
/* IF ( DC(1) .LE. BEGIN .AND. END .LE. DC(2) ) THEN */
/* CALL DAFGN ( IDENT ) */
/* CALL SPKSUB ( SRC, DESCR, IDENT, BEGIN, END, CUST ) */
/* END IF */
/* CALL DAFFNA ( FOUND ) */
/* END DO */
/* $ Restrictions */
/* 1) There is no way for SPKSUB to verify that the descriptor and */
/* identifier are the original ones for the segment. Changing */
/* the descriptor can cause the data in the new segment to be */
/* evaluated incorrectly; changing the identifier can destroy */
/* the path from the data back to its original source. */
/* $ 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) */
/* N.J. Bachman (JPL) */
/* J.M. Lynch (JPL) */
/* R.E. Thurman (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 9.0.0, 23-DEC-2013 (NJB) */
/* The routine was updated to handle types 19, 20 and 21. Some */
/* minor changes were made to comments. */
/* - SPICELIB Version 8.0.0, 12-AUG-2002 (NJB) */
/* The routine was updated to handle type 18. */
/* - SPICELIB Version 7.0.0, 06-NOV-1999 (NJB) */
/* The routine was updated to handle types 12 and 13. */
/* - SPICELIB Version 6.0.0, 30-JUN-1997 (WLT) */
/* The routine was updated to handle types 10 and 17. */
/* - SPICELIB Version 5.0.0, 10-MAR-1995 (KRG) */
/* The routine was updated to handle type 14. */
/* - SPICELIB Version 4.0.0, 07-NOV-1994 (WLT) */
/* The routine was updated to handle type 15. */
/* - SPICELIB Version 3.0.0, 05-AUG-1993 (NJB) */
/* The routine was updated to handle types 08 and 09. */
/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */
/* 1) The routine was updated to handle type 05. */
/* 2) DESCR was being used as both an input and output */
/* variable when it was only supposed to be used for */
/* input. A new local variable, NDSCR, was added where DESCR */
/* was being altered. */
/* - 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 */
/* subset of spk file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 9.0.0, 23-DEC-2013 (NJB) */
/* The routine was updated to handle types 19, 20 and 21. Some */
/* minor changes were made to comments. */
/* - SPICELIB Version 8.0.0, 12-AUG-2002 (NJB) */
/* The routine was updated to handle type 18. */
/* - SPICELIB Version 6.0.0, 30-JUN-1997 (WLT) */
/* The routine was updated to handle types 10 and 17. */
/* - SPICELIB Version 5.0.0, 10-MAR-1995 (KRG) */
/* The routine was updated to handle type 14. */
/* - SPICELIB Version 4.0.0, 07-NOV-1994 (WLT) */
/* The routine was updated to handle type 15. */
/* - SPICELIB Version 3.0.0, 05-AUG-1993 (NJB) */
/* The routine was updated to handle types 08 and 09. */
/* - SPICELIB Version 2.0.0, 01-APR-1992 (JML) */
/* 1) The routine was updated to handle type 05. */
/* 2) DESCR was being used as both an input and output */
/* variable when it was only supposed to be used for */
/* input. A new local variable, NDSCR, was added where DESCR */
/* was being altered. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKSUB", (ftnlen)6);
}
/* Unpack the descriptor. */
dafus_(descr, &c__2, &c__6, dc, ic);
alpha = dc[0];
omega = dc[1];
type__ = ic[3];
baddr = ic[4];
eaddr = ic[5];
/* Make sure the epochs check out. */
okay = alpha <= *begin && *begin <= *end && *end <= omega;
if (! okay) {
setmsg_("Specified interval [#, #] is not a subset of segment interv"
"al [#, #].", (ftnlen)69);
errdp_("#", begin, (ftnlen)1);
errdp_("#", end, (ftnlen)1);
errdp_("#", &alpha, (ftnlen)1);
errdp_("#", &omega, (ftnlen)1);
sigerr_("SPICE(SPKNOTASUBSET)", (ftnlen)20);
chkout_("SPKSUB", (ftnlen)6);
return 0;
}
/* Begin the new segment, with a descriptor containing the subset */
/* epochs. */
dc[0] = *begin;
dc[1] = *end;
dafps_(&c__2, &c__6, dc, ic, ndscr);
/* Let the type-specific (SPKSnn) routines decide what to move. */
if (type__ == 1) {
dafbna_(newh, ndscr, ident, ident_len);
spks01_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 2) {
dafbna_(newh, ndscr, ident, ident_len);
spks02_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 3) {
dafbna_(newh, ndscr, ident, ident_len);
spks03_(handle, &baddr, &eaddr, begin, end);
dafena_();
/* Type 04 has not been yet been added to SPICELIB. */
/* ELSE IF ( TYPE .EQ. 04 ) THEN */
/* CALL DAFBNA ( NEWH, NDSCR, IDENT ) */
/* CALL SPKS04 ( HANDLE, BADDR, EADDR, BEGIN, END ) */
/* CALL DAFENA */
} else if (type__ == 5) {
dafbna_(newh, ndscr, ident, ident_len);
spks05_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 8) {
dafbna_(newh, ndscr, ident, ident_len);
spks08_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 9) {
dafbna_(newh, ndscr, ident, ident_len);
spks09_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 10) {
spks10_(handle, descr, newh, ndscr, ident, ident_len);
} else if (type__ == 12) {
dafbna_(newh, ndscr, ident, ident_len);
spks12_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 13) {
dafbna_(newh, ndscr, ident, ident_len);
spks13_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 14) {
spks14_(handle, descr, newh, ndscr, ident, ident_len);
} else if (type__ == 15) {
dafbna_(newh, ndscr, ident, ident_len);
spks15_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 17) {
dafbna_(newh, ndscr, ident, ident_len);
spks17_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 18) {
dafbna_(newh, ndscr, ident, ident_len);
spks18_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 19) {
dafbna_(newh, ndscr, ident, ident_len);
spks19_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 20) {
dafbna_(newh, ndscr, ident, ident_len);
spks20_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else if (type__ == 21) {
dafbna_(newh, ndscr, ident, ident_len);
spks21_(handle, &baddr, &eaddr, begin, end);
dafena_();
} else {
setmsg_("SPK data type # is not supported.", (ftnlen)33);
errint_("#", &type__, (ftnlen)1);
sigerr_("SPICE(SPKTYPENOTSUPP)", (ftnlen)21);
chkout_("SPKSUB", (ftnlen)6);
return 0;
}
chkout_("SPKSUB", (ftnlen)6);
return 0;
} /* spksub_ */
/* $Procedure CKR05 ( Read CK record from segment, type 05 ) */
/* Subroutine */ int ckr05_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
*found)
{
/* Initialized data */
static integer lbeg = -1;
static integer lend = -1;
static integer lhand = 0;
static doublereal prevn = -1.;
static doublereal prevnn = -1.;
static doublereal prevs = -1.;
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer high;
doublereal rate;
integer last, type__, i__, j, n;
doublereal t;
integer begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer nidir;
extern doublereal dpmax_(void);
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer npdir, nsrch;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer lsize, first, nints, rsize;
doublereal start;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal dc[2];
integer ic[6];
extern logical failed_(void);
integer bufbas, dirbas;
doublereal hepoch;
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal lepoch;
integer npread, nsread, remain, pbegix, sbegix, timbas;
doublereal pbuffr[101];
extern integer lstled_(doublereal *, integer *, doublereal *);
doublereal sbuffr[103];
integer pendix, sendix, packsz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer maxwnd;
doublereal contrl[5];
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
doublereal nstart;
extern logical return_(void);
integer pgroup, sgroup, wndsiz, wstart, subtyp;
doublereal nnstrt;
extern logical odd_(integer *);
integer end, low;
/* $ Abstract */
/* Read a single CK data record from a segment of type 05 */
/* (MEX/Rosetta Attitude file interpolation). */
/* $ 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 */
/* POINTING */
/* $ 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. */
/* $ Abstract */
/* Declarations of the CK data type specific and general CK low */
/* level routine parameters. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK.REQ */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* 1) If new CK types are added, the size of the record passed */
/* between CKRxx and CKExx must be registered as separate */
/* parameter. If this size will be greater than current value */
/* of the CKMRSZ parameter (which specifies the maximum record */
/* size for the record buffer used inside CKPFS) then it should */
/* be assigned to CKMRSZ as a new value. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* CK Required Reading. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
/* Updated to support CK type 5. */
/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
/* -& */
/* Number of quaternion components and number of quaternion and */
/* angular rate components together. */
/* CK Type 1 parameters: */
/* CK1DTP CK data type 1 ID; */
/* CK1RSZ maximum size of a record passed between CKR01 */
/* and CKE01. */
/* CK Type 2 parameters: */
/* CK2DTP CK data type 2 ID; */
/* CK2RSZ maximum size of a record passed between CKR02 */
/* and CKE02. */
/* CK Type 3 parameters: */
/* CK3DTP CK data type 3 ID; */
/* CK3RSZ maximum size of a record passed between CKR03 */
/* and CKE03. */
/* CK Type 4 parameters: */
/* CK4DTP CK data type 4 ID; */
/* CK4PCD parameter defining integer to DP packing schema that */
/* is applied when seven number integer array containing */
/* polynomial degrees for quaternion and angular rate */
/* components packed into a single DP number stored in */
/* actual CK records in a file; the value of must not be */
/* changed or compatibility with existing type 4 CK files */
/* will be lost. */
/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
/* records; the value of this parameter must never exceed */
/* value of the CK4PCD; */
/* CK4SFT number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 4 */
/* CK record that passed between routines CKR04 and CKE04; */
/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
/* and CKE04; CK4RSZ is computed as follows: */
/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
/* CK Type 5 parameters: */
/* CK5DTP CK data type 5 ID; */
/* CK5MXD maximum polynomial degree allowed in type 5 */
/* records. */
/* CK5MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 5 */
/* CK record that passed between routines CKR05 and CKE05; */
/* CK5MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck05.inc */
/* for a description of the subtypes. */
/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
/* and CKE05; CK5RSZ is computed as follows: */
/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK4RSZ.) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Pointing request time. */
/* TOL I Lookup tolerance. */
/* NEEDAV I Angular velocity flag. */
/* RECORD O Data record. */
/* FOUND O Flag indicating whether record was found. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* a CK segment of type 05. */
/* SCLKDP is an encoded spacecraft clock time indicating */
/* the epoch for which pointing is desired. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. */
/* When SCLKDP falls within the bounds of one of the */
/* interpolation intervals then the tolerance has no */
/* effect because pointing will be returned at the */
/* request time. */
/* However, if the request time is not in one of the */
/* intervals, then the tolerance is used to determine */
/* if pointing at one of the interval endpoints should */
/* be returned. */
/* NEEDAV is true if angular velocity is requested. */
/* $ Detailed_Output */
/* RECORD is a set of data from the specified segment which, */
/* when evaluated at epoch SCLKDP, will give the */
/* attitude and angular velocity of some body, relative */
/* to the reference frame indicated by DESCR. */
/* The structure of the record is as follows: */
/* +----------------------+ */
/* | evaluation epoch | */
/* +----------------------+ */
/* | subtype code | */
/* +----------------------+ */
/* | number of packets (n)| */
/* +----------------------+ */
/* | nominal SCLK rate | */
/* +----------------------+ */
/* | packet 1 | */
/* +----------------------+ */
/* | packet 2 | */
/* +----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------+ */
/* | packet n | */
/* +----------------------+ */
/* | epochs 1--n | */
/* +----------------------+ */
/* The packet size is a function of the subtype code. */
/* All packets in a record have the same size. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* This routine follows the pattern established in the lower-numbered */
/* CK data type readers of not explicitly performing error */
/* diagnoses. Exceptions are listed below nonetheless. */
/* 1) If the input HANDLE does not designate a loaded CK file, the */
/* error will be diagnosed by routines called by this routine. */
/* 2) If the segment specified by DESCR is not of data type 05, */
/* the error 'SPICE(WRONGCKTYPE)' is signaled. */
/* 3) If the input SCLK value is not within the range specified */
/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */
/* is signaled. */
/* 4) If the window size is non-positive or greater than the */
/* maximum allowed value, the error SPICE(INVALIDVALUE) is */
/* signaled. */
/* 5) If the window size is not compatible with the segment */
/* subtype, the error SPICE(INVALIDVALUE) is signaled. */
/* 6) If the segment subtype is not recognized, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 7) If the tolerance is negative, the error SPICE(VALUEOUTOFRANGE) */
/* is signaled. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the CK Required Reading file for a description of the */
/* structure of a data type 05 segment. */
/* $ Examples */
/* The data returned by the CKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the CKRxx */
/* routines might be used to "dump" and check segment data for a */
/* particular epoch. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* C CALL CKBSS ( INST, SCLKDP, TOL, NEEDAV ) */
/* CALL CKSNS ( HANDLE, DESCR, SEGID, SFND ) */
/* IF ( .NOT. SFND ) THEN */
/* [Handle case of pointing not being found] */
/* END IF */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 05 ) THEN */
/* CALL CKR05 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* [Handle case of pointing not being found] */
/* END IF */
/* [Look at the RECORD data] */
/* . */
/* . */
/* . */
/* END IF */
/* $ Restrictions */
/* 1) Correctness of inputs must be ensured by the caller of */
/* this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 06-SEP-2002 (NJB) */
/* -& */
/* $ Index_Entries */
/* read record from type_5 ck segment */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Maximum polynomial degree: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKR05", (ftnlen)5);
/* No pointing found so far. */
*found = FALSE_;
/* Unpack the segment descriptor, and get the start and end addresses */
/* of the segment. */
dafus_(descr, &c__2, &c__6, dc, ic);
type__ = ic[2];
begin = ic[4];
end = ic[5];
/* Make sure that this really is a type 05 data segment. */
if (type__ != 5) {
setmsg_("You are attempting to locate type * data in a type 5 data s"
"egment.", (ftnlen)66);
errint_("*", &type__, (ftnlen)1);
sigerr_("SPICE(WRONGCKTYPE)", (ftnlen)18);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative but was actually *.", (ftnlen)
50);
errdp_("*", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the request time and tolerance against the bounds in */
/* the segment descriptor. */
if (*sclkdp + *tol < dc[0] || *sclkdp - *tol > dc[1]) {
/* The request time is too far outside the segment's coverage */
/* interval for any pointing to satisfy the request. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Set the request time to use for searching. */
t = brcktd_(sclkdp, dc, &dc[1]);
/* From this point onward, we assume the segment was constructed */
/* correctly. In particular, we assume: */
/* 1) The segment descriptor's time bounds are in order and are */
/* distinct. */
/* 2) The epochs in the segment are in strictly increasing */
/* order. */
/* 3) The interpolation interval start times in the segment are */
/* in strictly increasing order. */
/* 4) The degree of the interpolating polynomial specified by */
/* the segment is at least 1 and is no larger than MAXDEG. */
i__1 = end - 4;
dafgda_(handle, &i__1, &end, contrl);
/* Check the FAILED flag just in case HANDLE is not attached to */
/* any DAF file and the error action is not set to ABORT. We */
/* do this only after the first call to DAFGDA, as in CKR03. */
if (failed_()) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
rate = contrl[0];
subtyp = i_dnnt(&contrl[1]);
wndsiz = i_dnnt(&contrl[2]);
nints = i_dnnt(&contrl[3]);
n = i_dnnt(&contrl[4]);
/* Set the packet size, which is a function of the subtype. */
if (subtyp == 0) {
packsz = 8;
} else if (subtyp == 1) {
packsz = 4;
} else if (subtyp == 2) {
packsz = 14;
} else if (subtyp == 3) {
packsz = 7;
} else {
setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", (
ftnlen)55);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the window size. */
if (wndsiz <= 0) {
setmsg_("Window size in type 05 segment was #; must be positive.", (
ftnlen)55);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (subtyp == 0 || subtyp == 2) {
/* These are the Hermite subtypes. */
maxwnd = 8;
if (wndsiz > maxwnd) {
setmsg_("Window size in type 05 segment was #; max allowed value"
" is # for subtypes 0 and 2 (Hermite, 8 or 14-element pac"
"kets).", (ftnlen)117);
errint_("#", &wndsiz, (ftnlen)1);
errint_("#", &maxwnd, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (odd_(&wndsiz)) {
setmsg_("Window size in type 05 segment was #; must be even for "
"subtypes 0 and 2 (Hermite, 8 or 14-element packets).", (
ftnlen)107);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
} else if (subtyp == 1 || subtyp == 3) {
/* These are the Lagrange subtypes. */
maxwnd = 16;
if (wndsiz > maxwnd) {
setmsg_("Window size in type 05 segment was #; max allowed value"
" is # for subtypes 1 and 3 (Lagrange, 4 or 7-element pac"
"kets).", (ftnlen)117);
errint_("#", &wndsiz, (ftnlen)1);
errint_("#", &maxwnd, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (odd_(&wndsiz)) {
setmsg_("Window size in type 05 segment was #; must be even for "
"subtypes 1 and 3 (Lagrange, 4 or 7-element packets).", (
ftnlen)107);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
} else {
setmsg_("This point should not be reached. Getting here may indicate"
" that the code needs to updated to handle the new subtype #",
(ftnlen)118);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* We now need to select the pointing values to interpolate */
/* in order to satisfy the pointing request. The first step */
/* is to use the pointing directories (if any) to locate a set of */
/* epochs bracketing the request time. Note that the request */
/* time might not be bracketed: it could precede the first */
/* epoch or follow the last epoch. */
/* We'll use the variable PGROUP to refer to the set of epochs */
/* to search. The first group consists of the epochs prior to */
/* and including the first pointing directory entry. The last */
/* group consists of the epochs following the last pointing */
/* directory entry. Other groups consist of epochs following */
/* one pointing directory entry up to and including the next */
/* pointing directory entry. */
npdir = (n - 1) / 100;
dirbas = begin + n * packsz + n - 1;
if (npdir == 0) {
/* There's no mystery about which group of epochs to search. */
pgroup = 1;
} else {
/* There's at least one directory. Find the first directory */
/* whose time is greater than or equal to the request time, if */
/* there is such a directory. We'll search linearly through the */
/* directory entries, reading up to DIRSIZ of them at a time. */
/* Having found the correct set of directory entries, we'll */
/* perform a binary search within that set for the desired entry. */
bufbas = dirbas;
npread = min(npdir,100);
i__1 = bufbas + 1;
i__2 = bufbas + npread;
dafgda_(handle, &i__1, &i__2, pbuffr);
remain = npdir - npread;
while(pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)633)] < t && remain > 0) {
bufbas += npread;
npread = min(remain,100);
/* Note: NPREAD is always > 0 here. */
i__1 = bufbas + 1;
i__2 = bufbas + npread;
dafgda_(handle, &i__1, &i__2, pbuffr);
remain -= npread;
}
/* At this point, BUFBAS - DIRBAS is the number of directory */
/* entries preceding the one contained in PBUFFR(1). */
/* PGROUP is one more than the number of directories we've */
/* passed by. */
pgroup = bufbas - dirbas + lstltd_(&t, &npread, pbuffr) + 1;
}
/* PGROUP now indicates the set of epochs in which to search for the */
/* request epoch. The following cases can occur: */
/* PGROUP = 1 */
/* ========== */
/* NPDIR = 0 */
/* -------- */
/* The request time may precede the first time tag */
/* of the segment, exceed the last time tag, or lie */
/* in the closed interval bounded by these time tags. */
/* NPDIR >= 1 */
/* --------- */
/* The request time may precede the first time tag */
/* of the group but does not exceed the last epoch */
/* of the group. */
/* 1 < PGROUP <= NPDIR */
/* =================== */
/* The request time follows the last time of the */
/* previous group and is less than or equal to */
/* the pointing directory entry at index PGROUP. */
/* 1 < PGROUP = NPDIR + 1 */
/* ====================== */
/* The request time follows the last time of the */
/* last pointing directory entry. The request time */
/* may exceed the last time tag. */
/* Now we'll look up the time tags in the group of epochs */
/* we've identified. */
/* We'll use the variable names PBEGIX and PENDIX to refer to */
/* the indices, relative to the set of time tags, of the first */
/* and last time tags in the set we're going to look up. */
if (pgroup == 1) {
pbegix = 1;
pendix = min(n,100);
} else {
/* If the group index is greater than 1, we'll include the last */
/* time tag of the previous group in the set of time tags we look */
/* up. That way, the request time is strictly bracketed on the */
/* low side by the time tag set we look up. */
pbegix = (pgroup - 1) * 100;
/* Computing MIN */
i__1 = pbegix + 100;
pendix = min(i__1,n);
}
timbas = dirbas - n;
i__1 = timbas + pbegix;
i__2 = timbas + pendix;
dafgda_(handle, &i__1, &i__2, pbuffr);
npread = pendix - pbegix + 1;
/* At this point, we'll deal with the cases where T lies outside */
/* of the range of epochs we've buffered. */
if (t < pbuffr[0]) {
/* This can happen only if PGROUP = 1 and T precedes all epochs. */
/* If the input request time is too far from PBUFFR(1) on */
/* the low side, we're done. */
if (*sclkdp + *tol < pbuffr[0]) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Bracket T to move it within the range of buffered epochs. */
t = pbuffr[0];
} else if (t > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 :
s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)748)]) {
/* This can happen only if T follows all epochs. */
if (*sclkdp - *tol > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)752)]) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Bracket T to move it within the range of buffered epochs. */
t = pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)762)];
}
/* At this point, */
/* | T - SCLKDP | <= TOL */
/* Also, one of the following is true: */
/* T is the first time of the segment */
/* T is the last time of the segment */
/* T equals SCLKDP */
/* Find two adjacent time tags bounding the request epoch. The */
/* request time cannot be greater than all of time tags in the */
/* group, and it cannot precede the first element of the group. */
i__ = lstltd_(&t, &npread, pbuffr);
/* The variables LOW and HIGH are the indices of a pair of time */
/* tags that bracket the request time. Remember that NPREAD could */
/* be equal to 1, in which case we would have LOW = HIGH. */
if (i__ == 0) {
/* This can happen only if PGROUP = 1 and T = PBUFFR(1). */
low = 1;
lepoch = pbuffr[0];
if (n == 1) {
high = 1;
} else {
high = 2;
}
hepoch = pbuffr[(i__1 = high - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)805)];
} else {
low = pbegix + i__ - 1;
lepoch = pbuffr[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)810)];
high = low + 1;
hepoch = pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbu"
"ffr", i__1, "ckr05_", (ftnlen)813)];
}
/* We now need to find the interpolation interval containing */
/* T, if any. We may be able to use the interpolation */
/* interval found on the previous call to this routine. If */
/* this is the first call or if the previous interval is not */
/* applicable, we'll search for the interval. */
/* First check if the request time falls in the same interval as */
/* it did last time. We need to make sure that we are dealing */
/* with the same segment as well as the same time range. */
/* PREVS is the start time of the interval that satisfied */
/* the previous request for pointing. */
/* PREVN is the start time of the interval that followed */
/* the interval specified above. */
/* PREVNN is the start time of the interval that followed */
/* the interval starting at PREVN. */
/* LHAND is the handle of the file that PREVS and PREVN */
/* were found in. */
/* LBEG, are the beginning and ending addresses of the */
/* LEND segment in the file LHAND that PREVS and PREVN */
/* were found in. */
if (*handle == lhand && begin == lbeg && end == lend && t >= prevs && t <
prevn) {
start = prevs;
nstart = prevn;
nnstrt = prevnn;
} else {
/* Search for the interpolation interval. */
nidir = (nints - 1) / 100;
dirbas = end - 5 - nidir;
if (nidir == 0) {
/* There's no mystery about which group of epochs to search. */
sgroup = 1;
} else {
/* There's at least one directory. Find the first directory */
/* whose time is greater than or equal to the request time, if */
/* there is such a directory. We'll search linearly through */
/* the directory entries, reading up to DIRSIZ of them at a */
/* time. Having found the correct set of directory entries, */
/* we'll perform a binary search within that set for the */
/* desired entry. */
bufbas = dirbas;
nsread = min(nidir,100);
remain = nidir - nsread;
i__1 = bufbas + 1;
i__2 = bufbas + nsread;
dafgda_(handle, &i__1, &i__2, sbuffr);
while(sbuffr[(i__1 = nsread - 1) < 103 && 0 <= i__1 ? i__1 :
s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)885)] < t &&
remain > 0) {
bufbas += nsread;
nsread = min(remain,100);
remain -= nsread;
/* Note: NSREAD is always > 0 here. */
i__1 = bufbas + 1;
i__2 = bufbas + nsread;
dafgda_(handle, &i__1, &i__2, sbuffr);
}
/* At this point, BUFBAS - DIRBAS is the number of directory */
/* entries preceding the one contained in SBUFFR(1). */
/* SGROUP is one more than the number of directories we've */
/* passed by. */
sgroup = bufbas - dirbas + lstltd_(&t, &nsread, sbuffr) + 1;
}
/* SGROUP now indicates the set of interval start times in which */
/* to search for the request epoch. */
/* Now we'll look up the time tags in the group of epochs we've */
/* identified. */
/* We'll use the variable names SBEGIX and SENDIX to refer to the */
/* indices, relative to the set of start times, of the first and */
/* last start times in the set we're going to look up. */
if (sgroup == 1) {
sbegix = 1;
sendix = min(nints,102);
} else {
/* Look up the start times for the group of interest. Also */
/* buffer last start time from the previous group. Also, it */
/* turns out to be useful to pick up two extra start */
/* times---the first two start times of the next group---if */
/* they exist. */
sbegix = (sgroup - 1) * 100;
/* Computing MIN */
i__1 = sbegix + 102;
sendix = min(i__1,nints);
}
timbas = dirbas - nints;
i__1 = timbas + sbegix;
i__2 = timbas + sendix;
dafgda_(handle, &i__1, &i__2, sbuffr);
nsread = sendix - sbegix + 1;
/* Find the last interval start time less than or equal to the */
/* request time. We know T is greater than or equal to the */
/* first start time, so I will be > 0. */
nsrch = min(101,nsread);
i__ = lstled_(&t, &nsrch, sbuffr);
start = sbuffr[(i__1 = i__ - 1) < 103 && 0 <= i__1 ? i__1 : s_rnge(
"sbuffr", i__1, "ckr05_", (ftnlen)956)];
/* Let NSTART ("next start") be the start time that follows */
/* START, if START is not the last start time. If NSTART */
/* has a successor, let NNSTRT be that start time. */
if (i__ < nsread) {
nstart = sbuffr[(i__1 = i__) < 103 && 0 <= i__1 ? i__1 : s_rnge(
"sbuffr", i__1, "ckr05_", (ftnlen)965)];
if (i__ + 1 < nsread) {
nnstrt = sbuffr[(i__1 = i__ + 1) < 103 && 0 <= i__1 ? i__1 :
s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)969)];
} else {
nnstrt = dpmax_();
}
} else {
nstart = dpmax_();
nnstrt = dpmax_();
}
}
/* If T does not lie within the interpolation interval starting */
/* at time START, we'll determine whether T is closer to this */
/* interval or the next. If the distance between T and the */
/* closer interval is less than or equal to TOL, we'll map T */
/* to the closer endpoint of the closer interval. Otherwise, */
/* we return without finding pointing. */
if (hepoch == nstart) {
/* The first time tag greater than or equal to T is the start */
/* time of the next interpolation interval. */
/* The request time lies between interpolation intervals. */
/* LEPOCH is the last time tag of the first interval; HEPOCH */
/* is the first time tag of the next interval. */
if ((d__1 = t - lepoch, abs(d__1)) <= (d__2 = hepoch - t, abs(d__2)))
{
/* T is closer to the first interval... */
if ((d__1 = t - lepoch, abs(d__1)) > *tol) {
/* ...But T is too far from the interval. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Map T to the right endpoint of the preceding interval. */
t = lepoch;
high = low;
hepoch = lepoch;
} else {
/* T is closer to the second interval... */
if ((d__1 = hepoch - t, abs(d__1)) > *tol) {
/* ...But T is too far from the interval. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Map T to the left endpoint of the next interval. */
t = hepoch;
low = high;
lepoch = hepoch;
/* Since we're going to be picking time tags from the next */
/* interval, we'll need to adjust START and NSTART. */
start = nstart;
nstart = nnstrt;
}
}
/* We now have */
/* LEPOCH < T < HEPOCH */
/* - - */
/* where LEPOCH and HEPOCH are the time tags at indices */
/* LOW and HIGH, respectively. */
/* Now select the set of packets used for interpolation. Note */
/* that the window size is known to be even. */
/* Unlike CK types 8, 9, 12, and 13, for type 05 we adjust */
/* the window size to keep the request time within the central */
/* interval of the window. */
/* The nominal bracketing epochs we've found are the (WNDSIZ/2)nd */
/* and (WNDSIZ/2 + 1)st of the interpolating set. If the request */
/* time is too close to one end of the interpolation interval, we */
/* reduce the window size, after which one endpoint of the window */
/* will coincide with an endpoint of the interpolation interval. */
/* We start out by looking up the set of time tags we'd use */
/* if there were no gaps in the coverage. We then trim our */
/* time tag set to ensure all tags are in the interpolation */
/* interval. It's possible that the interpolation window will */
/* collapse to a single point as a result of this last step. */
/* Let LSIZE be the size of the "left half" of the window: the */
/* size of the set of window epochs to the left of the request time. */
/* We want this size to be WNDSIZ/2, but if not enough states are */
/* available, the set ranges from index 1 to index LOW. */
/* Computing MIN */
i__1 = wndsiz / 2;
lsize = min(i__1,low);
/* RSIZE is defined analogously for the right half of the window. */
/* Computing MIN */
i__1 = wndsiz / 2, i__2 = n - high + 1;
rsize = min(i__1,i__2);
/* The window size is simply the sum of LSIZE and RSIZE. */
wndsiz = lsize + rsize;
/* FIRST and LAST are the endpoints of the range of indices of */
/* time tags (and packets) we'll collect in the output record. */
first = low - lsize + 1;
last = first + wndsiz - 1;
/* Buffer the epochs. */
wstart = begin + n * packsz + first - 1;
i__1 = wstart + wndsiz - 1;
dafgda_(handle, &wstart, &i__1, pbuffr);
/* Discard any epochs less than START or greater than or equal */
/* to NSTART. The set of epochs we want ranges from indices */
/* I+1 to J. This range is non-empty unless START and NSTART */
/* are both DPMAX(). */
i__ = lstltd_(&start, &wndsiz, pbuffr);
j = lstltd_(&nstart, &wndsiz, pbuffr);
if (i__ == j) {
/* Fuggedaboudit. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Update FIRST, LAST, and WNDSIZ. */
wndsiz = j - i__;
first += i__;
last = first + wndsiz - 1;
/* Put the subtype into the output record. The size of the group */
/* of packets is derived from the subtype, so we need not include */
/* the size. */
record[0] = t;
record[1] = (doublereal) subtyp;
record[2] = (doublereal) wndsiz;
record[3] = rate;
/* Read the packets. */
i__1 = begin + (first - 1) * packsz;
i__2 = begin + last * packsz - 1;
dafgda_(handle, &i__1, &i__2, &record[4]);
/* Finally, add the epochs to the output record. */
i__2 = j - i__;
moved_(&pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbuffr",
i__1, "ckr05_", (ftnlen)1158)], &i__2, &record[wndsiz * packsz +
4]);
/* Save the information about the interval and segment. */
lhand = *handle;
lbeg = begin;
lend = end;
prevs = start;
prevn = nstart;
prevnn = nnstrt;
/* Indicate pointing was found. */
*found = TRUE_;
chkout_("CKR05", (ftnlen)5);
return 0;
} /* ckr05_ */
/* $Procedure CKR03 ( C-kernel, read pointing record, data type 3 ) */
/* Subroutine */ int ckr03_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
*found)
{
/* Initialized data */
static doublereal prevs = -1.;
static doublereal prevn = -1.;
static integer lhand = 0;
static integer lbeg = -1;
static integer lend = -1;
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer addr__, skip, psiz, i__, n;
doublereal ldiff;
integer laddr;
doublereal rdiff;
integer raddr;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer nidir;
doublereal lsclk;
extern doublereal dpmax_(void);
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer nrdir;
doublereal rsclk;
integer group;
doublereal start;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
extern logical failed_(void);
integer grpadd;
doublereal buffer[100];
integer remain, dirloc;
extern integer lstled_(doublereal *, integer *, doublereal *);
integer numrec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
integer numint;
doublereal nstart;
extern logical return_(void);
doublereal dcd[2];
integer beg, icd[6], end;
logical fnd;
/* $ Abstract */
/* Read a pointing record from a CK segment, data type 3. */
/* $ 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 */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Pointing request time. */
/* TOL I Time tolerance. */
/* NEEDAV I Angular velocity request flag. */
/* RECORD O Pointing data record. */
/* FOUND O True when data is found. */
/* $ Detailed_Input */
/* HANDLE is the integer handle of the CK file containing the */
/* segment. */
/* DESCR is the descriptor of the segment. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is being requested. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. */
/* When SCLKDP falls within the bounds of one of the */
/* interpolation intervals then the tolerance has no */
/* effect because pointing will be returned at the */
/* request time. */
/* However, if the request time is not in one of the */
/* intervals, then the tolerance is used to determine */
/* if pointing at one of the interval endpoints should */
/* be returned. */
/* NEEDAV is true if angular velocity is requested. */
/* $ Detailed_Output */
/* RECORD is the record that CKE03 will evaluate to determine */
/* the pointing. */
/* When the request time falls within an interval for */
/* which linear interpolation is valid, the values of */
/* the two pointing instances that bracket the request */
/* time are returned in RECORD as follows: */
/* RECORD( 1 ) = Left bracketing SCLK time. */
/* RECORD( 2 ) = lq0 \ */
/* RECORD( 3 ) = lq1 \ Left bracketing */
/* RECORD( 4 ) = lq2 / quaternion. */
/* RECORD( 5 ) = lq3 / */
/* RECORD( 6 ) = lav1 \ Left bracketing */
/* RECORD( 7 ) = lav2 angular velocity */
/* RECORD( 8 ) = lav3 / ( optional ) */
/* RECORD( 9 ) = Right bracketing SCLK time. */
/* RECORD( 10 ) = rq0 \ */
/* RECORD( 11 ) = rq1 \ Right bracketing */
/* RECORD( 12 ) = rq2 / quaternion. */
/* RECORD( 13 ) = rq3 / */
/* RECORD( 14 ) = rav1 \ Right bracketing */
/* RECORD( 15 ) = rav2 angular velocity */
/* RECORD( 16 ) = rav3 / ( optional ) */
/* RECORD( 17 ) = pointing request time, SCLKDP. */
/* The quantities lq0 - lq3 and rq0 - rq3 are the */
/* components of the quaternions that represent the */
/* C-matrices associated with the times that bracket */
/* the requested time. */
/* The quantities lav1, lav2, lav3 and rav1, rav2, rav3 */
/* are the components of the angular velocity vectors at */
/* the respective bracketing times. The components of the */
/* angular velocity vectors are specified relative to */
/* the inertial reference frame of the segment. */
/* If the request time does not fall within an */
/* interpolation interval, but is within TOL of an */
/* interval endpoint, the values of that pointing */
/* instance are returned in both parts of RECORD */
/* ( i.e. RECORD(1-9) and RECORD(10-16) ). */
/* FOUND is true if a record was found to satisfy the pointing */
/* request. This occurs when the time for which pointing */
/* is requested falls inside one of the interpolation */
/* intervals, or when the request time is within the */
/* tolerance of an interval endpoint. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the specified handle does not belong to an open DAF file, */
/* an error is diagnosed by a routine that this routine calls. */
/* 2) If DESCR is not a valid descriptor of a segment in the CK */
/* file specified by HANDLE, the results of this routine are */
/* unpredictable. */
/* 3) If the segment is not of data type 3, as specified in the */
/* third integer component of the segment descriptor, then */
/* the error SPICE(WRONGDATATYPE) is signalled. */
/* 4) If angular velocity data was requested but the segment */
/* contains no such data, the error SPICE(NOAVDATA) is signalled. */
/* $ Files */
/* The file containing the segment is specified by its handle and */
/* should be opened for read or write access, either by CKLPF, */
/* DAFOPR, or DAFOPW. */
/* $ Particulars */
/* See the CK Required Reading file for a detailed description of */
/* the structure of a type 3 pointing segment. */
/* When the time for which pointing was requested falls within an */
/* interpolation interval, then FOUND will be true and RECORD will */
/* contain the pointing instances in the segment that bracket the */
/* request time. CKE03 will evaluate RECORD to give pointing at */
/* the request time. */
/* However, when the request time is not within any of the */
/* interpolation intervals, then FOUND will be true only if the */
/* interval endpoint closest to the request time is within the */
/* tolerance specified by the user. In this case both parts of */
/* RECORD will contain this closest pointing instance, and CKE03 */
/* will evaluate RECORD to give pointing at the time associated */
/* with the returned pointing instance. */
/* $ Examples */
/* The CKRnn routines are usually used in tandem with the CKEnn */
/* routines, which evaluate the record returned by CKRnn to give */
/* the pointing information and output time. */
/* The following code fragment searches through all of the segments */
/* in a file applicable to the Mars Observer spacecraft bus that */
/* are of data type 3, for a particular spacecraft clock time. */
/* It then evaluates the pointing for that epoch and prints the */
/* result. */
/* CHARACTER*(20) SCLKCH */
/* CHARACTER*(20) SCTIME */
/* CHARACTER*(40) IDENT */
/* INTEGER I */
/* INTEGER SC */
/* INTEGER INST */
/* INTEGER HANDLE */
/* INTEGER DTYPE */
/* INTEGER ICD ( 6 ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOL */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION DESCR ( 5 ) */
/* DOUBLE PRECISION DCD ( 2 ) */
/* DOUBLE PRECISION RECORD ( 17 ) */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION AV ( 3 ) */
/* LOGICAL NEEDAV */
/* LOGICAL FND */
/* LOGICAL SFND */
/* SC = -94 */
/* INST = -94000 */
/* DTYPE = 3 */
/* NEEDAV = .FALSE. */
/* C */
/* C Load the MO SCLK kernel and the C-kernel. */
/* C */
/* CALL FURNSH ( 'MO_SCLK.TSC' ) */
/* CALL DAFOPR ( 'MO_CK.BC', HANDLE ) */
/* C */
/* C Get the spacecraft clock time. Then encode it for use */
/* C in the C-kernel. */
/* C */
/* WRITE (*,*) 'Enter spacecraft clock time string:' */
/* READ (*,FMT='(A)') SCLKCH */
/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */
/* C */
/* C Use a tolerance of 2 seconds ( half of the nominal */
/* C separation between MO pointing instances ). */
/* C */
/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */
/* C */
/* C Search from the beginning of the CK file through all */
/* C of the segments. */
/* C */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( SFND ) */
/* FND = .FALSE. */
/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */
/* C */
/* C Get the segment identifier and descriptor. */
/* C */
/* CALL DAFGN ( IDENT ) */
/* CALL DAFGS ( DESCR ) */
/* C */
/* C Unpack the segment descriptor into its integer and */
/* C double precision components. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* C */
/* C Determine if this segment should be processed. */
/* C */
/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */
/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */
/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */
/* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */
/* CALL CKR03 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FND ) */
/* IF ( FND ) THEN */
/* CALL CKE03 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */
/* CALL SCDECD ( SC, CLKOUT, SCTIME ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Segment identifier: ', IDENT */
/* WRITE (*,*) */
/* WRITE (*,*) 'Pointing returned for time: ', */
/* . SCTIME */
/* WRITE (*,*) */
/* WRITE (*,*) 'C-matrix:' */
/* WRITE (*,*) */
/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */
/* WRITE (*,*) */
/* END IF */
/* END IF */
/* CALL DAFFNA ( SFND ) */
/* END DO */
/* $ Restrictions */
/* 1) The file containing the segment should be opened for read */
/* or write access either by CKLPF, DAFOPR, or DAFOPW. */
/* 2) The record returned by this routine is intended to be */
/* evaluated by CKE03. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */
/* -& */
/* $ Index_Entries */
/* read ck type_3 pointing data record */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* DIRSIZ is the directory size. */
/* BUFSIZ is the maximum number of double precision numbers */
/* that we will read from the DAF file at one time. */
/* BUFSIZ is normally set equal to DIRSIZ. */
/* ND is the number of double precision components in an */
/* unpacked C-kernel segment descriptor. */
/* NI is the number of integer components in an unpacked */
/* C-kernel segment descriptor. */
/* QSIZ is the number of double precision numbers making up */
/* the quaternion portion of a pointing record. */
/* QAVSIZ is the number of double precision numbers making up */
/* the quaternion and angular velocity portion of a */
/* pointing record. */
/* DTYPE is the data type of the segment that this routine */
/* operates on. */
/* Local variables */
/* Saved variables. */
/* Initial values. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKR03", (ftnlen)5);
}
/* Start off with FOUND equal to false just in case a SPICELIB error */
/* is signalled and the return mode is not set to ABORT. */
*found = FALSE_;
/* We need to look at a few of the descriptor components. */
/* The unpacked descriptor contains the following information */
/* about the segment: */
/* DCD(1) Initial encoded SCLK */
/* DCD(2) Final encoded SCLK */
/* ICD(1) Instrument */
/* ICD(2) Inertial reference frame */
/* ICD(3) Data type */
/* ICD(4) Angular velocity flag */
/* ICD(5) Initial address of segment data */
/* ICD(6) Final address of segment data */
dafus_(descr, &c__2, &c__6, dcd, icd);
/* Check to make sure that the segment is type 3. */
if (icd[2] != 3) {
setmsg_("The segment is not a type 3 segment. Type is #", (ftnlen)47)
;
errint_("#", &icd[2], (ftnlen)1);
sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
chkout_("CKR03", (ftnlen)5);
return 0;
}
/* Does this segment contain angular velocity? */
if (icd[3] == 1) {
psiz = 7;
} else {
psiz = 4;
if (*needav) {
setmsg_("Segment does not contain angular velocity data.", (
ftnlen)47);
sigerr_("SPICE(NOAVDATA)", (ftnlen)15);
chkout_("CKR03", (ftnlen)5);
return 0;
}
}
/* The beginning and ending addresses of the segment are in the */
/* descriptor. */
beg = icd[4];
end = icd[5];
/* The procedure used in finding a record to satisfy the request */
/* for pointing is as follows: */
/* 1) Find the two pointing instances in the segment that bracket */
/* the request time. */
/* The pointing instance that brackets the request time on the */
/* left is defined to be the one associated with the largest */
/* time in the segment that is less than or equal to SCLKDP. */
/* The pointing instance that brackets the request time on the */
/* right is defined to be the one associated with the first */
/* time in the segment greater than SCLKDP. */
/* Since the times in the segment are strictly increasing the */
/* left and right bracketing pointing instances are always */
/* adjacent. */
/* 2) Determine if the bracketing times are in the same */
/* interpolation interval. */
/* 3) If they are, then pointing at the request time may be */
/* linearly interpolated from the bracketing times. */
/* 4) If the times that bracket the request time are not in the */
/* same interval then, since they are adjacent in the segment */
/* and since intervals begin and end at actual times, they must */
/* both be interval endpoints. Return the pointing instance */
/* associated with the endpoint closest to the request time, */
/* provided that it is within the tolerance. */
/* Get the number of intervals and pointing instances ( records ) */
/* in this segment, and from that determine the number of respective */
/* directory epochs. */
i__1 = end - 1;
dafgda_(handle, &i__1, &end, buffer);
numint = i_dnnt(buffer);
numrec = i_dnnt(&buffer[1]);
nidir = (numint - 1) / 100;
nrdir = (numrec - 1) / 100;
/* Check the FAILED flag just in case HANDLE is not attached to */
/* any DAF file and the error action is not set to ABORT. You need */
/* need to do this only after the first call to DAFGDA. */
if (failed_()) {
chkout_("CKR03", (ftnlen)5);
return 0;
}
/* To find the times that bracket the request time we will first */
/* find the greatest directory time less than the request time. */
/* This will narrow down the search to a group of DIRSIZ or fewer */
/* times where the Jth group is defined to contain SCLK times */
/* ((J-1)*DIRSIZ + 1) through (J*DIRSIZ). */
/* For example if DIRSIZ = 100 then: */
/* group first time # last time # */
/* ----- --------------- ------------ */
/* 1 1 100 */
/* 2 101 200 */
/* . . . */
/* . . . */
/* 10 901 1000 */
/* . . . */
/* . . . */
/* NRDIR+1 (NRDIR)*100+1 NUMREC */
/* Thus if the Ith directory time is the largest one less than */
/* our request time SCLKDP, then we know that: */
/* SCLKS ( DIRSIZ * I ) < SCLKDP <= SCLKS ( DIRSIZ * (I+1) ) */
/* where SCLKS is taken to be the array of NUMREC times associated */
/* with the pointing instances. */
/* Therefore, at least one of the bracketing times will come from */
/* the (I+1)th group. */
/* There is only one group if there are no directory epochs. */
if (nrdir == 0) {
group = 1;
} else {
/* Compute the location of the first directory epoch. From the */
/* beginning of the segment, we need to go through all of the */
/* pointing numbers (PSIZ*NUMREC of them) and then through all of */
/* the NUMREC SCLK times. */
dirloc = beg + (psiz + 1) * numrec;
/* Search through the directory times. Read in as many as BUFSIZ */
/* directory epochs at a time for comparison. */
fnd = FALSE_;
remain = nrdir;
group = 0;
while(! fnd) {
/* The number of records to read into the buffer. */
n = min(remain,100);
i__1 = dirloc + n - 1;
dafgda_(handle, &dirloc, &i__1, buffer);
remain -= n;
/* Determine the last directory element in BUFFER that's less */
/* than SCLKDP. */
i__ = lstltd_(sclkdp, &n, buffer);
if (i__ < n) {
group = group + i__ + 1;
fnd = TRUE_;
} else if (remain == 0) {
/* The request time is greater than the last directory time */
/* so we want the last group in the segment. */
group = nrdir + 1;
fnd = TRUE_;
} else {
/* Need to read another block of directory times. */
dirloc += n;
group += n;
}
}
}
/* Now we know which group of DIRSIZ (or less) times to look at. */
/* Out of the NUMREC SCLK times, the number that we should skip over */
/* to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
skip = (group - 1) * 100;
/* From this we can compute the address in the segment of the group */
/* of times we want. From the beginning, we need to pass through */
/* PSIZ * NUMREC pointing numbers to get to the first SCLK time. */
/* Then we skip over the number just computed above. */
grpadd = beg + numrec * psiz + skip;
/* The number of times that we have to look at may be less than */
/* DIRSIZ. However many there are, go ahead and read them into the */
/* buffer. */
/* Computing MIN */
i__1 = 100, i__2 = numrec - skip;
n = min(i__1,i__2);
i__1 = grpadd + n - 1;
dafgda_(handle, &grpadd, &i__1, buffer);
/* Find the largest time in the group less than or equal to the input */
/* time. */
i__ = lstled_(sclkdp, &n, buffer);
/* Find the pointing instances in the segment that bracket the */
/* request time and calculate the addresses for the pointing data */
/* associated with these times. For cases in which the request time */
/* is equal to one of the times in the segment, that time will be */
/* the left bracketing time of the returned pair. */
/* Need to handle the cases when the request time is greater than */
/* the last or less than the first time in the segment separately. */
if (i__ == 0) {
if (group == 1) {
/* The time occurs before the first time in the segment. Since */
/* this time cannot possibly be in any of the intervals, the */
/* first time can satisfy the request for pointing only if it */
/* is within the tolerance of the request time. */
if (buffer[0] - *sclkdp <= *tol) {
record[0] = buffer[0];
record[8] = buffer[0];
/* Calculate the address of the quaternion and angular */
/* velocity data. Then read it from the file. */
i__1 = beg + psiz - 1;
dafgda_(handle, &beg, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
record[16] = *sclkdp;
*found = TRUE_;
}
chkout_("CKR03", (ftnlen)5);
return 0;
} else {
/* The first time in the current group brackets the request */
/* time on the right and the last time from the preceding */
/* group brackets on the left. */
rsclk = buffer[0];
raddr = beg + skip * psiz;
i__1 = grpadd - 1;
i__2 = grpadd - 1;
dafgda_(handle, &i__1, &i__2, &lsclk);
laddr = raddr - psiz;
}
} else if (i__ == n) {
/* There are two possible cases, but the same action can handle */
/* both. */
/* 1) If this is the last group ( NRDIR + 1 ) then the request */
/* time occurs on or after the last time in the segment. */
/* In either case this last time can satisfy the request for */
/* pointing only if it is within the tolerance of the request */
/* time. */
/* 2) The request time is greater than or equal to the last time */
/* in this group. Since this time is the same as the (I+1)th */
/* directory time, and since the search on the directory times */
/* used a strictly less than test, we know that the request */
/* time must be equal to this time. Just return the pointing */
/* instance associated with the request time. ( Note that */
/* SCLKDP - BUFFER(N) will be zero in this case. ) */
if (*sclkdp - buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)826)] <= *tol) {
record[0] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)828)];
record[8] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)829)];
/* Calculate the address of the quaternion and angular */
/* velocity data. Then read it from the file. */
addr__ = beg + psiz * (skip + n - 1);
i__1 = addr__ + psiz - 1;
dafgda_(handle, &addr__, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
record[16] = *sclkdp;
*found = TRUE_;
}
chkout_("CKR03", (ftnlen)5);
return 0;
} else {
/* The bracketing times are contained in this group. */
lsclk = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge(
"buffer", i__1, "ckr03_", (ftnlen)855)];
rsclk = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge("buff"
"er", i__1, "ckr03_", (ftnlen)856)];
laddr = beg + (skip + i__ - 1) * psiz;
raddr = laddr + psiz;
}
/* At this point we have the two times in the segment that bracket */
/* the request time. We also have the addresses of the pointing */
/* data associated with those times. The task now is to determine */
/* if the bracketing times fall in the same interval. If so then */
/* we can interpolate between them. If they don't then return */
/* pointing for whichever of the two times is closest to the */
/* request time, provided that it is within the tolerance. */
/* Find the interpolation interval that the request time is in and */
/* determine if the bracketing SCLK's are both in it. */
/* First check if the request time falls in the same interval as */
/* it did last time. We need to make sure that we are dealing */
/* with the same segment as well as the same time range. */
/* PREVS is the start time of the interval that satisfied */
/* the previous request for pointing. */
/* PREVN is the start time of the interval that followed */
/* the interval specified above. */
/* LHAND is the handle of the file that PREVS and PREVN */
/* were found in. */
/* LBEG, are the beginning and ending addresses of the */
/* LEND segment in the file LHAND that PREVS and PREVN */
/* were found in. */
if (*handle == lhand && beg == lbeg && end == lend && *sclkdp >= prevs &&
*sclkdp < prevn) {
start = prevs;
nstart = prevn;
} else {
/* The START times of all of the intervals are stored in the */
/* segment and a directory of every hundredth START is also */
/* stored. The procedure to find the bracketing interval start */
/* times is identical to the one used above for finding the */
/* bracketing times. */
/* The directory epochs narrow down the search for the times that */
/* bracket the request time to a group of DIRSIZ or fewer records. */
/* There is only one group if there are no directory epochs. */
if (nidir == 0) {
group = 1;
} else {
/* Compute the location of the first directory epoch. From the */
/* beginning of the segment, we need to go through all of the */
/* pointing numbers (PSIZ*NUMREC of them), then through all of */
/* the NUMREC SCLK times and NRDIR directory times, and then */
/* finally through the NUMINT interval start times. */
dirloc = beg + (psiz + 1) * numrec + nrdir + numint;
/* Locate the largest directory time less than the */
/* request time SCLKDP. */
/* Read in as many as BUFSIZ directory epochs at a time for */
/* comparison. */
fnd = FALSE_;
remain = nidir;
group = 0;
while(! fnd) {
/* The number of records to read into the buffer. */
n = min(remain,100);
i__1 = dirloc + n - 1;
dafgda_(handle, &dirloc, &i__1, buffer);
remain -= n;
/* Determine the last directory element in BUFFER that's */
/* less than SCLKDP. */
i__ = lstltd_(sclkdp, &n, buffer);
if (i__ < n) {
group = group + i__ + 1;
fnd = TRUE_;
} else if (remain == 0) {
/* The request time is greater than the last directory */
/* time so we want the last group in the segment. */
group = nidir + 1;
fnd = TRUE_;
} else {
/* Need to read another block of directory times. */
dirloc += n;
group += n;
}
}
}
/* Now we know which group of DIRSIZ (or less) times to look at. */
/* Out of the NUMINT SCLK START times, the number that we should */
/* skip over to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
skip = (group - 1) * 100;
/* From this we can compute the address in the segment of the */
/* group of times we want. To get to the first interval start */
/* time we must pass over PSIZ * NUMREC pointing numbers, NUMREC */
/* SCLK times, and NRDIR SCLK directory times. Then we skip */
/* over the number just computed above. */
grpadd = beg + (psiz + 1) * numrec + nrdir + skip;
/* The number of times that we have to look at may be less than */
/* DIRSIZ. However many there are, go ahead and read them into */
/* the buffer. */
/* Computing MIN */
i__1 = 100, i__2 = numint - skip;
n = min(i__1,i__2);
i__1 = grpadd + n - 1;
dafgda_(handle, &grpadd, &i__1, buffer);
/* Find the index of the largest time in the group that is less */
/* than or equal to the input time. */
i__ = lstled_(sclkdp, &n, buffer);
if (i__ == 0) {
/* The first start time in the buffer is the start of the */
/* interval following the one containing the request time. */
/* We don't need to check if GROUP = 1 because the case of */
/* the request time occurring before the first time in the */
/* segment has already been handled. */
nstart = buffer[0];
addr__ = grpadd - 1;
dafgda_(handle, &addr__, &addr__, &start);
} else if (i__ == n) {
if (group == nidir + 1) {
/* This is the last interval in the segment. */
start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)1040)];
nstart = dpmax_();
} else {
/* The last START time in this group is equal to the */
/* request time. */
start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)1049)];
addr__ = grpadd + n;
dafgda_(handle, &addr__, &addr__, &nstart);
}
} else {
/* The bracketing START times are contained in this group. */
start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)1061)];
nstart = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge(
"buffer", i__1, "ckr03_", (ftnlen)1062)];
}
/* Save the information about the interval and segment. */
lhand = *handle;
lbeg = beg;
lend = end;
prevs = start;
prevn = nstart;
}
/* Check and see if the bracketing pointing instances belong */
/* to the same interval. If they do then we can interpolate */
/* between them, if not then check to see if the closer of */
/* the two to the request time lies within the tolerance. */
/* The left bracketing time will always belong to the same */
/* interval as the request time, therefore we need to check */
/* only that the right bracketing time is less than the start */
/* time of the next interval. */
if (rsclk < nstart) {
record[0] = lsclk;
i__1 = laddr + psiz - 1;
dafgda_(handle, &laddr, &i__1, &record[1]);
record[8] = rsclk;
i__1 = raddr + psiz - 1;
dafgda_(handle, &raddr, &i__1, &record[9]);
record[16] = *sclkdp;
*found = TRUE_;
} else {
ldiff = *sclkdp - lsclk;
rdiff = rsclk - *sclkdp;
if (ldiff <= *tol || rdiff <= *tol) {
/* Return the pointing instance closest to the request time. */
/* If the request time is midway between LSCLK and RSCLK then */
/* grab the pointing instance associated with the greater time. */
if (ldiff < rdiff) {
record[0] = lsclk;
record[8] = lsclk;
i__1 = laddr + psiz - 1;
dafgda_(handle, &laddr, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
} else {
record[0] = rsclk;
record[8] = rsclk;
i__1 = raddr + psiz - 1;
dafgda_(handle, &raddr, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
}
record[16] = *sclkdp;
*found = TRUE_;
}
}
chkout_("CKR03", (ftnlen)5);
return 0;
} /* ckr03_ */
/* $Procedure SPKR21 ( Read SPK record from segment, type 21 ) */
/* Subroutine */ int spkr21_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer i_dnnt(doublereal *);
/* Local variables */
doublereal data[100];
integer offd, offe, nrec, ndir, offr, i__, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer recno;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal dc[2];
integer ic[6], maxdim, dflsiz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
extern logical return_(void);
integer end, off;
/* $ Abstract */
/* Read a single SPK data record from a segment of type 21 */
/* (Extended Difference Lines). */
/* $ 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 */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* $ 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 File handle. */
/* DESCR I Segment descriptor. */
/* ET I Evaluation epoch. */
/* RECORD O Data record. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* a SPK segment of type 21. */
/* ET is an epoch for which a data record from a specific */
/* segment is required. The epoch is represented as */
/* seconds past J2000 TDB. */
/* $ Detailed_Output */
/* RECORD is a data record which, when evaluated at epoch ET, */
/* will give the state (position and velocity) of an */
/* ephemeris object, relative to its center of motion, */
/* in an inertial reference frame. */
/* The contents of RECORD are as follows: */
/* RECORD(1): The difference table size per */
/* Cartesian component. Call this */
/* size MAXDIM; then the difference */
/* line (MDA) size DLSIZE is */
/* ( 4 * MAXDIM ) + 11 */
/* RECORD(2) */
/* ... */
/* RECORD(1+DLSIZE): An extended difference line. */
/* The contents are: */
/* 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 */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the maximum table size of the input record exceeds */
/* MAXTRM, the error SPICE(DIFFLINETOOLARGE) is signaled. */
/* 2) Any errors that occur while reading SPK data will be */
/* diagnosed by routines in the call tree of this routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the SPK Required Reading file for a description of the */
/* structure of a data type 21 segment. */
/* $ Examples */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRxx */
/* routines might be used to "dump" and check segment data for a */
/* particular epoch. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 1 ) THEN */
/* CALL SPKR21 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* I.M. Underwood (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 16-JAN-2014 (NJB) (FTK) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* read record from type_21 spk segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKR21", (ftnlen)6);
/* Unpack the segment descriptor. */
dafus_(descr, &c__2, &c__6, dc, ic);
begin = ic[4];
end = ic[5];
/* Get the number of records in the segment. From that, we can */
/* compute */
/* NDIR The number of directory epochs. */
/* OFFD The offset of the first directory epoch. */
/* OFFE The offset of the first epoch. */
/* the number of directory epochs. */
/* We'll fetch the difference table dimension as well. */
i__1 = end - 1;
dafgda_(handle, &i__1, &end, data);
nrec = i_dnnt(&data[1]);
ndir = nrec / 100;
offd = end - ndir - 2;
offe = offd - nrec;
maxdim = i_dnnt(data);
if (maxdim > 25) {
setmsg_("The input record has a maximum table dimension of #, while "
"the maximum supported by this routine is #. It is possible t"
"hat this problem is due to your SPICE Toolkit being out of d"
"ate.", (ftnlen)183);
errint_("#", &maxdim, (ftnlen)1);
errint_("#", &c__25, (ftnlen)1);
sigerr_("SPICE(DIFFLINETOOLARGE)", (ftnlen)23);
chkout_("SPKR21", (ftnlen)6);
return 0;
}
/* The difference line dimension per component is the */
/* first element of the output record. */
record[0] = (doublereal) maxdim;
/* Set the difference line size. */
dflsiz = (maxdim << 2) + 11;
/* What we want is the record number: once we have that, we can */
/* compute the offset of the record from the beginning of the */
/* segment, grab it, and go. But how to find it? */
/* Ultimately, we want the first record whose epoch is greater */
/* than or equal to ET. If there are BUFSIZ or fewer records, all */
/* the record epochs can be examined in a single group. */
if (nrec <= 100) {
i__1 = offe + 1;
i__2 = offe + nrec;
dafgda_(handle, &i__1, &i__2, data);
recno = lstltd_(et, &nrec, data) + 1;
offr = begin - 1 + (recno - 1) * dflsiz;
i__1 = offr + 1;
i__2 = offr + dflsiz;
dafgda_(handle, &i__1, &i__2, &record[1]);
chkout_("SPKR21", (ftnlen)6);
return 0;
}
/* Searching directories is a little more difficult. */
/* The directory contains epochs BUFSIZ, 2*BUFSIZ, and so on. Once */
/* we find the first directory epoch greater than or equal to ET, we */
/* can grab the corresponding set of BUFSIZ record epochs, and */
/* search them. */
i__1 = ndir;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = offd + i__;
i__3 = offd + i__;
dafgda_(handle, &i__2, &i__3, data);
if (data[0] >= *et) {
off = offe + (i__ - 1) * 100;
i__2 = off + 1;
i__3 = off + 100;
dafgda_(handle, &i__2, &i__3, data);
recno = (i__ - 1) * 100 + lstltd_(et, &c__100, data) + 1;
offr = begin - 1 + (recno - 1) * dflsiz;
i__2 = offr + 1;
i__3 = offr + dflsiz;
dafgda_(handle, &i__2, &i__3, &record[1]);
chkout_("SPKR21", (ftnlen)6);
return 0;
}
}
/* If ET is greater than the final directory epoch, we want one */
/* of the final records. */
i__ = nrec % 100;
i__1 = end - ndir - i__ - 1;
i__2 = end - ndir - 2;
dafgda_(handle, &i__1, &i__2, data);
recno = ndir * 100 + lstltd_(et, &i__, data) + 1;
offr = begin - 1 + (recno - 1) * dflsiz;
i__1 = offr + 1;
i__2 = offr + dflsiz;
dafgda_(handle, &i__1, &i__2, &record[1]);
chkout_("SPKR21", (ftnlen)6);
return 0;
} /* spkr21_ */
/* $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 PCKEUL ( PCK, get Euler angles at time from PCK file ) */
/* Subroutine */ int pckeul_(integer *body, doublereal *et, logical *found,
char *ref, doublereal *eulang, ftnlen ref_len)
{
integer iref, type__;
extern /* Subroutine */ int pcke02_(doublereal *, doublereal *,
doublereal *), chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int pckr02_(integer *, doublereal *, doublereal *,
doublereal *), dafus_(doublereal *, integer *, integer *,
doublereal *, integer *);
char ident[40];
integer handle;
extern /* Subroutine */ int irfnam_(integer *, char *, ftnlen);
doublereal record[130];
extern /* Subroutine */ int pcksfs_(integer *, doublereal *, integer *,
doublereal *, char *, logical *, ftnlen), chkout_(char *, ftnlen);
extern logical return_(void);
doublereal dcd[2];
integer icd[5];
/* $ Abstract */
/* This routine is obsolete. It supports only the type 02 binary */
/* PCK format. It is maintained only for backward compatibility */
/* Return Euler angles and their derivatives and their reference */
/* frame, given an input time and body and reference frame from */
/* a PCK binary file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* NAIF_IDS */
/* ROTATION */
/* TIME */
/* PCK */
/* $ Keywords */
/* TRANSFORMATION */
/* ROTATION */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body */
/* ET I Epoch of transformation */
/* FOUND O True if ET, BODY found in a PCK file */
/* REF O Name of inertial ref. frame of state */
/* EULANG O Euler angles and their derivatives. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* state transformation matrix is requested. Bodies */
/* are numbered according to the standard NAIF */
/* numbering scheme. The numbering scheme is */
/* explained in the NAIF_IDS required reading file. */
/* ET is the epoch at which the state transformation */
/* matrix is requested. */
/* $ Detailed_Output */
/* FOUND if the Euler angles for the requested time */
/* and body are found in a PCK binary file, */
/* FOUND is true. Otherwise, it's false. */
/* REF is the name of an inertial ref. frame. */
/* (See the routine CHGIRF for a full list of names.) */
/* EULANG the Euler angles and their derivatives at */
/* time ET. The rotation matrix is */
/* [ EULANG(3) ] [EULANG(2)] [EULANG(1)] */
/* 3 1 3 */
/* and dEULANG(1)/dt = EULANG(4) */
/* dEULANG(2)/dt = EULANG(5) */
/* dEULANG(3)/dt = EULANG(6) */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* Here we load a binary PCK files and use PCKEUL to get the */
/* Euler angles. */
/* C */
/* C Load binary PCK file. */
/* C */
/* CALL PCKLOF ('example.pck', HANDLE) */
/* C Call routine to get Euler angles phi, delta, w. */
/* CALL PCKEUL ( BODY, ET, FOUND, REF, EULANG ) */
/* The Euler angles and their derivatives are returned */
/* in EULANG. */
/* $ Restrictions */
/* A binary PCK kernel must be loaded with PCKLOF before */
/* calling this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K. S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.1, 03-JAN-2014 (EDW) */
/* Minor edits to Procedure; clean trailing whitespace. */
/* Removed unneeded Revisions section. */
/* - SPICELIB Version 2.0.0, 21-MAR-1995 (KSZ) */
/* PCKEUL modified to check in. PCKMAT takes */
/* over for PCKEUL in many cases. REF now a character. */
/* - SPICELIB Version 1.1.0, 18-OCT-1994 (KSZ) */
/* Fixed bug which incorrecly modded DW by two pi. */
/* - SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */
/* -& */
/* $ Index_Entries */
/* get Euler angles and their derivatives */
/* -& */
/* SPICELIB functions */
/* Parameters */
/* ND number of double precision components of descriptor */
/* NI number of integer components of descriptor */
/* NR component number of reference frame in integer */
/* portion of descriptor */
/* NS size of a packed PCK segment descriptor */
/* NT component number of data type in integer portion */
/* of descriptor */
/* Local Variables */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
} else {
chkin_("PCKEUL", (ftnlen)6);
}
/* Get a segment applicable to a specified body and epoch. */
pcksfs_(body, et, &handle, descr, ident, found, (ftnlen)40);
if (*found) {
/* Look at parts of the descriptor. */
dafus_(descr, &c__2, &c__5, dcd, icd);
type__ = icd[2];
iref = icd[1];
irfnam_(&iref, ref, ref_len);
if (type__ == 2) {
/* Read in Chebyshev coefficients from segment. */
pckr02_(&handle, descr, et, record);
/* Call evaluation routine to get Euler angles */
/* phi, delta, w. */
pcke02_(et, record, eulang);
} else {
/* If appropriate data was not found, found is false. */
*found = FALSE_;
}
}
chkout_("PCKEUL", (ftnlen)6);
return 0;
} /* pckeul_ */
/* $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_ */
