/* $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 PCKR03 ( Read PCK record from segment, type 03 ) */
/* Subroutine */ int pckr03_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
integer ends, indx;
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical found;
doublereal value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), sgfcon_(
integer *, doublereal *, integer *, integer *, doublereal *),
sigerr_(char *, ftnlen), chkout_(char *, ftnlen), sgfpkt_(integer
*, doublereal *, integer *, integer *, doublereal *, integer *),
sgfrvi_(integer *, doublereal *, doublereal *, doublereal *,
integer *, logical *), setmsg_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Read a single PCK data record from a segment of type 03. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PCK */
/* $ Keywords */
/* PCK */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle for a PCK file. */
/* DESCR I Descriptor for a type 03 PCK segment. */
/* ET I Target epoch for orientation information. */
/* RECORD O Data record associated with epoch ET. */
/* $ Detailed_Input */
/* HANDLE is the file handle for a type 03 PCK segment. */
/* DESCR is the segment descriptor for a type 03 PCK segment. */
/* ET is a target epoch, for which a data record from */
/* the specified segment is required. */
/* $ Detailed_Output */
/* RECORD is the record from the specified segment which, */
/* when evaluated at epoch ET, will give the RA, DEC, */
/* W and body fixed angular rates for the body associated */
/* with the segment. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) It is assumed that the descriptor and handle supplied are */
/* for a properly constructed type 03 segment. No checks are */
/* performed to ensure this. */
/* 2) If the input ET value is not within the range specified */
/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */
/* is signalled. */
/* 3) All other errors are diagnosed by routines in the call tree */
/* of this routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* This subroutine reads a type 03 PCK record from the segment */
/* specified by HANDLE and DESCR. The record read will contain */
/* sufficient information to to compute RA, DEC, W and body fixed */
/* angular rates for the body associated with the segment for epoch */
/* ET. */
/* See the PCK Required Reading file for a description of the */
/* structure of a type 03 PCK segment. */
/* $ Examples */
/* The data returned by the PCKRnn 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 PCKRnn */
/* 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 PCKSFS ( 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. 03 ) THEN */
/* CALL PCKR03 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* END IF */
/* $ Restrictions */
/* 1) It is assumed that the descriptor and handle supplied are */
/* for a properly constructed type 03 segment. No checks are */
/* performed to ensure this. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-SEP-1995 (KRG) */
/* -& */
/* $ Index_Entries */
/* read record from type_03 pck segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* The number of constant values stored with a type 03 segment */
/* segment. */
/* The beginning location in the output record for the non-constant */
/* segment data. */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PCKR03", (ftnlen)6);
}
/* Check the request time against the time bounds in the segment */
/* descriptor. In order to get the right data back from the generic */
/* segment calls below, we need to be sure that the desired epoch */
/* falls within the bounds of the segment, as specified by the */
/* descriptor. The first two elements of the descriptor are the start */
/* time for the segment and the stop time for the segment, */
/* respectively. */
if (*et < descr[0] || *et > descr[1]) {
setmsg_("Request time # is outside of descriptor bounds # : #.", (
ftnlen)53);
errdp_("#", et, (ftnlen)1);
errdp_("#", descr, (ftnlen)1);
errdp_("#", &descr[1], (ftnlen)1);
sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22);
chkout_("PCKR03", (ftnlen)6);
return 0;
}
/* Fetch the constants and store them in the first part of */
/* the output RECORD. */
sgfcon_(handle, descr, &c__1, &c__1, record);
/* Locate the time in the file less than or equal to the input ET. */
sgfrvi_(handle, descr, et, &value, &indx, &found);
/* Fetch the data record. */
sgfpkt_(handle, descr, &indx, &indx, &record[1], &ends);
chkout_("PCKR03", (ftnlen)6);
return 0;
} /* pckr03_ */
/* $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 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 SPKR10 ( SPK, read record from SPK type 10 segment ) */
/* Subroutine */ int spkr10_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer ends[2], indx, from, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
static logical found;
static doublereal value;
static integer to, nepoch, getelm;
extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *,
integer *, doublereal *), sgmeta_(integer *, doublereal *,
integer *, integer *), chkout_(char *, ftnlen), sgfpkt_(integer *,
doublereal *, integer *, integer *, doublereal *, integer *),
sgfrvi_(integer *, doublereal *, doublereal *, doublereal *,
integer *, logical *);
static integer putelm;
extern logical return_(void);
static integer set1, set2;
/* $ Abstract */
/* Read a single SPK data record from a segment of type 10 */
/* (NORAD two line element sets). */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* 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 10. */
/* 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. */
/* $ Exceptions */
/* 1) It is assumed that the descriptor and handle supplied are */
/* for a properly constructed type 10 segment. No checks are */
/* performed to ensure this. */
/* 2) All errors are 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 10 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 SPKR10 ( 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 */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 09-MAR-2009 (EDW) */
/* Remove declaration of unused varaible DOINT. */
/* - SPICELIB Version 1.0.0, 05-JAN-1994 (WLT) */
/* -& */
/* $ Index_Entries */
/* read record from type_10 spk segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* We have 2 nutation/obliquity terms and their rates giving us */
/* four angle components for each packet. */
/* BEGEL1 is the location in the record where the first */
/* two-line element set will begin. */
/* BEGEL2 is the location in the record where the second */
/* two-line element set will begin. */
/* ENSET1 and ENSET2 are the locations in the record where the */
/* last element of set 1 and set 2 will be located. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKR10", (ftnlen)6);
/* Fetch the constants and store them in the first part of */
/* the output RECORD. */
sgfcon_(handle, descr, &c__1, &c__8, record);
/* Locate the time in the file closest to the input ET. */
sgfrvi_(handle, descr, et, &value, &indx, &found);
/* Determine which pair of element sets to choose so that */
/* they will bracket ET. */
if (*et <= value) {
/* Computing MAX */
i__1 = indx - 1;
from = max(i__1,1);
to = indx;
} else {
sgmeta_(handle, descr, &c__7, &nepoch);
from = indx;
/* Computing MIN */
i__1 = indx + 1;
to = min(i__1,nepoch);
}
/* Fetch the element sets */
sgfpkt_(handle, descr, &from, &to, &record[8], ends);
/* If the size of the packets is not 14, this is an old style */
/* two-line element set without nutation information. We simply */
/* set all of the angles to zero. */
if (ends[0] == 10) {
/* First shift the elements to their proper locations in RECORD */
/* so there will be room to fill in the zeros. */
putelm = 32;
getelm = 28;
while(getelm > 18) {
record[putelm - 1] = record[getelm - 1];
--putelm;
--getelm;
}
set1 = 19;
set2 = 33;
for (i__ = 1; i__ <= 4; ++i__) {
record[set1 - 1] = 0.;
record[set2 - 1] = 0.;
++set1;
++set2;
}
}
/* If we only got one element set, ET was either before the */
/* first one in the segment or after the last one in the */
/* segment. We simply copy the one fetched a second time so */
/* that the record is properly constructed. */
if (from == to) {
moved_(&record[8], &c__14, &record[22]);
}
chkout_("SPKR10", (ftnlen)6);
return 0;
} /* spkr10_ */