/* $Procedure SPKCOV ( SPK coverage ) */
/* Subroutine */ int spkcov_(char *spk, integer *idcode, doublereal *cover,
ftnlen spk_len)
{
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
char arch[80];
extern /* Subroutine */ int dafgs_(doublereal *), chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
logical found;
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
integer handle;
extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *,
char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
setmsg_(char *, ftnlen), wninsd_(doublereal *, doublereal *,
doublereal *);
char kertyp[80];
extern logical return_(void);
/* $ Abstract */
/* Find the coverage window for a specified ephemeris object in a */
/* specified SPK file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CELLS */
/* DAF */
/* SPK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* EPHEMERIS */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SPK I Name of SPK file. */
/* IDCODE I ID code of ephemeris object. */
/* COVER I/O Window giving coverage in SPK for IDCODE. */
/* $ Detailed_Input */
/* SPK is the name of an SPK file. */
/* IDCODE is the integer ID code of an object for which */
/* ephemeris data are expected to exist in the */
/* specified SPK file. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file SPK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. This is */
/* the set of time intervals for which data for */
/* IDCODE are present in the file SPK, merged with */
/* the set of time intervals present in COVER on */
/* input. The merged coverage is represented as the */
/* union of one or more disjoint time intervals. The */
/* window COVER contains the pairs of endpoints of */
/* these intervals. */
/* The interval endpoints contained in COVER are */
/* ephemeris times, expressed as seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* SPK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the SPK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output window argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* $ Files */
/* This routine reads an SPK file. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified SPK file provides for a specified */
/* ephemeris object. */
/* $ Examples */
/* 1) This example demonstrates combined usage of SPKCOV and the */
/* related SPK utility SKOBJ. */
/* Display the coverage for each object in a specified SPK file. */
/* Find the set of objects in the file; for each object, find */
/* and display the coverage. */
/* PROGRAM IDCOV */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER CARDI */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 1000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SPK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel for output time conversion. */
/* C SPKCOV itself does not require a leapseconds kernel. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* C */
/* C Get name of SPK file. */
/* C */
/* CALL PROMPT ( 'Name of SPK file > ', SPK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the SPK file. */
/* C */
/* CALL SPKOBJ ( SPK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL SPKCOV ( SPK, IDS(I), COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD ( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the coverage for the object designated by IDCODE */
/* provided by the set of SPK files loaded via a metakernel. */
/* (The metakernel must also specify a leapseconds kernel.) */
/* PROGRAM METCOV */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the SPK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded SPK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'SPK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'SPK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL SPKCOV ( FILE, IDCODE, COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD ( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) If an error occurs while this routine is updating the window */
/* COVER, the window may be corrupted. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 01-JUL-2014 (NJB) */
/* Added new index entries. */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 30-DEC-2004 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for spk_object */
/* get coverage start and stop time for spk_object */
/* get coverage start and stop time for ephemeris_object */
/* get coverage start and stop time for body */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKCOV", (ftnlen)6);
/* See whether GETFAT thinks we've got a binary SPK file. */
/* If not, indicate the specific problem. */
getfat_(spk, arch, kertyp, spk_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"SPK file to be readable by this routine. If the input file "
"is an SPK file in transfer format, run TOBIN on the file to "
"convert it to binary format.", (ftnlen)207);
errch_("#", spk, (ftnlen)1, spk_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("SPKCOV", (ftnlen)6);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"SPK file to be readable by this routine. Binary SPK files h"
"ave DAF architecture. If you expected the file to be a bina"
"ry SPK file, the problem may be due to the file being an old"
" non-native file lacking binary file format information. It'"
"s also possible the file has been corrupted.", (ftnlen)343);
errch_("#", spk, (ftnlen)1, spk_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("SPKCOV", (ftnlen)6);
return 0;
} else if (s_cmp(kertyp, "SPK", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has file type #. The file must be a binary SPK"
" file to be readable by this routine. If you expected the fi"
"le to be a binary SPK file, the problem may be due to the fi"
"le being an old non-native file lacking binary file format i"
"nformation. It's also possible the file has been corrupted.",
(ftnlen)298);
errch_("#", spk, (ftnlen)1, spk_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("SPKCOV", (ftnlen)6);
return 0;
}
/* Open the file for reading. */
dafopr_(spk, &handle, spk_len);
if (failed_()) {
chkout_("SPKCOV", (ftnlen)6);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found && ! failed_()) {
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
if (ic[0] == *idcode) {
/* This segment is for the body of interest. Insert the */
/* coverage bounds into the coverage window. */
wninsd_(dc, &dc[1], cover);
}
daffna_(&found);
}
/* Release the file. */
dafcls_(&handle);
chkout_("SPKCOV", (ftnlen)6);
return 0;
} /* spkcov_ */
/* $Procedure DAFRA ( DAF, Re-order arrays ) */
/* Subroutine */ int dafra_(integer *handle, integer *iorder, integer *n)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer hold, i__;
extern /* Subroutine */ int dafgn_(char *, ftnlen), dafgs_(doublereal *),
dafrn_(char *, ftnlen), chkin_(char *, ftnlen);
char holdn[1000];
extern /* Subroutine */ int dafws_(doublereal *);
integer index;
doublereal holds[128];
logical found;
char tempn[1000];
integer total;
doublereal temps[128];
integer start;
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *), sigerr_(char *, ftnlen),
chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical isordv_(integer *, integer *), return_(void);
/* $ Abstract */
/* Re-order the arrays in a DAF according to a given order */
/* vector. */
/* $ 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 */
/* $ Keywords */
/* FILES */
/* SORT */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of DAF. */
/* IORDER I Order vector. */
/* N I Dimension of IORDER. */
/* $ Detailed_Input */
/* HANDLE is the handle of a DAF that has been opened for */
/* write access. Use DAFOPW, for example, to open */
/* an existing file and get its handle. */
/* IORDER is the order vector to be used to re-order the */
/* arrays stored in the DAF specified by HANDLE. */
/* An integer order vector is an array of length */
/* N whose elements are the integers 1 through N. */
/* The first element of IORDER is the index of the */
/* first array in the re-ordered file, and so on. */
/* N is the number of elements in the order vector. */
/* This may be less than the number of arrays in */
/* the file. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* DAFRA does not actually move the elements of the double */
/* precision arrays; it works by rearranging the contents */
/* of the summary and name records in the file. The result */
/* is that the search routines (BFS, FNA, BBS, FPA) will */
/* return the arrays in the indicated order. */
/* After re-ordering, array IORDER(1) of the input file is the */
/* first array of the output file, array IORDER(2) of the input */
/* file is the second array of the output file, and so on. */
/* The order vector used by DAFRA is typically created for */
/* a related array by one of the ORDER routines, as shown in */
/* the example below. */
/* $ Examples */
/* The following code fragment sorts the arrays in a DAF by name. */
/* C */
/* C Collect the names of the arrays in the file. */
/* C */
/* CALL DAFOPW ( FILE, HANDLE ) */
/* N = 0 */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( FOUND ) */
/* DO WHILE ( FOUND ) */
/* N = N + 1 */
/* CALL DAFGN ( NAMES(I) ) */
/* CALL DAFFNA ( FOUND ) */
/* END DO */
/* C */
/* C Sort the names. */
/* C */
/* CALL ORDERC ( NAMES, N, IORDER ) */
/* C */
/* C Re-order the arrays. */
/* C */
/* CALL DARFA ( HANDLE, IORDER, N ) */
/* CALL DAFCLS ( HANDLE ) */
/* Afterward, a forward search like the one shown below */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( FOUND ) */
/* DO WHILE ( FOUND ) */
/* CALL DAFGN ( NAME ) */
/* WRITE (*,*) NAME */
/* CALL DAFFNA ( FOUND ) */
/* END DO */
/* produces an ordered list of the names in the sorted file. */
/* $ Restrictions */
/* None. */
/* $ Exceptions */
/* 1) If IORDER is not an order vector (that is, if it does */
/* not contain every integer between 1 and N), the error */
/* SPICE(DISORDER) is signalled. */
/* 2) If N is greater than the number of arrays in the file, */
/* the error SPICE(DISARRAY) is signalled. */
/* $ Files */
/* See argument HANDLE. */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 28-MAR-1991 (IMU) */
/* -& */
/* $ Index_Entries */
/* reorder daf arrays */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DAFRA", (ftnlen)5);
}
/* If the order vector has fewer than two elements, don't bother. */
if (*n < 2) {
chkout_("DAFRA", (ftnlen)5);
return 0;
}
/* If IORDER is not an order vector, complain. */
if (! isordv_(iorder, n)) {
setmsg_("Sorry, IORDER is not an order vector.", (ftnlen)37);
sigerr_("SPICE(DISORDER)", (ftnlen)15);
chkout_("DAFRA", (ftnlen)5);
return 0;
}
/* If the number of arrays to be moved exceeds the number of */
/* arrays in the file, complain. */
total = 0;
dafbfs_(handle);
daffna_(&found);
while(found && ! failed_()) {
++total;
daffna_(&found);
}
if (failed_()) {
chkout_("DAFRA", (ftnlen)5);
return 0;
} else if (total < *n) {
setmsg_("N (#) exceeds number of arrays (#).", (ftnlen)35);
errint_("#", n, (ftnlen)1);
errint_("#", &total, (ftnlen)1);
sigerr_("SPICE(DISARRAY)", (ftnlen)15);
chkout_("DAFRA", (ftnlen)5);
return 0;
}
/* Not surprisingly, this routine is patterned closely after the */
/* (original) REORDx routines in SPICELIB. The only differences */
/* are that */
/* 1) This routine is not error free---it checks to make */
/* sure that IORDER is in fact an order vector, and that */
/* every element in IORDER refers to an existing array. */
/* 2) Instead of moving elements of an array in and out of */
/* a temporary location, it moves summaries and names. */
/* This means that two sets of temporary storage locations */
/* are needed: one to hold the summary and name of the */
/* guy who began the current cycle; and one to hold the guy */
/* being moved from location HOLD to location INDEX. */
start = 1;
while(start < *n && ! failed_()) {
/* Start the cycle. One guy (pair of summary and name record) */
/* has to sit out (in HOLDS and HOLDN) until the end of the cycle */
/* is reached. */
index = start;
hold = iorder[index - 1];
dafbfs_(handle);
i__1 = index;
for (i__ = 1; i__ <= i__1; ++i__) {
daffna_(&found);
}
dafgs_(holds);
dafgn_(holdn, (ftnlen)1000);
/* Move guys from HOLD to INDEX; then update HOLD (to point */
/* to the next guy to be moved) and INDEX (to point at the */
/* space just vacated). */
/* Keep going until HOLD points to the first guy moved during */
/* the current cycle. This ends the cycle. */
while(hold != start) {
/* Get the guy in position HOLD. */
dafbfs_(handle);
i__1 = hold;
for (i__ = 1; i__ <= i__1; ++i__) {
daffna_(&found);
}
dafgs_(temps);
dafgn_(tempn, (ftnlen)1000);
/* Move him to position INDEX. (Note that DAFWS is used to */
/* update the summary instead of DAFRS, because the addresses */
/* are actually being changed.) */
dafbfs_(handle);
i__1 = index;
for (i__ = 1; i__ <= i__1; ++i__) {
daffna_(&found);
}
dafws_(temps);
dafrn_(tempn, (ftnlen)1000);
/* Update HOLD and INDEX. */
index = hold;
hold = iorder[hold - 1];
iorder[index - 1] = -iorder[index - 1];
}
/* The last element in the cycle is restored from TEMP. */
dafbfs_(handle);
i__1 = index;
for (i__ = 1; i__ <= i__1; ++i__) {
daffna_(&found);
}
dafws_(holds);
dafrn_(holdn, (ftnlen)1000);
iorder[hold - 1] = -iorder[hold - 1];
/* Begin the next cycle at the next element in the order */
/* vector with a positive sign. (That is, the next one */
/* that hasn't been moved.) */
while(iorder[start - 1] < 0 && start < *n) {
++start;
}
}
/* Restore the original signs of the elements of the order */
/* vector, for the next go around. */
i__1 = *n;
for (index = 1; index <= i__1; ++index) {
iorder[index - 1] = (i__2 = iorder[index - 1], abs(i__2));
}
chkout_("DAFRA", (ftnlen)5);
return 0;
} /* dafra_ */
/* $Procedure CKCOV ( CK coverage ) */
/* Subroutine */ int ckcov_(char *ck, integer *idcode, logical *needav, char *
level, doublereal *tol, char *timsys, doublereal *cover, ftnlen
ck_len, ftnlen level_len, ftnlen timsys_len)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
char arch[80];
logical avok;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int dafgs_(doublereal *);
integer clkid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dctol[2];
logical istdb, found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer dtype;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
doublereal et;
integer handle, segbeg;
extern /* Subroutine */ int dafcls_(integer *), ckmeta_(integer *, char *,
integer *, ftnlen);
integer segend;
extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen,
ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen);
logical seglvl;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), wninsd_(doublereal *, doublereal *, doublereal *),
errint_(char *, integer *, ftnlen);
char kertyp[80];
extern logical return_(void);
extern /* Subroutine */ int zzckcv01_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv02_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv03_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv04_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv05_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, char *, doublereal *,
ftnlen);
/* $ Abstract */
/* Find the coverage window for a specified object in a specified CK */
/* file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CELLS */
/* DAF */
/* CK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* POINTING */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CK I Name of CK file. */
/* IDCODE I ID code of object. */
/* NEEDAV I Flag indicating whether angular velocity is needed. */
/* LEVEL I Coverage level: 'SEGMENT' OR 'INTERVAL'. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* COVER I/O Window giving coverage for IDCODE. */
/* $ Detailed_Input */
/* CK is the name of a C-kernel. */
/* IDCODE is the integer ID code of an object, normally */
/* a spacecraft structure or instrument, for which */
/* pointing data are expected to exist in the */
/* specified CK file. */
/* NEEDAV is a logical variable indicating whether only */
/* segments having angular velocity are to be */
/* considered when determining coverage. When */
/* NEEDAV is .TRUE., segments without angular */
/* velocity don't contribute to the coverage */
/* window; when NEEDAV is .FALSE., all segments for */
/* IDCODE may contribute to the coverage window. */
/* LEVEL is the level (granularity) at which the coverage */
/* is examined. Allowed values and corresponding */
/* meanings are: */
/* 'SEGMENT' The output coverage window */
/* contains intervals defined by the */
/* start and stop times of segments */
/* for the object designated by */
/* IDCODE. */
/* 'INTERVAL' The output coverage window */
/* contains interpolation intervals */
/* of segments for the object */
/* designated by IDCODE. For type 1 */
/* segments, which don't have */
/* interpolation intervals, each */
/* epoch associated with a pointing */
/* instance is treated as a singleton */
/* interval; these intervals are */
/* added to the coverage window. */
/* All interpolation intervals are */
/* considered to lie within the */
/* segment bounds for the purpose of */
/* this summary: if an interpolation */
/* interval extends beyond the */
/* segment coverage interval, only */
/* its intersection with the segment */
/* coverage interval is considered to */
/* contribute to the total coverage. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with IDCODE. Before */
/* each interval is inserted into the coverage */
/* window, the interval is intersected with the */
/* segment coverage interval, then if the */
/* intersection is non-empty, it is expanded by TOL: */
/* the left endpoint of the intersection interval is */
/* reduced by TOL and the right endpoint is increased */
/* by TOL. Adjusted interval endpoints, when */
/* expressed as encoded SCLK, never are less than */
/* zero ticks. Any intervals that overlap as a */
/* result of the expansion are merged. */
/* The coverage window returned when TOL > 0 */
/* indicates the coverage provided by the file to the */
/* CK readers CKGPAV and CKGP when that value of TOL */
/* is passed to them as an input. */
/* TIMSYS is a string indicating the time system used */
/* in the output coverage window. TIMSYS may */
/* have the values: */
/* 'SCLK' Elements of COVER are expressed in */
/* encoded SCLK ("ticks"), where the */
/* clock is associated with the object */
/* designated by IDCODE. */
/* 'TDB' Elements of COVER are expressed as */
/* seconds past J2000 TDB. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file CK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. When */
/* the coverage level is 'INTERVAL', this is the set */
/* of time intervals for which data for IDCODE are */
/* present in the file CK, merged with the set of */
/* time intervals present in COVER on input. The */
/* merged coverage is represented as the union of one */
/* or more disjoint time intervals. The window COVER */
/* contains the pairs of endpoints of these */
/* intervals. */
/* When the coverage level is 'SEGMENT', COVER is */
/* computed in a manner similar to that described */
/* above, but the coverage intervals used in the */
/* computation are those of segments rather than */
/* interpolation intervals within segments. */
/* When TOL is > 0, the intervals comprising the */
/* coverage window for IDCODE are expanded by TOL and */
/* any intervals overlapping as a result are merged. */
/* The resulting window is returned in COVER. The */
/* expanded window in no case extends beyond the */
/* segment bounds in either direction by more than */
/* TOL. */
/* The interval endpoints contained in COVER are */
/* encoded spacecraft clock times if TIMSYS is */
/* 'SCLK'; otherwise the times are converted from */
/* encoded spacecraft clock to seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* CK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the CK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output WINDOW argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* 6) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 7) If LEVEL is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 8) If TIMSYS is not recognized, the error SPICE(NOTSUPPORTED) */
/* is signaled. */
/* 9) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 10) If the output time system is TDB, the CK subsystem must be */
/* able to map IDCODE to the ID code of the associated */
/* spacecraft clock. If this mapping cannot be performed, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* This routine reads a C-kernel. */
/* If the output time system is 'TDB', then a leapseconds kernel */
/* and an SCLK kernel for the spacecraft clock associated with */
/* IDCODE must be loaded before this routine is called. */
/* If the ID code of the clock associated with IDCODE is not */
/* equal to */
/* IDCODE / 1000 */
/* then the kernel variable */
/* CK_<IDCODE>_SCLK */
/* must be present in the kernel pool to identify the clock */
/* associated with IDCODE. This variable must contain the ID code */
/* to be used for conversion between SCLK and TDB. Normally this */
/* variable is provided in a text kernel loaded via FURNSH. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified CK file provides for a specified */
/* object. */
/* $ Examples */
/* 1) Display the interval-level coverage for each object in a */
/* specified CK file. Use tolerance of zero ticks. Do not */
/* request angular velocity. Express the results in the TDB time */
/* system. */
/* Find the set of objects in the file. Loop over the contents */
/* of the ID code set: find the coverage for each item in the */
/* set and display the coverage. */
/* PROGRAM CKCVR */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* INTEGER CARDI */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 100000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) CK */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SCLK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel and SCLK kernel for output */
/* C time conversion. Note that we assume a single spacecraft */
/* C clock is associated with all of the objects in the CK. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Get name of CK file. */
/* C */
/* CALL PROMPT ( 'Name of CK file > ', CK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the CK file. */
/* C */
/* CALL CKOBJ ( CK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL CKCOV ( CK, IDS(I), .FALSE., */
/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the segment-level coverage for the object designated by */
/* IDCODE provided by the set of CK files loaded via a */
/* metakernel. (The metakernel must also specify leapseconds and */
/* SCLK kernels.) Use tolerance of zero ticks. Do not request */
/* angular velocity. Express the results in the TDB time system. */
/* PROGRAM CKMET */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the CK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel and an SCLK */
/* C kernel for the clock associated with IDCODE. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded CK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'CK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'CK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL CKCOV ( FILE, IDCODE, .FALSE., */
/* . 'SEGMENT', 0.0, 'TDB', COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) When this routine is used to accumulate coverage for IDCODE */
/* provided by multiple CK files, the inputs NEEDAV, LEVEL, TOL, */
/* and TIMSYS must have the same values for all files in order */
/* for the result to be meaningful. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for ck object */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKCOV", (ftnlen)5);
/* Check tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative; actual value was #.", (
ftnlen)51);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Use a logical flag to indicate whether this is a segment-level */
/* coverage description. */
seglvl = eqstr_(level, "SEGMENT", level_len, (ftnlen)7);
/* Check coverage level keyword. */
if (! (seglvl || eqstr_(level, "INTERVAL", level_len, (ftnlen)8))) {
setmsg_("Allowed values of LEVEL are # and #; actual value was #.", (
ftnlen)56);
errch_("#", "SEGMENT", (ftnlen)1, (ftnlen)7);
errch_("#", "INTERVAL", (ftnlen)1, (ftnlen)8);
errch_("#", level, (ftnlen)1, level_len);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* See whether GETFAT thinks we've got a CK file. */
getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. If the input file i"
"s an CK file in transfer format, run TOBIN on the file to co"
"nvert it to binary format.", (ftnlen)205);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. Binary CK files hav"
"e DAF architecture. If you expected the file to be a binary"
" CK file, the problem may be due to the file being an old no"
"n-native file lacking binary file format information. It's a"
"lso possible the file has been corrupted.", (ftnlen)340);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) {
setmsg_("Input file # has file type #. The file must be a binary CK "
"file to be readable by this routine. If you expected the fil"
"e to be a binary CK file, the problem may be due to the file"
" being an old non-native file lacking binary file format inf"
"ormation. It's also possible the file has been corrupted.", (
ftnlen)296);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Set a logical flag indicating whether the time systm is SCLK. */
istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
/* Check time system. */
if (! istdb) {
if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
"and TDB.", (ftnlen)63);
errch_("#", timsys, (ftnlen)1, timsys_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* If the output time system is TDB, find the clock ID associated */
/* with IDCODE. */
if (istdb) {
ckmeta_(idcode, "SCLK", &clkid, (ftnlen)4);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* Open the file for reading. */
dafopr_(ck, &handle, ck_len);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* If TOL > 0, we'll apply TOL after we've found the coverage */
/* for the zero-tolerance case. */
/* If the time system is TDB, we'll convert the times to TDB */
/* at the end of this routine. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found) {
/* Note: we check FAILED() at the bottom of this loop; this */
/* routine returns if FAILED() returns .TRUE. at that point. */
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
/* Let AVOK indicate whether the segment satisfies the */
/* angular velocity restriction. */
avok = ic[3] == 1 || ! (*needav);
if (ic[0] == *idcode && avok) {
/* This segment is for the body of interest. If angular */
/* velocity is needed, this segment has it. */
if (seglvl) {
/* This is a segment-level summary. */
/* Insert the coverage bounds into the coverage window. */
/* Adjust the interval using the tolerance. */
/* Computing MAX */
d__1 = dc[0] - *tol;
dctol[0] = max(d__1,0.);
dctol[1] = dc[1] + *tol;
/* Convert the time to TDB if necessary. */
if (istdb) {
/* Convert the time bounds to TDB before inserting */
/* into the window. */
for (i__ = 1; i__ <= 2; ++i__) {
sct2e_(&clkid, &dctol[(i__1 = i__ - 1) < 2 && 0 <=
i__1 ? i__1 : s_rnge("dctol", i__1, "ckcov_",
(ftnlen)868)], &et);
dctol[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("dctol", i__1, "ckcov_", (ftnlen)869)]
= et;
}
}
if (dctol[0] <= dctol[1]) {
wninsd_(dctol, &dctol[1], cover);
}
} else {
/* We're looking for an interval-level coverage window. */
/* This information must be retrieved in a */
/* data-type-dependent fashion. The coverage routines */
/* we'll call will, if necessary, adjust intervals by TOL */
/* and convert interval times to TDB. */
dtype = ic[2];
segbeg = ic[4];
segend = ic[5];
if (dtype == 1) {
zzckcv01_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 2) {
zzckcv02_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 3) {
zzckcv03_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 4) {
zzckcv04_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 5) {
/* Note: this calling sequence is exceptional; the */
/* segment bounds are an input. */
zzckcv05_(&handle, &segbeg, &segend, &clkid, dc, tol,
timsys, cover, timsys_len);
} else {
setmsg_("Supported CK data types are 1, 2, 3, 4, 5. Dat"
"a type of segment: #. This problem may indicate "
"that you need to update your SPICE Toolkit.", (
ftnlen)138);
errint_("#", &dtype, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
}
daffna_(&found);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* COVER now represents the coverage of the entire file at the */
/* granularity indicated by LEVEL, combined with the coverage */
/* contained in COVER on input. */
/* Release the file. */
dafcls_(&handle);
chkout_("CKCOV", (ftnlen)5);
return 0;
} /* ckcov_ */
