/* $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 VERSION ( Print library version information ) */
/* Main program */ MAIN__(void)
{
/* System generated locals */
address a__1[2], a__2[4];
integer i__1[2], i__2, i__3[4], i__4;
doublereal d__1;
char ch__1[25], ch__2[99];
/* Builtin functions */
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
char line[80], vrsn[6];
extern /* Subroutine */ int zzplatfm_(char *, char *, ftnlen, ftnlen);
integer i__;
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
extern doublereal dpmin_(void);
extern /* Subroutine */ int repmd_(char *, char *, doublereal *, integer *
, char *, ftnlen, ftnlen, ftnlen);
extern doublereal dpmax_(void);
char fform[80];
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
char cmplr[80];
extern integer wdcnt_(char *, ftnlen);
char tform[80];
extern integer rtrim_(char *, ftnlen);
char os[80];
extern /* Subroutine */ int getcml_(char *, ftnlen), byebye_(char *,
ftnlen);
extern integer intmin_(void), intmax_(void);
char linout[80*6];
extern /* Subroutine */ int tostdo_(char *, ftnlen), tkvrsn_(char *, char
*, ftnlen, ftnlen);
extern integer pos_(char *, char *, integer *, ftnlen, ftnlen);
char sys[80];
/* $ Abstract */
/* This program prints to standard output the current SPICE */
/* distribution version number, hardware system ID, operating */
/* system ID, compiler name, the format of double precision */
/* numbers for the hardware architecture, and the max and min */
/* values for double precision and integer numbers. */
/* $ 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. */
/* $ Keyword */
/* VERSION */
/* UTILITY */
/* $ Parameters */
/* LINELN length of line output string, set to 80. */
/* DATEID update version time string, set to 20. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The version utility may use 3 different command line arguments. */
/* The default (no arguments) returns the Toolkit version string. */
/* Usage: $ version [OPTION] */
/* $ Description */
/* None. */
/* $ Examples */
/* Default behavior: */
/* $ version */
/* N0051 */
/* Display all (-a) information: */
/* $version -a */
/* Toolkit version : N0051 */
/* System : PC */
/* Operating System : LINUX */
/* Compiler : LINUX G77 */
/* File Format : LTL-IEEE */
/* MAX DP : 1.7976931348623E+308 */
/* MIN DP : -1.7976931348623E+308 */
/* MAX INT : 2147483647 */
/* MIN INT : -2147483647 */
/* Display version (-v) information: */
/* $version -v */
/* Version Utility for SPICE Toolkit edition N0051, */
/* last update: 1.1.0, 05-OCT-2001 */
/* Display help (-h) information: */
/* $version -h */
/* Usage: version [OPTION] */
/* no arguments output only the SPICE toolkit version string. */
/* -a(ll) output all environment variables; SPICE toolkit */
/* version, system ID, operating system, compiler, */
/* binary file format, max and min values for */
/* double precision and integer numbers. */
/* -v(ersion) output the version of the utility. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* SPICELIB Version 1.1.0 26-SEP-2001 (FST) (EDW) */
/* Added TEXT_FORMAT output. */
/* Included options for SYSTEM, O/S, COMPILER, FILE_FORMAT, */
/* max/min DPs & integers, outputs, version, and help. */
/* Added proper SPICE header. */
/* SPICELIB Version 1.0.0 13-NOV-2001 (WLT) */
/* First version, Thu NOV 13 10:04:41 PST 1997 W.L. Taber */
/* -& */
/* SPICELIB functions. */
/* Local Parameters. */
/* Local Variables. */
/* Get command line. */
getcml_(line, (ftnlen)80);
ucase_(line, line, (ftnlen)80, (ftnlen)80);
tkvrsn_("TOOLKIT", vrsn, (ftnlen)7, (ftnlen)6);
/* Parse the command line for arguments. Appropriately respond. */
if (wdcnt_(line, (ftnlen)80) == 0) {
/* No arguments, default to the toolkit version string. */
tostdo_(vrsn, rtrim_(vrsn, (ftnlen)6));
} else if (pos_(line, "-A", &c__1, (ftnlen)80, (ftnlen)2) == 1) {
/* All. Output everything. */
tostdo_(" ", (ftnlen)1);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Toolkit version : ";
i__1[1] = 6, a__1[1] = vrsn;
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)25);
tostdo_(ch__1, (ftnlen)25);
zzplatfm_("SYSTEM", sys, (ftnlen)6, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "System : ";
i__1[1] = 80, a__1[1] = sys;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("O/S", os, (ftnlen)3, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Operating System : ";
i__1[1] = 80, a__1[1] = os;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("COMPILER", cmplr, (ftnlen)8, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Compiler : ";
i__1[1] = 80, a__1[1] = cmplr;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("FILE_FORMAT", fform, (ftnlen)11, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "File Format : ";
i__1[1] = 80, a__1[1] = fform;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
zzplatfm_("TEXT_FORMAT", tform, (ftnlen)11, (ftnlen)80);
/* Writing concatenation */
i__1[0] = 19, a__1[0] = "Text File Format : ";
i__1[1] = 80, a__1[1] = tform;
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)99);
tostdo_(ch__2, (ftnlen)99);
s_copy(linout, "MAX DP : #", (ftnlen)80, (ftnlen)21);
d__1 = dpmax_();
repmd_(linout, "#", &d__1, &c__23, linout, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
tostdo_(linout, (ftnlen)80);
s_copy(linout + 80, "MIN DP : #", (ftnlen)80, (ftnlen)20);
d__1 = dpmin_();
repmd_(linout + 80, "#", &d__1, &c__23, linout + 80, (ftnlen)80, (
ftnlen)1, (ftnlen)80);
tostdo_(linout + 80, (ftnlen)80);
s_copy(linout + 160, "MAX INT : #", (ftnlen)80, (ftnlen)21);
i__2 = intmax_();
repmi_(linout + 160, "#", &i__2, linout + 160, (ftnlen)80, (ftnlen)1,
(ftnlen)80);
tostdo_(linout + 160, (ftnlen)80);
s_copy(linout + 240, "MIN INT : #", (ftnlen)80, (ftnlen)20);
i__2 = intmin_();
repmi_(linout + 240, "#", &i__2, linout + 240, (ftnlen)80, (ftnlen)1,
(ftnlen)80);
tostdo_(linout + 240, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
} else if (pos_(line, "-V", &c__1, (ftnlen)80, (ftnlen)2) == 1) {
/* Version. Output the utility version string. */
/* Writing concatenation */
i__3[0] = 42, a__2[0] = "Version Utility for SPICE Toolkit edition ";
i__3[1] = rtrim_(vrsn, (ftnlen)6), a__2[1] = vrsn;
i__3[2] = 15, a__2[2] = ", last update: ";
i__3[3] = 18, a__2[3] = "1.1.0, 07-JAN-2002 ";
s_cat(linout, a__2, i__3, &c__4, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
tostdo_(linout, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
} else if (pos_(line, "-H", &c__1, (ftnlen)80, (ftnlen)2) == 1) {
/* Help. How does does one use this perplexing routine? */
s_copy(linout, "Usage: version [OPTION]", (ftnlen)80, (ftnlen)23);
s_copy(linout + 80, " no arguments output only the SPICE toolkit v"
"ersion string.", (ftnlen)80, (ftnlen)61);
s_copy(linout + 160, " -a(ll) output all environment variabl"
"es; SPICE toolkit version, system", (ftnlen)80, (ftnlen)79);
s_copy(linout + 240, " ID, operating system, compiler"
", and binary file format, ", (ftnlen)80, (ftnlen)72);
s_copy(linout + 320, " max and min values for double "
"precision and integer numbers.", (ftnlen)80, (ftnlen)76);
s_copy(linout + 400, " -v(ersion) output the version of the util"
"ity.", (ftnlen)80, (ftnlen)50);
tostdo_(" ", (ftnlen)1);
for (i__ = 1; i__ <= 6; ++i__) {
tostdo_(linout + ((i__2 = i__ - 1) < 6 && 0 <= i__2 ? i__2 :
s_rnge("linout", i__2, "version_", (ftnlen)272)) * 80,
rtrim_(linout + ((i__4 = i__ - 1) < 6 && 0 <= i__4 ? i__4
: s_rnge("linout", i__4, "version_", (ftnlen)272)) * 80, (
ftnlen)80));
}
tostdo_(" ", (ftnlen)1);
} else {
/* The user put something on the command line, but nothing */
/* known. Return the toolkit version string. */
tostdo_(vrsn, rtrim_(vrsn, (ftnlen)6));
}
/* Done. Indicate as much. Say bye. */
byebye_("SUCCESS", (ftnlen)7);
s_stop("", (ftnlen)0);
return 0;
} /* MAIN__ */
/* $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 ZZXLATED ( Private --- Translate Double Precision Numbers ) */
/* Subroutine */ int zzxlated_(integer *inbff, char *input, integer *space,
doublereal *output, ftnlen input_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer natbff = 0;
/* System generated locals */
integer i__1, i__2, i__3;
char ch__1[1];
static doublereal equiv_0[128];
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen,
ftnlen), zzplatfm_(char *, char *, ftnlen, ftnlen);
integer i__, j, k;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
integer value;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer numdp;
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
static integer bigint;
#define dpbufr (equiv_0)
static char strbff[8*4];
#define inbufr ((integer *)equiv_0)
integer lenipt;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
extern integer intmin_(void);
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
static integer smlint;
extern logical return_(void);
char tmpstr[8];
integer outpos;
/* $ 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. */
/* Convert double precision values from one binary file format */
/* to another. */
/* $ 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 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 */
/* -------- --- -------------------------------------------------- */
/* INBFF I Binary file format of d.p. values in INPUT. */
/* INPUT I String containing d.p. values read as characters. */
/* SPACE I Number of d.p. values that can be placed in OUTPUT. */
/* OUTPUT O Translated d.p. values. */
/* $ Detailed_Input */
/* INBFF is an integer code that indicates the binary file */
/* format of INPUT. Acceptable values are the */
/* parameters: */
/* BIGI3E */
/* LTLI3E */
/* VAXGFL */
/* VAXDFL */
/* as defined in the include file 'zzddhman.inc'. */
/* INPUT is a string containing a group of d.p. values read */
/* from a file as a character string. The length of */
/* this string must be a multiple of the number of */
/* bytes used to store a d.p. value in a file utilizing */
/* INBFF. */
/* SPACE is the number of d.p. values that OUTPUT has room to */
/* store. */
/* $ Detailed_Output */
/* OUTPUT is an array of double precision values containing */
/* the translated values from INPUT into the native */
/* binary format. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* This routine signals several SPICE(BUG) exceptions. They are */
/* signaled when improperly specified inputs are passed into the */
/* routine or if the module or modules in its calling tree are */
/* improperly configured to run on this platform. Callers that */
/* prevent invalid inputs from being passed into this routine */
/* need not check in. See the $Restrictions section for a */
/* discussion of input argument restrictions. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine translates double precision values from a non-native */
/* binary format read from a file as a sequence of characters to the */
/* native format. */
/* $ Examples */
/* See ZZDAFGSR or ZZDAFGDR. */
/* $ Restrictions */
/* 1) Numeric data when read as characters from a file preserves */
/* the bit patterns present in the file in memory. */
/* 2) The intrinsic ICHAR preserves the bit pattern of the character */
/* byte read from a file. Namely if one examines the integer */
/* created the 8 least significant bits will be precisely those */
/* found in the character. */
/* 3) The size of double precision values on the target environment */
/* are a multiple of some number of bytes. */
/* 4) The length of the INPUT string is a multiple of the number */
/* of bytes for a double precision value in the INBFF format. */
/* 5) INBFF is supported for reading on this platform, and not */
/* equivalent to NATBFF on this platform. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (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.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 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Length of the double precision and integer buffers that */
/* are equivalenced. */
/* These parameters are used for arithmetic shifting. */
/* Local Variables */
/* Equivalence DPBUFR to INBUFR. */
/* Statement Functions */
/* Saved Variables */
/* Data Statements */
/* Statement Function Definitions */
/* This function controls the conversion of characters to integers. */
/* On some supported environments, ICHAR is not sufficient to */
/* produce the desired results. This, however, is not the case */
/* with this particular environment. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZXLATED", (ftnlen)8);
}
/* Perform some initialization tasks. */
if (first) {
/* Populate STRBFF. */
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, "zzxlated_", (ftnlen)
354)) << 3), (ftnlen)3, (ftnlen)8);
}
/* Fetch the native binary file format. */
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_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Store the largest value a 32-bit integer can actually */
/* hold. */
bigint = 2147483647;
/* Prepare the smallest value a 32-bit integer can actually */
/* store, regardless of what INTMIN returns. */
smlint = intmin_();
/* Set SMLINT to the appropriate value if INTMIN is too large. */
if (smlint == -2147483647) {
--smlint;
}
/* Do not perform initialization tasks again. */
first = FALSE_;
}
/* Check to see if INBFF makes sense. */
if (*inbff < 1 || *inbff > 4) {
setmsg_("The integer code used to indicate the binary file format of"
" the input integers, #, is out of range. This error should "
"never occur.", (ftnlen)131);
errint_("#", inbff, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Retrieve the length of the input string, and set the position */
/* into the output buffer to the beginning. */
lenipt = i_len(input, input_len);
outpos = 1;
/* Now branch based on NATBFF. */
if (natbff == 1) {
if (*inbff == 2) {
/* Check to see that the length of the input string is */
/* appropriate. Since this is a string containing LTL-IEEE */
/* d.p. values, and this is a BIG-IEEE machine characters */
/* are 1-byte and d.p. values are 8-bytes. So the length */
/* of INPUT must be a multiple of 8. */
numdp = lenipt / 8;
if (lenipt - (numdp << 3) != 0) {
setmsg_("The input string that is to be translated from the "
"binary format # to format # has a length that is not"
" a multiple of 4 bytes. This error should never occ"
"ur.", (ftnlen)158);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
450)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
451)) << 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Verify there is enough room to store the results of */
/* the translation. */
if (numdp > *space) {
setmsg_("The caller specified that # double precision number"
"s are to be translated from binary format # to #. H"
"owever there is only room to hold # integers in the "
"output array. This error should never occur.", (
ftnlen)200);
errint_("#", &numdp, (ftnlen)1);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
471)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
472)) << 3), (ftnlen)1, (ftnlen)8);
errint_("#", space, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* The remainder of this branch is devoted to translating */
/* and copying blocks of DPBLEN double precision numbers */
/* into OUTPUT. Initialize K, the integer index into the */
/* buffer equivalenced to DPBUFR. */
k = 1;
/* Start looping over each 8 character package in INPUT and */
/* converting it to double precision numbers. */
i__1 = numdp;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute the substring index of the first character */
/* in INPUT for this integer. */
j = (i__ - 1 << 3) + 1;
/* Now arrange the bytes properly. Since these characters */
/* were read from a file utilizing LTL-IEEE: */
/* . */
/* . */
/* . */
/* ------- */
/* | J | - Least Significant Byte of Mantissa */
/* ------- */
/* | J+1 | - Sixth Most Significant Mantissa Byte */
/* ------- */
/* | J+2 | - Fifth Most Significant Mantissa Byte */
/* ------- */
/* | J+3 | - Fourth Most Significant Mantissa Byte */
/* ------- */
/* | J+4 | - Third Most Significant Mantissa Byte */
/* ------- */
/* | J+5 | - Second Most Significant Mantissa Byte */
/* ------- */
/* | J+6 | - Tail of Exponent, Most Significant */
/* ------- Bits of the Mantissa */
/* | J+7 | - Sign Bit, Head of Exponent */
/* ------- */
/* . */
/* . */
/* . */
/* Now rearrange the bytes to place them in the */
/* proper order for d.p. values on BIG-IEEE machines. */
/* This is accomplished in the following manner: */
/* INPUT(J+4:J+4) */
/* INPUT(J+5:J+5)*SHFT8 */
/* INPUT(J+6:J+6)*SHFT16 */
/* + INPUT(J+7:J+7)*SHFT24 */
/* ------------------------- */
/* INBUFR(K) */
/* INPUT(J:J) */
/* INPUT(J+1:J+1)*SHFT8 */
/* INPUT(J+2:J+2)*SHFT16 */
/* + INPUT(J+3:J+3)*SHFT24 */
/* ------------------------- */
/* INBUFR(K+1) */
/* Utilize the military extension bit manipulation */
/* intrinsics to perform the necessary computations. */
/* It has been determined empirically that on these */
/* environments this is faster than arithmetic. */
i__2 = j + 3;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 4 - i__2);
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)553)] = value;
i__2 = j + 4;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 5 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)557)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)557)] | value;
i__2 = j + 5;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 6 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)561)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)561)] | value;
i__2 = j + 6;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 7 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)565)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)565)] | value;
*(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1];
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)569)] = value;
i__2 = j;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)573)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)573)] | value;
i__2 = j + 1;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)577)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)577)] | value;
i__2 = j + 2;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)581)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)581)] | value;
/* Check to see if the local buffer is full and the */
/* double precision numbers need to be moved into the */
/* next block of OUTPUT. */
if (k == 255) {
moved_(dpbufr, &c__128, &output[outpos - 1]);
outpos += 128;
k = 1;
/* Otherwise, increment K. */
} else {
k += 2;
}
}
/* Copy any remaining double precision numbers from DPBUFR */
/* into OUTPUT. */
if (k != 1) {
i__1 = k / 2;
moved_(dpbufr, &i__1, &output[outpos - 1]);
}
} else {
setmsg_("Unable to translate double precision values from binary"
" file format # to #. This error should never occur and i"
"s indicative of a bug. Contact NAIF.", (ftnlen)148);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)618))
<< 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)619))
<< 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
} else if (natbff == 2) {
if (*inbff == 1) {
/* Check to see that the length of the input string is */
/* appropriate. Since this is a string containing BIG-IEEE */
/* d.p. values, and this is a LTL-IEEE machine characters */
/* are 1-byte and d.p. values are 8-bytes. So the length */
/* of INPUT must be a multiple of 8. */
numdp = lenipt / 8;
if (lenipt - (numdp << 3) != 0) {
setmsg_("The input string that is to be translated from the "
"binary format # to format # has a length that is not"
" a multiple of 4 bytes. This error should never occ"
"ur.", (ftnlen)158);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
646)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
647)) << 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Verify there is enough room to store the results of */
/* the translation. */
if (numdp > *space) {
setmsg_("The caller specified that # double precision number"
"s are to be translated from binary format # to #. H"
"owever there is only room to hold # integers in the "
"output array. This error should never occur.", (
ftnlen)200);
errint_("#", &numdp, (ftnlen)1);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
667)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
668)) << 3), (ftnlen)1, (ftnlen)8);
errint_("#", space, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* The remainder of this branch is devoted to translating */
/* and copying blocks of DPBLEN double precision numbers */
/* into OUTPUT. Initialize K, the integer index into the */
/* buffer equivalenced to DPBUFR. */
k = 1;
/* Start looping over each 8 character package in INPUT and */
/* converting them to double precision numbers. */
i__1 = numdp;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute the substring index of the first character */
/* in INPUT for this integer. */
j = (i__ - 1 << 3) + 1;
/* Now arrange the bytes properly. Since these characters */
/* were read from a file utilizing BIG-IEEE: */
/* . */
/* . */
/* . */
/* ------- */
/* | J | - Sign Bit, Head of Exponent */
/* ------- */
/* | J+1 | - Tail of Exponent, Most Significant */
/* ------- Bits of the Mantissa */
/* | J+2 | - Second Most Significant Mantissa Byte */
/* ------- */
/* | J+3 | - Third Most Significant Mantissa Byte */
/* ------- */
/* | J+4 | - Fourth Most Significant Mantissa Byte */
/* ------- */
/* | J+5 | - Fifth Most Significant Mantissa Byte */
/* ------- */
/* | J+6 | - Sixth Most Significant Mantissa Byte */
/* ------- */
/* | J+7 | - Least Significant Byte of Mantissa */
/* ------- */
/* . */
/* . */
/* . */
/* Now rearrange the bytes to place them in the */
/* proper order for d.p. values on LTL-IEEE machines. */
/* This is accomplished in the following manner: */
/* INPUT(J+7:J+7) */
/* INPUT(J+6:J+6)*SHFT8 */
/* INPUT(J+5:J+5)*SHFT16 */
/* + INPUT(J+4:J+4)*SHFT24 */
/* ------------------------- */
/* INBUFR(K) */
/* INPUT(J+3:J+3) */
/* INPUT(J+2:J+2)*SHFT8 */
/* INPUT(J+1:J+1)*SHFT16 */
/* + INPUT(J:J)*SHFT24 */
/* ------------------------- */
/* INBUFR(K+1) */
/* Utilize the military extension bit manipulation */
/* intrinsics to perform the necessary computations. */
/* It has been determined empirically that on these */
/* environments this is faster than arithmetic. */
i__2 = j + 6;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 7 - i__2);
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)749)] = value;
i__2 = j + 5;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 6 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)753)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)753)] | value;
i__2 = j + 4;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 5 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)757)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)757)] | value;
i__2 = j + 3;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 4 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)761)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)761)] | value;
i__2 = j + 2;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2);
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)765)] = value;
i__2 = j + 1;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)769)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)769)] | value;
i__2 = j;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)773)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)773)] | value;
*(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1];
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)777)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)777)] | value;
/* Check to see if the local buffer is full and the */
/* double precision numbers need to be moved into the */
/* next block of OUTPUT. */
if (k == 255) {
moved_(dpbufr, &c__128, &output[outpos - 1]);
outpos += 128;
k = 1;
/* Otherwise, increment K. */
} else {
k += 2;
}
}
/* Copy any remaining double precision numbers from DPBUFR */
/* into OUTPUT. */
if (k != 1) {
i__1 = k / 2;
moved_(dpbufr, &i__1, &output[outpos - 1]);
}
} else {
setmsg_("Unable to translate double precision values from binary"
" file format # to #. This error should never occur and i"
"s indicative of a bug. Contact NAIF.", (ftnlen)148);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)814))
<< 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)815))
<< 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* The native binary file format on this platform is not supported */
/* for the conversion of integers. This is a bug, as this branch */
/* of code should never be reached in normal operation. */
} else {
setmsg_("The native binary file format of this toolkit build, #, is "
"not currently supported for translation of double precision "
"numbers from non-native formats.", (ftnlen)151);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? i__1 :
s_rnge("strbff", i__1, "zzxlated_", (ftnlen)833)) << 3), (
ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
chkout_("ZZXLATED", (ftnlen)8);
return 0;
} /* zzxlated_ */
