/* $ Procedure CONVBT ( Convert Kernel file from binary to text ) */
/* Subroutine */ int convbt_(char *binfil, char *txtfil, ftnlen binfil_len,
ftnlen txtfil_len)
{
/* System generated locals */
cllist cl__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *), s_wsle(
cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(
void);
/* Local variables */
extern /* Subroutine */ int dafbt_(char *, integer *, ftnlen);
char farch[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), spcec_(integer *,
integer *), dasbt_(char *, integer *, ftnlen), errch_(char *,
char *, ftnlen, ftnlen);
char ftype[4];
extern logical failed_(void);
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);
integer iostat;
logical comnts;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen);
integer txtlun;
/* Fortran I/O blocks */
static cilist io___7 = { 1, 0, 0, 0, 0 };
static cilist io___8 = { 1, 0, 0, 0, 0 };
/* $ Abstract */
/* Convert a SPICE binary file to an equivalent text file format. */
/* NOTE: This routine is currently for use ONLY with the SPACIT */
/* utility program. Use it at your own risk. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CONVERSION */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* BINFIL I Name of an existing SPICE binary file. */
/* TXTFIL I Name of the text file to be created. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) */
/* $ Particulars */
/* This routine accepts as inputs the name of a binary file to be */
/* converted to text and the name of the text file to be created. */
/* The binary file must already exist and the text file must not */
/* exist for this routine to work correctly. The architecture and the */
/* file type are determined and then an appropriate file conversion */
/* is performed. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* 1) */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - Beta Version 3.2.0, 30-AUG-1994 (KRG) */
/* Improved the error diagnostics when incorrect inputs are */
/* provided, e.g., a transfer filename instead of a binary kernel */
/* filename. */
/* - Beta Version 3.1.0, 12-AUG-1994 (KRG) */
/* Fixed a minor bug that would occur when formatting a long error */
/* message. ERRFNM was called with a logical unit that had already */
/* been closed. */
/* - Beta Version 3.0.0, 22-APR-1994 (KRG) */
/* Made updates to the routine to make use of the new SPICE */
/* capability of determining binary kernel file types at run time. */
/* Removed the arguments for the file architecture and file type */
/* from the calling list. This information was no longer */
/* necessary. */
/* Rearranged some of the code to make it easier to understand. */
/* Added a new error: if the architecture or type are not */
/* recognized, we can't process the file. */
/* - Beta Version 2.0.0, 28-JAN-1994 (KRG) */
/* -& */
/* $ Index_Entries */
/* convert binary SPICE files to text */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Begin and end markers in the file for the comment area. */
/* File types that are recognized. */
/* Length of a file architecture. */
/* Maximum length for a file type. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CONVBT", (ftnlen)6);
}
/* Initialize the file architecture and the file type. */
s_copy(farch, " ", (ftnlen)3, (ftnlen)1);
s_copy(ftype, " ", (ftnlen)4, (ftnlen)1);
/* Get the architecture and type of the binary file. */
getfat_(binfil, farch, ftype, binfil_len, (ftnlen)3, (ftnlen)4);
if (failed_()) {
/* If there was an error getting the file architecture, just */
/* return. An appropriate error message should have been set. */
/* So, all we need to do here is return to the caller. */
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Check to see that we got back a valid architecture and type. */
/* Open the text file for output, obtaining a Fortran logical */
/* unit. */
txtopn_(txtfil, &txtlun, txtfil_len);
if (failed_()) {
/* If there was an error opening the text file, just return. */
/* An appropriate error message should have been set by TXTOPN. */
/* So, all we need to do here is return to the caller. */
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Process the files based on their binary architectures */
if (s_cmp(farch, "DAF", (ftnlen)3, (ftnlen)3) == 0) {
/* If the file is a NAIF SPK, CK, or PCK binary file, it may have */
/* a comment area. So set the COMNTS flag appropriately. */
comnts = s_cmp(ftype, "SPK", (ftnlen)4, (ftnlen)3) == 0;
comnts = comnts || s_cmp(ftype, "CK", (ftnlen)4, (ftnlen)2) == 0;
comnts = comnts || s_cmp(ftype, "PCK", (ftnlen)4, (ftnlen)3) == 0;
/* First, convert the data portion of the binary file to text. */
/* We only support the latest and greatest text file format for */
/* conversion of the binary files to text. */
dafbt_(binfil, &txtlun, binfil_len);
if (failed_()) {
/* If an error occurred while attempting to convert the */
/* data portion of the DAF file to text, we need to close */
/* the text file and return to the caller. We will delete */
/* the text file when we close it. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* The DAF file may or may not have a comment area. If it is a */
/* NAIF SPICE kernel file, then it does and we need to deal with */
/* it. Otherwise we do nothing. */
if (comnts) {
/* We need to open the binary DAF file so that we can extract */
/* the comments from its comment area and place them in the */
/* text file. */
dafopr_(binfil, &handle, binfil_len);
if (failed_()) {
/* If an error occurred, we need to close the text file and */
/* return to the caller. We will delete the text file when */
/* we close it. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Write the begin comments marker to the text file. */
io___7.ciunit = txtlun;
iostat = s_wsle(&io___7);
if (iostat != 0) {
goto L100001;
}
iostat = do_lio(&c__9, &c__1, "~NAIF/SPC BEGIN COMMENTS~", (
ftnlen)25);
if (iostat != 0) {
goto L100001;
}
iostat = e_wsle();
L100001:
if (iostat != 0) {
/* An error occurred, so close both the text and binary */
/* files, set an appropriate error message, and return to */
/* the caller. The text file is deleted when it is closed. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
dafcls_(&handle);
setmsg_("Error writing the begin comments marker to the text"
" file: #. IOSTAT = #.", (ftnlen)72);
errch_("#", txtfil, (ftnlen)1, txtfil_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Extract the comment area of the binary file to the text */
/* file. */
spcec_(&handle, &txtlun);
if (failed_()) {
/* If the comment extraction failed, then an appropriate */
/* error message should have already been set, so close */
/* the text and binary files and return to the caller. The */
/* text file is deleted when it is closed. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Write the end comments marker. */
io___8.ciunit = txtlun;
iostat = s_wsle(&io___8);
if (iostat != 0) {
goto L100002;
}
iostat = do_lio(&c__9, &c__1, "~NAIF/SPC END COMMENTS~", (ftnlen)
23);
if (iostat != 0) {
goto L100002;
}
iostat = e_wsle();
L100002:
if (iostat != 0) {
/* An error occurred, so close both the text and binary */
/* files, set an appropriate error message, and return to */
/* the caller. The text file is deleted when it is closed. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
dafcls_(&handle);
setmsg_("Error writing the end comments marker to the text f"
"ile: #. IOSTAT = #.", (ftnlen)70);
errch_("#", txtfil, (ftnlen)1, txtfil_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Close the binary DAF file that we opened to extract the */
/* comments. */
dafcls_(&handle);
}
} else if (s_cmp(farch, "DAS", (ftnlen)3, (ftnlen)3) == 0) {
/* DAS files are easy. Everything is integrated into the files */
/* so we do not need to worry about comments or reserved records */
/* or anything. We just convert it. */
/* Convert the data portion of the binary file to text. We */
/* only support the latest and greatest text file format for */
/* conversion of the binary files to text. */
dasbt_(binfil, &txtlun, binfil_len);
if (failed_()) {
/* If an error occurred while attempting to convert the */
/* DAS file to text, we need to close the text file and */
/* return to the caller. We will delete the text file */
/* when we close it. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
} else if (s_cmp(farch, "XFR", (ftnlen)3, (ftnlen)3) == 0) {
/* This is an error case, most likely caused by reading a transfer */
/* file by accident. So signal an appropriate error. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
setmsg_("The file '#' appears to be a transfer file and not a binary"
" kernel file.", (ftnlen)72);
errch_("#", binfil, (ftnlen)1, binfil_len);
sigerr_("SPICE(NOTABINARYKERNEL)", (ftnlen)23);
chkout_("CONVBT", (ftnlen)6);
return 0;
} else if (s_cmp(farch, "DEC", (ftnlen)3, (ftnlen)3) == 0) {
/* This is an error case, most likely caused by reading a transfer */
/* file by accident. So signal an appropriate error. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
setmsg_("The file '#' appears to be a decimal transfer file and not "
"a binary kernel file.", (ftnlen)80);
errch_("#", binfil, (ftnlen)1, binfil_len);
sigerr_("SPICE(NOTABINARYKERNEL)", (ftnlen)23);
chkout_("CONVBT", (ftnlen)6);
return 0;
} else {
/* This is the catch all error case. At this point, we didn't */
/* match any of the files whose architecture and types are */
/* recognized. So, we toss our hands in the air and signal an */
/* error. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = "DELETE";
f_clos(&cl__1);
setmsg_("The architecture and type of the file '#' were not recogniz"
"ed.", (ftnlen)62);
errch_("#", binfil, (ftnlen)1, binfil_len);
sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20);
chkout_("CONVBT", (ftnlen)6);
return 0;
}
/* Close the text file that was created. */
cl__1.cerr = 0;
cl__1.cunit = txtlun;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("CONVBT", (ftnlen)6);
return 0;
} /* convbt_ */
/* $Procedure GETFAT ( Get file architecture and type ) */
/* Subroutine */ int getfat_(char *file, char *arch, char *kertyp, ftnlen
file_len, ftnlen arch_len, ftnlen kertyp_len)
{
/* System generated locals */
integer i__1;
cilist ci__1;
olist o__1;
cllist cl__1;
inlist ioin__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), s_rnge(
char *, integer, char *, integer), f_open(olist *), s_rdue(cilist
*), do_uio(integer *, char *, ftnlen), e_rdue(void), f_clos(
cllist *), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
e_rsfe(void);
/* Local variables */
integer unit;
extern /* Subroutine */ int zzddhfnh_(char *, integer *, logical *,
ftnlen), zzddhgsd_(char *, integer *, char *, ftnlen, ftnlen),
zzddhnfo_(integer *, char *, integer *, integer *, integer *,
logical *, ftnlen), zzddhhlu_(integer *, char *, logical *,
integer *, ftnlen);
integer i__;
extern integer cardi_(integer *);
char fname[255];
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen);
integer which;
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
logical found, exist;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
idw2at_(char *, char *, char *, ftnlen, ftnlen, ftnlen);
integer handle;
extern /* Subroutine */ int dafcls_(integer *);
char filarc[32];
extern /* Subroutine */ int dashof_(integer *);
integer intbff;
logical opened;
extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen);
integer intarc;
extern /* Subroutine */ int dashlu_(integer *, integer *);
char idword[12];
integer intamn, number;
logical diropn, notdas;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), getlun_(integer *), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen), ssizei_(
integer *, integer *), nextwd_(char *, char *, char *, ftnlen,
ftnlen, ftnlen);
char tmpwrd[12];
extern logical return_(void);
integer myunit, handles[106];
extern /* Subroutine */ int zzckspk_(integer *, char *, ftnlen);
/* Fortran I/O blocks */
static cilist io___19 = { 1, 0, 1, 0, 1 };
/* $ Abstract */
/* Determine the architecture and type of SPICE kernels. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* KERNEL */
/* UTILITY */
/* $ Declarations */
/* $ Abstract */
/* Parameter declarations for the DAF/DAS handle manager. */
/* $ 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, DAS */
/* $ Keywords */
/* PRIVATE */
/* $ Particulars */
/* This include file contains parameters defining limits and */
/* integer codes that are utilized in the DAF/DAS handle manager */
/* routines. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.5.0, 10-MAR-2014 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-INTEL. */
/* - SPICELIB Version 2.4.0, 10-MAR-2014 (BVS) */
/* Updated for PC-LINUX-64BIT-IFORT. */
/* - SPICELIB Version 2.3.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-GFORTRAN. */
/* - SPICELIB Version 2.2.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
/* - SPICELIB Version 2.1.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GCC_C. */
/* - SPICELIB Version 2.0.0, 12-APR-2012 (BVS) */
/* Increased FTSIZE (from 1000 to 5000). */
/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 1.0.1, 17-JUL-2002 */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 1.0.0, 07-NOV-2001 */
/* -& */
/* Unit and file table size parameters. */
/* FTSIZE is the maximum number of files (DAS and DAF) that a */
/* user may have open simultaneously. */
/* RSVUNT is the number of units protected from being locked */
/* to a particular handle by ZZDDHHLU. */
/* SCRUNT is the number of units protected for use by scratch */
/* files. */
/* UTSIZE is the maximum number of logical units this manager */
/* will utilize at one time. */
/* Access method enumeration. These parameters are used to */
/* identify which access method is associated with a particular */
/* handle. They need to be synchronized with the STRAMH array */
/* defined in ZZDDHGSD in the following fashion: */
/* STRAMH ( READ ) = 'READ' */
/* STRAMH ( WRITE ) = 'WRITE' */
/* STRAMH ( SCRTCH ) = 'SCRATCH' */
/* STRAMH ( NEW ) = 'NEW' */
/* These values are used in the file table variable FTAMH. */
/* Binary file format enumeration. These parameters are used to */
/* identify which binary file format is associated with a */
/* particular handle. They need to be synchronized with the STRBFF */
/* array defined in ZZDDHGSD in the following fashion: */
/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */
/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */
/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */
/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */
/* These values are used in the file table variable FTBFF. */
/* Some random string lengths... more documentation required. */
/* For now this will have to suffice. */
/* Architecture enumeration. These parameters are used to identify */
/* which file architecture is associated with a particular handle. */
/* They need to be synchronized with the STRARC array defined in */
/* ZZDDHGSD in the following fashion: */
/* STRARC ( DAF ) = 'DAF' */
/* STRARC ( DAS ) = 'DAS' */
/* These values will be used in the file table variable FTARC. */
/* For the following environments, record length is measured in */
/* characters (bytes) with eight characters per double precision */
/* number. */
/* Environment: Sun, Sun FORTRAN */
/* Source: Sun Fortran Programmer's Guide */
/* Environment: PC, MS FORTRAN */
/* Source: Microsoft Fortran Optimizing Compiler User's Guide */
/* Environment: Macintosh, Language Systems FORTRAN */
/* Source: Language Systems FORTRAN Reference Manual, */
/* Version 1.2, page 12-7 */
/* Environment: PC/Linux, g77 */
/* Source: Determined by experiment. */
/* Environment: PC, Lahey F77 EM/32 Version 4.0 */
/* Source: Lahey F77 EM/32 Language Reference Manual, */
/* page 144 */
/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
/* Source: FORTRAN/9000 Reference-Series 700 Computers, */
/* page 5-110 */
/* Environment: NeXT Mach OS (Black Hardware), */
/* Absoft Fortran Version 3.2 */
/* Source: NAIF Program */
/* The following parameter defines the size of a string used */
/* to store a filenames on this target platform. */
/* The following parameter controls the size of the character record */
/* buffer used to read data from non-native files. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FILE I The name of a file to be examined. */
/* ARCH O The architecture of the kernel file. */
/* KERTYP O The type of the kernel file. */
/* $ Detailed_Input */
/* FILE is the name of a SPICE kernel file whose architecture */
/* and type are desired. */
/* $ Detailed_Output */
/* ARCH is the file architecture of the SPICE kernel file */
/* specified be FILE. If the architecture cannot be */
/* determined or is not recognized the value '?' is */
/* returned. */
/* Architectures currently recognized are: */
/* DAF - The file is based on the DAF architecture. */
/* DAS - The file is based on the DAS architecture. */
/* XFR - The file is in a SPICE transfer file format. */
/* DEC - The file is an old SPICE decimal text file. */
/* ASC -- An ASCII text file. */
/* KPL -- Kernel Pool File (i.e., a text kernel) */
/* TXT -- An ASCII text file. */
/* TE1 -- Text E-Kernel type 1. */
/* ? - The architecture could not be determined. */
/* This variable must be at least 3 characters long. */
/* KERTYP is the type of the SPICE kernel file. If the type */
/* can not be determined the value '?' is returned. */
/* Kernel file types may be any sequence of at most four */
/* printing characters. NAIF has reserved for its use */
/* types which contain all upper case letters. */
/* A file type of 'PRE' means that the file is a */
/* pre-release file. */
/* This variable may be at most 4 characters long. */
/* $ Parameters */
/* RECL is the record length of a binary kernel file. Each */
/* record must be large enough to hold 128 double */
/* precision numbers. The units in which the record */
/* length must be specified vary from environment to */
/* environment. For example, VAX Fortran requires */
/* record lengths to be specified in longwords, */
/* where two longwords equal one double precision */
/* number. */
/* $ Exceptions */
/* 1) If the filename specified is blank, then the error */
/* SPICE(BLANKFILENAME) is signaled. */
/* 2) If any inquire on the filename specified by FILE fails for */
/* some reason, the error SPICE(INQUIREERROR) is signaled. */
/* 3) If the file specified by FILE does not exist, the error */
/* SPICE(FILENOTFOUND) is signaled. */
/* 4) If the file specified by FILE is already open but not through */
/* SPICE interfaces, the error SPICE(EXTERNALOPEN) is signaled. */
/* 5) If an attempt to open the file specified by FILE fails when */
/* this routine requires that it succeed, the error */
/* SPICE(FILEOPENFAILED) is signaled. */
/* 6) If an attempt to read the file specified by FILE fails when */
/* this routine requires that it succeed, the error */
/* SPICE(FILEREADFAILED) is signaled. */
/* 7) Routines in the call tree of this routine may trap and */
/* signal errors. */
/* 8) If the ID word in a DAF based kernel is NAIF/DAF, then the */
/* algorithm GETFAT uses to distinguish between CK and SPK */
/* kernels may result in an indeterminate KERTYP if the SPK or */
/* CK files have invalid first segments. */
/* $ Files */
/* The SPICE kernel file specified by FILE is examined by this */
/* routine to determine its architecture and type. If the file */
/* named by FILE is not connected to a logical unit or loaded */
/* in the handle manager, this routine will OPEN and CLOSE it. */
/* $ Particulars */
/* This subroutine is a support utility routine that determines the */
/* architecture and type of a SPICE kernel file. */
/* $ Examples */
/* Suppose you wish to write a single routine for loading binary */
/* kernels. You can use this routine to determine the type of the */
/* file and then pass the file to the appropriate low level file */
/* loader to handle the actual loading of the file. */
/* CALL GETFAT ( FILE, ARCH, KERTYP ) */
/* IF ( KERTYP .EQ. 'SPK' ) THEN */
/* CALL SPKLEF ( FILE, HANDLE ) */
/* ELSE IF ( KERTYP .EQ. 'CK' ) THEN */
/* CALL CKLPF ( FILE, HANDLE ) */
/* ELSE IF ( KERTYP .EQ. 'EK' ) THEN */
/* CALL EKLEF ( FILE, HANDLE ) */
/* ELSE */
/* WRITE (*,*) 'The file could not be identified as a known' */
/* WRITE (*,*) 'kernel type. Did you load the wrong file' */
/* WRITE (*,*) 'by mistake?' */
/* END IF */
/* $ Restrictions */
/* 1) In order to properly determine the type of DAF based binary */
/* kernels, the routine requires that their first segments and */
/* the meta data necessary to address them are valid. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 4.25.0, 10-MAR-2014 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-INTEL. */
/* - SPICELIB Version 4.24.0, 10-MAR-2014 (BVS) */
/* Updated for PC-LINUX-64BIT-IFORT. */
/* - SPICELIB Version 4.23.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-GFORTRAN. */
/* - SPICELIB Version 4.22.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.21.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GCC_C. */
/* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 4.0.2, 24-APR-2003 (EDW) */
/* Added MAC-OSX-F77 to the list of platforms */
/* that require READONLY to read write protected */
/* kernels. */
/* - SPICELIB Version 4.0.1, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 4.0.0, 22-AUG-2001 (WLT) (FST) (EDW) */
/* Added code so that the architecture and type of open binary */
/* SPICE kernels can be determined. */
/* Added exception for MACPPC_C (CodeWarrior Mac classic). */
/* Reduced RECL value to 12 to prevent expression of */
/* the fseek bug. */
/* - SPICELIB Version 3.2.0, 06-DEC-1999 (WLT) */
/* The heuristics for distinguishing between CK and SPK have */
/* been enhanced so that the routine is no longer requires */
/* that TICKS in C-kernels be positive or integral. */
/* - SPICELIB Version 3.1.4, 08-OCT-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are WIN-NT */
/* - SPICELIB Version 3.1.3, 22-SEP-1999 (NJB) */
/* CSPICE environments were added. Some typos were corrected. */
/* - SPICELIB Version 3.1.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 3.1.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 3.1.0, 11-FEB-1999 (FST) */
/* Added an integrality check to Test 3. If LASTDP is not */
/* an integral value, then GETFAT simply returns KERTYP = '?', */
/* since it is of an indeterminate type. */
/* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */
/* Module was updated for the PC-LINUX platform. */
/* - SPICELIB Version 2.0.0, 19-DEC-1995 (KRG) */
/* Added several new features to the subroutine: */
/* - Error handling has been enhanced. */
/* - Several new file architectures have been added. */
/* Removed the mention of 1000 characters as a candidate for the */
/* record length of a file. */
/* Added the exception for a blank filename to the header. The */
/* error is signalled, but it was not listed in the header. */
/* Added IOSTAT values to the appropriate error messages. */
/* Non-printing characters are replaced with blanks in the ID */
/* word when it is read. This deals with the case where a */
/* platform allows a text file to be opened as an unformatted */
/* file and the ID word does not completely fill 8 characters. */
/* - SPICELIB Version 1.4.0, 5-JAN-1995 (HAN) */
/* Removed ENV11 since it is now the same as ENV2. */
/* Removed ENV10 since it is the same as the VAX environment. */
/* - SPICELIB Version 1.3.0, 30-AUG-1994 (HAN) */
/* Added two new environments, DEC Alpha/OpenVMS and */
/* Sun/Solaris, to the source master file. */
/* - SPICELIB Version 1.2.0, 25-MAR-1994 (HAN) */
/* Added two new environments, DEC Alpha/OpenVMS and */
/* Sun/Solaris, to the source master file. */
/* - SPICELIB Version 1.1.0, 25-MAR-1994 (HAN) */
/* Modified master source code file to use READONLY on platforms */
/* that support it. Also, changed some local declaration comment */
/* lines to match the standard NAIF template. */
/* - SPICELIB Version 1.0.0, 24-JUL-1993 (WLT) (HAN) (KRG) */
/* -& */
/* $ Index_Entries */
/* determine the architecture and type of a kernel file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.0.0, 22-AUG-2001 (WLT) (FST) */
/* Added code so that the architecture and type of open binary */
/* SPICE kernels can be determined. This uses the new DAF/DAS */
/* handle manager as well as examination of handles of open DAS */
/* files. Currently the handle manager deals only with DAF */
/* files. This routine should be updated again when the DAS */
/* system is integrated with the handle manager. */
/* Some slight changes were required to support ZZDDHFNH on */
/* the VAX environment. This resulted in the addition of */
/* the logical USEFNH that is set to true in most */
/* environments, and never used again other than to allow */
/* the invocation of the ZZDDHFNH module. */
/* - SPICELIB Version 2.0.0, 19-DEC-1995 (KRG) */
/* Added several new features to the subroutine: */
/* - Error handling has been enhanced. */
/* - Several new file architectures have been added. */
/* Removed the mention of 1000 characters as a candidate for the */
/* record length of a file. It seems unlikely that we will */
/* encounter an environment where 1000 characters of storage is */
/* larger than the storage necessary for 128 double precision */
/* numbers; typically there are 8 characters per double precision */
/* number, yeilding 1024 characters. */
/* Added the exception for a blank filename to the header. The */
/* error is signalled, but it was not listed in the header. */
/* Added IOSTAT values to the appropriate error messages. */
/* Non-printing characters are replaced with blanks in the ID */
/* word when it is read. This deals with the case where a */
/* platform allows a text file to be opened as an unformatted */
/* file and the ID word does not completely fill 8 characters. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Set the length of a SPICE kernel file ID word. */
/* Set minimum and maximum values for the range of ASCII printing */
/* characters. */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("GETFAT", (ftnlen)6);
}
/* Initialize the temporary storage variables that we use. */
s_copy(idword, " ", (ftnlen)12, (ftnlen)1);
/* If the filename we have is blank, signal an error and return. */
if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) {
setmsg_("The file name is blank.", (ftnlen)23);
sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* See if this is a binary file that is currently open */
/* within the SPICE binary file management subsystem. At */
/* the moment, as far as we know, the file is not opened. */
opened = FALSE_;
zzddhfnh_(file, &handle, &found, file_len);
if (found) {
/* If the file was recognized, we need to get the unit number */
/* associated with it. */
zzddhnfo_(&handle, fname, &intarc, &intbff, &intamn, &found, (ftnlen)
255);
/* Translate the architecture ID to a string and retrieve the */
/* logical unit to use with this file. */
zzddhgsd_("ARCH", &intarc, filarc, (ftnlen)4, (ftnlen)32);
zzddhhlu_(&handle, filarc, &c_false, &number, (ftnlen)32);
opened = TRUE_;
} else {
/* We'll do a bit of inquiring before we try opening anything. */
ioin__1.inerr = 1;
ioin__1.infilen = file_len;
ioin__1.infile = file;
ioin__1.inex = ∃
ioin__1.inopen = &opened;
ioin__1.innum = 0;
ioin__1.innamed = 0;
ioin__1.inname = 0;
ioin__1.inacc = 0;
ioin__1.inseq = 0;
ioin__1.indir = 0;
ioin__1.infmt = 0;
ioin__1.inform = 0;
ioin__1.inunf = 0;
ioin__1.inrecl = 0;
ioin__1.innrec = 0;
ioin__1.inblank = 0;
iostat = f_inqu(&ioin__1);
/* Not too likely, but if the INQUIRE statement fails... */
if (iostat != 0) {
setmsg_("IOSTAT error in INQUIRE statement. IOSTAT = #.", (ftnlen)
46);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREERROR)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Note: the following two tests MUST be performed in the order */
/* in which they appear, since in some environments files that do */
/* not exist are considered to be open. */
if (! exist) {
setmsg_("The kernel file '#' does not exist.", (ftnlen)35);
errch_("#", file, (ftnlen)1, file_len);
sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* If the file is already open, it may be a DAS file. */
if (opened) {
/* At the moment, the handle manager doesn't manage DAS */
/* handles. As a result we need to treat the case of an open */
/* DAS separately. When the Handle Manager is hooked in with */
/* DAS as well as DAF, we should remove the block below. */
/* =================================================== */
/* DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS */
/* vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv */
/* This file may or may not be a DAS file. Until we */
/* have determined otherwise, we assume it is not */
/* a DAS file. */
notdas = TRUE_;
ioin__1.inerr = 1;
ioin__1.infilen = file_len;
ioin__1.infile = file;
ioin__1.inex = 0;
ioin__1.inopen = 0;
ioin__1.innum = &unit;
ioin__1.innamed = 0;
ioin__1.inname = 0;
ioin__1.inacc = 0;
ioin__1.inseq = 0;
ioin__1.indir = 0;
ioin__1.infmt = 0;
ioin__1.inform = 0;
ioin__1.inunf = 0;
ioin__1.inrecl = 0;
ioin__1.innrec = 0;
ioin__1.inblank = 0;
iostat = f_inqu(&ioin__1);
if (iostat != 0) {
setmsg_("IOSTAT error in INQUIRE statement. IOSTAT = #.", (
ftnlen)46);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREERROR)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Get the set of handles of open DAS files. We will */
/* translate each of these handles to the associated */
/* logical unit. If the tranlation matches the result */
/* of the inquire, this must be a DAS file and we */
/* can proceed to determine the type. */
ssizei_(&c__100, handles);
dashof_(handles);
which = cardi_(handles);
while(which > 0) {
dashlu_(&handles[(i__1 = which + 5) < 106 && 0 <= i__1 ? i__1
: s_rnge("handles", i__1, "getfat_", (ftnlen)654)], &
myunit);
if (unit == myunit) {
number = myunit;
which = 0;
notdas = FALSE_;
} else {
--which;
}
}
/* If we reach this point and do not have a DAS, there */
/* is no point in going on. The user has opened this */
/* file outside the SPICE system. We shall not attempt */
/* to determine its type. */
if (notdas) {
setmsg_("The file '#' is already open.", (ftnlen)29);
errch_("#", file, (ftnlen)1, file_len);
sigerr_("SPICE(EXTERNALOPEN)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
/* DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS */
/* =================================================== */
}
}
/* Open the file with a record length of RECL (the length of the */
/* DAF and DAS records). We assume, for now, that opening the file as */
/* a direct access file will work. */
diropn = TRUE_;
/* If the file is not already open (probably the case that */
/* happens most frequently) we try opening it for direct access */
/* and see if we can locate the idword. */
if (! opened) {
getlun_(&number);
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = file_len;
o__1.ofnm = file;
o__1.orl = 1024;
o__1.osta = "OLD";
o__1.oacc = "DIRECT";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
/* If we had trouble opening the file, try opening it as a */
/* sequential file. */
if (iostat != 0) {
diropn = FALSE_;
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = file_len;
o__1.ofnm = file;
o__1.orl = 0;
o__1.osta = "OLD";
o__1.oacc = "SEQUENTIAL";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
/* If we still have problems opening the file, we don't have a */
/* clue about the file architecture and type. */
if (iostat != 0) {
s_copy(arch, "?", arch_len, (ftnlen)1);
s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", (
ftnlen)48);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
}
}
/* We opened the file successfully, so let's try to read from the */
/* file. We need to be sure to use the correct form of the read */
/* statement, depending on whether the file was opened with direct */
/* acces or sequential access. */
if (diropn) {
io___19.ciunit = number;
iostat = s_rdue(&io___19);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, tmpwrd, (ftnlen)12);
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
/* If we couldn't read from the file as a direct access file with */
/* a fixed record length, then try to open the file as a */
/* sequential file and read from it. */
if (iostat != 0) {
if (opened) {
/* Something has gone wrong here. The file was opened */
/* as either a DAF or DAS prior to the call to GETFAT. */
/* We retrieved the unit number maintained by the */
/* underlying binary file management system, but we */
/* were unable to read the file as direct access. */
/* There's nothing we can do but abandon our quest to */
/* determine the type of the file. */
setmsg_("The file '#' is opened as a binary SPICE kernel. B"
"ut it cannot be read using a direct access read. The"
" value of IOSTAT returned by the attempted READ is #"
". ", (ftnlen)157);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* If we reach this point, the file was opened locally */
/* as a direct access file. We could not read it that */
/* way, so we'll try using a sequential read. However, */
/* we first need to close the file and then reopen it */
/* for sequential reading. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = file_len;
o__1.ofnm = file;
o__1.orl = 0;
o__1.osta = "OLD";
o__1.oacc = "SEQUENTIAL";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
/* If we could not open the file, we don't have a clue about */
/* the file architecture and type. */
if (iostat != 0) {
s_copy(arch, "?", arch_len, (ftnlen)1);
s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", (
ftnlen)48);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Try to read from the file. */
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = number;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100002;
}
iostat = do_fio(&c__1, tmpwrd, (ftnlen)12);
if (iostat != 0) {
goto L100002;
}
iostat = e_rsfe();
L100002:
;
}
} else {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = number;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100003;
}
iostat = do_fio(&c__1, tmpwrd, (ftnlen)12);
if (iostat != 0) {
goto L100003;
}
iostat = e_rsfe();
L100003:
;
}
/* If we had an error while reading, we don't recognize this file. */
if (iostat != 0) {
s_copy(arch, "?", arch_len, (ftnlen)1);
s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
setmsg_("Attempt to read from file '#' failed. IOSTAT = #.", (ftnlen)
49);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Close the file (if we opened it here), as we do not need it */
/* to be open any more. */
if (! opened) {
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* At this point, we have a candidate for an ID word. To avoid */
/* difficulties with Fortran I/O and other things, we will now */
/* replace any non printing ASCII characters with blanks. */
for (i__ = 1; i__ <= 12; ++i__) {
if (*(unsigned char *)&tmpwrd[i__ - 1] < 32 || *(unsigned char *)&
tmpwrd[i__ - 1] > 126) {
*(unsigned char *)&tmpwrd[i__ - 1] = ' ';
}
}
/* Identify the architecture and type, if we can. */
ljust_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12);
ucase_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12);
nextwd_(tmpwrd, idword, tmpwrd, (ftnlen)12, (ftnlen)12, (ftnlen)12);
if (s_cmp(idword, "DAFETF", (ftnlen)12, (ftnlen)6) == 0) {
/* We have a DAF encoded transfer file. */
s_copy(arch, "XFR", arch_len, (ftnlen)3);
s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3);
} else if (s_cmp(idword, "DASETF", (ftnlen)12, (ftnlen)6) == 0) {
/* We have a DAS encoded transfer file. */
s_copy(arch, "XFR", arch_len, (ftnlen)3);
s_copy(kertyp, "DAS", kertyp_len, (ftnlen)3);
} else if (s_cmp(idword, "'NAIF/DAF'", (ftnlen)10, (ftnlen)10) == 0) {
/* We have an old DAF decimal text file. */
s_copy(arch, "DEC", arch_len, (ftnlen)3);
s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3);
} else if (s_cmp(idword, "NAIF/DAS", (ftnlen)8, (ftnlen)8) == 0) {
/* We have a pre release DAS binary file. */
s_copy(arch, "DAS", arch_len, (ftnlen)3);
s_copy(kertyp, "PRE", kertyp_len, (ftnlen)3);
} else {
/* Get the architecture and type from the ID word, if we can. */
idw2at_(idword, arch, kertyp, (ftnlen)8, arch_len, kertyp_len);
}
/* If the architecture is DAF and the type is unknown, '?', then we */
/* have either an SPK file, a CK file, or something we don't */
/* understand. Let's check it out. */
if (s_cmp(arch, "DAF", arch_len, (ftnlen)3) == 0 && s_cmp(kertyp, "?",
kertyp_len, (ftnlen)1) == 0) {
/* We have a DAF file and we do not know what the type is. This */
/* situation can occur for older SPK and CK files, before the ID */
/* word was used to store type information. */
/* We use Bill's (WLT'S) magic heuristics to determine the type */
/* of the file. */
/* Open the file and pass the handle to the private routine */
/* that deals with the dirty work. */
dafopr_(file, &handle, file_len);
zzckspk_(&handle, kertyp, kertyp_len);
dafcls_(&handle);
}
chkout_("GETFAT", (ftnlen)6);
return 0;
} /* getfat_ */
/* $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 CKCOV ( CK coverage ) */
/* Subroutine */ int ckcov_(char *ck, integer *idcode, logical *needav, char *
level, doublereal *tol, char *timsys, doublereal *cover, ftnlen
ck_len, ftnlen level_len, ftnlen timsys_len)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
char arch[80];
logical avok;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int dafgs_(doublereal *);
integer clkid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dctol[2];
logical istdb, found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer dtype;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
doublereal et;
integer handle, segbeg;
extern /* Subroutine */ int dafcls_(integer *), ckmeta_(integer *, char *,
integer *, ftnlen);
integer segend;
extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen,
ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen);
logical seglvl;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), wninsd_(doublereal *, doublereal *, doublereal *),
errint_(char *, integer *, ftnlen);
char kertyp[80];
extern logical return_(void);
extern /* Subroutine */ int zzckcv01_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv02_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv03_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv04_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv05_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, char *, doublereal *,
ftnlen);
/* $ Abstract */
/* Find the coverage window for a specified object in a specified CK */
/* file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CELLS */
/* DAF */
/* CK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* POINTING */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CK I Name of CK file. */
/* IDCODE I ID code of object. */
/* NEEDAV I Flag indicating whether angular velocity is needed. */
/* LEVEL I Coverage level: 'SEGMENT' OR 'INTERVAL'. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* COVER I/O Window giving coverage for IDCODE. */
/* $ Detailed_Input */
/* CK is the name of a C-kernel. */
/* IDCODE is the integer ID code of an object, normally */
/* a spacecraft structure or instrument, for which */
/* pointing data are expected to exist in the */
/* specified CK file. */
/* NEEDAV is a logical variable indicating whether only */
/* segments having angular velocity are to be */
/* considered when determining coverage. When */
/* NEEDAV is .TRUE., segments without angular */
/* velocity don't contribute to the coverage */
/* window; when NEEDAV is .FALSE., all segments for */
/* IDCODE may contribute to the coverage window. */
/* LEVEL is the level (granularity) at which the coverage */
/* is examined. Allowed values and corresponding */
/* meanings are: */
/* 'SEGMENT' The output coverage window */
/* contains intervals defined by the */
/* start and stop times of segments */
/* for the object designated by */
/* IDCODE. */
/* 'INTERVAL' The output coverage window */
/* contains interpolation intervals */
/* of segments for the object */
/* designated by IDCODE. For type 1 */
/* segments, which don't have */
/* interpolation intervals, each */
/* epoch associated with a pointing */
/* instance is treated as a singleton */
/* interval; these intervals are */
/* added to the coverage window. */
/* All interpolation intervals are */
/* considered to lie within the */
/* segment bounds for the purpose of */
/* this summary: if an interpolation */
/* interval extends beyond the */
/* segment coverage interval, only */
/* its intersection with the segment */
/* coverage interval is considered to */
/* contribute to the total coverage. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with IDCODE. Before */
/* each interval is inserted into the coverage */
/* window, the interval is intersected with the */
/* segment coverage interval, then if the */
/* intersection is non-empty, it is expanded by TOL: */
/* the left endpoint of the intersection interval is */
/* reduced by TOL and the right endpoint is increased */
/* by TOL. Adjusted interval endpoints, when */
/* expressed as encoded SCLK, never are less than */
/* zero ticks. Any intervals that overlap as a */
/* result of the expansion are merged. */
/* The coverage window returned when TOL > 0 */
/* indicates the coverage provided by the file to the */
/* CK readers CKGPAV and CKGP when that value of TOL */
/* is passed to them as an input. */
/* TIMSYS is a string indicating the time system used */
/* in the output coverage window. TIMSYS may */
/* have the values: */
/* 'SCLK' Elements of COVER are expressed in */
/* encoded SCLK ("ticks"), where the */
/* clock is associated with the object */
/* designated by IDCODE. */
/* 'TDB' Elements of COVER are expressed as */
/* seconds past J2000 TDB. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file CK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. When */
/* the coverage level is 'INTERVAL', this is the set */
/* of time intervals for which data for IDCODE are */
/* present in the file CK, merged with the set of */
/* time intervals present in COVER on input. The */
/* merged coverage is represented as the union of one */
/* or more disjoint time intervals. The window COVER */
/* contains the pairs of endpoints of these */
/* intervals. */
/* When the coverage level is 'SEGMENT', COVER is */
/* computed in a manner similar to that described */
/* above, but the coverage intervals used in the */
/* computation are those of segments rather than */
/* interpolation intervals within segments. */
/* When TOL is > 0, the intervals comprising the */
/* coverage window for IDCODE are expanded by TOL and */
/* any intervals overlapping as a result are merged. */
/* The resulting window is returned in COVER. The */
/* expanded window in no case extends beyond the */
/* segment bounds in either direction by more than */
/* TOL. */
/* The interval endpoints contained in COVER are */
/* encoded spacecraft clock times if TIMSYS is */
/* 'SCLK'; otherwise the times are converted from */
/* encoded spacecraft clock to seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* CK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the CK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output WINDOW argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* 6) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 7) If LEVEL is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 8) If TIMSYS is not recognized, the error SPICE(NOTSUPPORTED) */
/* is signaled. */
/* 9) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 10) If the output time system is TDB, the CK subsystem must be */
/* able to map IDCODE to the ID code of the associated */
/* spacecraft clock. If this mapping cannot be performed, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* This routine reads a C-kernel. */
/* If the output time system is 'TDB', then a leapseconds kernel */
/* and an SCLK kernel for the spacecraft clock associated with */
/* IDCODE must be loaded before this routine is called. */
/* If the ID code of the clock associated with IDCODE is not */
/* equal to */
/* IDCODE / 1000 */
/* then the kernel variable */
/* CK_<IDCODE>_SCLK */
/* must be present in the kernel pool to identify the clock */
/* associated with IDCODE. This variable must contain the ID code */
/* to be used for conversion between SCLK and TDB. Normally this */
/* variable is provided in a text kernel loaded via FURNSH. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified CK file provides for a specified */
/* object. */
/* $ Examples */
/* 1) Display the interval-level coverage for each object in a */
/* specified CK file. Use tolerance of zero ticks. Do not */
/* request angular velocity. Express the results in the TDB time */
/* system. */
/* Find the set of objects in the file. Loop over the contents */
/* of the ID code set: find the coverage for each item in the */
/* set and display the coverage. */
/* PROGRAM CKCVR */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* INTEGER CARDI */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 100000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) CK */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SCLK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel and SCLK kernel for output */
/* C time conversion. Note that we assume a single spacecraft */
/* C clock is associated with all of the objects in the CK. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Get name of CK file. */
/* C */
/* CALL PROMPT ( 'Name of CK file > ', CK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the CK file. */
/* C */
/* CALL CKOBJ ( CK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL CKCOV ( CK, IDS(I), .FALSE., */
/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the segment-level coverage for the object designated by */
/* IDCODE provided by the set of CK files loaded via a */
/* metakernel. (The metakernel must also specify leapseconds and */
/* SCLK kernels.) Use tolerance of zero ticks. Do not request */
/* angular velocity. Express the results in the TDB time system. */
/* PROGRAM CKMET */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the CK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel and an SCLK */
/* C kernel for the clock associated with IDCODE. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded CK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'CK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'CK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL CKCOV ( FILE, IDCODE, .FALSE., */
/* . 'SEGMENT', 0.0, 'TDB', COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) When this routine is used to accumulate coverage for IDCODE */
/* provided by multiple CK files, the inputs NEEDAV, LEVEL, TOL, */
/* and TIMSYS must have the same values for all files in order */
/* for the result to be meaningful. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for ck object */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKCOV", (ftnlen)5);
/* Check tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative; actual value was #.", (
ftnlen)51);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Use a logical flag to indicate whether this is a segment-level */
/* coverage description. */
seglvl = eqstr_(level, "SEGMENT", level_len, (ftnlen)7);
/* Check coverage level keyword. */
if (! (seglvl || eqstr_(level, "INTERVAL", level_len, (ftnlen)8))) {
setmsg_("Allowed values of LEVEL are # and #; actual value was #.", (
ftnlen)56);
errch_("#", "SEGMENT", (ftnlen)1, (ftnlen)7);
errch_("#", "INTERVAL", (ftnlen)1, (ftnlen)8);
errch_("#", level, (ftnlen)1, level_len);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* See whether GETFAT thinks we've got a CK file. */
getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. If the input file i"
"s an CK file in transfer format, run TOBIN on the file to co"
"nvert it to binary format.", (ftnlen)205);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. Binary CK files hav"
"e DAF architecture. If you expected the file to be a binary"
" CK file, the problem may be due to the file being an old no"
"n-native file lacking binary file format information. It's a"
"lso possible the file has been corrupted.", (ftnlen)340);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) {
setmsg_("Input file # has file type #. The file must be a binary CK "
"file to be readable by this routine. If you expected the fil"
"e to be a binary CK file, the problem may be due to the file"
" being an old non-native file lacking binary file format inf"
"ormation. It's also possible the file has been corrupted.", (
ftnlen)296);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Set a logical flag indicating whether the time systm is SCLK. */
istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
/* Check time system. */
if (! istdb) {
if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
"and TDB.", (ftnlen)63);
errch_("#", timsys, (ftnlen)1, timsys_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* If the output time system is TDB, find the clock ID associated */
/* with IDCODE. */
if (istdb) {
ckmeta_(idcode, "SCLK", &clkid, (ftnlen)4);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* Open the file for reading. */
dafopr_(ck, &handle, ck_len);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* If TOL > 0, we'll apply TOL after we've found the coverage */
/* for the zero-tolerance case. */
/* If the time system is TDB, we'll convert the times to TDB */
/* at the end of this routine. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found) {
/* Note: we check FAILED() at the bottom of this loop; this */
/* routine returns if FAILED() returns .TRUE. at that point. */
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
/* Let AVOK indicate whether the segment satisfies the */
/* angular velocity restriction. */
avok = ic[3] == 1 || ! (*needav);
if (ic[0] == *idcode && avok) {
/* This segment is for the body of interest. If angular */
/* velocity is needed, this segment has it. */
if (seglvl) {
/* This is a segment-level summary. */
/* Insert the coverage bounds into the coverage window. */
/* Adjust the interval using the tolerance. */
/* Computing MAX */
d__1 = dc[0] - *tol;
dctol[0] = max(d__1,0.);
dctol[1] = dc[1] + *tol;
/* Convert the time to TDB if necessary. */
if (istdb) {
/* Convert the time bounds to TDB before inserting */
/* into the window. */
for (i__ = 1; i__ <= 2; ++i__) {
sct2e_(&clkid, &dctol[(i__1 = i__ - 1) < 2 && 0 <=
i__1 ? i__1 : s_rnge("dctol", i__1, "ckcov_",
(ftnlen)868)], &et);
dctol[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("dctol", i__1, "ckcov_", (ftnlen)869)]
= et;
}
}
if (dctol[0] <= dctol[1]) {
wninsd_(dctol, &dctol[1], cover);
}
} else {
/* We're looking for an interval-level coverage window. */
/* This information must be retrieved in a */
/* data-type-dependent fashion. The coverage routines */
/* we'll call will, if necessary, adjust intervals by TOL */
/* and convert interval times to TDB. */
dtype = ic[2];
segbeg = ic[4];
segend = ic[5];
if (dtype == 1) {
zzckcv01_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 2) {
zzckcv02_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 3) {
zzckcv03_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 4) {
zzckcv04_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 5) {
/* Note: this calling sequence is exceptional; the */
/* segment bounds are an input. */
zzckcv05_(&handle, &segbeg, &segend, &clkid, dc, tol,
timsys, cover, timsys_len);
} else {
setmsg_("Supported CK data types are 1, 2, 3, 4, 5. Dat"
"a type of segment: #. This problem may indicate "
"that you need to update your SPICE Toolkit.", (
ftnlen)138);
errint_("#", &dtype, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
}
daffna_(&found);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* COVER now represents the coverage of the entire file at the */
/* granularity indicated by LEVEL, combined with the coverage */
/* contained in COVER on input. */
/* Release the file. */
dafcls_(&handle);
chkout_("CKCOV", (ftnlen)5);
return 0;
} /* ckcov_ */
/* $Procedure SPASUM ( SPACIT, summarize binary file ) */
/* Subroutine */ int spasum_(logical *logfil, integer *loglun)
{
/* Initialized data */
static logical lpsldd = FALSE_;
static logical sclldd = FALSE_;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
char arch[3], line[255], type__[4];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical ndlps;
extern /* Subroutine */ int sumck_(integer *, char *, char *, char *,
logical *, integer *, ftnlen, ftnlen, ftnlen), sumek_(integer *,
char *, logical *, integer *, ftnlen);
char prmpt[80];
extern logical failed_(void);
integer handle;
extern /* Subroutine */ int dafcls_(integer *);
char binfnm[128];
logical fileok;
extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen,
ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen);
logical ndsclk;
extern /* Subroutine */ int dascls_(integer *);
static char sclfnm[128];
char bfstat[3];
extern /* Subroutine */ int dasopr_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen);
char lfstat[3];
static char lpsfnm[128];
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), sumpck_(integer *, char *, char *, logical *, integer *,
ftnlen, ftnlen);
char sfstat[3];
extern /* Subroutine */ int furnsh_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int writln_(char *, integer *, ftnlen), sumspk_(
integer *, char *, char *, logical *, integer *, ftnlen, ftnlen),
getfnm_1__(char *, char *, char *, logical *, ftnlen, ftnlen,
ftnlen);
/* $ Abstract */
/* SPACIT utility subroutine used to summarize the segments in SPICE */
/* data kernel files. This subroutine is for use only be the SPACIT */
/* program. Use it at your own risk. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* None. */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* LOGFIL I Logical flag indicating a log file is being kept. */
/* LOGLUN I The logical unit of the log file. */
/* $ Detailed_Input */
/* LOGFIL Logical flag indicating a log file is being kept. This */
/* Variable has the value of .TRUE. if a log file is being */
/* written, and a value of .FALSE. otherwise. */
/* LOGLUN The logical unit of the log file. If LOGFIL has the */
/* value .TRUE. then LOGLUN will be the Fortran logical */
/* unit of the log file. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* xxx */
/* $ Examples */
/* xxx */
/* $ Restrictions */
/* xxx */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - Beta Version 2.1.0, 02-OCT-2006 (BVS) */
/* Replaced LDPOOL with FURNSH. */
/* - Beta Version 2.0.0, 14-MAR-1997 (WLT) */
/* The routine was enhanced to provide a diagnostic in the */
/* event that the type of the file does belong to EK, CK, SPK */
/* or PCK */
/* - Beta Version 1.0.0, 11-JUL-1995 (KRG) */
/* -& */
/* $ Index_Entries */
/* spacit convert binary to transfer */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Set values for the NAIF SPICE file types */
/* Set a value for the logical unit which represents the standard */
/* output device, commonly a terminal. A value of 6 is widely used, */
/* but the Fortran standard does not specify a value, so it may be */
/* different for different Fortran implementations. */
/* Set a value for the length of an input text line. */
/* Set a value for the length of a filename. */
/* Set a length for the prompt. */
/* Set a length for the status of a file: 'OLD' or 'NEW'. */
/* Set the length for the type of a file. */
/* Set the length for the architecture of a file. */
/* Local variables */
/* Saved values */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPASUM", (ftnlen)6);
}
s_copy(bfstat, "OLD", (ftnlen)3, (ftnlen)3);
fileok = FALSE_;
s_copy(prmpt, " Binary file : ", (ftnlen)80, (ftnlen)21);
getfnm_1__(prmpt, bfstat, binfnm, &fileok, (ftnlen)80, (ftnlen)3, (ftnlen)
128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
getfat_(binfnm, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__, "?", (
ftnlen)4, (ftnlen)1) == 0) {
setmsg_("The architecture and type of the file '#' could not be dete"
"rmined.", (ftnlen)66);
errch_("#", binfnm, (ftnlen)1, (ftnlen)128);
sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20);
chkout_("SPASUM", (ftnlen)6);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)3, (ftnlen)3) != 0 && s_cmp(arch,
"DAS", (ftnlen)3, (ftnlen)3) != 0) {
setmsg_("The file '#' was not a binary SPICE file. In order to summa"
"rize a file it must be a binary CK, EK, PCK, or SPK file.", (
ftnlen)116);
errch_("#", binfnm, (ftnlen)1, (ftnlen)128);
sigerr_("SPICE(IMPROPERFILE)", (ftnlen)19);
chkout_("SPASUM", (ftnlen)6);
return 0;
}
if (s_cmp(type__, "PRE", (ftnlen)4, (ftnlen)3) == 0) {
s_copy(type__, "EK", (ftnlen)4, (ftnlen)2);
}
if (lpsldd || s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
ndlps = FALSE_;
} else {
ndlps = TRUE_;
}
ndsclk = FALSE_;
if (! sclldd && s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
ndsclk = TRUE_;
}
if (ndlps) {
s_copy(lfstat, "OLD", (ftnlen)3, (ftnlen)3);
fileok = FALSE_;
s_copy(prmpt, " Leapseconds file: ", (ftnlen)80, (ftnlen)21);
getfnm_1__(prmpt, lfstat, lpsfnm, &fileok, (ftnlen)80, (ftnlen)3, (
ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
}
if (ndsclk) {
s_copy(sfstat, "OLD", (ftnlen)3, (ftnlen)3);
fileok = FALSE_;
s_copy(prmpt, " SCLK file : ", (ftnlen)80, (ftnlen)21);
getfnm_1__(prmpt, sfstat, sclfnm, &fileok, (ftnlen)80, (ftnlen)3, (
ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
}
writln_(" ", &c__6, (ftnlen)1);
if (ndlps) {
s_copy(line, " Loading the Leapseconds kernel file. Please wait ..."
, (ftnlen)255, (ftnlen)55);
writln_(line, &c__6, (ftnlen)255);
furnsh_(lpsfnm, (ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
lpsldd = TRUE_;
}
if (ndsclk) {
s_copy(line, " Loading the SCLK kernel file. Please wait ...", (
ftnlen)255, (ftnlen)48);
writln_(line, &c__6, (ftnlen)255);
furnsh_(sclfnm, (ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
sclldd = TRUE_;
}
writln_(" ", &c__6, (ftnlen)1);
if (*logfil) {
writln_(" ", loglun, (ftnlen)1);
}
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Summarize a binary CK file. */
dafopr_(binfnm, &handle, (ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
sumck_(&handle, binfnm, lpsfnm, sclfnm, logfil, loglun, (ftnlen)128, (
ftnlen)128, (ftnlen)128);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Summarize a binary SPK file. */
dafopr_(binfnm, &handle, (ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
sumspk_(&handle, binfnm, lpsfnm, logfil, loglun, (ftnlen)128, (ftnlen)
128);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Summarize a binary PCK file. */
dafopr_(binfnm, &handle, (ftnlen)128);
if (failed_()) {
chkout_("SPASUM", (ftnlen)6);
return 0;
}
sumpck_(&handle, binfnm, lpsfnm, logfil, loglun, (ftnlen)128, (ftnlen)
128);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Summarize a binary EK file. */
dasopr_(binfnm, &handle, (ftnlen)128);
sumek_(&handle, binfnm, logfil, loglun, (ftnlen)128);
dascls_(&handle);
} else {
setmsg_("The specified file is not of a \"type\" that can be summari"
"zed. The types of files that can be summarized are: CK, EK, "
"PCK, and SPK. According to the type in the internal id-word"
" of the file, this file has type: '#'. You will need to get"
" an upgrade of SPACIT to summarize this file. ", (ftnlen)283);
errch_("#", type__, (ftnlen)1, (ftnlen)4);
sigerr_("SPICE(UNKNOWNTYPE)", (ftnlen)18);
chkout_("SPASUM", (ftnlen)6);
return 0;
}
chkout_("SPASUM", (ftnlen)6);
return 0;
} /* spasum_ */
/* $Procedure COMMNT ( Comment utility program ) */
/* Main program */ MAIN__(void)
{
/* Initialized data */
static logical insbln = TRUE_;
static char maintl[20] = "COMMNT Options ";
static char mainvl[20*5] = "QUIT " "ADD_COMMENTS "
"READ_COMMENTS " "EXTRACT_COMMENTS " "DELETE_COMMENTS "
" ";
static char maintx[40*5] = "Quit. "
"Add comments to a binary file. " "Read the comments in"
" a binary file. " "Extract comments from a binary file. "
"Delete the comments in a binary file. ";
static char mainnm[1*5] = "Q" "A" "R" "E" "D";
/* System generated locals */
address a__1[3];
integer i__1[3], i__2, i__3, i__4, i__5;
cllist cl__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen), f_clos(cllist *);
/* Local variables */
static char arch[3];
static logical done;
static char line[1000];
static logical more;
static integer iopt;
static char type__[4];
static integer i__;
extern /* Subroutine */ int dasdc_(integer *);
extern integer cardi_(integer *);
static integer r__;
extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *,
ftnlen, ftnlen), chkin_(char *, ftnlen), spcec_(integer *,
integer *), spcdc_(integer *), errch_(char *, char *, ftnlen,
ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen,
ftnlen, ftnlen), reset_(void);
extern integer rtrim_(char *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int dafhof_(integer *);
static integer handle;
extern /* Subroutine */ int dafcls_(integer *), dasacu_(integer *, char *,
char *, logical *, integer *, ftnlen, ftnlen), cleari_(integer *,
integer *), delfil_(char *, ftnlen), dasecu_(integer *, integer *
, logical *), scardi_(integer *, integer *), dashof_(integer *);
static logical fileok;
extern /* Subroutine */ int clcomm_(void), getfat_(char *, char *, char *,
ftnlen, ftnlen, ftnlen), cnfirm_(char *, logical *, ftnlen);
static char fnmtbl[128*2], messag[1000], errmsg[320], messgs[1000*7],
option[20], prmtbl[80*2], statbl[3*2];
extern logical exists_(char *, ftnlen);
static integer comlun;
static char status[1000*2];
static integer numfnm;
static char prmpts[80*2];
static integer numopn, opnset[7], tblidx[2];
static logical comnts, contnu, ndfnms, tryagn;
extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen),
erract_(char *, char *, ftnlen, ftnlen), errprt_(char *, char *,
ftnlen, ftnlen), tostdo_(char *, ftnlen), ssizei_(integer *,
integer *), getopt_(char *, integer *, char *, char *, integer *,
ftnlen, ftnlen, ftnlen), getfnm_(char *, char *, char *, logical *
, char *, ftnlen, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen)
, sigerr_(char *, ftnlen), txtopr_(char *, integer *, ftnlen),
dafopw_(char *, integer *, ftnlen), dasopw_(char *, integer *,
ftnlen), dascls_(integer *), dafopr_(char *, integer *, ftnlen),
spcrfl_(integer *, char *, logical *, ftnlen), spcrnl_(char *,
logical *, ftnlen), dasopr_(char *, integer *, ftnlen), txtopn_(
char *, integer *, ftnlen), chkout_(char *, ftnlen);
static logical eoc;
static char tkv[12];
/* $ Abstract */
/* NAIF Toolkit utility program for adding, reading, extracting, */
/* and deleting comments from a binary file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPC */
/* DAS */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* J.E. McLean (JPL) */
/* M.J. Spencer (JPL) */
/* $ Version */
/* - Version 6.0.1, 08-MAY-2001 (BVS) */
/* Increased LINLEN from 255 to 1000 to make it consistent */
/* with SPICELIB's SPC* and SUPPORT's DAF* internal line sizes. */
/* - Version 5.0.1, 21-JUL-1997 (WLT) */
/* Modified the banner at start up so that the version of the */
/* toolkit used to link COMMNT will be displayed. */
/* In addition all WRITE statements were replaced by calls to */
/* TOSTDO. */
/* - Version 5.0.0, 05-MAY-1994 (KRG) */
/* Modified the program to use the new file type identification */
/* capability that was added to spicelib. No file type menu is */
/* necessary now, as the file type is determined during the */
/* execution of the program. */
/* The prompts for the begin and end markers used to extract a */
/* subset of text lines from an input comment file which were then */
/* placed into the comment area of a SPICE binary kernel file have */
/* been removed. The entire input comment file is now placed into */
/* the comment area of the binary kernel file. This change */
/* simplifies the user interaction with the program. */
/* Added support for the new PCK binary kernel files. */
/* If an error occurs during the extraction of comments to a file, */
/* the file that was being created is deleted. We cannot know */
/* whether the file had been successfully created before the error */
/* occurred. */
/* - Version 4.0.0, 11-DEC-1992 (KRG) */
/* Added code to support the E-Kernel, and redesigned the */
/* user interface. */
/* - Version 3.1.0, 19-NOV-1991 (MJS) */
/* Variable QUIT initialized to FALSE. */
/* - Version 3.0.1, 10-AUG-1991 (CHA) (NJB) */
/* Updated comments to reflect status as a Toolkit */
/* utility program. Message indicating that no comments */
/* were found in the specified file was changed to include */
/* the file name. */
/* - Version 2.0.0, 28-JUN-1991 (JEM) */
/* The option to read the comments from the comment */
/* area of a binary SPK or CK was added to the menu. */
/* - Version 1.0.0, 05-APR-1991 (JEM) */
/* -& */
/* SPICELIB functions */
/* Parameters */
/* Set the version of the comment program. This should be updated */
/* every time a change is made, and it should agree with the */
/* version number in the header. */
/* Set a value for the logical unit which represents the standard */
/* output device, commonly a terminal. A value of 6 is widely used, */
/* but the Fortran standard does not specify a value, so it may be */
/* different for different Fortran implementations. */
/* Lower bound for a SPICELIB CELL data structure. */
/* Maximum number of open binary files allowed. */
/* Set a value for a replacement marker. */
/* Set a value for a filename prompt. */
/* File types */
/* Set a value for the length of a text line. */
/* Set a value for the length of an error message. */
/* Set a value for the length of a filename. */
/* Set a length for the prompts in the prompt table. */
/* Set a length for the status of a file: 'OLD' or 'NEW'. */
/* Set the length for the architecture of a file. */
/* Set the length for the type of a file. */
/* Set a length for the option values. */
/* Set a length for the title of a menu. */
/* Set a length for an option name (what is typed to select it) */
/* for a menu. */
/* Set the length of the text description of an option on a menu. */
/* The number of options available on the main menu. */
/* Set up some mnemonics for indexing the prompts in the prompt */
/* table. */
/* Set the maximum size of the filename table: this must be the */
/* number of distinct ``types'' of files that the program may */
/* require. */
/* Set up some mnemonics for indexing the messages in the message */
/* table. */
/* Set the maximum size of the message table: There should be a */
/* message for each ``type'' of action that the program can take. */
/* Set up some mnemonics for the OK and not OK status messages. */
/* Set the maximum number of status messages that are available. */
/* We need to have TKVLEN characters to hold the current version */
/* of the toolkit. */
/* Variables */
/* We want to insert a blank line between additions if there are */
/* already comments in the binary file. We indicate this by giving */
/* the variable INSBLN the value .TRUE.. */
/* Define the main menu title ... */
/* Define the main menu option values ... */
/* Define the main menu descriptive text for each option ... */
/* Define the main menu option names ... */
/* Register the COMMNT main program with the SPICELIB error handler. */
chkin_("COMMNT", (ftnlen)6);
clcomm_();
tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)12);
r__ = rtrim_(tkv, (ftnlen)12);
/* Set the error action to 'RETURN'. We don't want the program */
/* to abort if an error is signalled. We check FAILED where */
/* necessary. If an error is signalled, we'll just handle the */
/* error, display an appropriate message, then call RESET at the */
/* end of the loop to continue. */
erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6);
/* Set the error messages that we want to have displayed. We will */
/* diaplay the SPICELIB short and long error messages. This is done */
/* to ensure that some sort of an error message is displayed if an */
/* error occurs. In several places, long error messages are not set, */
/* so if only the long error messages were displayed, it would be */
/* possible to have an error signalled and not see any error */
/* information. This is not a very useful thing. */
errprt_("SET", "NONE, SHORT, LONG, TRACEBACK", (ftnlen)3, (ftnlen)28);
/* Set up the prompt table for the different types of files. */
s_copy(prmtbl + 80, "Enter the name of the comment file to be #.", (
ftnlen)80, (ftnlen)43);
s_copy(prmtbl, "Enter the name of the binary file.", (ftnlen)80, (ftnlen)
34);
/* Set up the message table for the different ``types'' of */
/* operations. The message table contains generic messages which will */
/* have their missing parts filled in after the option and file type */
/* havve been selected. */
s_copy(messgs, "Reading the comment area of the # file.", (ftnlen)1000, (
ftnlen)39);
s_copy(messgs + 1000, "Adding comments to the # file.", (ftnlen)1000, (
ftnlen)30);
s_copy(messgs + 2000, "Extracting comments from the # file.", (ftnlen)
1000, (ftnlen)36);
s_copy(messgs + 3000, "Deleting the comment area of # file.", (ftnlen)
1000, (ftnlen)36);
s_copy(messgs + 4000, "Quitting the program.", (ftnlen)1000, (ftnlen)21);
s_copy(messgs + 5000, "The comments were successfully #.", (ftnlen)1000, (
ftnlen)33);
s_copy(messgs + 6000, "The comments were NOT successfully #.", (ftnlen)
1000, (ftnlen)37);
/* Display a brief commercial with the name of the program and the */
/* version. */
s_copy(line, " Welcome to COMMNT Version: #", (ftnlen)1000, (ftnlen)31);
repmc_(line, "#", "6.0.1", line, (ftnlen)1000, (ftnlen)1, (ftnlen)5, (
ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
/* Writing concatenation */
i__1[0] = 23, a__1[0] = " (Spice Toolkit ";
i__1[1] = r__, a__1[1] = tkv;
i__1[2] = 1, a__1[2] = ")";
s_cat(line, a__1, i__1, &c__3, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
/* Initialize the CELL oriented set for collecting open DAF or DAS */
/* files in the event of an error. */
ssizei_(&c__1, opnset);
/* While there is still more to do ... */
done = FALSE_;
while(! done) {
/* We initialize a few things here, so that they get reset for */
/* every trip through the loop. */
/* Initialize the logical flags that we use. */
comnts = FALSE_;
contnu = TRUE_;
eoc = FALSE_;
ndfnms = FALSE_;
/* Initialize the filename table, ... */
s_copy(fnmtbl, " ", (ftnlen)128, (ftnlen)1);
s_copy(fnmtbl + 128, " ", (ftnlen)128, (ftnlen)1);
/* the file status table, ... */
s_copy(statbl, " ", (ftnlen)3, (ftnlen)1);
s_copy(statbl + 3, " ", (ftnlen)3, (ftnlen)1);
/* the table indices, ... */
tblidx[0] = 0;
tblidx[1] = 0;
/* set the number of file names to zero, ... */
numfnm = 0;
/* the prompts in the prompt table, ... */
s_copy(prmpts, " ", (ftnlen)80, (ftnlen)1);
s_copy(prmpts + 80, " ", (ftnlen)80, (ftnlen)1);
/* the message, and the option. */
s_copy(messag, " ", (ftnlen)1000, (ftnlen)1);
s_copy(option, " ", (ftnlen)20, (ftnlen)1);
/* Set the status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)1000);
/* Get the option to be performed from the main menu. */
getopt_(maintl, &c__5, mainnm, maintx, &iopt, (ftnlen)20, (ftnlen)1, (
ftnlen)40);
s_copy(option, mainvl + ((i__2 = iopt - 1) < 5 && 0 <= i__2 ? i__2 :
s_rnge("mainvl", i__2, "commnt_", (ftnlen)502)) * 20, (ftnlen)
20, (ftnlen)20);
/* Set up the messages and other information for the option */
/* selected. */
if (contnu) {
if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) {
ndfnms = TRUE_;
numfnm = 2;
s_copy(messag, messgs + 1000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 2;
s_copy(prmpts, prmtbl + 80, (ftnlen)80, (ftnlen)80);
repmc_(prmpts, "#", "added", prmpts, (ftnlen)80, (ftnlen)1, (
ftnlen)5, (ftnlen)80);
s_copy(statbl + 3, "OLD", (ftnlen)3, (ftnlen)3);
tblidx[1] = 1;
s_copy(prmpts + 80, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "added", status, (ftnlen)1000, (ftnlen)1,
(ftnlen)5, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "added", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000);
} else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13)
== 0) {
ndfnms = TRUE_;
numfnm = 1;
s_copy(messag, messgs, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "read", status, (ftnlen)1000, (ftnlen)1, (
ftnlen)4, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "read", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)4, (ftnlen)1000);
} else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
16) == 0) {
ndfnms = TRUE_;
numfnm = 2;
s_copy(messag, messgs + 2000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
tblidx[1] = 2;
s_copy(prmpts + 80, prmtbl + 80, (ftnlen)80, (ftnlen)80);
repmc_(prmpts + 80, "#", "created", prmpts + 80, (ftnlen)80, (
ftnlen)1, (ftnlen)7, (ftnlen)80);
s_copy(statbl + 3, "NEW", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "extracted", status, (ftnlen)1000, (
ftnlen)1, (ftnlen)9, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "extracted", status + 1000, (
ftnlen)1000, (ftnlen)1, (ftnlen)9, (ftnlen)1000);
} else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
15) == 0) {
ndfnms = TRUE_;
numfnm = 1;
s_copy(messag, messgs + 3000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "deleted", status, (ftnlen)1000, (ftnlen)
1, (ftnlen)7, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "deleted", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)7, (ftnlen)1000);
} else if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
s_copy(messag, messgs + 4000, (ftnlen)1000, (ftnlen)1000);
}
}
/* Collect any filenames that we may need. */
if (contnu && ndfnms) {
/* we always need at least one filename if we get to here. */
i__ = 1;
more = TRUE_;
while(more) {
fileok = FALSE_;
tryagn = TRUE_;
while(tryagn) {
tostdo_(" ", (ftnlen)1);
tostdo_(prmpts + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ?
i__2 : s_rnge("prmpts", i__2, "commnt_", (ftnlen)
614)) * 80, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
getfnm_("Filename? ", statbl + ((i__3 = tblidx[(i__2 =
i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("tblidx"
, i__2, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <=
i__3 ? i__3 : s_rnge("statbl", i__3, "commnt_", (
ftnlen)617)) * 3, fnmtbl + (((i__5 = tblidx[(i__4
= i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("tbl"
"idx", i__4, "commnt_", (ftnlen)617)] - 1) < 2 &&
0 <= i__5 ? i__5 : s_rnge("fnmtbl", i__5, "commn"
"t_", (ftnlen)617)) << 7), &fileok, errmsg, (
ftnlen)10, (ftnlen)3, (ftnlen)128, (ftnlen)320);
/* If the filename is OK, increment the filename index */
/* and leave the try again loop. Otherwise, write out the */
/* error message, and give the opportunity to go around */
/* again. */
if (fileok) {
++i__;
tryagn = FALSE_;
} else {
tostdo_(" ", (ftnlen)1);
tostdo_(errmsg, (ftnlen)320);
tostdo_(" ", (ftnlen)1);
cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20);
if (! tryagn) {
contnu = FALSE_;
more = FALSE_;
}
}
}
if (i__ > numfnm) {
more = FALSE_;
}
}
}
/* Get the file architecture and type. */
if (contnu && ndfnms) {
getfat_(fnmtbl, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4);
if (failed_()) {
contnu = FALSE_;
}
}
/* Check to see that we got back a valid architecture and type. */
if (contnu && ndfnms) {
if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__,
"?", (ftnlen)4, (ftnlen)1) == 0) {
contnu = FALSE_;
setmsg_("The architecture and type of the binary file '#' co"
"uld not be determined. A common error is to give the"
" name of a text file instead of the name of a binary"
" file.", (ftnlen)161);
errch_("#", fnmtbl, (ftnlen)1, (ftnlen)128);
sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20);
}
}
/* Customize the message. We know we can do this, because we */
/* need files, and so we don't have the QUIT message. */
if (contnu && ndfnms) {
repmc_(messag, "#", type__, messag, (ftnlen)1000, (ftnlen)1, (
ftnlen)4, (ftnlen)1000);
}
/* Process the option that was selected so long ago. */
if (contnu) {
if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
done = TRUE_;
} else if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12)
== 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
(ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
/* Open the text file which contains the comments to be */
/* added to the binary file. */
txtopr_(fnmtbl + 128, &comlun, (ftnlen)128);
if (! failed_()) {
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
{
/* Open the binary file, add the comments, and close */
/* the binary file. */
dasopw_(fnmtbl, &handle, (ftnlen)128);
dasacu_(&comlun, " ", " ", &insbln, &handle, (ftnlen)
1, (ftnlen)1);
dascls_(&handle);
}
/* Close the comment file. */
cl__1.cerr = 0;
cl__1.cunit = comlun;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13)
== 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no comments found in the fil"
"e.", (ftnlen)41);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no commentfound in the file.",
(ftnlen)39);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no comments found in the fil"
"e.", (ftnlen)41);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dasopr_(fnmtbl, &handle, (ftnlen)128);
dasecu_(&handle, &c__6, &comnts);
dascls_(&handle);
if (! comnts) {
s_copy(line, "There were no comments found in the fi"
"le.", (ftnlen)1000, (ftnlen)41);
tostdo_(line, (ftnlen)1000);
}
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
16) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
(ftnlen)128, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
/* Open the text file. */
txtopn_(fnmtbl + 128, &comlun, (ftnlen)128);
if (! failed_()) {
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
{
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dasopr_(fnmtbl, &handle, (ftnlen)128);
dasecu_(&handle, &comlun, &comnts);
dascls_(&handle);
if (! comnts) {
s_copy(line, "There were no comments found in th"
"e file.", (ftnlen)1000, (ftnlen)41);
tostdo_(line, (ftnlen)1000);
}
}
/* Close the text file that we opened. */
cl__1.cerr = 0;
cl__1.cunit = comlun;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
15) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dasopw_(fnmtbl, &handle, (ftnlen)128);
dasdc_(&handle);
dascls_(&handle);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
}
}
/* If anything failed, close any binary files that might still be */
/* open and reset the error handling before getting the next */
/* option. */
if (failed_()) {
/* Before we can attempt to perform any clean up actions if an */
/* error occurred, we need to reset the SPICELIB error handling */
/* mechanism so that we can call the SPICELIB routines that we */
/* need to. */
reset_();
/* Clear out any binary file handles in the open set, OPNSET. */
scardi_(&c__0, opnset);
cleari_(&c__1, &opnset[6]);
/* Get the handles for any DAF files which may still be open. */
dafhof_(opnset);
numopn = cardi_(opnset);
if (numopn > 0) {
i__2 = numopn;
for (i__ = 1; i__ <= i__2; ++i__) {
dafcls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
s_rnge("opnset", i__3, "commnt_", (ftnlen)1100)])
;
}
}
/* Clear out any binary file handles in the open set, OPNSET. */
scardi_(&c__0, opnset);
cleari_(&c__1, &opnset[6]);
/* Get the handles for any DAS files which may still be open. */
dashof_(opnset);
numopn = cardi_(opnset);
if (numopn > 0) {
i__2 = numopn;
for (i__ = 1; i__ <= i__2; ++i__) {
dascls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
s_rnge("opnset", i__3, "commnt_", (ftnlen)1121)])
;
}
}
/* If there was an error and we were extracting comments to a */
/* file, then we should delete the file that was created, */
/* because we do not know whether the extraction was completed */
/* successfully. */
if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)16) ==
0) {
if (exists_(fnmtbl + 128, (ftnlen)128)) {
delfil_(fnmtbl + 128, (ftnlen)128);
}
}
/* Finally, reset the error handling, and go get the next */
/* option. This is just to be sure. */
reset_();
}
}
chkout_("COMMNT", (ftnlen)6);
return 0;
} /* MAIN__ */
