/* $Procedure ZZDAFGFR ( Private --- DAF Get Data Record ) */
/* Subroutine */ int zzdafgfr_(integer *handle, char *idword, integer *nd,
integer *ni, char *ifname, integer *fward, integer *bward, integer *
free, logical *found, ftnlen idword_len, ftnlen ifname_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer natbff = 0;
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), s_rdue(cilist *),
do_uio(integer *, char *, ftnlen), e_rdue(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer ibff, iamh;
extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen,
ftnlen), zzddhnfo_(integer *, char *, integer *, integer *,
integer *, logical *, ftnlen), zzddhhlu_(integer *, char *,
logical *, integer *, ftnlen), zzplatfm_(char *, char *, ftnlen,
ftnlen), zzxlatei_(integer *, char *, integer *, integer *,
ftnlen);
integer i__;
char fname[255];
integer iarch;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer locnd;
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
integer locni;
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
extern logical failed_(void);
logical locfnd;
char chrbuf[1024], locifn[60];
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
integer cindex, locbwd;
char locidw[8];
integer locfre;
static char strbff[8*4];
integer locfwd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
char tmpstr[8];
integer lun;
/* Fortran I/O blocks */
static cilist io___13 = { 1, 0, 1, 0, 1 };
static cilist io___21 = { 1, 0, 1, 0, 1 };
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Read the contents of the file record of a DAF. */
/* $ 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 */
/* PRIVATE */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of the DAF. */
/* IDWORD O DAF ID Word that indicates file type. */
/* ND O Number of double precision components in summaries. */
/* NI O Number of integer components in summaries. */
/* IFNAME O Internal file name. */
/* FWARD O Forward list pointer. */
/* BWARD O Backward list pointer. */
/* FREE O Free address pointer. */
/* FOUND O Logical indicating whether the record was found. */
/* $ Detailed_Input */
/* HANDLE is the handle associated with the DAF. */
/* $ Detailed_Output */
/* IDWORD is a character string identifying the architecture */
/* and type of a SPICE binary kernel. In this case */
/* it will be a string identifying the type of DAF. */
/* ND, */
/* NI are the number of double precision and integer */
/* components, respectively, in each array summary in */
/* the specified file. */
/* IFNAME is the internal file name stored in the first */
/* (or file) record of the specified file. */
/* FWARD is the forward list pointer. This points to the */
/* first summary record in the file. (Records between */
/* the first record and the first summary record are */
/* reserved when the file is created, and are invisible */
/* to DAF routines.) */
/* BWARD is the backward list pointer. This points */
/* to the final summary record in the file. */
/* FREE is the free address pointer. This contains the */
/* first free address in the file. (That is, the */
/* initial address of the next array to be added */
/* to the file.) */
/* FOUND is TRUE when the file record is found, and is */
/* FALSE otherwise. */
/* $ Parameters */
/* None. */
/* $ Files */
/* This routine reads data from the DAF associated with HANDLE. */
/* This action may result in connecting a logical unit to the */
/* file, if the handle manager has rotated the file out of the */
/* unit table. */
/* $ Exceptions */
/* 1) SPICE(HANDLENOTFOUND) is signaled if HANDLE can not be */
/* found in the set of loaded handles. The output arguments */
/* are unmodified when this error occurs. */
/* 2) Routines in the call tree of this routine may trap and */
/* signal errors. The output arguments are unmodified in */
/* these cases. */
/* $ Particulars */
/* This routine reads the publically available components of */
/* file records from native and supported non-native DAFs. */
/* The size of the character buffer and the number of records */
/* read may have to change to support new environments. As of */
/* the original release of this routine, all systems currently */
/* supported have a 1 kilobyte record length. */
/* $ Examples */
/* See DAFRFR for sample usage. */
/* $ Restrictions */
/* 1) Numeric data when read as characters from a file preserves */
/* the bit patterns present in the file in memory. */
/* 2) A record of double precision data is at most 1024 characters */
/* in length. */
/* 3) Future updates to this module must preserve the fact that */
/* FOUND is returned as FALSE whenever an error occurs. An */
/* incompletely translated or extracted file record is NOT */
/* FOUND. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Record Number of the file record in a DAF. */
/* Length of the IDWORD string. */
/* Length of the internal filename string. */
/* Starting location in bytes of the internal filename in the */
/* file record. */
/* Size of an integer in bytes. */
/* Local Variables */
/* Saved Variables */
/* Data Statements */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZDAFGFR", (ftnlen)8);
}
/* Perform some initialization tasks. */
if (first) {
/* Populate STRBFF, the buffer that contains the labels */
/* for each binary file format. */
for (i__ = 1; i__ <= 4; ++i__) {
zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <=
i__1 ? i__1 : s_rnge("strbff", i__1, "zzdafgfr_", (ftnlen)
275)) << 3), (ftnlen)3, (ftnlen)8);
}
/* Fetch the native binary file format and determine its */
/* integer code. */
zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8);
ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8);
natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8);
if (natbff == 0) {
setmsg_("The binary file format, '#', is not supported by this v"
"ersion of the toolkit. This is a serious problem, contac"
"t NAIF.", (ftnlen)118);
errch_("#", tmpstr, (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
}
/* Do not perform initialization tasks again. */
first = FALSE_;
}
/* Assume the data record will not be found, until it has been read */
/* from the file, and if necessary, successfully translated. */
*found = FALSE_;
/* Retrieve information regarding the file from the handle manager. */
/* The value of IARCH is not a concern, since this is a DAF routine */
/* all values passed into handle manager entry points will have */
/* 'DAF' as their architecture arguments. */
zzddhnfo_(handle, fname, &iarch, &ibff, &iamh, &locfnd, (ftnlen)255);
if (! locfnd) {
setmsg_("Unable to locate file associated with HANDLE, #. The most "
"likely cause of this is the file that you are trying to read"
" has been closed.", (ftnlen)136);
errint_("#", handle, (ftnlen)1);
sigerr_("SPICE(HANDLENOTFOUND)", (ftnlen)21);
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
}
/* Now get a logical unit for the handle. Check FAILED() in */
/* case an error occurs. */
zzddhhlu_(handle, "DAF", &c_false, &lun, (ftnlen)3);
if (failed_()) {
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
}
/* Branch based on whether the binary file format is native */
/* or not. Only supported formats can be opened by ZZDDHOPN, */
/* so no check of IBFF is required. */
if (ibff == natbff) {
/* In the native case, just read the components of the file */
/* record from the file. */
io___13.ciunit = lun;
iostat = s_rdue(&io___13);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, locidw, (ftnlen)8);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locnd, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locni, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, locifn, (ftnlen)60);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locfwd, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locbwd, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locfre, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
/* Since this routine does not signal any IOSTAT based */
/* errors, return if a non-zero value is assigned to IOSTAT. */
if (iostat != 0) {
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
}
/* Process the non-native binary file format case. */
} else {
/* Read the data record as characters. */
io___21.ciunit = lun;
iostat = s_rdue(&io___21);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, chrbuf, (ftnlen)1024);
if (iostat != 0) {
goto L100002;
}
iostat = e_rdue();
L100002:
/* Again, since this routine does not signal any IOSTAT */
/* based errors, return if one occurs. */
if (iostat != 0) {
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
}
/* Assign the character components of the file record. */
s_copy(locidw, chrbuf, (ftnlen)8, (ftnlen)8);
s_copy(locifn, chrbuf + 16, (ftnlen)60, (ftnlen)60);
/* Convert the integer components. */
cindex = 9;
zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locnd, (ftnlen)4);
cindex += 4;
zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locni, (ftnlen)4);
cindex = 77;
zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locfwd, (ftnlen)4);
cindex += 4;
zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locbwd, (ftnlen)4);
cindex += 4;
zzxlatei_(&ibff, chrbuf + (cindex - 1), &c__1, &locfre, (ftnlen)4);
if (failed_()) {
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
}
}
/* Transfer the contents of the record to the output arguments */
/* and return to the caller. */
*found = TRUE_;
s_copy(idword, locidw, idword_len, (ftnlen)8);
*nd = locnd;
*ni = locni;
s_copy(ifname, locifn, ifname_len, (ftnlen)60);
*fward = locfwd;
*bward = locbwd;
*free = locfre;
chkout_("ZZDAFGFR", (ftnlen)8);
return 0;
} /* zzdafgfr_ */
/* $Procedure ZZASCII ( determine/verify EOL terminators in a text file ) */
/* Subroutine */ int zzascii_(char *file, char *line, logical *check, char *
termin, ftnlen file_len, ftnlen line_len, ftnlen termin_len)
{
/* System generated locals */
olist o__1;
cllist cl__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_len(char *, ftnlen), f_open(olist *), f_clos(cllist *), s_rdue(
cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void);
/* Local variables */
extern /* Subroutine */ int zzplatfm_(char *, char *, ftnlen, ftnlen);
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
extern integer rtrim_(char *, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
integer maccnt, reclen;
char native[5];
integer number, doscnt;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), getlun_(integer *), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
integer unxcnt;
/* Fortran I/O blocks */
static cilist io___5 = { 1, 0, 1, 0, 1 };
/* $ Abstract */
/* Returns a string indicating the line terminators of an ASCII file */
/* and, if requested, stops execution if the terminator does match */
/* the one that is native to the platform on which the toolkit was */
/* compiled. */
/* $ 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 */
/* FILE TYPE */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* FILE I Name of the text file to scan. */
/* LINE I The work string for file reads. */
/* CHECK I Flag directing to check for mismatched EOL. */
/* TERMIN 0 The deduced terminator ID. */
/* $ Detailed_Input */
/* FILE the name of the ASCII file to scan for a line */
/* terminator */
/* LINE a character string of sufficient length to perform the */
/* line reads from FILE. */
/* CHECK a logical flag that, if set to .TRUE., instructs this */
/* routine to check terminator that has been determined */
/* against the one that is native to the platform, on */
/* which the toolkit was compiled, and to generate error */
/* if it was not the case. If set to .FALSE., instructs */
/* the routine to bypass the check. */
/* $ Detailed_Output */
/* TERMIN the terminator ID extracted from FILE. The possible */
/* values: */
/* 'CR' - carriage return (Mac classic) */
/* 'LF' - line feed (Unix) */
/* 'CR-LF' - carriage return and line feed (DOS) */
/* '?' - unable to determine, possibly */
/* due to an error event */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) A SPICE(STRINGTOOSHORT) error signals if LINE has length less */
/* than 3. */
/* 2) A SPICE(FILEOPENFAILED) error signals if the file of interest */
/* fails to open, i.e. IOSTAT < 0. */
/* 3) A text kernel found to contain non-native line terminators */
/* and abort of the run was requested by causes this routine to */
/* signal the error SPICE(INCOMPATIBLEEOL). */
/* $ Files */
/* None. */
/* $ Particulars */
/* The function scans a string read from a text file to determine */
/* the native platform of the file. The functions response is */
/* unpredictable if it scans a binary file. */
/* $ Examples */
/* To return EOL terminator for a given file: */
/* CHARACTER*(5) TERMIN */
/* CHARACTER*(64) LINE */
/* ... given a file name */
/* ... and a line long enough to hold a text string */
/* from FILE */
/* CALL ZZASCII( FILE, LINE, .FALSE., TERMIN ) */
/* CALL TOSTDO( 'FOUND FILE TERMINATOR '//TERMIN ) */
/* To stop if EOL terminator for a given file, if detected */
/* successfully, is not native to this platform: */
/* CHARACTER*(5) TERMIN */
/* CHARACTER*(64) LINE */
/* ... given a file name */
/* ... and a line long enough to hold a text string */
/* from FILE */
/* CALL ZZASCII( FILE, LINE, .TRUE., TERMIN ) */
/* If the EOL terminator was not native, the call will generate */
/* SPICE(INCOMPATIBLEEOL) error. */
/* $ Restrictions */
/* 1) The terminator detection is not performed if the read from */
/* the file fails because the file is smaller than the allocated */
/* LINE size or for any other reason. */
/* 2) The terminator detection is not possible if the length of the */
/* first text line in the file exceeds the length of the LINE */
/* work space. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - 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.1, 26-OCT-2006 (EDW) */
/* Expanded error message explanation the */
/* routine outputs when the file-of-interest */
/* includes non-native text line terminators. */
/* - 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.0, 17-FEB-2004 (EDW) (BVS) */
/* -& */
/* $ Index_Entries */
/* determine ascii text file end-of-line type */
/* -& */
/* SPICELIB functions. */
/* Local parameters. */
/* Local variables. */
/* Discovery check-in. Can't determine the terminator in RETURN */
/* mode. */
if (return_()) {
s_copy(termin, "?", termin_len, (ftnlen)1);
return 0;
}
/* Check-in to the error system. */
chkin_("ZZASCII", (ftnlen)7);
/* Retrieve the native line terminator. */
zzplatfm_("TEXT_FORMAT", native, (ftnlen)11, (ftnlen)5);
/* If it is VAX, return immediately with undefined terminator. */
if (eqstr_(native, "VAX", (ftnlen)5, (ftnlen)3)) {
s_copy(termin, "?", termin_len, (ftnlen)1);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* Set the record lenght that will be used to read data from */
/* the file. */
reclen = i_len(line, line_len);
/* Check the length of the work string is sufficient to perform the */
/* operations. Less than 3 is a no-op. */
if (i_len(line, line_len) < 3) {
s_copy(termin, "?", termin_len, (ftnlen)1);
setmsg_("Work string lacks sufficient length to perform operation.", (
ftnlen)57);
sigerr_("SPICE(STRINGTOOSHORT)", (ftnlen)21);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* Find a free logical unit for file access. */
getlun_(&number);
/* Open the file for DIRECT access. */
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = rtrim_(file, file_len);
o__1.ofnm = file;
o__1.orl = reclen;
o__1.osta = "OLD";
o__1.oacc = "DIRECT";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
if (iostat != 0) {
/* The open failed, can't determine the terminator if the routine */
/* can't open the file. */
s_copy(termin, "?", termin_len, (ftnlen)1);
/* Execute a close, J.I.C. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
setmsg_("File open failed for file '$1'. IOSTAT value $2.", (ftnlen)
49);
errch_("$1", file, (ftnlen)2, file_len);
errint_("$2", &iostat, (ftnlen)2);
sigerr_("SPICE(FILEOPENFAIL)", (ftnlen)19);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* Read a line into the LINE variable assigned by the user. */
s_copy(line, " ", line_len, (ftnlen)1);
io___5.ciunit = number;
iostat = s_rdue(&io___5);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, line, line_len);
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
if (iostat != 0) {
/* If something went wrong during this read, a part or the whole */
/* returned line may contain garbage. Instead of examining it and */
/* making wrong determination based on it, set terminator to */
/* undefined and return. */
s_copy(termin, "?", termin_len, (ftnlen)1);
/* Execute a close, J.I.C. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
/* We have a line of text data. Use ICHAR to scan for carriage */
/* returns and line feeds and count how may of various recognized */
/* line termination sequences are in this line. */
doscnt = 0;
unxcnt = 0;
maccnt = 0;
i__ = 1;
while(i__ < i_len(line, line_len)) {
/* Check for ICHAR values of 10 (LF) and 13 (CR). */
if (*(unsigned char *)&line[i__ - 1] == 10) {
/* Found a UNIX line terminator LF. */
++unxcnt;
} else if (*(unsigned char *)&line[i__ - 1] == 13) {
/* Found CR, increment character counter and check */
/* the next character. */
++i__;
if (*(unsigned char *)&line[i__ - 1] == 10) {
/* Found a DOS line terminator CR+LF. */
++doscnt;
} else {
/* Found a Classic Mac line terminator CR. */
++maccnt;
}
}
++i__;
}
/* Examine the counters. */
if (doscnt > 0 && unxcnt == 0 && maccnt == 0) {
/* Only DOS terminator counter is non-zero. ID the file as DOS. */
s_copy(termin, "CR-LF", termin_len, (ftnlen)5);
} else if (doscnt == 0 && unxcnt > 0 && maccnt == 0) {
/* Only Unix terminator counter is non-zero. ID the file as UNIX. */
s_copy(termin, "LF", termin_len, (ftnlen)2);
} else if (doscnt == 0 && unxcnt == 0 && maccnt > 0) {
/* Only Mac terminator counter is non-zero. ID the file as Mac */
/* Classic. */
s_copy(termin, "CR", termin_len, (ftnlen)2);
} else {
/* We can get here in two cases. First if the line did not */
/* contain any CRs or LFs. Second if the line contained more than */
/* one kind of terminators. In either case the format of the file */
/* is unclear. */
s_copy(termin, "?", termin_len, (ftnlen)1);
}
/* Close the file. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
/* If we were told check the terminator against the native one, do */
/* it. */
if (*check) {
/* If the terminator was identified and does not match the native */
/* one, error out. */
if (! eqstr_(termin, native, termin_len, (ftnlen)5) && ! eqstr_(
termin, "?", termin_len, (ftnlen)1)) {
setmsg_("Text file '$1' contains lines terminated with '$2' whil"
"e the expected terminator for this platform is '$3'. SPI"
"CE cannot process the file in the current form. This pro"
"blem likely occurred because the file was copied in bina"
"ry mode between operating systems where the operating sy"
"stems use different text line terminators. Try convertin"
"g the file to native text form using a utility such as d"
"os2unix or unix2dos.", (ftnlen)411);
errch_("$1", file, (ftnlen)2, file_len);
errch_("$2", termin, (ftnlen)2, termin_len);
errch_("$3", native, (ftnlen)2, (ftnlen)5);
sigerr_("SPICE(INCOMPATIBLEEOL)", (ftnlen)22);
chkout_("ZZASCII", (ftnlen)7);
return 0;
}
}
chkout_("ZZASCII", (ftnlen)7);
return 0;
} /* zzascii_ */
/* $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_ */
/* DECK SREADP */
/* Subroutine */ int sreadp_(integer *ipage, integer *list, real *rlist,
integer *lpage, integer *irec)
{
/* System generated locals */
address a__1[4];
integer i__1, i__2, i__3[4];
char ch__1[40];
/* Local variables */
static integer i__, lpg;
static char xern1[8], xern2[8];
static integer irecn, ipagef;
extern /* Subroutine */ int xermsg_(char *, char *, char *, integer *,
integer *, ftnlen, ftnlen, ftnlen);
/* Fortran I/O blocks */
static cilist io___4 = { 1, 0, 0, 0, 0 };
static cilist io___6 = { 1, 0, 0, 0, 0 };
static icilist io___8 = { 0, xern1, 0, "(I8)", 8, 1 };
static icilist io___10 = { 0, xern2, 0, "(I8)", 8, 1 };
/* ***BEGIN PROLOGUE SREADP */
/* ***SUBSIDIARY */
/* ***PURPOSE Subsidiary to SPLP */
/* ***LIBRARY SLATEC */
/* ***TYPE SINGLE PRECISION (SREADP-S, DREADP-D) */
/* ***AUTHOR (UNKNOWN) */
/* ***DESCRIPTION */
/* READ RECORD NUMBER IRECN, OF LENGTH LPG, FROM UNIT */
/* NUMBER IPAGEF INTO THE STORAGE ARRAY, LIST(*). */
/* READ RECORD IRECN+1, OF LENGTH LPG, FROM UNIT NUMBER */
/* IPAGEF INTO THE STORAGE ARRAY RLIST(*). */
/* TO CONVERT THIS PROGRAM UNIT TO DOUBLE PRECISION CHANGE */
/* /REAL (12 BLANKS)/ TO /DOUBLE PRECISION/. */
/* ***SEE ALSO SPLP */
/* ***ROUTINES CALLED XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 811215 DATE WRITTEN */
/* 890605 Corrected references to XERRWV. (WRB) */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900328 Added TYPE section. (WRB) */
/* 900510 Convert XERRWV calls to XERMSG calls. (RWC) */
/* ***END PROLOGUE SREADP */
/* ***FIRST EXECUTABLE STATEMENT SREADP */
/* Parameter adjustments */
--rlist;
--list;
/* Function Body */
ipagef = *ipage;
lpg = *lpage;
irecn = *irec;
io___4.ciunit = ipagef;
io___4.cirec = irecn;
i__1 = s_rdue(&io___4);
if (i__1 != 0) {
goto L100;
}
i__2 = lpg;
for (i__ = 1; i__ <= i__2; ++i__) {
i__1 = do_uio(&c__1, (char *)&list[i__], (ftnlen)sizeof(integer));
if (i__1 != 0) {
goto L100;
}
}
i__1 = e_rdue();
if (i__1 != 0) {
goto L100;
}
io___6.ciunit = ipagef;
io___6.cirec = irecn + 1;
i__1 = s_rdue(&io___6);
if (i__1 != 0) {
goto L100;
}
i__2 = lpg;
for (i__ = 1; i__ <= i__2; ++i__) {
i__1 = do_uio(&c__1, (char *)&rlist[i__], (ftnlen)sizeof(real));
if (i__1 != 0) {
goto L100;
}
}
i__1 = e_rdue();
if (i__1 != 0) {
goto L100;
}
return 0;
L100:
s_wsfi(&io___8);
do_fio(&c__1, (char *)&lpg, (ftnlen)sizeof(integer));
e_wsfi();
s_wsfi(&io___10);
do_fio(&c__1, (char *)&irecn, (ftnlen)sizeof(integer));
e_wsfi();
/* Writing concatenation */
i__3[0] = 15, a__1[0] = "IN SPLP, LPG = ";
i__3[1] = 8, a__1[1] = xern1;
i__3[2] = 9, a__1[2] = " IRECN = ";
i__3[3] = 8, a__1[3] = xern2;
s_cat(ch__1, a__1, i__3, &c__4, (ftnlen)40);
xermsg_("SLATEC", "SREADP", ch__1, &c__100, &c__1, (ftnlen)6, (ftnlen)6, (
ftnlen)40);
return 0;
} /* sreadp_ */
/* $Procedure DASIOD ( DAS, Fortran I/O, double precision ) */
/* Subroutine */ int dasiod_(char *action, integer *unit, integer *recno,
doublereal *record, ftnlen action_len)
{
/* Builtin functions */
integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void),
s_wdue(cilist *), e_wdue(void);
/* Local variables */
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
/* Fortran I/O blocks */
static cilist io___2 = { 1, 0, 1, 0, 0 };
static cilist io___3 = { 1, 0, 0, 0, 0 };
/* $ Abstract */
/* Perform Fortran reads and writes of double precision records. */
/* $ 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 */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ACTION I Action to take (read or write). */
/* UNIT I Fortran unit connected to DAS file. */
/* RECNO I Number of record to read or write. */
/* RECORD I-O DAS double precision record. */
/* $ Detailed_Input */
/* ACTION is a character string specifying whether to read */
/* from or write to the specified DAS file. Possible */
/* values are: */
/* 'READ' */
/* 'WRITE' */
/* Case and leading or trailing blanks are not */
/* significant. */
/* UNIT is the Fortran unit number connected to the DAS */
/* file that is to be read or written. Given the */
/* handle of the DAS file, the unit number can be */
/* obtained using DASHLU. */
/* RECNO is the Fortran record number of the record to be */
/* read or written. */
/* RECORD is a double precision array whose contents are to */
/* be written to record RECNO, if ACTION is WRITE. */
/* $ Detailed_Output */
/* RECORD is a double precision array whose contents are to */
/* be set equal to those of record RECNO, if ACTION */
/* is READ. */
/* $ Parameters */
/* NWD is the number of elements in a DAS double precision */
/* record. */
/* $ Exceptions */
/* 1) If the value of ACTION is not recognized, the error */
/* SPICE(UNRECOGNIZEDACTION) is signalled. */
/* 2) If a Fortran read error occurs, the error */
/* SPICE(DASFILEREADFAILED) is signalled. */
/* 3) If a Fortran write error occurs, the error */
/* SPICE(DASFILEWRITEFAILED) is signalled. */
/* $ Files */
/* See the description of the argument UNIT in $Detailed_Input. */
/* $ Particulars */
/* Normally, routines outside of SPICELIB will not need to call this */
/* routine directly. Writes to DAS files should be performed using */
/* the DASADx and DASUDx routines; reads should be performed using */
/* the DASRDx routines. */
/* This routines centralizes I/O and the concommitant error handling */
/* for DAS character records. */
/* Although most DAS routines use file handles to indentify DAS */
/* files, this routine uses Fortran logical units for this purpose. */
/* Using unit numbers allows the DASIOx routines to be called from */
/* any DAS routine, including entry points of DASFM. (DASFM */
/* contains as entry points the routines DASHLU and DASLUH, which */
/* map between handles and unit numbers.) */
/* $ Examples */
/* 1) Read and print to the screen double precision records */
/* number 10 through 20 from the DAS file designated by HANDLE. */
/* DOUBLE PRECISION RECORD ( NWD ) */
/* . */
/* . */
/* . */
/* CALL DASHLU ( HANDLE, UNIT ) */
/* CALL DASHFN ( HANDLE, NAME ) */
/* DO I = 1, 20 */
/* CALL DASIOD ( 'READ', UNIT, 10, RECORD ) */
/* LABEL = 'Contents of the # record in DAS file #: ' */
/* CALL REPMOT ( LABEL, '#', I, 'L', LABEL ) */
/* CALL REPMC ( LABEL, '#', NAME, LABEL ) */
/* WRITE (*,*) LABEL */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) RECORD */
/* END DO */
/* 2) Write the contents of the array RECORD to record number */
/* 10 in the DAS file designated by HANDLE. */
/* DOUBLE PRECISION RECORD ( NWD ) */
/* . */
/* . */
/* . */
/* CALL DASHLU ( HANDLE, UNIT ) */
/* CALL DASIOD ( 'WRITE', UNIT, 10, RECORD ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* perform Fortran reads of double precision records */
/* perform Fortran writes of double precision records */
/* perform low-level I/O for DAS routines */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
if (eqstr_(action, "READ", action_len, (ftnlen)4)) {
/* We're supposed to read the file. */
io___2.ciunit = *unit;
io___2.cirec = *recno;
iostat = s_rdue(&io___2);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof(
doublereal));
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
if (iostat != 0) {
chkin_("DASIOD", (ftnlen)6);
setmsg_("Could not read DAS double precision record. File = # Re"
"cord number = #. IOSTAT = #.", (ftnlen)83);
errfnm_("#", unit, (ftnlen)1);
errint_("#", recno, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24);
chkout_("DASIOD", (ftnlen)6);
return 0;
}
} else if (eqstr_(action, "WRITE", action_len, (ftnlen)5)) {
/* We're supposed to write to the file. */
io___3.ciunit = *unit;
io___3.cirec = *recno;
iostat = s_wdue(&io___3);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof(
doublereal));
if (iostat != 0) {
goto L100002;
}
iostat = e_wdue();
L100002:
if (iostat != 0) {
chkin_("DASIOD", (ftnlen)6);
setmsg_("Could not write DAS double precision record. File = # R"
"ecord number = #. IOSTAT = #.", (ftnlen)84);
errfnm_("#", unit, (ftnlen)1);
errint_("#", recno, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25);
chkout_("DASIOD", (ftnlen)6);
return 0;
}
} else {
/* The requested action is a little too weird. */
chkin_("DASIOD", (ftnlen)6);
setmsg_("Action was #; should be READ or WRITE", (ftnlen)37);
errch_("#", action, (ftnlen)1, action_len);
sigerr_("SPICE(UNRECOGNIZEDACTION)", (ftnlen)25);
chkout_("DASIOD", (ftnlen)6);
return 0;
}
return 0;
} /* dasiod_ */
/* $Procedure DASWFR ( DAS write file record ) */
/* Subroutine */ int daswfr_(integer *handle, char *idword, char *ifname,
integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc,
ftnlen idword_len, ftnlen ifname_len)
{
/* Builtin functions */
integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wdue(cilist *), e_wdue(void);
/* Local variables */
integer free;
char tail[932];
integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern logical failed_(void);
integer oldcch, locncc, oldcrc;
extern /* Subroutine */ int dashfs_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *);
char locifn[60];
integer oldrch;
extern /* Subroutine */ int dassih_(integer *, char *, ftnlen);
integer lastla[3];
char locidw[8];
integer locncr, locnvc, oldrrc;
char format[8];
integer lastrc[3];
extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *,
integer *, ftnlen), chkout_(char *, ftnlen);
integer lastwd[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), dasufs_(integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *), setmsg_(char *, ftnlen);
integer iostat, locnvr;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
char ifn[60];
/* Fortran I/O blocks */
static cilist io___3 = { 1, 0, 1, 0, 1 };
static cilist io___13 = { 1, 0, 0, 0, 1 };
/* $ Abstract */
/* Update the contents of the file record of a specified DAS 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 */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* IDWORD I ID word. */
/* IFNAME I DAS internal file name. */
/* NRESVR I Number of reserved records in file. */
/* NRESVC I Number of characters in use in reserved rec. area. */
/* NCOMR I Number of comment records in file. */
/* NCOMC I Number of characters in use in comment area. */
/* $ Detailed_Input */
/* HANDLE is a file handle for a DAS file open for writing. */
/* IDWORD is the `ID word' contained in the first eight */
/* characters of the file record. */
/* IFNAME is the internal file name of the DAS file. The */
/* maximum length of the internal file name is 60 */
/* characters. */
/* NRESVR is the number of reserved records in the DAS file */
/* specified by HANDLE. */
/* NRESVC is the number of characters in use in the reserved */
/* record area of the DAS file specified by HANDLE. */
/* NCOMR is the number of comment records in the DAS file */
/* specified by HANDLE. */
/* NCOMC is the number of characters in use in the comment area */
/* of the DAS file specified by HANDLE. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the handle passed to this routine is not the handle of an */
/* open DAS file, the error will be signaled by a routine called */
/* by this routine. */
/* 2) If the specified DAS file is not open for write access, the */
/* error will be diagnosed by a routine called by this routine. */
/* 3) If the attempt to read the file record fails, the error */
/* SPICE(DASREADFAIL) is signaled. */
/* 4) If the file write attempted by this routine fails, the error */
/* SPICE(DASFILEWRITEFAILED) is signaled. */
/* $ Files */
/* See the description of HANDLE under $Detailed_Input. */
/* $ Particulars */
/* This routine provides a convenient way of updating the internal */
/* file name of a DAS file. */
/* The `ID word' contained in the file record is a string of eight */
/* characters that identifies the file as a DAS file and optionally */
/* indicates a specific file format, for example, `EK'. */
/* $ Examples */
/* 1) Update the internal file name of an existing DAS file. */
/* C */
/* C Open the file for writing. */
/* C */
/* CALL DASOPW ( FNAME, HANDLE ) */
/* C */
/* C Retrieve the ID word and current reserved record */
/* C and comment area record and character counts. */
/* C */
/* CALL DASRFR ( HANDLE, */
/* . IDWORD, */
/* . IFNAME, */
/* . NRESVR, */
/* . NRESVC, */
/* . NCOMR, */
/* . NCOMC ) */
/* C */
/* C Set the internal file name and update the file */
/* C with it. */
/* C */
/* IFNAME = 'New internal file name' */
/* CALL DASWFR ( HANDLE, */
/* . IDWORD, */
/* . IFNAME, */
/* . NRESVR, */
/* . NRESVC, */
/* . NCOMR, */
/* . NCOMC ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */
/* This routine was modified to accomodate the preservation */
/* of the FTP validation and binary file format strings that */
/* are not part of the DAS file record. */
/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if these open routines ever */
/* change. */
/* Added a check of FAILED after the call to DASHLU which will */
/* check out and return if DASHLU fails. This is so that when in */
/* return mode of the error handling the READ following the call */
/* to DASHLU will not be executed. */
/* Reworded some of the descriptions contained in the */
/* $ Detailed_Output section of the header so that they were more */
/* clear. */
/* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* write DAS file record */
/* write DAS internal file name */
/* update DAS internal file name */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */
/* In order to preserve the additional information that */
/* now resides in the file record, this routine reads */
/* the entire record into local buffers, including the */
/* TAILEN characters that follow the actual data content. */
/* The contents of the local buffers that correspond to */
/* information brought in from the call sequence of the */
/* routine are ignored when the record is rewritten. */
/* However, the ID word, the file format string, and the */
/* trailing TAILEN characters that contain the FTP validation */
/* string are rewritten along with the input values. */
/* This routine does not simply replace the FTP validation */
/* string with the components from ZZFTPSTR, since that */
/* would possibly validate a corrupt file created using a newer */
/* Toolkit. */
/* The string arguments passed into this routine are now */
/* copied to local buffers of the appropriate length. */
/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if these open routines ever */
/* change. */
/* Added a check of FAILED after the call to DASHLU which will */
/* check out and return if DASHLU fails. This is so that when in */
/* return mode of the error handling the READ following the call */
/* to DASHLU will not be executed. */
/* Reworded some of the descriptions contained in the */
/* $ Detailed_Output section of the header so that they were more */
/* clear. */
/* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* The parameter TAILEN determines the tail length of a DAS file */
/* record. This is the number of bytes (characters) that */
/* occupy the portion of the file record that follows the */
/* integer holding the first free address. For environments */
/* with a 32 bit word length, 1 byte characters, and DAS */
/* record sizes of 1024 bytes, we have: */
/* 8 bytes - IDWORD */
/* 60 bytes - IFNAME */
/* 4 bytes - NRESVR (32 bit integer) */
/* 4 bytes - NRESVC (32 bit integer) */
/* 4 bytes - NCOMR (32 bit integer) */
/* + 4 bytes - NCOMC (32 bit integer) */
/* --------- */
/* 84 bytes - (All file records utilize this space.) */
/* So the size of the remaining portion (or tail) of the DAS */
/* file record for computing enviroments as described above */
/* would be: */
/* 1024 bytes - DAS record size */
/* - 8 bytes - DAS Binary File Format Word */
/* - 84 bytes - (from above) */
/* ------------ */
/* 932 bytes - DAS file record tail length */
/* Note: environments that do not have a 32 bit word length, */
/* 1 byte characters, and a DAS record size of 1024 bytes, will */
/* require the adjustment of this parameter. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASWFR", (ftnlen)6);
}
/* Check to be sure that HANDLE is attached to a file that is open */
/* with write access. If the call fails, check out and return. */
dassih_(handle, "WRITE", (ftnlen)5);
/* Get the logical unit for this DAS file. */
dashlu_(handle, &unit);
if (failed_()) {
chkout_("DASWFR", (ftnlen)6);
return 0;
}
/* In order to maintain the integrity of the file ID word, the */
/* file FORMAT, and the FTP string if present, we need to */
/* read the entire file record into the appropriate sized local */
/* buffers. The values of the LOCxxx variables are simply */
/* ignored, since the caller passes new values in for updates. */
io___3.ciunit = unit;
iostat = s_rdue(&io___3);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, locidw, (ftnlen)8);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, locifn, (ftnlen)60);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locnvr, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locnvc, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locncr, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locncc, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, format, (ftnlen)8);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, tail, (ftnlen)932);
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
if (iostat != 0) {
setmsg_("Attempt to read the file record failed for file '#'. IOSTAT"
" = #", (ftnlen)63);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASREADFAIL)", (ftnlen)18);
chkout_("DASWFR", (ftnlen)6);
return 0;
}
/* Set the value of the internal file name and IDWORD before */
/* writing. This is to guarantee that their lengths are ok. */
s_copy(ifn, ifname, (ftnlen)60, ifname_len);
s_copy(locidw, idword, (ftnlen)8, idword_len);
io___13.ciunit = unit;
iostat = s_wdue(&io___13);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, locidw, (ftnlen)8);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, ifn, (ftnlen)60);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, format, (ftnlen)8);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, tail, (ftnlen)932);
if (iostat != 0) {
goto L100002;
}
iostat = e_wdue();
L100002:
if (iostat != 0) {
setmsg_("Could not write file record. File was #. IOSTAT was #.", (
ftnlen)56);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25);
chkout_("DASWFR", (ftnlen)6);
return 0;
}
/* Update the file summary, in case the values of the reserved */
/* record or comment area counts have changed. */
dashfs_(handle, &oldrrc, &oldrch, &oldcrc, &oldcch, &free, lastla, lastrc,
lastwd);
dasufs_(handle, nresvr, nresvc, ncomr, ncomc, &free, lastla, lastrc,
lastwd);
chkout_("DASWFR", (ftnlen)6);
return 0;
} /* daswfr_ */