/* PURE fio_inquire PUREGV */
int fio_inquire(int inerr, int inunit,
char *infile, int infilen,
ftnint *inex, ftnint *inopen,
ftnint *innum, ftnint *innamed,
char *inname, int innamlen,
char *inacc, int inacclen,
char *inseq, int inseqlen,
char *indir, int indirlen,
char *infmt, int infmtlen,
char *inform, int informlen,
char *inunf, int inunflen,
ftnint *inrecl, ftnint *innrec,
char *inblank, int inblanklen)
{
static inlist params;
params.inerr = inerr;
params.inunit = inunit;
params.infile = infile;
params.infilen = infilen;
params.inex = inex;
params.inopen = inopen;
params.innum = innum;
params.innamed = innamed;
params.inname = inname;
params.innamlen = innamlen;
params.inacc = inacc;
params.inacclen = inacclen;
params.inseq = inseq;
params.inseqlen = inseqlen;
params.indir = indir;
params.indirlen = indirlen;
params.infmt = infmt;
params.infmtlen = infmtlen;
params.inform = inform;
params.informlen = informlen;
params.inunf = inunf;
params.inunflen = inunflen;
params.inrecl = inrecl;
params.innrec = innrec;
params.inblank = inblank;
params.inblanklen = inblanklen;
return f_inqu( ¶ms );
}
/* $Procedure DAFECU( DAF extract comments to a logical unit ) */
/* Subroutine */ int dafecu_(integer *handle, integer *comlun, logical *
comnts)
{
/* System generated locals */
inlist ioin__1;
/* Builtin functions */
integer f_inqu(inlist *);
/* Local variables */
extern /* Subroutine */ int dafec_(integer *, integer *, integer *, char *
, logical *, ftnlen), chkin_(char *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen);
logical opened;
char combuf[1000*22];
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numcom;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
logical gotsom;
extern logical return_(void);
logical eoc;
/* $ Abstract */
/* Extract comments from a previously opened binary DAF file to a */
/* previously opened text file attached to a Fortran logical unit. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* None. */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of a DAF file opened with read access. */
/* COMLUN I Logical unit of an opened text file. */
/* COMNTS O Logical flag, indicating comments were found. */
/* $ Detailed_Input */
/* HANDLE The file handle for a binary DAF file that has been */
/* opened with read access. */
/* COMLUN The Fortran logical unit of a previously opened text */
/* file to which the comments from a binary DAF file are */
/* to be written. */
/* The comments will be placed into the text file beginning */
/* at the current location in the file and continuing */
/* until all of the comments from the comment area of the */
/* DAF file have been written. */
/* $ Detailed_Output */
/* COMNTS A logical flag indicating whether or not any comments */
/* were found in the comment area of a DAF file. COMNTS will */
/* have the value .TRUE. if there were some comments, and */
/* the value .FALSE. otherwise. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input logical unit COMLUN is not positive or there */
/* is not an opened file attached to it, the error */
/* SPICE(INVALIDARGUMENT) will be signalled. */
/* 2) If the INQUIRE on the logical unit to see if there is a */
/* file attached fails, the error SPICE(INQUIREFAILED) will */
/* be signalled. */
/* 3) If an error occurs while reading from the binary DAF file */
/* attached to HANDLE, a routine called by this routine will */
/* signal an error. */
/* 4) If an error occurs while writing to the text file attached */
/* to COMLUN, a routine called by this routine will signal an */
/* error. */
/* $ Files */
/* See parameters COMLUN and HANDLE in the $ Detailed_Inputs section. */
/* $ Particulars */
/* This routine will extract all of the comments from the comment */
/* area of a binary DAF file, placing them into a text file */
/* attached to COMLUN beginning at the current position in the */
/* text file. If there are no comments in the DAF file, nothing is */
/* written to the text file attached to COMLUN. */
/* $ Examples */
/* Let */
/* HANDLE be the DAF file handle of a previously opened binary */
/* DAF file. */
/* COMLUN be the Fortran logical unit of a previously opened */
/* text file that is to accept the comments from the */
/* DAF comment area. */
/* The subroutine call */
/* CALL DAFECU ( HANDLE, COMLUN, COMNTS ) */
/* will extract the comments from the comment area of the binary */
/* DAF file attached to HANDLE, if there are any, and write them */
/* to the logical unit COMLUN. Upon successful completion, the */
/* value of COMNTS will be .TRUE. if there were some comments */
/* in the comment area of the DAF file and .FALSE. otherwise. */
/* $ Restrictions */
/* The maximum length of a single comment line in the comment area is */
/* specified by the parameter LINLEN defined below. Currently this */
/* value is 1000 characters. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - Beta Version 1.1.1, 08-MAY-2001 (BVS) */
/* Buffer line size (LINLEN) was increased from 255 to 1000 */
/* characters to make it consistent the line size in SPC */
/* routines. */
/* - Beta Version 1.1.0, 18-JAN-1996 (KRG) */
/* Added a test and errors for checking to see whether COMLUN */
/* was actually attached to an ASCII text file when this routine */
/* was called. */
/* - Beta Version 1.0.0, 23-SEP-1994 (KRG) */
/* -& */
/* $ Index_Entries */
/* extract comments from a DAF to a logical unit */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Set the value for the maximum length of a text line. */
/* Set the size of the comment buffer. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DAFECU", (ftnlen)6);
}
/* Verify that the DAF file attached to HANDLE is opened for reading. */
dafsih_(handle, "READ", (ftnlen)4);
if (failed_()) {
chkout_("DAFECU", (ftnlen)6);
return 0;
}
/* Logical units must be positive. If it is not, signal an error. */
if (*comlun <= 0) {
setmsg_("# is not a valid logical unit. Logical units must be positi"
"ve.", (ftnlen)62);
errint_("#", comlun, (ftnlen)1);
sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22);
chkout_("DAFECU", (ftnlen)6);
return 0;
}
/* Verify that there is an open ASCII text file attached to COMLUN. */
ioin__1.inerr = 1;
ioin__1.inunit = *comlun;
ioin__1.infile = 0;
ioin__1.inex = 0;
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);
if (iostat != 0) {
setmsg_("The INQUIRE on logical unit # failed. The value of IOSTAT w"
"as #.", (ftnlen)64);
errint_("#", comlun, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20);
chkout_("DAFECU", (ftnlen)6);
return 0;
}
if (! opened) {
setmsg_("There is no open file attached to logical unit #, so no com"
"ments could be written.", (ftnlen)82);
errint_("#", comlun, (ftnlen)1);
sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22);
chkout_("DAFECU", (ftnlen)6);
return 0;
}
/* Initialize some things before the loop. */
numcom = 0;
eoc = FALSE_;
gotsom = FALSE_;
while(! eoc) {
/* While we have not reached the end of the comments, get some */
/* more. */
dafec_(handle, &c__22, &numcom, combuf, &eoc, (ftnlen)1000);
if (failed_()) {
chkout_("DAFECU", (ftnlen)6);
return 0;
}
if (numcom > 0) {
/* If NUMCOM .GT. 0 then we did get some comments, and we need */
/* to write them out, but first, set the flag indicating that */
/* we got some comments. */
if (! gotsom) {
gotsom = TRUE_;
}
writla_(&numcom, combuf, comlun, (ftnlen)1000);
if (failed_()) {
chkout_("DAFECU", (ftnlen)6);
return 0;
}
}
}
/* Set the output flag indicating whether or not we got any comments. */
*comnts = gotsom;
chkout_("DAFECU", (ftnlen)6);
return 0;
} /* dafecu_ */
/* $Procedure WRLINE ( Write Output Line to a Device ) */
/* Subroutine */ int wrline_0_(int n__, char *device, char *line, ftnlen
device_len, ftnlen line_len)
{
/* System generated locals */
integer i__1;
cilist ci__1;
olist o__1;
cllist cl__1;
inlist ioin__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
integer *, char *, ftnlen), e_wsfe(void), f_inqu(inlist *),
s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), f_open(olist *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer f_clos(cllist *);
/* Local variables */
integer unit;
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
extern integer ltrim_(char *, ftnlen);
char error[240];
extern integer rtrim_(char *, ftnlen);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
logical opened;
extern /* Subroutine */ int fndlun_(integer *);
char tmpnam[128];
integer iostat;
extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen,
ftnlen);
logical exists;
char errstr[11];
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
/* Fortran I/O blocks */
static cilist io___6 = { 0, 6, 0, 0, 0 };
static cilist io___7 = { 0, 6, 0, 0, 0 };
static cilist io___8 = { 0, 6, 0, 0, 0 };
static cilist io___9 = { 0, 6, 0, 0, 0 };
static cilist io___10 = { 0, 6, 0, 0, 0 };
static cilist io___11 = { 0, 6, 0, 0, 0 };
static cilist io___12 = { 0, 6, 0, 0, 0 };
static cilist io___15 = { 0, 6, 0, 0, 0 };
static cilist io___16 = { 0, 6, 0, 0, 0 };
static cilist io___17 = { 0, 6, 0, 0, 0 };
static cilist io___18 = { 0, 6, 0, 0, 0 };
/* $ Abstract */
/* Write a character string to an output device. */
/* $ 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 */
/* TEXT */
/* FILES */
/* ERROR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* DEVICE I A string specifying an output device. */
/* LINE I A line of text to be output. */
/* FILEN P Maximum length of a file name. */
/* $ Detailed_Input */
/* LINE is a line of text to be written to the output */
/* device specified by DEVICE. */
/* DEVICE is the output device to which the line of text */
/* will be written. */
/* Possible values and meanings of DEVICE are: */
/* a device name This may be the name of a */
/* file, or any other name that */
/* is valid in a FORTRAN OPEN */
/* statement. For example, on a */
/* VAX, a logical name may be */
/* used. */
/* The device name must not */
/* be any of the reserved strings */
/* below. */
/* 'SCREEN' The output will go to the */
/* terminal screen. */
/* 'NULL' The data will not be output. */
/* 'SCREEN' and 'NULL' can be written in mixed */
/* case. For example, the following call will work: */
/* CALL WRLINE ( 'screEn', LINE ) */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* FILEN is the maximum length of a file name. */
/* $ Exceptions */
/* This routine is a special case as far as error handling */
/* is concerned because it is called to output error */
/* messages resulting from errors detected by other routines. */
/* In such a case, calling SIGERR would constitute recursion. */
/* Therefore, this routine prints error messages rather */
/* than signalling errors via SIGERR and setting the long */
/* error message via SETMSG. */
/* The following exceptional cases are treated as errors: */
/* 1) SPICE(NOFREELOGICALUNIT) -- No logical unit number */
/* is available to refer to the device. */
/* 2) SPICE(FILEOPENFAILED) -- General file open error. */
/* 3) SPICE(FILEWRITEFAILED) -- General file write error. */
/* 4) SPICE(INQUIREFAILED) -- INQUIRE statement failed. */
/* 5) Leading blanks in (non-blank) file names are not */
/* significant. The file names */
/* 'MYFILE.DAT' */
/* ' MYFILE.DAT' */
/* are considered to name the same file. */
/* 6) If different names that indicate the same file are supplied */
/* to this routine on different calls, all output associated */
/* with these calls WILL be written to the file. For example, */
/* on a system where logical filenames are supported, if */
/* ALIAS is a logical name pointing to MYFILE, then the calls */
/* CALL WRLINE ( 'MYFILE', 'This is the first line' ) */
/* CALL WRLINE ( 'ALIAS', 'This is the second line' ) */
/* will place the lines of text */
/* 'This is the first line' */
/* 'This is the second line' */
/* in MYFILE. See $Restrictions for more information on use */
/* of logical names on VAX systems. */
/* $ Files */
/* 1) If DEVICE specifies a device other than 'SCREEN' or 'NULL', */
/* that device is opened (if it's not already open) as a NEW, */
/* SEQUENTIAL, FORMATTED file. The logical unit used is */
/* determined at run time. */
/* $ Particulars */
/* If the output device is a file that is not open, the file will */
/* be opened (if possible) as a NEW, sequential, formatted file, */
/* and the line of text will be written to the file. If the file */
/* is already opened as a sequential, formatted file, the line of */
/* text will be written to the file. */
/* Use the entry point CLLINE to close files opened by WRLINE. */
/* $ Examples */
/* 1) Write a message to the screen: */
/* CALL WRLINE ( 'SCREEN', 'Here''s a message.' ) */
/* The text */
/* Here's a message. */
/* will be written to the screen. */
/* 2) Write out all of the elements of a character string array */
/* to a file. */
/* CHARACTER*(80) STRING ( ASIZE ) */
/* . */
/* . */
/* . */
/* DO I = 1, ASIZE */
/* CALL WRLINE ( FILE, STRING(I) ) */
/* END DO */
/* 3) Set DEVICE to NULL to suppress output: */
/* C */
/* C Ask the user whether verbose program output is */
/* C desired. Set the output device accordingly. */
/* C */
/* WRITE (*,*) 'Do you want to see test results ' // */
/* . 'on the screen?' */
/* READ (*,FMT='(A)') VERBOS */
/* CALL LJUST ( VERBOS, VERBOS ) */
/* CALL UCASE ( VERBOS, VERBOS ) */
/* IF ( VERBOS(1:1) .EQ. 'Y' ) THEN */
/* DEVICE = 'SCREEN' */
/* ELSE */
/* DEVICE = 'NULL' */
/* ENDIF */
/* . */
/* . */
/* . */
/* C */
/* C Output test results. */
/* C */
/* CALL WRLINE ( DEVICE, STRING ) */
/* . */
/* . */
/* . */
/* $ Restrictions */
/* 1) File names must not exceed FILEN characters. */
/* 2) On VAX systems, caution should be exercised when using */
/* multiple logical names to point to the same file. Logical */
/* name translation supporting execution of the Fortran */
/* INQUIRE statement does not appear to work reliably in all */
/* cases, which may lead this routine to believe that different */
/* logical names indicate different files. The specific problem */
/* that has been observed is that logical names that include */
/* disk specifications are not always recognized as pointing */
/* to the file they actually name. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (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.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 4.0.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 4.0.3, 16-SEP-1999 (NJB) */
/* CSPICE environments were added. Some typos were corrected. */
/* - SPICELIB Version 4.0.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 4.0.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 4.0.0, 07-APR-1998 (NJB) */
/* References to the PC-LINUX environment were added. The */
/* write format for the case where the output device is the */
/* screen has been made system-dependent; list-directed output */
/* format is now used for systems that require a leading carriage */
/* control character; other systems use character format. The */
/* write format for the case where the output device is a file */
/* has been changed from list-directed to character. */
/* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */
/* Module was updated to include the value for FILEN */
/* and the appropriate OPEN statement for the Silicon */
/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */
/* value of 256 for Unix platforms was changed to 255. */
/* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */
/* Module was updated to include the value of FILEN for the */
/* Hewlett Packard UX 9000/750 environment. */
/* The code was also reformatted so that a utility program can */
/* create the source file for a specific environment given a */
/* master source file. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
/* This routine now can write to files that have been opened */
/* by other routines. */
/* The limit imposed by this routine on the number of files it */
/* can open has been removed. */
/* The output file is now opened as a normal text file on */
/* VAX systems. */
/* Improper treatment of the case where DEVICE is blank was */
/* remedied. */
/* Unneeded variable declarations and references were removed. */
/* Initialization of SAVED variables was added. */
/* All occurrences of "PRINT *" have been replaced by */
/* "WRITE (*,*)". */
/* Calls to UCASE and LJUST replace in-line code that performed */
/* these operations. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* write output line to a device */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */
/* References to the PC-LINUX environment were added. */
/* The write format for the case where the output device is the */
/* screen has been made system-dependent; list-directed output */
/* format is now used for systems that require a leading carriage */
/* control character; other systems use character format. The */
/* write format for the case where the output device is a file */
/* has been changed from list-directed to character. */
/* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */
/* Module was updated to include the value for FILEN */
/* and the appropriate OPEN statement for the Silicon */
/* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */
/* value of 256 for Unix platforms was changed to 255. */
/* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */
/* Module was updated to include the value of FILEN for the */
/* Hewlett Packard UX 9000/750 environment. */
/* The code was also reformatted so that a utility program can */
/* create the source file for a specific environment given a */
/* master source file. */
/* - SPICELIB Version 2.0.0, 25-MAR-1991 (NJB) */
/* 1) This routine now can write to files that have been opened */
/* by other routines. WRLINE uses an INQUIRE statement to */
/* determine whether the file indicated by DEVICE is open, */
/* and if it is, WRLINE does not attempt to open it. This */
/* allows use of WRLINE to feed error output into a log file */
/* opened by another routine. */
/* The header has been updated accordingly. */
/* This fix also fixes a bug wherein this routine would treat */
/* different character strings naming the same file as though */
/* they indicated different files. */
/* 2) The limit imposed by this routine on the number of files it */
/* can open has been removed. The file database used in */
/* previous versions of this routine is no longer used. */
/* 3) On VAX systems, this routine now opens the output file */
/* (when required to do so) as a normal text file. */
/* 4) Improper treatment of the case where DEVICE is blank was */
/* remedied. Any value of DEVICE that is not equal to */
/* 'SCREEN' or 'NULL' after being left-justified and */
/* converted to upper case is considered to be a file name. */
/* 5) Unneeded variable declarations and references were removed. */
/* The arrays called STATUS and FILES are not needed. */
/* 6) All instances if "PRINT *" have been replaced by */
/* "WRITE (*,*)" because Language Systems Fortran on the */
/* Macintosh interprets "PRINT *" in a non-standard manner. */
/* 7) Use of the EXIST specifier was added to the INQUIRE */
/* statement used to determine whether the file named by */
/* DEVICE is open. This is a work-around for a rather */
/* peculiar behavior of at least one version of Sun Fortran: */
/* files that don't exist may be considered to be open, as */
/* indicated by the OPENED specifier of the INQUIRE statement. */
/* 8) One other thing: now that LJUST and UCASE are error-free, */
/* WRLINE uses them; this simplifies the code. */
/* - Beta Version 1.2.0, 27-FEB-1989 (NJB) */
/* Call to GETLUN replaced by call to FNDLUN, which is error-free. */
/* Call to IOERR replaced with in-line code to construct long */
/* error message indicating file open failure. Arrangement of */
/* declarations changed. Keywords added. FILEN declaration */
/* moved to "declarations" section. Parameters section added. */
/* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */
/* Upper bound of written substring changed to prevent use of */
/* invalid substring bound. Specifically, LASTNB ( LINE ) was */
/* replaced by MAX ( 1, LASTNB (LINE) ). This upper bound */
/* now used in the PRINT statement as well. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Executable Code: */
switch(n__) {
case 1: goto L_clline;
}
ljust_(device, tmpnam, device_len, (ftnlen)128);
ucase_(tmpnam, tmpnam, (ftnlen)128, (ftnlen)128);
/* TMPNAM is now left justified and is in upper case. */
if (s_cmp(tmpnam, "NULL", (ftnlen)128, (ftnlen)4) == 0) {
return 0;
} else if (s_cmp(tmpnam, "SCREEN", (ftnlen)128, (ftnlen)6) == 0) {
ci__1.cierr = 1;
ci__1.ciunit = 6;
ci__1.cifmt = "(A)";
iostat = s_wsfe(&ci__1);
if (iostat != 0) {
goto L100001;
}
iostat = do_fio(&c__1, line, rtrim_(line, line_len));
if (iostat != 0) {
goto L100001;
}
iostat = e_wsfe();
L100001:
return 0;
}
/* Find out whether we'll need to open the file. */
/* We use the EXIST inquiry specifier because files that don't exist */
/* may be (possibly due to a Sun compiler bug) deemed to be OPEN by */
/* Sun Fortran. */
i__1 = ltrim_(device, device_len) - 1;
ioin__1.inerr = 1;
ioin__1.infilen = device_len - i__1;
ioin__1.infile = device + i__1;
ioin__1.inex = &exists;
ioin__1.inopen = &opened;
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) {
/* This is weird. How can an INQUIRE statement fail, */
/* if the syntax is correct? But just in case... */
s_wsle(&io___6);
do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20);
e_wsle();
s_wsle(&io___7);
do_lio(&c__9, &c__1, "WRLINE: File = ", (ftnlen)15);
do_lio(&c__9, &c__1, device, device_len);
do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9);
do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer));
e_wsle();
return 0;
}
if (! (opened && exists)) {
/* We will need a free logical unit. There is always the chance */
/* that no units are available. */
fndlun_(&unit);
if (unit < 1) {
s_wsle(&io___8);
do_lio(&c__9, &c__1, "SPICE(NOFREELOGICALUNIT)", (ftnlen)24);
e_wsle();
s_wsle(&io___9);
do_lio(&c__9, &c__1, " ", (ftnlen)1);
e_wsle();
s_wsle(&io___10);
do_lio(&c__9, &c__1, "WRLINE: Maximum number of logical units th"
"at can be allocated by SPICELIB has already been reached",
(ftnlen)98);
e_wsle();
return 0;
}
/* Okay, we have a unit. Open the file, and hope nothing */
/* goes awry. (On the VAX, the qualifier */
/* CARRIAGECONTROL = 'LIST' */
/* may be inserted into the OPEN statement.) */
i__1 = ltrim_(device, device_len) - 1;
o__1.oerr = 1;
o__1.ounit = unit;
o__1.ofnmlen = device_len - i__1;
o__1.ofnm = device + i__1;
o__1.orl = 0;
o__1.osta = "NEW";
o__1.oacc = 0;
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
if (iostat != 0) {
s_wsle(&io___11);
do_lio(&c__9, &c__1, "SPICE(FILEOPENFAILED)", (ftnlen)21);
e_wsle();
s_wsle(&io___12);
do_lio(&c__9, &c__1, " ", (ftnlen)1);
e_wsle();
s_copy(error, "WRLINE: An error occurred while attempting to open"
, (ftnlen)240, (ftnlen)50);
suffix_(device, &c__1, error, device_len, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)
32, (ftnlen)240);
suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240);
intstr_(&iostat, errstr, (ftnlen)11);
suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
s_wsle(&io___15);
do_lio(&c__9, &c__1, error, (ftnlen)240);
e_wsle();
return 0;
}
/* Whew! We're ready to write to this file. */
}
/* At this point, either we opened the file, or it was already */
/* opened by somebody else. */
/* This is the easy part. Write the next line to the file. */
ci__1.cierr = 1;
ci__1.ciunit = unit;
ci__1.cifmt = "(A)";
iostat = s_wsfe(&ci__1);
if (iostat != 0) {
goto L100002;
}
iostat = do_fio(&c__1, line, rtrim_(line, line_len));
if (iostat != 0) {
goto L100002;
}
iostat = e_wsfe();
L100002:
/* Well, what happened? Any non-zero value for IOSTAT indicates */
/* an error. */
if (iostat != 0) {
s_copy(error, "WRLINE: An error occurred while attempting to WRITE t"
"o ", (ftnlen)240, (ftnlen)55);
suffix_(device, &c__1, error, device_len, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)32,
(ftnlen)240);
suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240);
intstr_(&iostat, errstr, (ftnlen)11);
suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240);
suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
s_wsle(&io___16);
do_lio(&c__9, &c__1, error, (ftnlen)240);
e_wsle();
return 0;
}
return 0;
/* $Procedure CLLINE ( Close a device ) */
L_clline:
/* $ Abstract */
/* Close a device. */
/* $ 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 */
/* TEXT, FILES, ERROR */
/* $ Declarations */
/* CHARACTER*(*) DEVICE */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* DEVICE I Device to be closed. */
/* $ Detailed_Input */
/* DEVICE is the name of a device which is currently */
/* opened for reading or writing. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* This routine is called by SPICELIB error handling routines, so */
/* it cannot use the normal SPICELIB error signalling mechanism. */
/* Instead, it writes error messages to the screen if necessary. */
/* 1) If the device indicated by DEVICE was not opened by WRLINE, */
/* this routine closes it anyway. */
/* 2) If the INQUIRE performed by this routine fails, an error */
/* diagnosis is printed to the screen. */
/* $ Files */
/* This routin */
/* $ Particulars */
/* CLLINE closes a device that is currently open. */
/* $ Examples */
/* 1) Write two lines to the file, SPUD.DAT (VAX file name */
/* syntax), and then close the file. */
/* CALL WRLINE ( 'SPUD.DAT', ' This is line 1 ' ) */
/* CALL WRLINE ( 'SPUD.DAT', ' This is line 2 ' ) */
/* CALL CLLINE ( 'SPUD.DAT' ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 4.0.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 4.0.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 4.0.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 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
/* All occurrences of "PRINT *" have been replaced by */
/* "WRITE (*,*)". */
/* Also, this routine now closes the device named by DEVICE */
/* whether or not the device was opened by WRLINE. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* None. */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
/* All instances if "PRINT *" have been replaced by "WRITE (*,*)" */
/* because Language Systems Fortran on the Macintosh interprets */
/* "PRINT *" in a non-standard manner. */
/* This routine no longer has to maintain the file database, since */
/* WRLINE does not use it any more. */
/* Also, this routine now closes the device named by DEVICE, */
/* whether or not the device was opened by WRLINE. */
/* - Beta Version 1.0.1, 08-NOV-1988 (NJB) */
/* Keywords added. */
/* -& */
/* Find the unit connected to DEVICE. */
i__1 = ltrim_(device, device_len) - 1;
ioin__1.inerr = 1;
ioin__1.infilen = device_len - i__1;
ioin__1.infile = device + i__1;
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) {
/* This is weird. How can an INQUIRE statement fail, */
/* if the syntax is correct? But just in case... */
s_wsle(&io___17);
do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20);
e_wsle();
s_wsle(&io___18);
do_lio(&c__9, &c__1, "CLLINE: File = ", (ftnlen)16);
do_lio(&c__9, &c__1, device, device_len);
do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9);
do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer));
e_wsle();
return 0;
}
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
return 0;
} /* wrline_ */
/* $Procedure GETFAT ( Get file architecture and type ) */
/* Subroutine */ int getfat_(char *file, char *arch, char *kertyp, ftnlen
file_len, ftnlen arch_len, ftnlen kertyp_len)
{
/* System generated locals */
integer i__1;
cilist ci__1;
olist o__1;
cllist cl__1;
inlist ioin__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), s_rnge(
char *, integer, char *, integer), f_open(olist *), s_rdue(cilist
*), do_uio(integer *, char *, ftnlen), e_rdue(void), f_clos(
cllist *), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
e_rsfe(void);
/* Local variables */
integer unit;
extern /* Subroutine */ int zzddhfnh_(char *, integer *, logical *,
ftnlen), zzddhgsd_(char *, integer *, char *, ftnlen, ftnlen),
zzddhnfo_(integer *, char *, integer *, integer *, integer *,
logical *, ftnlen), zzddhhlu_(integer *, char *, logical *,
integer *, ftnlen);
integer i__;
extern integer cardi_(integer *);
char fname[255];
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen);
integer which;
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
logical found, exist;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
idw2at_(char *, char *, char *, ftnlen, ftnlen, ftnlen);
integer handle;
extern /* Subroutine */ int dafcls_(integer *);
char filarc[32];
extern /* Subroutine */ int dashof_(integer *);
integer intbff;
logical opened;
extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen);
integer intarc;
extern /* Subroutine */ int dashlu_(integer *, integer *);
char idword[12];
integer intamn, number;
logical diropn, notdas;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), getlun_(integer *), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen), ssizei_(
integer *, integer *), nextwd_(char *, char *, char *, ftnlen,
ftnlen, ftnlen);
char tmpwrd[12];
extern logical return_(void);
integer myunit, handles[106];
extern /* Subroutine */ int zzckspk_(integer *, char *, ftnlen);
/* Fortran I/O blocks */
static cilist io___19 = { 1, 0, 1, 0, 1 };
/* $ Abstract */
/* Determine the architecture and type of SPICE kernels. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* KERNEL */
/* UTILITY */
/* $ Declarations */
/* $ Abstract */
/* Parameter declarations for the DAF/DAS handle manager. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAF, DAS */
/* $ Keywords */
/* PRIVATE */
/* $ Particulars */
/* This include file contains parameters defining limits and */
/* integer codes that are utilized in the DAF/DAS handle manager */
/* routines. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.5.0, 10-MAR-2014 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-INTEL. */
/* - SPICELIB Version 2.4.0, 10-MAR-2014 (BVS) */
/* Updated for PC-LINUX-64BIT-IFORT. */
/* - SPICELIB Version 2.3.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-GFORTRAN. */
/* - SPICELIB Version 2.2.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
/* - SPICELIB Version 2.1.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GCC_C. */
/* - SPICELIB Version 2.0.0, 12-APR-2012 (BVS) */
/* Increased FTSIZE (from 1000 to 5000). */
/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 1.0.1, 17-JUL-2002 */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 1.0.0, 07-NOV-2001 */
/* -& */
/* Unit and file table size parameters. */
/* FTSIZE is the maximum number of files (DAS and DAF) that a */
/* user may have open simultaneously. */
/* RSVUNT is the number of units protected from being locked */
/* to a particular handle by ZZDDHHLU. */
/* SCRUNT is the number of units protected for use by scratch */
/* files. */
/* UTSIZE is the maximum number of logical units this manager */
/* will utilize at one time. */
/* Access method enumeration. These parameters are used to */
/* identify which access method is associated with a particular */
/* handle. They need to be synchronized with the STRAMH array */
/* defined in ZZDDHGSD in the following fashion: */
/* STRAMH ( READ ) = 'READ' */
/* STRAMH ( WRITE ) = 'WRITE' */
/* STRAMH ( SCRTCH ) = 'SCRATCH' */
/* STRAMH ( NEW ) = 'NEW' */
/* These values are used in the file table variable FTAMH. */
/* Binary file format enumeration. These parameters are used to */
/* identify which binary file format is associated with a */
/* particular handle. They need to be synchronized with the STRBFF */
/* array defined in ZZDDHGSD in the following fashion: */
/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */
/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */
/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */
/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */
/* These values are used in the file table variable FTBFF. */
/* Some random string lengths... more documentation required. */
/* For now this will have to suffice. */
/* Architecture enumeration. These parameters are used to identify */
/* which file architecture is associated with a particular handle. */
/* They need to be synchronized with the STRARC array defined in */
/* ZZDDHGSD in the following fashion: */
/* STRARC ( DAF ) = 'DAF' */
/* STRARC ( DAS ) = 'DAS' */
/* These values will be used in the file table variable FTARC. */
/* For the following environments, record length is measured in */
/* characters (bytes) with eight characters per double precision */
/* number. */
/* Environment: Sun, Sun FORTRAN */
/* Source: Sun Fortran Programmer's Guide */
/* Environment: PC, MS FORTRAN */
/* Source: Microsoft Fortran Optimizing Compiler User's Guide */
/* Environment: Macintosh, Language Systems FORTRAN */
/* Source: Language Systems FORTRAN Reference Manual, */
/* Version 1.2, page 12-7 */
/* Environment: PC/Linux, g77 */
/* Source: Determined by experiment. */
/* Environment: PC, Lahey F77 EM/32 Version 4.0 */
/* Source: Lahey F77 EM/32 Language Reference Manual, */
/* page 144 */
/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
/* Source: FORTRAN/9000 Reference-Series 700 Computers, */
/* page 5-110 */
/* Environment: NeXT Mach OS (Black Hardware), */
/* Absoft Fortran Version 3.2 */
/* Source: NAIF Program */
/* The following parameter defines the size of a string used */
/* to store a filenames on this target platform. */
/* The following parameter controls the size of the character record */
/* buffer used to read data from non-native files. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FILE I The name of a file to be examined. */
/* ARCH O The architecture of the kernel file. */
/* KERTYP O The type of the kernel file. */
/* $ Detailed_Input */
/* FILE is the name of a SPICE kernel file whose architecture */
/* and type are desired. */
/* $ Detailed_Output */
/* ARCH is the file architecture of the SPICE kernel file */
/* specified be FILE. If the architecture cannot be */
/* determined or is not recognized the value '?' is */
/* returned. */
/* Architectures currently recognized are: */
/* DAF - The file is based on the DAF architecture. */
/* DAS - The file is based on the DAS architecture. */
/* XFR - The file is in a SPICE transfer file format. */
/* DEC - The file is an old SPICE decimal text file. */
/* ASC -- An ASCII text file. */
/* KPL -- Kernel Pool File (i.e., a text kernel) */
/* TXT -- An ASCII text file. */
/* TE1 -- Text E-Kernel type 1. */
/* ? - The architecture could not be determined. */
/* This variable must be at least 3 characters long. */
/* KERTYP is the type of the SPICE kernel file. If the type */
/* can not be determined the value '?' is returned. */
/* Kernel file types may be any sequence of at most four */
/* printing characters. NAIF has reserved for its use */
/* types which contain all upper case letters. */
/* A file type of 'PRE' means that the file is a */
/* pre-release file. */
/* This variable may be at most 4 characters long. */
/* $ Parameters */
/* RECL is the record length of a binary kernel file. Each */
/* record must be large enough to hold 128 double */
/* precision numbers. The units in which the record */
/* length must be specified vary from environment to */
/* environment. For example, VAX Fortran requires */
/* record lengths to be specified in longwords, */
/* where two longwords equal one double precision */
/* number. */
/* $ Exceptions */
/* 1) If the filename specified is blank, then the error */
/* SPICE(BLANKFILENAME) is signaled. */
/* 2) If any inquire on the filename specified by FILE fails for */
/* some reason, the error SPICE(INQUIREERROR) is signaled. */
/* 3) If the file specified by FILE does not exist, the error */
/* SPICE(FILENOTFOUND) is signaled. */
/* 4) If the file specified by FILE is already open but not through */
/* SPICE interfaces, the error SPICE(EXTERNALOPEN) is signaled. */
/* 5) If an attempt to open the file specified by FILE fails when */
/* this routine requires that it succeed, the error */
/* SPICE(FILEOPENFAILED) is signaled. */
/* 6) If an attempt to read the file specified by FILE fails when */
/* this routine requires that it succeed, the error */
/* SPICE(FILEREADFAILED) is signaled. */
/* 7) Routines in the call tree of this routine may trap and */
/* signal errors. */
/* 8) If the ID word in a DAF based kernel is NAIF/DAF, then the */
/* algorithm GETFAT uses to distinguish between CK and SPK */
/* kernels may result in an indeterminate KERTYP if the SPK or */
/* CK files have invalid first segments. */
/* $ Files */
/* The SPICE kernel file specified by FILE is examined by this */
/* routine to determine its architecture and type. If the file */
/* named by FILE is not connected to a logical unit or loaded */
/* in the handle manager, this routine will OPEN and CLOSE it. */
/* $ Particulars */
/* This subroutine is a support utility routine that determines the */
/* architecture and type of a SPICE kernel file. */
/* $ Examples */
/* Suppose you wish to write a single routine for loading binary */
/* kernels. You can use this routine to determine the type of the */
/* file and then pass the file to the appropriate low level file */
/* loader to handle the actual loading of the file. */
/* CALL GETFAT ( FILE, ARCH, KERTYP ) */
/* IF ( KERTYP .EQ. 'SPK' ) THEN */
/* CALL SPKLEF ( FILE, HANDLE ) */
/* ELSE IF ( KERTYP .EQ. 'CK' ) THEN */
/* CALL CKLPF ( FILE, HANDLE ) */
/* ELSE IF ( KERTYP .EQ. 'EK' ) THEN */
/* CALL EKLEF ( FILE, HANDLE ) */
/* ELSE */
/* WRITE (*,*) 'The file could not be identified as a known' */
/* WRITE (*,*) 'kernel type. Did you load the wrong file' */
/* WRITE (*,*) 'by mistake?' */
/* END IF */
/* $ Restrictions */
/* 1) In order to properly determine the type of DAF based binary */
/* kernels, the routine requires that their first segments and */
/* the meta data necessary to address them are valid. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 4.25.0, 10-MAR-2014 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-INTEL. */
/* - SPICELIB Version 4.24.0, 10-MAR-2014 (BVS) */
/* Updated for PC-LINUX-64BIT-IFORT. */
/* - SPICELIB Version 4.23.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-GFORTRAN. */
/* - SPICELIB Version 4.22.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.21.0, 10-MAR-2014 (BVS) */
/* Updated for PC-CYGWIN-64BIT-GCC_C. */
/* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 4.0.2, 24-APR-2003 (EDW) */
/* Added MAC-OSX-F77 to the list of platforms */
/* that require READONLY to read write protected */
/* kernels. */
/* - SPICELIB Version 4.0.1, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 4.0.0, 22-AUG-2001 (WLT) (FST) (EDW) */
/* Added code so that the architecture and type of open binary */
/* SPICE kernels can be determined. */
/* Added exception for MACPPC_C (CodeWarrior Mac classic). */
/* Reduced RECL value to 12 to prevent expression of */
/* the fseek bug. */
/* - SPICELIB Version 3.2.0, 06-DEC-1999 (WLT) */
/* The heuristics for distinguishing between CK and SPK have */
/* been enhanced so that the routine is no longer requires */
/* that TICKS in C-kernels be positive or integral. */
/* - SPICELIB Version 3.1.4, 08-OCT-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are WIN-NT */
/* - SPICELIB Version 3.1.3, 22-SEP-1999 (NJB) */
/* CSPICE environments were added. Some typos were corrected. */
/* - SPICELIB Version 3.1.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 3.1.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitly given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 3.1.0, 11-FEB-1999 (FST) */
/* Added an integrality check to Test 3. If LASTDP is not */
/* an integral value, then GETFAT simply returns KERTYP = '?', */
/* since it is of an indeterminate type. */
/* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */
/* Module was updated for the PC-LINUX platform. */
/* - SPICELIB Version 2.0.0, 19-DEC-1995 (KRG) */
/* Added several new features to the subroutine: */
/* - Error handling has been enhanced. */
/* - Several new file architectures have been added. */
/* Removed the mention of 1000 characters as a candidate for the */
/* record length of a file. */
/* Added the exception for a blank filename to the header. The */
/* error is signalled, but it was not listed in the header. */
/* Added IOSTAT values to the appropriate error messages. */
/* Non-printing characters are replaced with blanks in the ID */
/* word when it is read. This deals with the case where a */
/* platform allows a text file to be opened as an unformatted */
/* file and the ID word does not completely fill 8 characters. */
/* - SPICELIB Version 1.4.0, 5-JAN-1995 (HAN) */
/* Removed ENV11 since it is now the same as ENV2. */
/* Removed ENV10 since it is the same as the VAX environment. */
/* - SPICELIB Version 1.3.0, 30-AUG-1994 (HAN) */
/* Added two new environments, DEC Alpha/OpenVMS and */
/* Sun/Solaris, to the source master file. */
/* - SPICELIB Version 1.2.0, 25-MAR-1994 (HAN) */
/* Added two new environments, DEC Alpha/OpenVMS and */
/* Sun/Solaris, to the source master file. */
/* - SPICELIB Version 1.1.0, 25-MAR-1994 (HAN) */
/* Modified master source code file to use READONLY on platforms */
/* that support it. Also, changed some local declaration comment */
/* lines to match the standard NAIF template. */
/* - SPICELIB Version 1.0.0, 24-JUL-1993 (WLT) (HAN) (KRG) */
/* -& */
/* $ Index_Entries */
/* determine the architecture and type of a kernel file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.0.0, 22-AUG-2001 (WLT) (FST) */
/* Added code so that the architecture and type of open binary */
/* SPICE kernels can be determined. This uses the new DAF/DAS */
/* handle manager as well as examination of handles of open DAS */
/* files. Currently the handle manager deals only with DAF */
/* files. This routine should be updated again when the DAS */
/* system is integrated with the handle manager. */
/* Some slight changes were required to support ZZDDHFNH on */
/* the VAX environment. This resulted in the addition of */
/* the logical USEFNH that is set to true in most */
/* environments, and never used again other than to allow */
/* the invocation of the ZZDDHFNH module. */
/* - SPICELIB Version 2.0.0, 19-DEC-1995 (KRG) */
/* Added several new features to the subroutine: */
/* - Error handling has been enhanced. */
/* - Several new file architectures have been added. */
/* Removed the mention of 1000 characters as a candidate for the */
/* record length of a file. It seems unlikely that we will */
/* encounter an environment where 1000 characters of storage is */
/* larger than the storage necessary for 128 double precision */
/* numbers; typically there are 8 characters per double precision */
/* number, yeilding 1024 characters. */
/* Added the exception for a blank filename to the header. The */
/* error is signalled, but it was not listed in the header. */
/* Added IOSTAT values to the appropriate error messages. */
/* Non-printing characters are replaced with blanks in the ID */
/* word when it is read. This deals with the case where a */
/* platform allows a text file to be opened as an unformatted */
/* file and the ID word does not completely fill 8 characters. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Set the length of a SPICE kernel file ID word. */
/* Set minimum and maximum values for the range of ASCII printing */
/* characters. */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("GETFAT", (ftnlen)6);
}
/* Initialize the temporary storage variables that we use. */
s_copy(idword, " ", (ftnlen)12, (ftnlen)1);
/* If the filename we have is blank, signal an error and return. */
if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) {
setmsg_("The file name is blank.", (ftnlen)23);
sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* See if this is a binary file that is currently open */
/* within the SPICE binary file management subsystem. At */
/* the moment, as far as we know, the file is not opened. */
opened = FALSE_;
zzddhfnh_(file, &handle, &found, file_len);
if (found) {
/* If the file was recognized, we need to get the unit number */
/* associated with it. */
zzddhnfo_(&handle, fname, &intarc, &intbff, &intamn, &found, (ftnlen)
255);
/* Translate the architecture ID to a string and retrieve the */
/* logical unit to use with this file. */
zzddhgsd_("ARCH", &intarc, filarc, (ftnlen)4, (ftnlen)32);
zzddhhlu_(&handle, filarc, &c_false, &number, (ftnlen)32);
opened = TRUE_;
} else {
/* We'll do a bit of inquiring before we try opening anything. */
ioin__1.inerr = 1;
ioin__1.infilen = file_len;
ioin__1.infile = file;
ioin__1.inex = ∃
ioin__1.inopen = &opened;
ioin__1.innum = 0;
ioin__1.innamed = 0;
ioin__1.inname = 0;
ioin__1.inacc = 0;
ioin__1.inseq = 0;
ioin__1.indir = 0;
ioin__1.infmt = 0;
ioin__1.inform = 0;
ioin__1.inunf = 0;
ioin__1.inrecl = 0;
ioin__1.innrec = 0;
ioin__1.inblank = 0;
iostat = f_inqu(&ioin__1);
/* Not too likely, but if the INQUIRE statement fails... */
if (iostat != 0) {
setmsg_("IOSTAT error in INQUIRE statement. IOSTAT = #.", (ftnlen)
46);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREERROR)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Note: the following two tests MUST be performed in the order */
/* in which they appear, since in some environments files that do */
/* not exist are considered to be open. */
if (! exist) {
setmsg_("The kernel file '#' does not exist.", (ftnlen)35);
errch_("#", file, (ftnlen)1, file_len);
sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* If the file is already open, it may be a DAS file. */
if (opened) {
/* At the moment, the handle manager doesn't manage DAS */
/* handles. As a result we need to treat the case of an open */
/* DAS separately. When the Handle Manager is hooked in with */
/* DAS as well as DAF, we should remove the block below. */
/* =================================================== */
/* DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS */
/* vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv */
/* This file may or may not be a DAS file. Until we */
/* have determined otherwise, we assume it is not */
/* a DAS file. */
notdas = TRUE_;
ioin__1.inerr = 1;
ioin__1.infilen = file_len;
ioin__1.infile = file;
ioin__1.inex = 0;
ioin__1.inopen = 0;
ioin__1.innum = &unit;
ioin__1.innamed = 0;
ioin__1.inname = 0;
ioin__1.inacc = 0;
ioin__1.inseq = 0;
ioin__1.indir = 0;
ioin__1.infmt = 0;
ioin__1.inform = 0;
ioin__1.inunf = 0;
ioin__1.inrecl = 0;
ioin__1.innrec = 0;
ioin__1.inblank = 0;
iostat = f_inqu(&ioin__1);
if (iostat != 0) {
setmsg_("IOSTAT error in INQUIRE statement. IOSTAT = #.", (
ftnlen)46);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREERROR)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Get the set of handles of open DAS files. We will */
/* translate each of these handles to the associated */
/* logical unit. If the tranlation matches the result */
/* of the inquire, this must be a DAS file and we */
/* can proceed to determine the type. */
ssizei_(&c__100, handles);
dashof_(handles);
which = cardi_(handles);
while(which > 0) {
dashlu_(&handles[(i__1 = which + 5) < 106 && 0 <= i__1 ? i__1
: s_rnge("handles", i__1, "getfat_", (ftnlen)654)], &
myunit);
if (unit == myunit) {
number = myunit;
which = 0;
notdas = FALSE_;
} else {
--which;
}
}
/* If we reach this point and do not have a DAS, there */
/* is no point in going on. The user has opened this */
/* file outside the SPICE system. We shall not attempt */
/* to determine its type. */
if (notdas) {
setmsg_("The file '#' is already open.", (ftnlen)29);
errch_("#", file, (ftnlen)1, file_len);
sigerr_("SPICE(EXTERNALOPEN)", (ftnlen)19);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
/* DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS DAS */
/* =================================================== */
}
}
/* Open the file with a record length of RECL (the length of the */
/* DAF and DAS records). We assume, for now, that opening the file as */
/* a direct access file will work. */
diropn = TRUE_;
/* If the file is not already open (probably the case that */
/* happens most frequently) we try opening it for direct access */
/* and see if we can locate the idword. */
if (! opened) {
getlun_(&number);
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = file_len;
o__1.ofnm = file;
o__1.orl = 1024;
o__1.osta = "OLD";
o__1.oacc = "DIRECT";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
/* If we had trouble opening the file, try opening it as a */
/* sequential file. */
if (iostat != 0) {
diropn = FALSE_;
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = file_len;
o__1.ofnm = file;
o__1.orl = 0;
o__1.osta = "OLD";
o__1.oacc = "SEQUENTIAL";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
/* If we still have problems opening the file, we don't have a */
/* clue about the file architecture and type. */
if (iostat != 0) {
s_copy(arch, "?", arch_len, (ftnlen)1);
s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", (
ftnlen)48);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
}
}
/* We opened the file successfully, so let's try to read from the */
/* file. We need to be sure to use the correct form of the read */
/* statement, depending on whether the file was opened with direct */
/* acces or sequential access. */
if (diropn) {
io___19.ciunit = number;
iostat = s_rdue(&io___19);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, tmpwrd, (ftnlen)12);
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
/* If we couldn't read from the file as a direct access file with */
/* a fixed record length, then try to open the file as a */
/* sequential file and read from it. */
if (iostat != 0) {
if (opened) {
/* Something has gone wrong here. The file was opened */
/* as either a DAF or DAS prior to the call to GETFAT. */
/* We retrieved the unit number maintained by the */
/* underlying binary file management system, but we */
/* were unable to read the file as direct access. */
/* There's nothing we can do but abandon our quest to */
/* determine the type of the file. */
setmsg_("The file '#' is opened as a binary SPICE kernel. B"
"ut it cannot be read using a direct access read. The"
" value of IOSTAT returned by the attempted READ is #"
". ", (ftnlen)157);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* If we reach this point, the file was opened locally */
/* as a direct access file. We could not read it that */
/* way, so we'll try using a sequential read. However, */
/* we first need to close the file and then reopen it */
/* for sequential reading. */
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
o__1.oerr = 1;
o__1.ounit = number;
o__1.ofnmlen = file_len;
o__1.ofnm = file;
o__1.orl = 0;
o__1.osta = "OLD";
o__1.oacc = "SEQUENTIAL";
o__1.ofm = 0;
o__1.oblnk = 0;
iostat = f_open(&o__1);
/* If we could not open the file, we don't have a clue about */
/* the file architecture and type. */
if (iostat != 0) {
s_copy(arch, "?", arch_len, (ftnlen)1);
s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", (
ftnlen)48);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Try to read from the file. */
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = number;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100002;
}
iostat = do_fio(&c__1, tmpwrd, (ftnlen)12);
if (iostat != 0) {
goto L100002;
}
iostat = e_rsfe();
L100002:
;
}
} else {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = number;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100003;
}
iostat = do_fio(&c__1, tmpwrd, (ftnlen)12);
if (iostat != 0) {
goto L100003;
}
iostat = e_rsfe();
L100003:
;
}
/* If we had an error while reading, we don't recognize this file. */
if (iostat != 0) {
s_copy(arch, "?", arch_len, (ftnlen)1);
s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
setmsg_("Attempt to read from file '#' failed. IOSTAT = #.", (ftnlen)
49);
errch_("#", file, (ftnlen)1, file_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
chkout_("GETFAT", (ftnlen)6);
return 0;
}
/* Close the file (if we opened it here), as we do not need it */
/* to be open any more. */
if (! opened) {
cl__1.cerr = 0;
cl__1.cunit = number;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* At this point, we have a candidate for an ID word. To avoid */
/* difficulties with Fortran I/O and other things, we will now */
/* replace any non printing ASCII characters with blanks. */
for (i__ = 1; i__ <= 12; ++i__) {
if (*(unsigned char *)&tmpwrd[i__ - 1] < 32 || *(unsigned char *)&
tmpwrd[i__ - 1] > 126) {
*(unsigned char *)&tmpwrd[i__ - 1] = ' ';
}
}
/* Identify the architecture and type, if we can. */
ljust_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12);
ucase_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12);
nextwd_(tmpwrd, idword, tmpwrd, (ftnlen)12, (ftnlen)12, (ftnlen)12);
if (s_cmp(idword, "DAFETF", (ftnlen)12, (ftnlen)6) == 0) {
/* We have a DAF encoded transfer file. */
s_copy(arch, "XFR", arch_len, (ftnlen)3);
s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3);
} else if (s_cmp(idword, "DASETF", (ftnlen)12, (ftnlen)6) == 0) {
/* We have a DAS encoded transfer file. */
s_copy(arch, "XFR", arch_len, (ftnlen)3);
s_copy(kertyp, "DAS", kertyp_len, (ftnlen)3);
} else if (s_cmp(idword, "'NAIF/DAF'", (ftnlen)10, (ftnlen)10) == 0) {
/* We have an old DAF decimal text file. */
s_copy(arch, "DEC", arch_len, (ftnlen)3);
s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3);
} else if (s_cmp(idword, "NAIF/DAS", (ftnlen)8, (ftnlen)8) == 0) {
/* We have a pre release DAS binary file. */
s_copy(arch, "DAS", arch_len, (ftnlen)3);
s_copy(kertyp, "PRE", kertyp_len, (ftnlen)3);
} else {
/* Get the architecture and type from the ID word, if we can. */
idw2at_(idword, arch, kertyp, (ftnlen)8, arch_len, kertyp_len);
}
/* If the architecture is DAF and the type is unknown, '?', then we */
/* have either an SPK file, a CK file, or something we don't */
/* understand. Let's check it out. */
if (s_cmp(arch, "DAF", arch_len, (ftnlen)3) == 0 && s_cmp(kertyp, "?",
kertyp_len, (ftnlen)1) == 0) {
/* We have a DAF file and we do not know what the type is. This */
/* situation can occur for older SPK and CK files, before the ID */
/* word was used to store type information. */
/* We use Bill's (WLT'S) magic heuristics to determine the type */
/* of the file. */
/* Open the file and pass the handle to the private routine */
/* that deals with the dirty work. */
dafopr_(file, &handle, file_len);
zzckspk_(&handle, kertyp, kertyp_len);
dafcls_(&handle);
}
chkout_("GETFAT", (ftnlen)6);
return 0;
} /* getfat_ */
/* $Procedure ZZDDHF2H ( Private --- DDH Filename to Handle ) */
/* Subroutine */ int zzddhf2h_(char *fname, integer *ftabs, integer *ftamh,
integer *ftarc, integer *ftbff, integer *fthan, char *ftnam, integer *
ftrtm, doublereal *ftmnm, integer *nft, integer *utcst, integer *
uthan, logical *utlck, integer *utlun, integer *nut, logical *exists,
logical *opened, integer *handle, logical *found, doublereal *mnm,
ftnlen fname_len, ftnlen ftnam_len)
{
/* System generated locals */
olist o__1;
cllist cl__1;
inlist ioin__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open(
olist *), f_clos(cllist *);
/* Local variables */
integer unit;
extern doublereal zzddhmnm_(integer *);
extern /* Subroutine */ int zzddhgtu_(integer *, integer *, logical *,
integer *, integer *, integer *), zzddhrmu_(integer *, integer *,
integer *, integer *, logical *, integer *, integer *);
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer rchar;
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
extern integer rtrim_(char *, ftnlen);
extern logical failed_(void);
extern integer isrchi_(integer *, integer *, integer *);
logical locopn;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer uindex;
logical locexs;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
/* $ 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 filename to a handle. */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* FNAME I Name of the file to convert to a handle. */
/* FTABS, */
/* FTAMH, */
/* FTARC, */
/* FTBFF, */
/* FTHAN, */
/* FTNAM, */
/* FTRTM, */
/* FTMNM I File table. */
/* NFT I Number of entries in the file table. */
/* UTCST, */
/* UTHAN, */
/* UTLCK, */
/* UTLUN I/O Unit table. */
/* NUT I/O Number of entries in the unit table. */
/* EXISTS O Logical indicating if FNAME exists. */
/* OPENED O Logical indicating if FNAME is opened. */
/* HANDLE O Handle associated with FNAME. */
/* FOUND O Logical indicating if FNAME's HANDLE was found. */
/* MNM O Unique DP (Magic NuMber) associated with FNAME. */
/* $ Detailed_Input */
/* FNAME is the name of the file to locate in the file table. */
/* FTABS, */
/* FTAMH, */
/* FTARC, */
/* FTBFF, */
/* FTHAN, */
/* FTNAM, */
/* FTRTM, */
/* FTMNM are the arrays respectively containing the absolute */
/* value of the handle, access method, architecture, */
/* binary file format, handle, name, RTRIM and */
/* magic number columns of the file table. */
/* NFT is the number of entries in the file table. */
/* UTCST, */
/* UTHAN, */
/* UTLCK, */
/* UTLUN are the arrays respectively containing the cost, */
/* handle, locked, and logical unit columns of the unit */
/* table. */
/* NUT is the number of entries in the unit table. */
/* $ Detailed_Output */
/* UTCST, */
/* UTHAN, */
/* UTLCK, */
/* UTLUN are the arrays respectively containing the cost, */
/* handle, locked, and logical unit columns of the unit */
/* table. If ZZDDHF2H requires a logical unit, then */
/* it will borrow one from the unit table. Depending */
/* on the state of the table passed in from the caller */
/* one of three possible scenarios may occur (Recall */
/* that 'zero-cost' rows are ones whose units are */
/* reserved with RESLUN and not currently connected */
/* to any file.) */
/* A 'zero-cost' row exists in the table, in */
/* which case the row is used temporarily and */
/* may be removed depending on the number of entries */
/* in the file table (NFT). */
/* The unit table is full (NUT=UTSIZE), in which */
/* case the unit with the lowest cost that is not */
/* locked to its handle will be disconnected, used, */
/* and then returned to the table as a 'zero-cost' */
/* row before returning to the caller. */
/* The unit table is not full (NUT<UTSIZE) and there */
/* are no 'zero-cost' rows. In this case NUT is */
/* temporarily increased by one, and the new row */
/* is used. After this routine no longer requires */
/* the unit, depending on the number of entries in */
/* the file table (NFT) the row may be left in the */
/* table as a 'zero-handle' row or removed entirely. */
/* In the event an error is signaled, the contents of the */
/* unit table are placed into a usable state before */
/* returning to the caller. */
/* NUT is the number of entries in the unit table. Since */
/* this routine borrows a unit from the unit table, which */
/* may involve allocation of a new unit, this value may */
/* change. */
/* EXISTS is a logical if set to TRUE, indicates that FNAME */
/* exists. If FALSE, FNAME does not exist. In the event */
/* an exception is signaled the value is undefined. */
/* OPENED is a logical if set to TRUE, indicates that FNAME */
/* is opened and attached to a logical unit. If FALSE, */
/* FNAME is not attached to a unit. In the event an */
/* exception is signaled the value is undefined. */
/* HANDLE is the handle in the file table associated with */
/* FNAME. If FOUND is FALSE, then HANDLE is returned as */
/* 0. */
/* FOUND is a logical if TRUE indicates that FNAME was found */
/* in the file table. If FALSE indicates that it was not */
/* located. */
/* MNM is a unique (enough) DP number -- the Magic NuMber -- */
/* associated with FNAME computed by this examining the */
/* file contents. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If any of the INQUIRE statments this routine performs fail, */
/* the error SPICE(INQUIREFAILED) is signaled. FOUND is set to */
/* FALSE and HANDLE to 0. */
/* 2) If the attempt to open FNAME fails, then SPICE(FILEOPENFAILED) */
/* is signaled. FOUND is set to FALSE, and HANDLE to 0. */
/* 3) If FNAME is determined not to be loaded into the file table */
/* then FOUND is set to FALSE and HANDLE is set to 0. */
/* $ Files */
/* If the file named by FNAME is not connected to a logical unit, */
/* this routine will open it for direct access to complete its */
/* examination. */
/* $ Particulars */
/* This routine encapsulates the logic necessary to determine if */
/* a particular filename names a file already loaded into the */
/* DAF/DAS handle manager. If it discovers the file is loaded, */
/* the routine returns the handle to the caller. */
/* $ Examples */
/* See ZZDDHFNH for sample usage. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* E.D. Wright (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.0, 26-APR-2012 (BVS) */
/* Changed calling sequence to include FTMNM and MNM. Change */
/* algorithm to compute MNM and use it to bypass n^2 INQUIREs */
/* for files opened for READ access, if possible. */
/* - SPICELIB Version 2.0.1, 24-APR-2003 (EDW) */
/* Added MAC-OSX-F77 to the list of platforms */
/* that require READONLY to read write protected */
/* kernels. */
/* - SPICELIB Version 2.0.0, 05-AUG-2002 (FST) */
/* Bug fix: this module was updated to allow proper loading */
/* of read-only files on VAX environments. */
/* - SPICELIB Version 1.0.0, 04-OCT-2001 (FST) */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 05-AUG-2002 (FST) */
/* An OPEN statement that is exercised by this module under */
/* certain circumstances, failed to pass the non-standard */
/* READONLY option for the VAX environments. This had the */
/* undesirable side-effect of not permitting files available */
/* only for READ access to be opened. */
/* This file was promoted from a standard portable module */
/* to a master file. */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZDDHF2H", (ftnlen)8);
}
/* First check to see if FNAME is blank. If so, set FOUND to .FALSE. */
/* and return. ZZDDHOPN prevents any blank filenames from being */
/* loaded into the file table. */
if (s_cmp(fname, " ", fname_len, (ftnlen)1) == 0) {
*found = FALSE_;
*handle = 0;
*opened = FALSE_;
*exists = FALSE_;
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* Start by trimming the file name in preparation for the INQUIRE. */
rchar = rtrim_(fname, fname_len);
/* Now INQUIRE on the input file FNAME. */
ioin__1.inerr = 1;
ioin__1.infilen = rchar;
ioin__1.infile = fname;
ioin__1.inex = &locexs;
ioin__1.inopen = &locopn;
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);
/* Check IOSTAT for failure. */
if (iostat != 0) {
*found = FALSE_;
*handle = 0;
setmsg_("INQUIRE failed. Value of IOSTAT was #.", (ftnlen)38);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20);
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* First, set some of the output arguments. Remember, some */
/* systems consider non-existant files as open. Compensate for */
/* this unusual behavior. */
*exists = locexs;
*opened = locopn && *exists;
/* Now check to see if the file exists. If it does not, then */
/* set FOUND to false and HANDLE to 0 as non-existant files */
/* can not possibly be present in the file table. */
if (! (*exists)) {
*found = FALSE_;
*handle = 0;
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* Now check to see if the file is opened. If it is, we need to */
/* determine whether or not the logical unit to which it is */
/* attached is present in the unit table. */
if (*opened) {
/* Since the file is opened, see if we can find its unit */
/* in the unit table. */
uindex = isrchi_(&unit, nut, utlun);
/* When UINDEX is 0, the file is opened, but not by */
/* the DAF/DAS handle manager. Set FOUND to FALSE, HANDLE */
/* to 0, and return to the caller. */
if (uindex == 0) {
*handle = 0;
*found = FALSE_;
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* If we end up here, then we found UNIT in the unit table. */
/* Set FOUND to TRUE if the handle associated with UNIT is */
/* non-zero. */
*handle = uthan[uindex - 1];
*found = *handle != 0;
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* At this point, we took action for all simple cases. Now */
/* we need to find out if FNAME is one of the files in the */
/* file table that isn't open. To determine this, we open FNAME, */
/* and then INQUIRE on every file in the table. To do this, we */
/* need a unit. Get one. */
zzddhgtu_(utcst, uthan, utlck, utlun, nut, &uindex);
if (failed_()) {
*handle = 0;
*found = FALSE_;
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* Now open the file (which we know exists and isn't open). Since */
/* we effectively are just borrowing this unit, we are not going to */
/* set UTHAN or UTCST from the defaults that ZZDDHGTU sets up. */
o__1.oerr = 1;
o__1.ounit = utlun[uindex - 1];
o__1.ofnmlen = rchar;
o__1.ofnm = fname;
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);
/* Check IOSTAT. */
if (iostat != 0) {
/* Since an error has occurred, set FOUND to false and HANDLE */
/* to 0. */
*found = FALSE_;
*handle = 0;
/* Close the unit and remove it from the unit table. */
cl__1.cerr = 0;
cl__1.cunit = utlun[uindex - 1];
cl__1.csta = 0;
f_clos(&cl__1);
zzddhrmu_(&uindex, nft, utcst, uthan, utlck, utlun, nut);
/* Signal the error and return. */
setmsg_("Attempt to open file '#' failed. Value of IOSTAT was #.", (
ftnlen)55);
errch_("#", fname, (ftnlen)1, fname_len);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* Get a unique enough DP number -- the Magic NuMber (MNM) ;) -- for */
/* this file. */
*mnm = zzddhmnm_(&utlun[uindex - 1]);
/* Now loop through all the files in the file table. Unfortunately */
/* we have no other choice. */
i__ = 1;
*found = FALSE_;
while(i__ <= *nft && ! (*found)) {
/* If this file's magic number is non-zero and is different from */
/* the magic number of the currently checked, opened-for-READ */
/* file, we will declare that these files are not the same file */
/* and will skip INQUIRE. In all other cases we will do INQUIRE */
/* and check UNITs. */
if (*mnm != 0. && (*mnm != ftmnm[i__ - 1] && ftamh[i__ - 1] == 1)) {
/* These files are not the same file. Clear IOSTAT and set */
/* UNIT to not match the UNIT of the input file. */
iostat = 0;
unit = utlun[uindex - 1] + 1;
} else {
/* Do the INQUIRE. ;( */
ioin__1.inerr = 1;
ioin__1.infilen = ftrtm[i__ - 1];
ioin__1.infile = ftnam + (i__ - 1) * ftnam_len;
ioin__1.inex = &locexs;
ioin__1.inopen = &locopn;
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);
}
/* Check IOSTAT. */
if (iostat != 0) {
/* Since we have an error condition, set FOUND to FALSE */
/* and HANDLE to 0. */
*found = FALSE_;
*handle = 0;
/* Close the unit and clean up the unit table. */
cl__1.cerr = 0;
cl__1.cunit = utlun[uindex - 1];
cl__1.csta = 0;
f_clos(&cl__1);
zzddhrmu_(&uindex, nft, utcst, uthan, utlck, utlun, nut);
/* Signal the error and return. */
setmsg_("INQUIRE failed. Value of IOSTAT was #.", (ftnlen)38);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20);
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
}
/* Now check to see if FILE exists, is currently open. and */
/* its UNIT matches UTLUN(UINDEX). */
if (locexs && locopn && unit == utlun[uindex - 1]) {
*handle = fthan[i__ - 1];
*found = TRUE_;
/* Otherwise, continue searching. */
} else {
++i__;
}
}
/* Check to see if we found the file in the file table. */
if (! (*found)) {
*handle = 0;
}
/* Close the unit and clean up the unit table. */
cl__1.cerr = 0;
cl__1.cunit = utlun[uindex - 1];
cl__1.csta = 0;
f_clos(&cl__1);
zzddhrmu_(&uindex, nft, utcst, uthan, utlck, utlun, nut);
chkout_("ZZDDHF2H", (ftnlen)8);
return 0;
} /* zzddhf2h_ */
/* $Procedure FNDLUN ( Find a free logical unit ) */
/* Subroutine */ int fndlun_0_(int n__, integer *unit)
{
/* Initialized data */
static integer last = 1;
static logical first = TRUE_;
static integer resnum[3] = { 5,6,7 };
/* System generated locals */
integer i__1, i__2;
inlist ioin__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), f_inqu(inlist *);
/* Local variables */
static integer i__;
static logical resvd[99], opened;
static integer iostat;
/* $ Abstract */
/* Return the number of a free logical unit, if one is available. */
/* $ 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 */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UNIT O The number of a free logical unit. */
/* MINLUN P Minimum logical unit number. */
/* MAXLUN P Maximum logical unit number. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* UNIT is the number of a free logical unit (also called */
/* an "external unit"). A "free" logical unit is one */
/* that is not reserved and is not currently connected to */
/* and open file. If no free units are available, the */
/* value of UNIT is 0. */
/* $ Parameters */
/* MINLUN is the minimum logical unit number. The Fortran */
/* standard states that unit numbers must be zero or */
/* positive. However, the value 0 is reserved as a */
/* status code for this routine, so MINLUN must be */
/* assigned a value greater than 0. */
/* MAXLUN is the maximum logical unit number allowed by the */
/* VAX Fortran compiler. This may differ for other */
/* machines. */
/* Listed below are the values for several machines: */
/* Environment: VAX/VMS, VAX FORTRAN */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* Environment: Sun, Sun FORTRAN */
/* MINLUN: 1 */
/* MAXLUN: 63 */
/* Environment: PC, MS FORTRAN * */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* Environment: PC/Linux, Fort77 */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* Environment: Macintosh, Language Systems FORTRAN */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* Environment: PC, Lahey F77 EM/32 Version 4.0 */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
/* MINLUN: 1 */
/* MAXLUN: 61 */
/* Environment: Silicon Graphics, SGI f77 */
/* MINLUN: 1 */
/* MAXLUN: 63 */
/* Environment: DEC Alpha OSF/1, DEC FORTRAN */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* Environment: NeXT, Absoft Fortran */
/* MINLUN: 1 */
/* MAXLUN: 99 */
/* * 32767 is the actual value a logical unit may be assigned to */
/* on the IBM PC, however, using this value increases the memory */
/* requirements of a program calling this routine by 128K. */
/* $ Exceptions */
/* Error free. */
/* 1) If no logical units are available, UNIT is set equal */
/* to 0. */
/* 2) This routine performs a Fortran INQUIRE operation. If */
/* the INQUIRE fails, UNIT is set equal to the negative */
/* of the INQUIRE iostat ( UNIT will thus have a negative */
/* value). */
/* $ Files */
/* None. */
/* $ Particulars */
/* FNDLUN returns the number of the first (unreserved) unit not */
/* currently connected to a file. It thus frees the user from */
/* having to maintain an accounting of which units are open, which */
/* are closed, and which are available. */
/* This routine is related to the routines GETLUN, RESLUN, and */
/* FRELUN. Together, these routines support coordinated usage of */
/* Fortran logical units. FNDLUN (Find a free logical unit) and */
/* GETLUN (Get a free logical unit) both have the function of */
/* returning a logical unit number that is not reserved or already */
/* in use. The principal difference between the functionality of */
/* these routines is that GETLUN both returns a status code and */
/* signals an error if a free unit is not found, while FNDLUN */
/* merely returns a status code. */
/* RESLUN is used to reserve logical unit numbers, so that they will */
/* not be returned by GETLUN or FNDLUN; FRELUN frees logical units */
/* previously reserved via calls to RESLUN. */
/* On the VAX, SUN, PC, and HP logical units 5-7 are reserved by */
/* default. On the Macintosh logical units 5,6 and 9 are reserved */
/* by default. Other units may be reserved by calling RESLUN. Once */
/* reserved, units (except ones reserved by default) may be */
/* unreserved by calling FRELUN. */
/* To reserve logical unit numbers for special use, refer to */
/* RESLUN. To make reserved units available to FNDLUN and GETLUN, */
/* refer to FRELUN. */
/* A unit returned by FNDLUN does NOT automatically become a */
/* reserved unit. If the user wishes to reserve a unit found by */
/* FNDLUN, the call to FNDLUN must be followed by a call to RESLUN. */
/* Note that although 0 is a valid logical unit number on some */
/* systems, a value of 0 returned by FNDLUN indicates that no free */
/* logical unit was available, rather than that logical unit 0 is */
/* available. Similarly, negative values returned by FNDLUN are */
/* status codes, not logical unit numbers. */
/* $ Examples */
/* The following code fragment illustrates the use of FNDLUN. */
/* CALL FNDLUN ( UNIT ) */
/* IF ( UNIT .LT. 0 ) THEN */
/* RETURN */
/* END IF */
/* $ Restrictions */
/* This routine never returns logical unit numbers that are less */
/* than or equal to 0. */
/* $ Literature_References */
/* 1. "Programming in VAX FORTRAN", Digital Equipment Corporation, */
/* September 1984, Section 11.1.1, page 11-2. */
/* 2. "Microsoft FORTRAN Reference", Microsoft Corporation */
/* 1989, Section 3.2.2, page 61. */
/* 3. "Sun FORTRAN Programmer's Guide", Sun Microsystems, */
/* Revision A of 6 May 1988, Section 7.2, page 73. */
/* 4. "Language Systems FORTRAN Reference Manual", Version 2.1, */
/* page 193. */
/* 5. "Lahey F77L EM/32 Programmers Reference Manual", version 4.0, */
/* page 94. */
/* 6. "FORTRAN/9000 Reference HP 9000 Series 700 Computers", */
/* First Edition, June 1991, Hewlett Packard Company, pages 6-2 */
/* and 6-4. */
/* 7. Silicon Graphics "Fortran 77 Programmer's Guide", */
/* Document number 007-0711-030, page 1-20. */
/* 8. "Language Reference Manual", Absoft Fortran V3.2, 1993, */
/* page 7-4, section 7.3.1 (for the NeXT). */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* M.J. Spencer (JPL) */
/* $ Version */
/* - SPICELIB Version 6.21.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 6.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 6.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 6.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 6.17.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 6.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 6.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 6.14.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 6.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 6.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 6.11.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 6.10.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 6.9.0, 16-MAR-2009 (BVS) */
/* Changed MAXLUN from 99 to 61 for HP and HP_C environments. The */
/* value 61 was determined by trial-n-error while preparing a */
/* special HP toolkit delivery for GSFC in July 2008. */
/* - SPICELIB Version 6.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 6.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 6.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 6.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 6.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 6.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 6.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 6.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 6.0.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 6.0.3, 24-SEP-1999 (NJB) */
/* CSPICE environments were added. Some typos were corrected. */
/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 6.0.0, 05-APR-1998 (NJB) */
/* References to the PC-LINUX environment were added. */
/* - SPICELIB Version 5.0.0, 9-NOV-1993 (HAN) */
/* Module was updated to include the logical unit values */
/* for the Silicon Graphics, DEC Alpha-OSF/1, and */
/* NeXT platforms. */
/* - SPICELIB Version 4.0.0, 6-OCT-1992 (HAN) */
/* Module was updated to include the logical unit values for */
/* the Hewlett Packard UX 9000/750 environment. */
/* - SPICELIB Version 3.0.0, 20-MAR-1992 (MJS) */
/* IOSTAT check now placed directly after the INQUIRE */
/* statement. */
/* - SPICELIB Version 2.2.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.2.0, 13-NOV-1991 (MJS) */
/* Module was updated to include the value of MAXLUN */
/* for the Lahey F77L EM/32 environment (PC). */
/* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */
/* Module was updated to allow portability to the Macintosh */
/* environment. */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */
/* The array RESNUM now contains the default reserved */
/* logical units. All the elements of the array RESVD */
/* were initialized. The value of MAXLUN for the IBM PC */
/* was changed from 32767 to 99. Some header comments */
/* were clarified. */
/* - SPICELIB Version 1.0.1, 20-MAR-1990 (HAN) */
/* Parameters section was updated to include the values */
/* of MINLUN and MAXLUN for several machines. Sources of */
/* these values are listed in the Literature References */
/* section. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* find a free logical unit */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 6.0.0, 05-APR-1998 (NJB) */
/* References to the PC-LINUX environment were added. */
/* - SPICELIB Version 5.0.0, 9-NOV-1993 (HAN) */
/* Module was updated to include the logical unit values */
/* for the Silicon Graphics, DEC Alpha-OSF/1, and */
/* NeXT platforms. */
/* The values used for the DEC Alpha worked in all of the */
/* porting tests, but NAIF has no documentation for this */
/* platform. */
/* - SPICELIB Version 1.4.0, 6-OCT-1992 (HAN) */
/* Module was updated to include the logical unit values for */
/* the Hewlett Packard UX 9000/750 environment. */
/* The code was also reformatted so that a utility program can */
/* create the source file for a specific environment given a */
/* master source file. */
/* - SPICELIB Version 3.0.0, 20-MAR-1992 (MJS) */
/* IOSTAT check now placed directly after the INQUIRE */
/* statement. Previously, IOSTAT could have been checked */
/* without first being assigned a value. */
/* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */
/* Module was updated to allow portability to the Macintosh */
/* environment. Literature References section was updated. */
/* Some header comments were clarified. */
/* - SPICELIB Version 2.0.0, 26-MAR-1991 (MJS) (NJB) */
/* The default reserved logical units are now declared in the */
/* array RESNUM. All the elements of the array RESVD were */
/* initialized. These two changes allow FNDLUN to be ported */
/* to other platforms more easily. The value of MAXLUN for the */
/* IBM PC was decreased from 32767 to 99. */
/* Some cosmetic changes to variable declarations were made. */
/* Also, some header comments were added to make the header's */
/* discussion clearer. */
/* - Beta Version 1.1.0, 09-MAR-1989 (HAN) */
/* Declaration of the variable RETURN was removed from the code. */
/* The variable was declared, but not used. */
/* -& */
/* Parameters */
/* Local variables */
/* Save everything between calls. */
/* Initial values */
switch(n__) {
case 1: goto L_reslun;
case 2: goto L_frelun;
}
/* VAX, SUN, PC, HP, SGI, DEC Alpha-OSF/1, and PC/Lunix */
/* reserved units. */
/* Initialize RESVD if it hasn't already been done. */
if (first) {
for (i__ = 1; i__ <= 99; ++i__) {
resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd",
i__1, "fndlun_", (ftnlen)513)] = FALSE_;
}
for (i__ = 1; i__ <= 3; ++i__) {
resvd[(i__2 = resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("resnum", i__1, "fndlun_", (ftnlen)517)] - 1) < 99
&& 0 <= i__2 ? i__2 : s_rnge("resvd", i__2, "fndlun_", (
ftnlen)517)] = TRUE_;
}
first = FALSE_;
}
/* Begin with the unit following the last one returned. */
/* Cycle through the available units. Skip reserved units, */
/* INQUIRE about others. */
for (i__ = last + 1; i__ <= 99; ++i__) {
if (resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd",
i__1, "fndlun_", (ftnlen)531)]) {
opened = TRUE_;
} else {
ioin__1.inerr = 1;
ioin__1.inunit = i__;
ioin__1.infile = 0;
ioin__1.inex = 0;
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);
if (iostat > 0) {
*unit = -iostat;
return 0;
}
}
if (! opened) {
*unit = i__;
last = *unit;
return 0;
}
}
/* If we've come this far, we need to search the first part of */
/* the list again, up to the last unit returned. Once again, */
/* skip reserved units, INQUIRE about others. */
i__1 = last;
for (i__ = 1; i__ <= i__1; ++i__) {
if (resvd[(i__2 = i__ - 1) < 99 && 0 <= i__2 ? i__2 : s_rnge("resvd",
i__2, "fndlun_", (ftnlen)558)]) {
opened = TRUE_;
} else {
ioin__1.inerr = 1;
ioin__1.inunit = i__;
ioin__1.infile = 0;
ioin__1.inex = 0;
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);
if (iostat > 0) {
*unit = -iostat;
return 0;
}
}
if (! opened) {
*unit = i__;
last = *unit;
return 0;
}
}
/* If we've come this far, there are no free units to be had. */
/* C'est la vie. Assign 0 to the unit number. */
*unit = 0;
return 0;
/* $Procedure RESLUN ( Reserve a logical unit ) */
L_reslun:
/* $ Abstract */
/* Reserve a logical unit number. Reserved units are never returned */
/* by FNDLUN or GETLUN. */
/* $ 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 */
/* FILES */
/* $ Declarations */
/* INTEGER UNIT */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UNIT I Number of the logical unit to be reserved. */
/* $ Detailed_Input */
/* UNIT is the number of the logical unit to be reserved. */
/* Once reserved, the unit number will not be returned */
/* by the routines FNDLUN or GETLUN, even if it is not */
/* connected to a file. */
/* On the VAX, SUN, PC, and HP logical units 5-7 are */
/* reserved by default. On the Macintosh logical units */
/* 5,6 and 9 are reserved by default. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* FNDLUN maintains an array of logical flags, one for each positive */
/* unit number offered by the system. RESLUN sets the value of the */
/* flag for UNIT to TRUE. */
/* Once reserved, units (except units reserved by default) may be */
/* unreserved by calling FRELUN. */
/* $ Examples */
/* The following code fragment illustrates the use of RESLUN. */
/* C */
/* C Units 17-23 are used by non-NAIF file readers. */
/* C Reserve these, so that they will not be returned */
/* C by FNDLUN or GETLUN. */
/* C */
/* DO I = 17, 23 */
/* CALL RESLUN ( I ) */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* See the module FNDLUN. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* C.A. Curzon (JPL) */
/* H.A. Neilan (JPL) */
/* M.J Spencer (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 6.0.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 6.0.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */
/* RESVD is now initialized on entry to this routine if */
/* it hasn't been done previously. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (IMU) */
/* -& */
/* $ Index_Entries */
/* reserve a logical unit */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */
/* RESVD is now initialized on entry to this routine if */
/* it hasn't been done previously. Prior to this fix, any actions */
/* taken by RESLUN or FRELUN before FNDLUN was called would have */
/* been discarded. FIRST is now checked on entry to all entry */
/* points. */
/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) (NJB) */
/* This routine is now an entry point of FNDLUN rather than */
/* GETLUN. The code of this entry point itself has not changed */
/* however. References to the routine FNDLUN were added to the */
/* header. The restrictions section was updated to read "none." */
/* This module was declared "error free", which means */
/* that it will never participate in error handling. */
/* -& */
/* Initialize RESVD if it hasn't already been done. */
if (first) {
for (i__ = 1; i__ <= 99; ++i__) {
resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd",
i__1, "fndlun_", (ftnlen)781)] = FALSE_;
}
for (i__ = 1; i__ <= 3; ++i__) {
resvd[(i__2 = resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("resnum", i__1, "fndlun_", (ftnlen)785)] - 1) < 99
&& 0 <= i__2 ? i__2 : s_rnge("resvd", i__2, "fndlun_", (
ftnlen)785)] = TRUE_;
}
first = FALSE_;
}
/* If UNIT is in the proper range, set the corresponding flag */
/* to TRUE. */
if (*unit >= 1 && *unit <= 99) {
resvd[(i__1 = *unit - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd",
i__1, "fndlun_", (ftnlen)797)] = TRUE_;
}
return 0;
/* $Procedure FRELUN ( Free a reserved logical unit ) */
L_frelun:
/* $ Abstract */
/* Unreserve a logical unit number reserved by RESLUN. */
/* $ 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 */
/* FILES */
/* $ Declarations */
/* INTEGER UNIT */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UNIT I Number of the logical unit to be unreserved. */
/* $ Detailed_Input */
/* UNIT is the number of the logical unit to be unreserved. */
/* Once unreserved, the unit number may be returned by */
/* the routines GETLUN or FNDLUN whenever not connected to */
/* a file. */
/* On the VAX, SUN, PC, and HP logical units 5-7 are */
/* reserved by default. On the Macintosh logical units */
/* 5,6 and 9 are reserved by default. These may not be */
/* unreserved. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* FNDLUN maintains an array of logical flags, one for each unit */
/* offered by the system. FRELUN sets the value of the flag for */
/* UNIT to FALSE. */
/* $ Examples */
/* The following code fragment illustrates the use of FRELUN. */
/* C */
/* C Free the units used by the non-NAIF file readers, */
/* C so that they may be returned by FNDLUN or GETLUN. */
/* C */
/* DO I = 17, 23 */
/* CALL FRELUN ( I ) */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* See the module FNDLUN. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* C.A. Curzon (JPL) */
/* H.A. Neilan (JPL) */
/* M.J. Spencer (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 6.0.5, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 6.0.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 6.0.3, 24-SEP-1999 (NJB) */
/* CSPICE environments were added. Some typos were corrected. */
/* - SPICELIB Version 6.0.2, 28-JUL-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. New */
/* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
/* - SPICELIB Version 6.0.1, 18-MAR-1999 (WLT) */
/* The environment lines were expanded so that the supported */
/* environments are now explicitely given. Previously, */
/* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
/* by the environment label SUN. */
/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */
/* RESVD is now initialized on entry to this routine if */
/* it hasn't been done previously. */
/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.1.0, 12-MAR-1991 (MJS) */
/* The array RESNUM now contains the default reserved */
/* logical units. All the elements of the array RESVD */
/* were initialized. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (IMU) */
/* -& */
/* $ Index_Entries */
/* free a reserved logical unit */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 16-MAR-1992 (MJS) */
/* RESVD is now initialized on entry to this routine if */
/* it hasn't been done previously. Prior to this fix, any actions */
/* taken by RESLUN or FRELUN before FNDLUN was called would have */
/* been discarded. FIRST is now checked on entry to all entry */
/* points. */
/* - Beta Version 1.1.0, 27-FEB-1989 (HAN) (NJB) */
/* This routine is now an entry point of FNDLUN rather than */
/* GETLUN. The code of this entry point itself has not changed */
/* however. References to the routine FNDLUN were added to the */
/* header. The restrictions section was updated to read "none." */
/* This module was declared "error free", which means */
/* that it will never participate in error handling. */
/* -& */
/* Initialize RESVD if it hasn't already been done. */
if (first) {
for (i__ = 1; i__ <= 99; ++i__) {
resvd[(i__1 = i__ - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd",
i__1, "fndlun_", (ftnlen)1002)] = FALSE_;
}
for (i__ = 1; i__ <= 3; ++i__) {
resvd[(i__2 = resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("resnum", i__1, "fndlun_", (ftnlen)1006)] - 1) <
99 && 0 <= i__2 ? i__2 : s_rnge("resvd", i__2, "fndlun_",
(ftnlen)1006)] = TRUE_;
}
first = FALSE_;
}
/* If UNIT is in the proper range and it has not been reserved by */
/* default, set the corresponding flag to FALSE. */
if (*unit >= 1 && *unit <= 99) {
for (i__ = 1; i__ <= 3; ++i__) {
if (*unit == resnum[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("resnum", i__1, "fndlun_", (ftnlen)1020)]) {
return 0;
}
}
resvd[(i__1 = *unit - 1) < 99 && 0 <= i__1 ? i__1 : s_rnge("resvd",
i__1, "fndlun_", (ftnlen)1025)] = FALSE_;
}
return 0;
} /* fndlun_ */
/* $Procedure ISOPEN ( Is a file currently open? ) */
logical isopen_(char *file, ftnlen file_len)
{
/* System generated locals */
logical ret_val;
inlist ioin__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *);
/* Local variables */
extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
logical myopen;
extern logical return_(void);
logical exists;
/* $ Abstract */
/* Determine whether a named file is currently open. */
/* $ 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 */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FILE I Name of the file in question. */
/* The function returns the value TRUE if the file is open, FALSE */
/* otherwise. */
/* $ Detailed_Input */
/* FILE is the name of the file in question. */
/* $ Detailed_Output */
/* The function returns the value TRUE if the file is open, FALSE */
/* otherwise. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the filename is blank, the error SPICE(BLANKFILENAME) will */
/* be signalled. */
/* 2) If an error occurs during the execution of the Fortran INQUIRE */
/* statement, the error SPICE(INQUIREFAILED) is signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Use the Fortran INQUIRE statement to determine the open status */
/* of FILE. */
/* $ Examples */
/* The following code fragment illustrates the use of ISOPEN. */
/* IF ( .NOT. ISOPEN ( FILE ) ) THEN */
/* Open the file here */
/* ELSE */
/* ERROR = 'Input file is already open.' */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* Added a local logical variable that is used as temporary */
/* storage for the results from the INQUIRE statement rather */
/* than using the function name. This solved a problem on the */
/* macintosh. */
/* - SPICELIB Version 1.0.0, 05-OCT-1994 (KRG) */
/* -& */
/* $ Index_Entries */
/* test for file already open */
/* is a file open */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
ret_val = FALSE_;
return ret_val;
} else {
chkin_("ISOPEN", (ftnlen)6);
}
/* First we test to see if the filename is blank. */
if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) {
ret_val = FALSE_;
setmsg_("The file name is blank. ", (ftnlen)24);
sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20);
chkout_("ISOPEN", (ftnlen)6);
return ret_val;
}
/* So simple, it defies explanation. */
ioin__1.inerr = 1;
ioin__1.infilen = file_len;
ioin__1.infile = file;
ioin__1.inex = &exists;
ioin__1.inopen = &myopen;
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);
if (iostat != 0) {
ret_val = FALSE_;
setmsg_("Value of IOSTAT was *.", (ftnlen)22);
errint_("*", &iostat, (ftnlen)1);
sigerr_("SPICE(INQUIREFAILED)", (ftnlen)20);
chkout_("ISOPEN", (ftnlen)6);
return ret_val;
}
/* A file cannot be open if it does not exist. We do actually need to */
/* check this because some operating environments return .TRUE. for */
/* the value of OPENED if a file does not exist. */
if (! exists) {
myopen = FALSE_;
}
/* Set the function value, check out, and return. */
ret_val = myopen;
chkout_("ISOPEN", (ftnlen)6);
return ret_val;
} /* isopen_ */