/* $Procedure SGFRVI ( Generic Segments: Fetch ref. value and index ) */
/* Subroutine */ int sgfrvi_(integer *handle, doublereal *descr, doublereal *
x, doublereal *value, integer *indx, logical *found)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
logical done;
integer i__, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical myfnd;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafgda_(
integer *, integer *, integer *, doublereal *);
extern logical failed_(void);
doublereal endref;
integer nfetch;
doublereal buffer[101];
integer bfindx, remain;
extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *,
integer *);
doublereal dpimax;
integer myrefb;
extern integer lstled_(doublereal *, integer *, doublereal *);
doublereal dptemp;
integer fullrd, rdridx, myrdrb;
extern integer intmax_(void);
integer mynref;
logical isdirv;
integer myindx;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen);
integer mynrdr;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
doublereal myvalu;
extern logical return_(void);
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer myrdrt, mynpkt, end;
/* $ Abstract */
/* Given the handle of a DAF and the descriptor associated with */
/* a generic DAF segment in the file, find the reference value */
/* associated with the value X and it's index. */
/* $ 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 */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I The handle of a DAF open for reading. */
/* DESCR I The descriptor for a DAF generic segment. */
/* X I The key value used to find a reference and index. */
/* VALUE O The reference value associated with X. */
/* INDX O The index of VALUE within the reference values. */
/* FOUND O A flag indicating whether values for X were found. */
/* $ Detailed_Input */
/* HANDLE is the handle of a DAF open for reading */
/* DESCR is the descriptor of the generic segment that we are */
/* going to search for a reference value to associate with */
/* X. */
/* X a value for which the associated reference value */
/* and reference index is requested. */
/* $ Detailed_Output */
/* VALUE is the reference value associated with the input value */
/* X. */
/* INDX is the index of VALUE within the set of reference */
/* values for the generic segment. This value may be used */
/* to obtain a particular packet of data from the generic */
/* segment. */
/* FOUND is a logical flag indicating whether a reference value */
/* associated with X was found. If a reference value was */
/* found, FOUND will have a value of TRUE; otherwise it */
/* will have a value of FALSE. */
/* $ Parameters */
/* This subroutine makes use of parameters defined in the file */
/* 'sgparam.inc'. */
/* $ Files */
/* See the description of HANDLE above. */
/* $ Exceptions */
/* 1) The error SPICE(UNKNOWNREFDIR) will be signalled if */
/* the reference directory structure is unrecognized. The most */
/* likely cause of this error is that an upgrade to your */
/* version of the SPICE toolkit is needed. */
/* 2) If a value computed for the index of an implicitly indexed */
/* generic segment is too large to be represented as an integer, */
/* the error SPICE(INDEXTOOLARGE) will be signalled. */
/* $ Particulars */
/* This routine allows you to easily find the index and value */
/* of the reference item that should be associated with a */
/* value X. Given this information you can then easily retrieve */
/* the packet that should be associated with X. */
/* $ Examples */
/* Suppose that you have a generic segment that contains the */
/* following items. */
/* 1) Packets that model the motion of a body as a function */
/* of time over some interval of time. */
/* 2) Reference values that are the epochs corresponding */
/* to the beginning of the intervals for the packets. */
/* To retrieve the correct packet to use to compute the position */
/* and velocity of the body at a particular epoch, ET, you could */
/* use the following code. (Note this block of code assumes that */
/* you aren't going to run into any exceptional cases such as ET */
/* falling outside the range of times for which the packets can */
/* provide ephemeris data.) */
/* Find out the index of the time that should be associated */
/* with the ET we've been given */
/* CALL SGFRVI ( HANDLE, DESCR, ET, ETFND, INDX, FOUND ) */
/* Fetch the INDX'th ephemeris packet from the segment. */
/* CALL SGFPKT ( HANDLE, DESCR, INDX, EPHEM ) */
/* $ Restrictions */
/* The segment described by DESCR MUST be a generic segment, */
/* otherwise the results of this routine are not predictable. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* - SPICELIB Version 1.1.0, 08-MAY-1996 (WLT) */
/* A bug was found in the EXPCLS index case when the */
/* trying to retrieve the last value in a generic segment. */
/* This bug was discovered by the HP compiler complaining */
/* that an index used was not initialized. */
/* The offending line was */
/* MYVALU = BUFFER(I) */
/* The corrected line is: */
/* MYVALU = BUFFER(BFINDX) */
/* - SPICELIB Version 1.0.0, 28-Mar-1994 (KRG) (WLT) */
/* -& */
/* $ Index_Entries */
/* find the index of a reference value in a generic segment */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Include the mnemonic values for the generic segment 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. */
/* Local Variables */
/* Saved Variables */
/* Initial Values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SGFRVI", (ftnlen)6);
/* Set the value for the maximum index as a double precision number, */
/* but only do it the first time into the subroutine. */
if (first) {
first = FALSE_;
dpimax = (doublereal) intmax_();
}
/* Collect the necessary meta data values common to all cases. */
sgmeta_(handle, descr, &c__12, &mynpkt);
sgmeta_(handle, descr, &c__7, &mynref);
sgmeta_(handle, descr, &c__5, &myrdrt);
sgmeta_(handle, descr, &c__6, &myrefb);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* Check to be sure that we know how to deal with the type of index */
/* in the segment. The index type should be between the minimum */
/* allowed index type, MNIDXT, and the maximum allowed index type, */
/* MXIDXT, as specified in the file 'sgparam.inc'. */
if (myrdrt < 0 || myrdrt > 4) {
setmsg_("The generic DAF segment you attempted to read has an unsupp"
"orted reference directory structure. The integer code given "
"for this structure is #, and allowed codes are within the ra"
"nge # to #. The likely cause of this anamoly is your version"
" of SPICELIB needs updating. Contact your system administrat"
"or or NAIF for a toolkit update.", (ftnlen)331);
errint_("#", &myrdrt, (ftnlen)1);
errint_("#", &c__0, (ftnlen)1);
errint_("#", &c__4, (ftnlen)1);
sigerr_("SPICE(UNKNOWNREFDIR)", (ftnlen)20);
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* We don't have an index yet and we initialize things to zero. */
myfnd = FALSE_;
myindx = 0;
myvalu = 0.;
/* We pass the idiot checks, so lets proceed. We have a IF block for */
/* each allowed reference directory type code. */
/* For implicitly indexed data packets, the interval */
/* [ BUFFER(1), BUFFER(1) + (N - 1) * BUFFER(2) ) */
/* is divided into subintervals as follows: */
/* (-infinity, r1), [r_1,r_2) [r_2, r_3), ..., [r_i, r_(i+1)), */
/* ..., [r_N, +infinity), */
/* where N = the number of packets in the segment, MYNPKT, and */
/* r_i = BUFFER(1) + (i-1) * BUFFER(2). */
/* If X is in [r_i, r_(i+1)), i = 1, N-1, then we found a value */
/* and the index returned will be i with the reference value */
/* returned will be r_i. */
/* If X is in [r_N, +infinity), then we found a value and the */
/* index returned will be N and the reference value returned will */
/* be r_N. */
/* If X is in (-infinity, r1), we have two possibilities: */
/* 1) If the index type is implicit closest, we found a value, */
/* the index returned will be 1 and the reference value */
/* returned will be r_1. */
/* 2) If the index type is implicit less than or equal, we do */
/* not find a value. */
/* For explicitly indexed packets we simply search the reference */
/* directory for an appropriate reference value. */
if (myrdrt != 0 && myrdrt != 1) {
/* In addition to the meta data items we already have, we also */
/* need these. */
sgmeta_(handle, descr, &c__4, &mynrdr);
sgmeta_(handle, descr, &c__3, &myrdrb);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* We need to scan the reference directory (if there is one) to */
/* determine the appropriate block of reference values to read */
/* from the generic segment. Then we compute the number of */
/* reference values to fetch and examine. Finally, based on the */
/* index type we figure out whether we have found a reference */
/* value or not. It will take a little while to get there, so */
/* let's get going. */
/* We have not started yet, so we're not done and we cannot have a */
/* reference directory value yet. */
done = FALSE_;
isdirv = FALSE_;
/* We have not read any full buffers of reference directory values */
/* yet, all of the reference directory values remain to be read, */
/* and we have no index for a reference directory value. */
fullrd = 0;
remain = mynrdr;
rdridx = 0;
/* Search the reference directory values to select the appropriate */
/* block of reference values to read. */
while(! done && remain > 0) {
/* Read a buffer of reference directory items. */
nfetch = min(100,remain);
begin = myrdrb + fullrd * 100 + 1;
end = begin + nfetch - 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* See if X is in the current buffer. */
rdridx = lstled_(x, &nfetch, buffer);
if (rdridx == 0) {
/* If not, then X < BUFFER(1) and we're done. This indicates */
/* that the desired reference value is before, or in, the */
/* previous block of reference values. */
done = TRUE_;
} else if (rdridx == nfetch) {
/* If we get the last value of the buffer, then either we */
/* are done, X = BUFFER(NFETCH), or X > BUFFER(NFETCH). */
if (*x == buffer[(i__1 = nfetch - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)417)]
) {
/* If X = BUFFER(NFETCH) we are done, we have a directory */
/* value, and it might be a value we want to return. */
done = TRUE_;
isdirv = TRUE_;
} else {
/* Otherwise, we might have more stuff to read, so update */
/* the remainder and the current number of full buffer */
/* reads and try the loop again. */
remain -= nfetch;
if (remain > 0) {
/* We don't want to increment FULLRD for a partial */
/* buffer read. The arithmetic for the index */
/* calculations below will use RDRIDX to deal with */
/* this. */
++fullrd;
}
}
} else {
/* BUFFER(1) <= X < BUFFER(NFETCH), i.e., we have something */
/* in the buffer. Check to see if X = BUFFER(RDRIDX). If so, */
/* we are done, we have a directory value, and it might be a */
/* value we want to return. Otherwise, we are just done. */
done = TRUE_;
if (*x == buffer[(i__1 = rdridx - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)455)]
) {
isdirv = TRUE_;
}
}
}
rdridx = fullrd * 100 + rdridx;
/* There are three cases that we need to consider when X is not a */
/* reference directory value: */
/* Case 1: 0 < RDRIDX < MYNRDR (most common first) */
/* Case 2: RDRIDX = 0 */
/* Case 3: RDRIDX = MYNRDR */
if (! isdirv) {
if (rdridx > 0 && rdridx < mynrdr) {
/* If we were able to bracket X before reaching the end of */
/* the reference directory, then we KNOW that we have a */
/* candidate for a reference value in the reference data. */
/* All we need to do is read the reference data and find it */
/* in the buffer. We also read the reference directory */
/* values that bracket the desired reference value into */
/* BUFFER, so that they are there if we need them. */
/* Computing MIN */
i__1 = 101, i__2 = mynref - rdridx * 100 + 1;
nfetch = min(i__1,i__2);
begin = myrefb + rdridx * 100;
end = begin + nfetch - 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
bfindx = lstled_(x, &nfetch, buffer);
myindx = rdridx * 100 + bfindx - 1;
} else if (rdridx == 0) {
/* The reference value may be one of the reference values */
/* less than the first reference directory item. So we */
/* compute the beginning and ending addresses for the data, */
/* read it in, and try to find a reference value. */
nfetch = min(101,mynref);
begin = myrefb + 1;
end = begin + nfetch - 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
bfindx = lstled_(x, &nfetch, buffer);
myindx = bfindx;
} else if (rdridx == mynrdr) {
/* If we were not able to bracket X before reaching the end */
/* of the reference directory, then we might have a */
/* candidate for a reference value in the reference data */
/* after the last reference directory value. All we need to */
/* do is read the reference data and look. */
/* NOTE: NFETCH can never be zero or negative, so we can */
/* glibly use it. The reason for this is the NFETCH can only */
/* be zero if the desired reference value is a reference */
/* directory value, and we already know that the reference */
/* value we want is not a reference directory value, because */
/* we are here. For similar reasons, NFETCH can never be */
/* negative. */
begin = myrefb + rdridx * 100;
end = myrefb + mynref;
nfetch = end - begin + 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
bfindx = lstled_(x, &nfetch, buffer);
myindx = rdridx * 100 + bfindx - 1;
}
} else {
/* We have a reference directory value, whose index is easy to */
/* compute. */
myindx = rdridx * 100;
}
/* Now, if we have a candidate for a reference value, lets make */
/* sure, based onthe type of index we have. */
if (myrdrt == 2) {
/* We have a reference value only if X > some reference */
/* value. */
if (! isdirv) {
/* If the value is not a reference directory value, then */
/* we have two cases: */
/* Case 1: 0 < MYINDX <= MYNREF */
/* Case 2: MYINDX = 0 */
if (myindx > 0 && myindx <= mynref) {
/* We found a reference value. The reference value we */
/* want is either the value indicated by MYINDX or */
/* the reference value immediately preceding MYINDX, */
/* if there is such a value. To deal with this we */
/* split the test up into two cases. */
if (myindx > 1) {
/* If X > BUFFER(BFINDX) then we are done, so set the */
/* value. If not, then we want the reference value */
/* that is immediately before the current one. */
if (*x > buffer[(i__1 = bfindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
, (ftnlen)595)]) {
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1,
"sgfrvi_", (ftnlen)598)];
} else {
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 2) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1,
"sgfrvi_", (ftnlen)603)];
--myindx;
}
} else {
/* Remember, MYINDX is 1 here. If we are greater */
/* than the first reference value in the segment, */
/* we are done. Otherwise there is no reference */
/* value to be associated with X. */
if (*x > buffer[(i__1 = myindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
, (ftnlen)615)]) {
myfnd = TRUE_;
myvalu = buffer[(i__1 = myindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1,
"sgfrvi_", (ftnlen)618)];
} else {
/* We did not find a reference value. X was */
/* equal to the first reference value of the */
/* generic segment. */
myfnd = FALSE_;
}
}
} else if (myindx == 0) {
/* We did not find a reference value. X was < the */
/* first reference value for the generic segment. */
myfnd = FALSE_;
}
} else {
/* We have a reference directory value, and we are done. */
/* Either the reference directory value is the one we */
/* want or the reference value immediately preceeding it */
/* is the one we want. */
myfnd = TRUE_;
--myindx;
begin = myrefb + myindx;
end = begin;
dafgda_(handle, &begin, &end, &myvalu);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
}
} else if (myrdrt == 3) {
/* We have a reference value only if X >= some reference */
/* value. At this point, either we have the value and index */
/* we want or X is before the first reference value of the */
/* generic segment. We consider two cases, the first when X */
/* is not a referecne directory value, and the second when */
/* it is. */
if (! isdirv) {
/* If X is not a directory value, then MYINDX is either */
/* equal to zero, implying that X is before the first */
/* reference value in the generic segment, or MYINDX > 0, */
/* implying that we have found a reference value. */
if (myindx > 0 && myindx <= mynref) {
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
684)];
} else if (myindx == 0) {
/* We did not find a reference value. X was < the */
/* first reference value for the generic segment. */
myfnd = FALSE_;
}
} else {
/* We have a reference directory value, and it is the one */
/* we want. */
myfnd = TRUE_;
myvalu = *x;
}
} else if (myrdrt == 4) {
/* We have a reference value for every value of X. If X < */
/* the first reference value of the generic segment, the */
/* closest value is the first reference value. If X > the */
/* last reference value of the generic segment, the closest */
/* value is the last reference value. For X between the */
/* first and last reference values we simple take the */
/* closest reference value to X, resolving a tie by */
/* accepting the larger reference value. */
if (! isdirv) {
/* If X is not a directory value, then MYINDX is either */
/* equal to zero, implying that X is before the first */
/* reference value in the generic segment, */
/* 0 < MYINDX < MYNPKT, implying X is between the first */
/* and last reference values in the generic segment, or */
/* MYINDX = MYNPKT implying that X is greater than or */
/* equal to the last reference value. */
if (myindx > 0 && myindx < mynref) {
i__ = bfindx;
/* Find the closest value to X, choosing the larger in */
/* the event of a tie. */
if (buffer[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)734)] -
*x <= *x - buffer[(i__2 = i__ - 1) < 101 && 0 <=
i__2 ? i__2 : s_rnge("buffer", i__2, "sgfrvi_", (
ftnlen)734)]) {
++i__;
++myindx;
}
myfnd = TRUE_;
myvalu = buffer[(i__1 = i__ - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
742)];
} else if (myindx == 0) {
/* X is before the first reference value for the */
/* generic segment, so the closest reference value is */
/* the first one. */
myfnd = TRUE_;
myindx = 1;
myvalu = buffer[0];
} else if (myindx == mynref) {
/* X is at of after the last reference value for the */
/* generic segment, so the closest reference value is */
/* the last reference value, which will be in BUFFER. */
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
762)];
}
} else {
/* We have a reference directory value, and it is the one */
/* we want. */
myfnd = TRUE_;
myvalu = *x;
}
}
} else if (myrdrt == 0) {
/* Get the begin and end addresses from which to read the */
/* reference values and get the reference values. */
begin = myrefb + 1;
end = myrefb + 2;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];
/* Compute the index if we can. */
if (*x < buffer[0]) {
/* If X is less than BUFFER(1), we do not have a reference */
/* value. */
myfnd = FALSE_;
} else if (*x > endref) {
/* If X is greater than ENDREF, then we have a reference */
/* value, ENDREF. */
myfnd = TRUE_;
myindx = mynpkt;
myvalu = endref;
} else {
/* r_1 < X < r_N, i.e., we found a value. Compute the index */
/* and the reference value. */
if (mynpkt > 1) {
myfnd = TRUE_;
/* Compute the index. */
dptemp = (*x - buffer[0]) / buffer[1] + 1.;
/* Test to see if we can safely convert the index to an */
/* integer. */
if (dptemp > dpimax) {
setmsg_("The computed index is too large to be represent"
"ed as an integer. The most likely problem is tha"
"t an incorrect value was stored for the step siz"
"e. The value found for the step was: #", (ftnlen)
181);
errdp_("#", &buffer[1], (ftnlen)1);
sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
myindx = (integer) dptemp;
myindx = min(myindx,mynpkt);
} else {
/* There is only one packet. */
myindx = 1;
}
/* Compute the reference value. */
myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
}
} else if (myrdrt == 1) {
/* Get the begin and end addresses from which to read the */
/* reference values and get the reference values. */
begin = myrefb + 1;
end = myrefb + 2;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];
/* Compute the index if we can. */
if (*x < buffer[0]) {
/* If X < BUFFER(1), then we found a value, the index */
/* returned will be 1 and the reference value returned will */
/* be BUFFER(1). */
myfnd = TRUE_;
myindx = 1;
myvalu = buffer[0];
} else if (*x > endref) {
/* If X > ENDREF, then we found a value, the index returned */
/* will be MYNPKT and the reference value returned will be */
/* ENDREF. */
myfnd = TRUE_;
myindx = mynpkt;
myvalu = endref;
} else {
/* r_1 < X < r_N, i.e., we found a value. Compute the index */
/* and the reference value. If X is closer to r_I, the index */
/* returned will be I with a reference value of r_I. If X is */
/* closer to r_(I+1), the index returned will be I+1 with a */
/* reference value of r_(I+1). */
if (mynpkt > 1) {
myfnd = TRUE_;
/* Compute the index. */
dptemp = (*x - buffer[0]) / buffer[1] + 1.5;
if (dptemp > dpimax + .5) {
setmsg_("The computed index is too large to be represent"
"ed as an integer. The most likely problem is tha"
"t an incorrect value was stored for the step siz"
"e. The value found for the step was: #", (ftnlen)
181);
errdp_("#", &buffer[1], (ftnlen)1);
sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
myindx = (integer) dptemp;
} else {
/* There is only one packet. */
myindx = 1;
}
/* Compute the reference value. */
myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
}
}
/* At this point, we have either found a value or not. If so, then we */
/* need to set the index, value, and found flag for output. */
/* Otherwise, we simply set the found flag. */
if (myfnd) {
*indx = myindx;
*value = myvalu;
}
*found = myfnd;
chkout_("SGFRVI", (ftnlen)6);
return 0;
} /* sgfrvi_ */
void dafgda_c ( SpiceInt handle,
SpiceInt begin,
SpiceInt end,
SpiceDouble * data )
/*
-Brief_I/O
Variable I/O Description
-------- --- --------------------------------------------------
handle I Handle of a DAF.
begin,
end I Initial, final address within file.
data O Data contained between `begin' and `end'.
-Detailed_Input
handle is the handle of a DAF.
begin,
end are the initial and final addresses of a contiguous
set of double precision numbers within a DAF.
Presumably, these make up all or part of a particular
array.
Note that CSPICE DAF addresses begin at 1 as in the
FORTRAN version of the SPICE Toolkit.
-Detailed_Output
data are the double precision data contained between
the specified addresses within the specified file.
-Parameters
None.
-Exceptions
1) If `begin' is zero or negative, the error SPICE(DAFNEGADDR)
is signaled.
2) If `begin' > `end', the error SPICE(DAFBEGGTEND)
is signaled.
3) If `handle' is invalid, routines in the call tree of dafgda_c
signal an appropriate error.
4) If the range of addresses covered between `begin' and `end'
includes records that do not contain strictly double
precision data, then the values returned in `data' are
undefined. See the Restrictions section below for details.
-Files
None.
-Particulars
The principal reason that DAFs are so easy to use is that
the data in each DAF are considered to be one long contiguous
set of double precision numbers. You can grab data from anywhere
within a DAF without knowing (or caring) about the physical
records in which they are stored.
This routine replaces dafrda_c as the principal mechanism for
reading the contents of DAF arrays.
-Examples
The following code fragment illustrates the use of dafgda_c to read
data from an array. The array begins with a directory containing 11
epochs. Each pair of epochs bounds an interval, and each interval is
covered by a set of eight osculating elements.
#include "SpiceUsr.h"
.
.
.
dafus_c ( sum, nd, ni, dc, ic );
begin = ic[4];
end = ic[5];
dafgda_c ( handle, begin, begin+10, epochs );
for ( i = 0; i < 10; i++ )
{
if ( ( et > epochs[i] )
&& ( et < epochs[i+1] ) )
{
offset = begin + 11 + (i - 1) * 8;
dafgda_c ( handle, offset+1, offset+8, elements );
return;
}
}
-Restrictions
1) There are several types of records in a DAF. This routine
is only to be used to read double precision data bounded
between two DAF addresses. The range of addresses input
may not cross data and summary record boundaries.
-Literature_References
None.
-Author_and_Institution
N.J. Bachman (JPL)
-Version
-CSPICE Version 1.0.1, 23-JAN-2008 (EDW)
Removed a spurious and unneeded "-Declarations"
tag. The tag's presence prevented the HTML API doc
script from parsing the function description.
-CSPICE Version 1.0.0, 14-SEP-2006 (NJB)
-Index_Entries
read data from daf address
-&
*/
{ /* Begin dafgda_c */
/*
Participate in error tracing.
*/
chkin_c ( "dafgda_c" );
dafgda_ ( ( integer * ) &handle,
( integer * ) &begin,
( integer * ) &end,
( doublereal * ) data );
chkout_c ( "dafgda_c" );
} /* End of dafgda_c */
/* $Procedure SPKS02 ( S/P Kernel, subset, type 2 ) */
/* Subroutine */ int spks02_(integer *handle, integer *baddr, integer *eaddr,
doublereal *begin, doublereal *end)
{
/* System generated locals */
integer i__1;
/* Local variables */
doublereal data[50];
integer addr__, nrec;
doublereal init;
integer last, move;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer first;
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_(
integer *, integer *, integer *, doublereal *);
integer remain;
doublereal intlen;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer recsiz;
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in a SPK segment of type 2 */
/* into a new 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of source segment. */
/* BADDR I Beginning address of source segment. */
/* EADDR I Ending address of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* $ Detailed_Input */
/* HANDLE, */
/* BADDR, */
/* EADDR are the file handle assigned to a SPK file, and the */
/* beginning and ending addresses of a segment within */
/* the file. 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 to be extracted. */
/* $ Detailed_Output */
/* None. This routine writes data to the SPK file currently */
/* open for write access. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) Any errors that occur while reading data from the source SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* 2) Any errors that occur while writing data to the output SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* The exact structure of a segment of data type 2 is detailed in */
/* the SPK Required Reading file. */
/* $ Examples */
/* None. */
/* $ 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, 30-DEC-2013 (NJB) */
/* Enhanced header 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) */
/* SPK02 was removed from the Required_Reading section of the */
/* header. The information in the SPK02 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 */
/* subset type_2 spk segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKS02", (ftnlen)6);
}
/* 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 records to extract by comparing the input */
/* epochs with the initial time of the segment and the length of the */
/* interval covered by each record. These final two 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 = *eaddr - 3;
dafgda_(handle, &i__1, eaddr, data);
init = data[0];
intlen = data[1];
recsiz = (integer) data[2];
nrec = (integer) data[3];
first = (integer) ((*begin - init) / intlen) + 1;
first = min(first,nrec);
last = (integer) ((*end - init) / intlen) + 1;
last = min(last,nrec);
/* The number of records to be moved. */
nrec = last - first + 1;
/* We're going to move the data in chunks of 50 d.p. words. Compute */
/* the number of words left to move, the address of the beginning */
/* of the records to move, and the number to move this time. */
remain = nrec * recsiz;
addr__ = *baddr + (first - 1) * recsiz;
move = min(50,remain);
while(remain > 0) {
i__1 = addr__ + move - 1;
dafgda_(handle, &addr__, &i__1, data);
dafada_(data, &move);
remain -= move;
addr__ += move;
move = min(50,remain);
}
/* That's all the records we have to move. But there are still four */
/* final numbers left to write: */
/* 1) The initial time for the polynomials (INIT). */
/* 2) The time interval length for each polynomial (INTLEN). */
/* 3) The record size (RECSIZ). */
/* 4) The number of records (NREC). */
/* INIT and NREC will probably be different for the new segment (in */
/* fact, NREC has already been changed), the other two will not. */
init += (first - 1) * intlen;
data[0] = init;
data[1] = intlen;
data[2] = (doublereal) recsiz;
data[3] = (doublereal) nrec;
dafada_(data, &c__4);
chkout_("SPKS02", (ftnlen)6);
return 0;
} /* spks02_ */
/* $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 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 SGMETA ( Generic segments: Fetch meta data value ) */
/* Subroutine */ int sgmeta_(integer *handle, doublereal *descr, integer *
mnemon, integer *value)
{
/* Initialized data */
static integer lstbeg = -1;
static integer lsthan = 0;
/* System generated locals */
integer i__1, i__2, i__3;
static doublereal equiv_0[2];
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *);
/* Local variables */
static integer meta[17];
integer begm1, i__, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen);
#define dtemp (equiv_0)
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
doublereal xmeta[17];
#define itemp ((integer *)equiv_0)
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
integer niovr2, nd;
extern logical failed_(void);
integer ni;
extern /* Subroutine */ int dafhsf_(integer *, integer *, integer *);
integer begmta, endmta, ametas;
static logical nieven;
static integer ioffst;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal dmtasz;
static integer metasz;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
integer end;
/* $ Abstract */
/* Obtain the value of a specified generic segment meta data item. */
/* $ 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 */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of a DAF open for reading. */
/* DESCR I Descriptor for a generic segment in the DAF. */
/* MNEMON I An integer mnemonic for the desired meta data. */
/* VALUE O The value of the meta data item requested. */
/* $ Detailed_Input */
/* HANDLE is the handle of a DAF opened for reading that */
/* contains the generic segment described by DESCR. */
/* DESCR is the descriptor of a generic segment. This must */
/* be the descriptor for a generic segment in the DAF */
/* associated with HANDLE. */
/* MNEMON is the mnemonic used to represent the desired piece of */
/* meta data. See the file 'sgparam.inc' for details, the */
/* mnemonics, and their values. */
/* $ Detailed_Output */
/* VALUE is the value of the meta data item associated with */
/* the mnemonic MNEMON that is in the generic segment */
/* specified by HANDLE and DESCR. */
/* $ Parameters */
/* This subroutine makes use of parameters defined in the file */
/* 'sgparam.inc'. */
/* $ Files */
/* See the description of HANDLE above. */
/* $ Exceptions */
/* 1) If the mnemonic for the meta data item is not valid, the error */
/* SPICE(UNKNOWNMETAITEM) will be signalled. */
/* 2) If the last address in the DAF segment that reports the number */
/* of meta data items that exist in the segment is less than */
/* MNMETA, the error SPICE(INVALIDMETADATA) will be signaled. */
/* $ Particulars */
/* This routine is a utility for fetching the meta data associated */
/* with a DAF 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 segment is */
/* required. The other data partitions may occur in any order in the */
/* segment because the meta data will contain pointers to the */
/* appropriate locations of the other data partitions within the */
/* segment. */
/* The meta data for the segment should be obtained only through */
/* use of this routine, SGMETA. */
/* $ Examples */
/* Suppose that we would like to know how many constants, data */
/* packets, and reference values are in the generic segment that we */
/* have located in the DAF file associated with HANDLE. */
/* C */
/* C Get the number of constants. */
/* C */
/* CALL SGMETA ( HANDLE, DESCR, NCON, NCONST ) */
/* C */
/* C Get the number of data packets. */
/* C */
/* CALL SGMETA ( HANDLE, DESCR, NPKT, NPKTS ) */
/* C */
/* C Get the number of constants. */
/* C */
/* CALL SGMETA ( HANDLE, DESCR, NREF, NREFS ) */
/* C */
/* C Print the values. */
/* C */
/* WRITE (*, *) 'Number of Constants : ', NCONST */
/* WRITE (*, *) 'Number of Data Packets : ', NPKTS */
/* WRITE (*, *) 'Number of Reference Values: ', NREFS */
/* $ Restrictions */
/* The segment described by DESCR MUST be a generic segment, */
/* otherwise the results of this routine are not predictable. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.4.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* - SPICELIB Version 1.3.0, 14-JUN-1999 (FST) */
/* Altered the check in/out structure to be more reasonable. */
/* This introduced redundant code, but only to increase the */
/* efficiency of the normal mode of operation. */
/* - SPICELIB Version 1.2.0, 24-SEP-1998 (FST) */
/* Modified the code that handles reading the meta data from the */
/* DAF to handle the case when the number of meta data items in */
/* the file exceeds the current maximum defined in sgparam.inc. */
/* In the event that this situation occurs, the routine loads */
/* what meta data it can interpret and ignores the rest. In */
/* this event if NMETA is requested, it is returned as MXMETA in */
/* sgparam.inc. */
/* An additional exception is now trapped by the routine. If */
/* a generic segment in a DAF reports less than the known minimum */
/* number of meta data items, then the routine signals the */
/* error SPICE(INVALIDMETADATA). */
/* The conditions that cause the SPICE(UNKNOWNMETAITEM) to be */
/* signaled have been altered. Now if the integer mnemonic */
/* is not between 1 and METASZ inclusive, or NMETA the error */
/* is signaled. In the versions preceding this change, for */
/* segments that reported less than NMETA items of meta data */
/* could not use this routine to request the number of meta */
/* data items without signalling SPICE(UNKNOWNMETAITEM). */
/* - SPICELIB Version 1.1.0, 11-APR-1995 (KRG) */
/* Modified the code that deals with the EQUIVALENCEd part */
/* descriptor. We now call MOVED rather than using a direct */
/* assignment. */
/* - SPICELIB Version 1.0.0, 11-APR-1995 (KRG) (WLT) */
/* -& */
/* $ Index_Entries */
/* retrieve a meta data value for a generic segment */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Include the mnemonic values for the generic segment declarations. */
/* Local Variables */
/* $ 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. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
/* Handle the case when we are looking at the same file and segment */
/* descriptor first. This will result in duplicated code, but will */
/* increase efficiency for the usual execution case. We need not */
/* worry about the first time through, since LSTHAN and LSTBEG are */
/* set to values that are bogus for actual DAF files. */
if (*handle == lsthan) {
/* Get the begin and end values from the descriptor. They are */
/* located in the last two "integer" positions of the descriptor. */
if (nieven) {
moved_(&descr[ioffst - 1], &c__1, dtemp);
begin = itemp[0];
end = itemp[1];
} else {
moved_(&descr[ioffst - 1], &c__2, dtemp);
begin = itemp[1];
end = itemp[2];
}
/* Check the segment start address. This will tell us whether we */
/* are looking at the same segment. */
if (lstbeg == begin) {
/* The only acceptable integer mnemonics at this point are 1 */
/* through METASZ inclusive, and NMETA. All other requests */
/* should signal the SPICE(UNKNOWNMETAITEM) error, since the */
/* current segment has no knowledge of these values. */
if (*mnemon <= 0 || *mnemon > metasz && *mnemon != 17) {
chkin_("SGMETA", (ftnlen)6);
*value = -1;
setmsg_("The item requested, #, is not one of the recognized"
" meta data items associated with this generic segmen"
"t.", (ftnlen)105);
errint_("#", mnemon, (ftnlen)1);
sigerr_("SPICE(UNKNOWNMETAITEM)", (ftnlen)22);
chkout_("SGMETA", (ftnlen)6);
return 0;
}
/* Set the value for the desired meta data item and return. */
*value = meta[(i__1 = *mnemon - 1) < 17 && 0 <= i__1 ? i__1 :
s_rnge("meta", i__1, "sgmeta_", (ftnlen)364)];
return 0;
}
}
/* At this point we are going to have to load the meta data. If */
/* the new handle and the old handle are the same, then the above */
/* code has already retrieved the relevant segment addresses. If not */
/* we need to fetch them. First check in. */
chkin_("SGMETA", (ftnlen)6);
if (*handle != lsthan) {
dafhsf_(handle, &nd, &ni);
if (failed_()) {
chkout_("SGMETA", (ftnlen)6);
return 0;
}
niovr2 = ni / 2;
nieven = niovr2 << 1 == ni;
ioffst = nd + niovr2;
lsthan = *handle;
/* Get the begin and end values from the descriptor. They are */
/* located in the last two "integer" positions of the descriptor. */
if (nieven) {
moved_(&descr[ioffst - 1], &c__1, dtemp);
begin = itemp[0];
end = itemp[1];
} else {
moved_(&descr[ioffst - 1], &c__2, dtemp);
begin = itemp[1];
end = itemp[2];
}
}
/* Save the new begin address. Remember we have either just computed */
/* this from the IF block above, or we computed it in the very */
/* first IF block. */
lstbeg = begin;
/* Compute the begin address of the meta data and compute the */
/* end address of the number we will be collecting. */
dafgda_(handle, &end, &end, &dmtasz);
if (failed_()) {
chkout_("SGMETA", (ftnlen)6);
return 0;
}
metasz = i_dnnt(&dmtasz);
/* Store the actual meta size in AMETAS, in case METASZ ends up */
/* being modified to conform to our current understanding of */
/* meta data items. */
ametas = metasz;
/* Check to see if METASZ is an unacceptable value. */
if (metasz < 15) {
*value = -1;
setmsg_("This segment reports that it has # meta data items. Every g"
"eneric segment must have at least #.", (ftnlen)95);
errint_("#", &metasz, (ftnlen)1);
errint_("#", &c__15, (ftnlen)1);
sigerr_("SPICE(INVALIDMETADATA)", (ftnlen)22);
chkout_("SGMETA", (ftnlen)6);
return 0;
/* If it is not, we may need to fix a few things to work around some */
/* older files that have been delivered. We perform these kludges */
/* here. Originally, the number of meta data items was not */
/* considered to be part of the meta data. It now is, so if we */
/* encounter an older version of the file, we need to increment the */
/* meta data size by 1. The number of meta data items is always */
/* after all of the meta data items, so we can do this. */
} else if (metasz == 15) {
++metasz;
ametas = metasz;
/* If not check to see if METASZ is greater than the known MXMETA. */
/* If it is then this segment most likely was constructed from */
/* some newer version of the toolkit. Load what meta data we */
/* currently know about as laid out in sgparam.inc. */
} else if (metasz > 17) {
/* Leave AMETAS alone, since we need to know how far back */
/* into the DAF file to begin reading. */
metasz = 17;
}
/* The address computations that follow are precisely the same */
/* as the previous version of the file, except when AMETAS is not */
/* METASZ. This only happens when METASZ is greater than MXMETA. */
begmta = end - ametas + 1;
endmta = begmta + metasz - 1;
dafgda_(handle, &begmta, &endmta, xmeta);
if (failed_()) {
chkout_("SGMETA", (ftnlen)6);
return 0;
}
/* Convert all of the meta data values into integers. */
i__1 = metasz;
for (i__ = 1; i__ <= i__1; ++i__) {
meta[(i__2 = i__ - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("meta", i__2,
"sgmeta_", (ftnlen)503)] = i_dnnt(&xmeta[(i__3 = i__ - 1) <
17 && 0 <= i__3 ? i__3 : s_rnge("xmeta", i__3, "sgmeta_", (
ftnlen)503)]);
}
/* The kludge continues... NMETA and MXMETA are ALWAYS the same */
/* value, and any missing values must appear between the last known */
/* value, META(METASZ-1), and the end value, META(NMETA), so we zero */
/* them out. */
meta[16] = metasz;
for (i__ = metasz; i__ <= 16; ++i__) {
meta[(i__1 = i__ - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge("meta", i__1,
"sgmeta_", (ftnlen)515)] = 0;
}
/* Adjust the bases so that the N'th item of a partition is at */
/* address META(PARTITION_BASE) + N */
begm1 = begin - 1;
meta[0] += begm1;
meta[5] += begm1;
meta[2] += begm1;
meta[7] += begm1;
meta[10] += begm1;
meta[12] += begm1;
/* The only acceptable integer mnemonics at this point are 1 through */
/* METASZ inclusive, and NMETA. All other requests should signal */
/* the SPICE(UNKNOWNMETAITEM) error, since the current segment has */
/* no knowledge of these values. */
if (*mnemon <= 0 || *mnemon > metasz && *mnemon != 17) {
*value = -1;
setmsg_("The item requested, #, is not one of the recognized meta da"
"ta items associated with this generic segment.", (ftnlen)105);
errint_("#", mnemon, (ftnlen)1);
sigerr_("SPICE(UNKNOWNMETAITEM)", (ftnlen)22);
chkout_("SGMETA", (ftnlen)6);
return 0;
}
/* Set the value for the desired meta data item, check out if we */
/* need to, and return. */
*value = meta[(i__1 = *mnemon - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge(
"meta", i__1, "sgmeta_", (ftnlen)555)];
chkout_("SGMETA", (ftnlen)6);
return 0;
} /* sgmeta_ */
/* $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 SPKS17 ( S/P Kernel, subset, type 17 ) */
/* Subroutine */ int spks17_(integer *handle, integer *baddr, integer *eaddr,
doublereal *begin, doublereal *end)
{
doublereal data[12];
extern /* Subroutine */ int chkin_(char *, ftnlen), dafada_(doublereal *,
integer *), dafgda_(integer *, integer *, integer *, doublereal *)
, chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in an SPK segment of type 17 */
/* into a new 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 file containing source segment. */
/* BADDR I Beginning address in file of source segment. */
/* EADDR I Ending address in file of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* $ Detailed_Input */
/* HANDLE, */
/* BADDR, */
/* EADDR are the file handle assigned to an SPK file, and the */
/* beginning and ending addresses of a segment within */
/* that file. 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. */
/* $ Detailed_Output */
/* See $Files section. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This routine relies on the caller to ensure that the */
/* interval [BEGIN, END] is contained in the coverage */
/* interval of the segment. */
/* 2) If BEGIN > END, no data is written to the target file. */
/* $ Files */
/* Data is extracted from the file connected to the input */
/* handle, and written to the current DAF open for writing. */
/* The segment descriptor and summary must already have been written */
/* prior to calling this routine. The segment must be ended */
/* external to this routine. */
/* $ Particulars */
/* This routine is intended solely for use as a utility by the */
/* routine SPKSUB. It transfers a subset of a type 17 SPK data */
/* segment to a properly initialized segment of a second SPK file. */
/* The exact structure of a segment of data type 17 is described */
/* in the section on type 17 in the SPK Required Reading. */
/* $ Examples */
/* This routine is intended only for use as a utility by SPKSUB. */
/* To use this routine successfully, you must: */
/* Open the SPK file from which to extract data. */
/* Locate the segment from which data should be extracted. */
/* Open the SPK file to which this data should be written. */
/* Begin a new segment (array). */
/* Write the summary information for the array. */
/* Call this routine to extract the appropriate data from the */
/* SPK open for read. */
/* End the array to which this routine writes data. */
/* Much of this procedure is carried out by the routine SPKSUB. The */
/* examples of that routine illustrate more fully the process */
/* described above. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ 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) */
/* -& */
/* $ Index_Entries */
/* subset type_17 spk segment */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKS17", (ftnlen)6);
}
/* See whether there's any work to do; return immediately if not. */
if (*begin > *end) {
chkout_("SPKS17", (ftnlen)6);
return 0;
}
/* This couldn't be much easier. First copy the entire */
/* type 17 segment out of the file. */
dafgda_(handle, baddr, eaddr, data);
/* Now write the data into the output file. */
dafada_(data, &c__12);
chkout_("SPKS17", (ftnlen)6);
return 0;
} /* spks17_ */
/* $Procedure SPKS21 ( S/P Kernel, subset, type 21 ) */
/* Subroutine */ int spks21_(integer *handle, integer *baddr, integer *eaddr,
doublereal *begin, doublereal *end)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer i_dnnt(doublereal *);
/* Local variables */
doublereal data[111];
integer offe, nrec, ndir, last, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer first;
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafgda_(
integer *, integer *, integer *, doublereal *);
integer maxdim, offset, dlsize;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in a SPK segment of type 21 */
/* into a new 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 */
/* DAF */
/* 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 Handle of source segment. */
/* BADDR I Beginning address of source segment. */
/* EADDR I Ending address of source segment. */
/* BEGIN I Beginning (initial epoch) of subset. */
/* END I End (final epoch) of subset. */
/* $ Detailed_Input */
/* HANDLE, */
/* BADDR, */
/* EADDR are the file handle assigned to a SPK file, and the */
/* beginning and ending addresses of a segment within */
/* the file. 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 to be extracted. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) Any errors that occur while reading data from the source SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* 2) Any errors that occur while writing data to the output SPK */
/* file will be diagnosed by routines in the call tree of this */
/* routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* The exact structure of a segment of data type 21 is detailed in */
/* the SPK Required Reading file. */
/* $ Examples */
/* None. */
/* $ 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 */
/* subset type_21 spk segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKS01", (ftnlen)6);
/* Get the number of records in the segment. From that, we can */
/* compute */
/* NDIR The number of directory epochs. */
/* OFFE The offset of the first epoch. */
/* the number of directory epochs. */
i__1 = *eaddr - 1;
dafgda_(handle, &i__1, eaddr, data);
maxdim = i_dnnt(data);
nrec = i_dnnt(&data[1]);
ndir = nrec / 100;
offe = *eaddr - ndir - nrec - 2;
/* Well, the new segment has already been begun. We just have to */
/* decide what to move, and move it (using DAFADA). */
/* Let's agree right now that speed is not of the greatest */
/* importance here. We can probably do this with two passes */
/* through the record epochs, and one pass through the records. */
/* 1) Determine the first and last records to be included */
/* in the subset. */
/* 2) Move the records. */
/* 3) Write the epochs. */
/* We can leap through the epochs one last time to get the */
/* directory epochs. */
/* First pass: which records are to be moved? */
first = 0;
last = 0;
i__1 = nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = offe + i__;
i__3 = offe + i__;
dafgda_(handle, &i__2, &i__3, data);
if (first == 0 && data[0] >= *begin) {
first = i__;
}
if (first != 0 && last == 0 && data[0] >= *end) {
last = i__;
}
}
/* Second pass. Move the records. */
dlsize = (maxdim << 2) + 11;
offset = *baddr - 1 + (first - 1) * dlsize;
i__1 = last;
for (i__ = first; i__ <= i__1; ++i__) {
i__2 = offset + 1;
i__3 = offset + dlsize;
dafgda_(handle, &i__2, &i__3, data);
dafada_(data, &dlsize);
offset += dlsize;
}
/* Third pass. Move the epochs. */
i__1 = last;
for (i__ = first; i__ <= i__1; ++i__) {
i__2 = offe + i__;
i__3 = offe + i__;
dafgda_(handle, &i__2, &i__3, data);
dafada_(data, &c__1);
}
/* Get every DIRSIZ'th epoch for the directory. */
i__1 = last;
for (i__ = first + 99; i__ <= i__1; i__ += 100) {
i__2 = offe + i__;
i__3 = offe + i__;
dafgda_(handle, &i__2, &i__3, data);
dafada_(data, &c__1);
}
/* Add the maximum difference line dimension and the */
/* number of records, and we're done. */
d__1 = (doublereal) maxdim;
dafada_(&d__1, &c__1);
data[0] = (doublereal) (last - first + 1);
dafada_(data, &c__1);
chkout_("SPKS01", (ftnlen)6);
return 0;
} /* spks21_ */
/* $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 ZZCKCVR2 ( Private --- C-kernel segment coverage, type 02 ) */
/* Subroutine */ int zzckcvr2_(integer *handle, integer *arrbeg, integer *
arrend, doublereal *schedl)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer nrec;
doublereal last[100];
integer i__, begat, endat;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal first[100];
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *), chkout_(char *, ftnlen), wninsd_(doublereal *,
doublereal *, doublereal *);
integer arrsiz;
extern logical return_(void);
integer get, got;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Determine the "window" of coverage of a type 02 C-kernel 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 */
/* CK */
/* UTILITY */
/* PRIVATE */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of a C-kernel open for read access */
/* ARRBEG I Beginning DAF address */
/* ARREND I Ending DAF address */
/* SCHEDL I/O An initialized window/schedule of interval */
/* $ Detailed_Input */
/* HANDLE is the handle of some DAF that is open for reading. */
/* ARRBEG is the beginning address of a type 02 segment */
/* ARREND is the ending address of a type 02 segment. */
/* SCHEDL is a schedule (window) of intervals, to which the */
/* intervals of coverage for this segment will be added. */
/* $ Detailed_Output */
/* SCHEDL the input schedule updated to include the intervals */
/* of coverage for this segment. */
/* $ Parameters */
/* None. */
/* $ Files */
/* This routine reads the contents of the file associated with */
/* HANDLE to locate coverage intervals. */
/* $ Exceptions */
/* Routines in the call tree of this routine may signal errors */
/* if insufficient room in SCHEDL exists or other error */
/* conditions relating to file access arise. */
/* $ Particulars */
/* This is a utility routine that determines the intervals */
/* of coverage for a type 02 C-kernel segment. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SUPPORT Version 2.1.0, 13-FEB-2003 (BVS) */
/* Replaced MAX with MIN in the assignment of GET. This bug */
/* caused the routine either to look beyond the end of the */
/* start/stop time blocks of the segment (for NREC < BSIZE) or to */
/* attempt to fill in internal buffers with more data than they */
/* were declared to hold (for NREC > BSIZE.) */
/* - SUPPORT Version 2.0.0, 27-AUG-2002 (FST) */
/* Updated this routine to use DAFGDA instead of DAFRDA. */
/* This allows the module to process non-native kernels. */
/* Header and code clean up for delivery to SUPPORT. */
/* - SUPPORT Version 1.0.0, 14-Feb-2000 (WLT) */
/* Happy Valentine's Day. */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZCKCVR2", (ftnlen)8);
}
/* Determine the size of the array and the number of records */
/* in it. */
arrsiz = *arrend - *arrbeg + 1;
d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.;
nrec = i_dnnt(&d__1);
/* The variable GOT tells us how many time endpoints we've */
/* gotten so far. */
got = 0;
while(got < nrec) {
/* Computing MIN */
i__1 = 100, i__2 = nrec - got;
get = min(i__1,i__2);
begat = *arrbeg + (nrec << 3) + got;
endat = *arrbeg + (nrec << 3) + nrec + got;
/* Retrieve the list next list of windows. */
i__1 = begat + get - 1;
dafgda_(handle, &begat, &i__1, first);
i__1 = endat + get - 1;
dafgda_(handle, &endat, &i__1, last);
/* Insert the coverage intervals into the schedule. */
i__1 = get;
for (i__ = 1; i__ <= i__1; ++i__) {
wninsd_(&first[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 :
s_rnge("first", i__2, "zzckcvr2_", (ftnlen)214)], &last[(
i__3 = i__ - 1) < 100 && 0 <= i__3 ? i__3 : s_rnge("last",
i__3, "zzckcvr2_", (ftnlen)214)], schedl);
}
got += get;
}
chkout_("ZZCKCVR2", (ftnlen)8);
return 0;
} /* zzckcvr2_ */
/* $Procedure ZZCKCV02 ( Private --- C-kernel segment coverage, type 02 ) */
/* Subroutine */ int zzckcv02_(integer *handle, integer *arrbeg, integer *
arrend, integer *sclkid, doublereal *tol, char *timsys, doublereal *
schedl, ftnlen timsys_len)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer nrec;
doublereal last[100];
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__, begat;
doublereal begin;
integer endat;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical istdb;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal first[100];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal et, finish;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), wninsd_(doublereal *,
doublereal *, doublereal *);
integer arrsiz;
extern logical return_(void);
integer get, got;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Determine the "window" of coverage of a type 02 C-kernel 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 */
/* CK */
/* UTILITY */
/* PRIVATE */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of a C-kernel open for read access */
/* ARRBEG I Beginning DAF address */
/* ARREND I Ending DAF address */
/* SCLKID I ID of SCLK associated with segment. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* SCHEDL I/O An initialized window/schedule of interval */
/* $ Detailed_Input */
/* HANDLE is the handle of some DAF that is open for reading. */
/* ARRBEG is the beginning address of a type 02 segment */
/* ARREND is the ending address of a type 02 segment. */
/* SCLKID is the ID code of the spacecraft clock associated with */
/* the object for which the segment contains pointing. */
/* This is the ID code used by the SCLK conversion */
/* routines. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with the segment. Before */
/* each interval is inserted into the coverage window, */
/* the intervals are expanded by TOL: the left endpoint */
/* of each interval is reduced by TOL and the right */
/* endpoint is increased by TOL. 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 SCHEDL are expressed in */
/* encoded SCLK ("ticks"), where the clock */
/* is associated with the object designated */
/* by IDCODE. */
/* 'TDB' Elements of SCHEDL are expressed as */
/* seconds past J2000 TDB. */
/* TIMSYS must be consistent with the system used for */
/* the contents of SCHEDL on input, if any. */
/* SCHEDL is a schedule (window) of intervals, to which the */
/* intervals of coverage for this segment will be added. */
/* $ Detailed_Output */
/* SCHEDL the input schedule updated to include the intervals */
/* of coverage for this segment. */
/* $ Parameters */
/* None. */
/* $ Files */
/* This routine reads the contents of the file associated with */
/* HANDLE to locate coverage intervals. */
/* $ Exceptions */
/* 1) Routines in the call tree of this routine may signal errors */
/* if insufficient room in SCHEDL exists or other error */
/* conditions relating to file access arise. */
/* 2) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 3) If TIMSYS is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 4) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine */
/* $ Particulars */
/* This is a utility routine that determines the intervals */
/* of coverage for a type 02 C-kernel segment. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-JAN-2005 (NJB) (FST) (WLT) (BVS) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZCKCV02", (ftnlen)8);
}
/* 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_("ZZCKCV02", (ftnlen)8);
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(INVALIDOPTION)", (ftnlen)20);
chkout_("ZZCKCV02", (ftnlen)8);
return 0;
}
}
/* Determine the size of the array and the number of records */
/* in it. */
arrsiz = *arrend - *arrbeg + 1;
d__1 = ((doublereal) arrsiz * 100. + 1.) / 1001.;
nrec = i_dnnt(&d__1);
/* The variable GOT tells us how many time endpoints we've */
/* gotten so far. */
got = 0;
while(got < nrec) {
/* Computing MIN */
i__1 = 100, i__2 = nrec - got;
get = min(i__1,i__2);
begat = *arrbeg + (nrec << 3) + got;
endat = *arrbeg + (nrec << 3) + nrec + got;
/* Retrieve the list next list of windows. */
i__1 = begat + get - 1;
dafgda_(handle, &begat, &i__1, first);
i__1 = endat + get - 1;
dafgda_(handle, &endat, &i__1, last);
/* Insert the coverage intervals into the schedule. */
i__1 = get;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Adjust the interval using the tolerance. */
begin = first[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge(
"first", i__2, "zzckcv02_", (ftnlen)295)];
finish = last[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge(
"last", i__2, "zzckcv02_", (ftnlen)296)];
if (*tol > 0.) {
/* Computing MAX */
d__1 = begin - *tol;
begin = max(d__1,0.);
finish += *tol;
}
/* Convert the time to TDB if necessary. */
if (istdb) {
sct2e_(sclkid, &begin, &et);
begin = et;
sct2e_(sclkid, &finish, &et);
finish = et;
}
wninsd_(&begin, &finish, schedl);
}
got += get;
}
chkout_("ZZCKCV02", (ftnlen)8);
return 0;
} /* zzckcv02_ */
/* $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 SGFPKT ( Generic Segment: Fetch data packets ) */
/* Subroutine */ int sgfpkt_(integer *handle, doublereal *descr, integer *
first, integer *last, doublereal *values, integer *ends)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer size, b, e, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal dtemp[2];
integer begin1, begin2;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
extern logical failed_(void);
extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *,
integer *), sigerr_(char *, ftnlen);
integer mypdrb;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer soffst;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
integer mypktb, voffst;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
integer mynpdr;
extern logical return_(void);
integer mypdrt, mynpkt, mypkto, mypksz;
/* $ Abstract */
/* Given the descriptor for a generic segment in a DAF file */
/* associated with HANDLE, fetch the data packets indexed from FIRST */
/* to LAST from the packet partition of the generic 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 */
/* DAF Required Reading */
/* $ Keywords */
/* GENERIC SEGMENTS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I The file handle attached to an open DAF. */
/* DESCR I The descriptor associated with a generic segment. */
/* FIRST I The index of the first data packet to fetch. */
/* LAST I The index of the last data packet to fetch. */
/* VALUES O The data packets that have been fetched. */
/* ENDS O An array of pointers to the ends of the packets. */
/* $ Detailed_Input */
/* HANDLE is the handle of a DAF opened for reading that */
/* contains the segment described by DESCR. */
/* DESCR is the descriptor of the segment with the desired */
/* constant values. This must be the descriptor for a */
/* generic segment in the DAF associated with HANDLE. */
/* FIRST is the index of the first value to fetch from the */
/* constants section of the DAF segment described */
/* by DESCR. */
/* LAST is the index of the last value to fetch from the */
/* constants section of the DAF segment described */
/* by DESCR */
/* $ Detailed_Output */
/* VALUES is the array of values constructed by concatenating */
/* requested packets one after the other into */
/* an array. Pictorially we can represent VALUES */
/* as: */
/* +--------------------------+ */
/* | first requested packet | */
/* +--------------------------+ */
/* | second requested packet | */
/* +--------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------+ */
/* | first requested packet | */
/* +--------------------------+ */
/* ENDS is an array of pointers to the ends of the */
/* fetched packets. ENDS(1) gives the index */
/* of the last item of the first packet fetched. */
/* ENDS(2) gives the index of the last item of */
/* the second packet fetched, etc. */
/* $ Parameters */
/* This subroutine makes use of parameters defined in the file */
/* 'sgparam.inc'. */
/* $ Files */
/* See the description of HANDLE above. */
/* $ Exceptions */
/* 1) The error SPICE(REQUESTOUTOFBOUNDS) will be signalled */
/* if FIRST is less than 1 or LAST is greater than the */
/* number of packets. */
/* 2) The error SPICE(REQUESTOUTOFORDER) will be signalled */
/* if LAST is less than FIRST. */
/* 3) The error SPICE(UNKNOWNPACKETDIR) will be signalled if */
/* the packet directory structure is unrecognized. The most */
/* likely cause of this error is that an upgrade to your */
/* version of the SPICE toolkit is needed. */
/* $ Particulars */
/* This routine fetches requested packets from a generic */
/* DAF segment. The two arrays returned have the following */
/* relationship to one another. The first packet returned */
/* resides in VALUES between indexes 1 and ENDS(1). If a */
/* second packet is returned it resides in VALUES between */
/* indices ENDS(1)+1 and ENDS(2). This relations ship is */
/* repeated so that if I is greater than 1 and at least I */
/* packets were returned then the I'th packet resides in */
/* VALUES between index ENDS(I-1) + 1 and ENDS(I). */
/* $ Examples */
/* Suppose that you have located a generic DAF segment (as */
/* identified by the contents of a segment descriptor). The */
/* fragment of code below shows how you could fetch packets */
/* 3 through 7 (assuming that many packets are present). */
/* from the segment. */
/* Declarations: */
/* DOUBLE PRECISION MYPKSZ (<enough room to hold all packets>) */
/* INTEGER ENDS ( 5 ) */
/* INTEGER MYNPKT */
/* get the number of packets */
/* CALL SGMETA ( HANDLE, DESCR, NPKT, MYNPKT ) */
/* finally, fetch the packets from the segment. */
/* IF ( 7 .LE. MYNPKT ) THEN */
/* CALL SGFPKT ( HANDLE, DESCR, 3, 7, MYPKSZ, ENDS ) */
/* END IF */
/* $ Restrictions */
/* The segment described by DESCR must be a generic segment, */
/* otherwise the results of this routine are not predictable. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA calls with DAFGDA. */
/* - SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */
/* Found and fixed a bug in the calculation of the beginning */
/* address for variable length packet fetching. The base address */
/* for the packet directory was not added into the value. This */
/* bug went unnoticed because of a bug in SGSEQW, entry SGWES, */
/* that put absolute addresses into the packet directory rather */
/* than addresses that were relative to the start of the DAF */
/* array. The bug in SGSEQW has also been fixed. */
/* - SPICELIB Version 1.0.0, 06-JAN-1994 (KRG) (WLT) */
/* -& */
/* $ Index_Entries */
/* fetch packets from a generic segment */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Include the mnemonic values. */
/* Local Variables */
/* $ 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. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SGFPKT", (ftnlen)6);
/* Perform the needed initialization */
sgmeta_(handle, descr, &c__12, &mynpkt);
sgmeta_(handle, descr, &c__10, &mypdrt);
sgmeta_(handle, descr, &c__16, &mypkto);
sgmeta_(handle, descr, &c__15, &mypksz);
sgmeta_(handle, descr, &c__11, &mypktb);
if (failed_()) {
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
/* Perform checks on the inputs for reasonableness. */
if (*first < 1 || *last > mynpkt) {
setmsg_("The range of packets requested extends beyond the available"
" packet data. The packet data is available for indexes 1 to"
" #. You've requested data from # to #. ", (ftnlen)159);
errint_("#", &mynpkt, (ftnlen)1);
errint_("#", first, (ftnlen)1);
errint_("#", last, (ftnlen)1);
sigerr_("SPICE(REQUESTOUTOFBOUNDS)", (ftnlen)25);
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
if (*last < *first) {
setmsg_("The last packet requested, #, is before the first packet re"
"quested, #. ", (ftnlen)71);
errint_("#", last, (ftnlen)1);
errint_("#", first, (ftnlen)1);
sigerr_("SPICE(REQUESTOUTOFORDER)", (ftnlen)24);
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
/* We've passed the sanity tests, if the packet directory structure */
/* is recognized fetch the values and ends. We assume that we are */
/* reading data from a correctly constructed generic segment, so we */
/* do not need to worry about the type of reference index, as this is */
/* not needed to fetch a data packet. */
/* Currently, only two packet directory types are supported, and this */
/* subroutine is the only place that this is documented. The types */
/* have values zero (0) and one (1) for, respectively, fixed size */
/* packets and variable size packets. */
if (mypdrt == 0) {
/* All packets have the same size MYPKSZ so the address of the */
/* start of the first packet and end of the last packet are easily */
/* computed. */
if (mypkto == 0) {
/* Compute tha addresses for the packet data in the generic */
/* segment. */
b = mypktb + (*first - 1) * mypksz + 1;
e = mypktb + *last * mypksz;
/* Get the packet data all in one shot since we know it's */
/* contiguous. */
dafgda_(handle, &b, &e, values);
} else {
/* Compute the addresses for the packet data in the generic */
/* segment. Remember that we need to account for an offset */
/* here to get to the start of the actual data packet. */
size = mypksz + mypkto;
/* Get the packet data. Because there is an offset from the */
/* address to the start of the packet data, we need to get */
/* the data one packet at a time rather than all at once. */
i__1 = *last;
for (i__ = *first; i__ <= i__1; ++i__) {
soffst = (i__ - 1) * size + 1;
voffst = (i__ - *first) * mypksz + 1;
b = mypktb + soffst + mypkto;
e = mypktb + soffst + mypksz;
dafgda_(handle, &b, &e, &values[voffst - 1]);
if (failed_()) {
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
}
}
/* Compute the ends for each of the data packets. This is the */
/* same for both of the cases above because we have fixed size */
/* data packets. */
i__1 = *last - *first + 1;
for (i__ = 1; i__ <= i__1; ++i__) {
ends[i__ - 1] = i__ * mypksz;
}
} else {
/* In addition to the other meta data items already retrieved, we */
/* will also need a few others. */
sgmeta_(handle, descr, &c__8, &mypdrb);
sgmeta_(handle, descr, &c__9, &mynpdr);
if (failed_()) {
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
/* Each packet has a different size, so we need to fetch each one */
/* individually, keeping track of the ends and things. We assume */
/* that there is enough room in the array of values to hold all of */
/* the packets. For the variable packet case, however, we do not */
/* need to treat the implicit indexing and explicit indexing cases */
/* separately. */
voffst = 1;
i__1 = *last - *first + 1;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute the addresses in the generic segment for the */
/* beginning of data packets I and I+1. We need these to */
/* compute the size of the packet. */
b = mypdrb + *first + i__ - 1;
e = b + 1;
/* Get the beginning addresses for the two data packets and */
/* convert them into integers. */
dafgda_(handle, &b, &e, dtemp);
if (failed_()) {
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
begin1 = (integer) dtemp[0];
begin2 = (integer) dtemp[1];
/* Compute the size of data packet I, remembering to deal with */
/* the packet offset that might be present, and the beginning */
/* and ending addresses for the packet data. */
size = begin2 - begin1 - mypkto;
b = mypktb + begin1;
e = b + size - 1;
/* Get the data for packet I. */
dafgda_(handle, &b, &e, &values[voffst - 1]);
if (failed_()) {
chkout_("SGFPKT", (ftnlen)6);
return 0;
}
/* Compute the end for packet I and store it. */
voffst += size;
ends[i__ - 1] = voffst - 1;
}
}
chkout_("SGFPKT", (ftnlen)6);
return 0;
} /* sgfpkt_ */
