/* $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 EKUCEI ( EK, update integer column entry ) */
/* Subroutine */ int ekucei_(integer *handle, integer *segno, integer *recno,
char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen
column_len)
{
integer unit;
extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *,
integer *, ftnlen), zzekrbck_(char *, integer *, integer *,
integer *, integer *, ftnlen), zzeksdsc_(integer *, integer *,
integer *), zzektrdp_(integer *, integer *, integer *, integer *),
chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
integer class__, dtype;
extern logical failed_(void);
integer coldsc[11], segdsc[24];
logical isshad;
extern /* Subroutine */ int dashlu_(integer *, integer *);
integer recptr;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), ekshdw_(integer *,
logical *), zzekue01_(integer *, integer *, integer *, integer *,
integer *, logical *), zzekue04_(integer *, integer *, integer *,
integer *, integer *, integer *, logical *);
/* $ Abstract */
/* Update an integer column entry in a specified EK record. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* SEGNO I Index of segment containing record. */
/* RECNO I Record in which entry is to be updated. */
/* COLUMN I Column name. */
/* NVALS I Number of values in in new column entry. */
/* IVALS I Integer values to add to column. */
/* ISNULL I Flag indicating whether column entry is null. */
/* $ Detailed_Input */
/* HANDLE is a file handle attached to an EK open for */
/* write access. */
/* SEGNO is the index of the segment containing the column */
/* entry to be updated. */
/* RECNO is the index of the record containing the column */
/* entry to be updated. This record number is */
/* relative to the start of the segment indicated by */
/* SEGNO; the first record in the segment has index 1. */
/* COLUMN is the name of the column containing the entry to */
/* be updated. */
/* NVALS, */
/* IVALS are, respectively, the number of values to add to */
/* the specified column and the set of values */
/* themselves. The data values are written in to the */
/* specifed column and record. */
/* If the column has fixed-size entries, then NVALS */
/* must equal the entry size for the specified column. */
/* For columns with variable-sized entries, the size */
/* of the new entry need not match the size of the */
/* entry it replaces. In particular, the new entry */
/* may be larger. */
/* ISNULL is a logical flag indicating whether the entry is */
/* null. If ISNULL is .FALSE., the column entry */
/* defined by NVALS and IVALS is added to the */
/* specified kernel file. */
/* If ISNULL is .TRUE., NVALS and IVALS are ignored. */
/* The contents of the column entry are undefined. */
/* If the column has fixed-length, variable-size */
/* entries, the number of entries is considered to */
/* be 1. */
/* The new entry may be null even though it replaces */
/* a non-null value, and vice versa. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If SEGNO is out of range, the error will diagnosed by routines */
/* called by this routine. */
/* 3) If COLUMN is not the name of a declared column, the error */
/* will be diagnosed by routines called by this routine. */
/* 4) If COLUMN specifies a column of whose data type is not */
/* integer, the error SPICE(WRONGDATATYPE) will be */
/* signalled. */
/* 5) If RECNO is out of range, the error will diagnosed by routines */
/* called by this routine. */
/* 6) If the specified column has fixed-size entries and NVALS */
/* does not match this size, the error will diagnosed by routines */
/* called by this routine. */
/* 7) If the specified column has variable-size entries and NVALS */
/* is non-positive, the error will diagnosed by routines */
/* called by this routine. */
/* 8) If an attempt is made to add a null value to a column that */
/* doesn't take null values, the error will diagnosed by routines */
/* called by this routine. */
/* 9) If COLUMN specifies a column of whose class is not */
/* an integer class known to this routine, the error */
/* SPICE(NOCLASS) will be signalled. */
/* 10) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine operates by side effects: it modifies the named */
/* EK file by adding data to the specified record in the specified */
/* column. Data may be added to a segment in random order; it is not */
/* necessary to fill in columns or rows sequentially. Data may only */
/* be added one logical element at a time. Partial assignments of */
/* logical elements are not supported. */
/* $ Examples */
/* 1) Replace the value in the third record of the column ICOL in */
/* the fifth segment of an EK file designated by HANDLE. Set */
/* the new value to 999. */
/* CALL EKUCEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .FALSE. ) */
/* 2) Same as (1), but this time add a null value. The argument */
/* 999 is ignored because the null flag is set to .TRUE. */
/* CALL EKUCEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .TRUE. ) */
/* 3) Replace the entry in the third record of the column IARRAY in */
/* the fifth segment of an EK file designated by HANDLE. Set */
/* the new value using an array IBUFF of 10 values. */
/* CALL EKUCEI ( HANDLE, 5, 3, 'IARRAY', 10, IBUFF, .FALSE. ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 20-JUN-1999 (WLT) */
/* Removed unbalanced call to CHKOUT. */
/* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */
/* -& */
/* $ Index_Entries */
/* replace integer entry in an EK column */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* First step: find the descriptor for the named segment. Using */
/* this descriptor, get the column descriptor. */
zzeksdsc_(handle, segno, segdsc);
zzekcdsc_(handle, segdsc, column, coldsc, column_len);
if (failed_()) {
return 0;
}
/* This column had better be of integer type. */
dtype = coldsc[1];
if (dtype != 3) {
chkin_("EKUCEI", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("Column # is of type #; EKUCEI only works with integer colum"
"ns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)93);
errch_("#", column, (ftnlen)1, column_len);
errint_("#", &dtype, (ftnlen)1);
errint_("#", recno, (ftnlen)1);
errint_("#", segno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
chkout_("EKUCEI", (ftnlen)6);
return 0;
}
/* Look up the record pointer for the target record. */
zzektrdp_(handle, &segdsc[6], recno, &recptr);
/* Determine whether the EK is shadowed. */
ekshdw_(handle, &isshad);
/* If the EK is shadowed, we must back up the current column entry */
/* if the entry has not already been backed up. ZZEKRBCK will */
/* handle this task. */
if (isshad) {
zzekrbck_("UPDATE", handle, segdsc, coldsc, recno, (ftnlen)6);
}
/* Now it's time to carry out the replacement. */
class__ = coldsc[0];
if (class__ == 1) {
/* Class 1 columns contain scalar integer data. */
zzekue01_(handle, segdsc, coldsc, &recptr, ivals, isnull);
} else if (class__ == 4) {
/* Class 4 columns contain array-valued integer data. */
zzekue04_(handle, segdsc, coldsc, &recptr, nvals, ivals, isnull);
} else {
/* This is an unsupported integer column class. */
*segno = segdsc[1];
chkin_("EKUCEI", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("Class # from input column descriptor is not a supported int"
"eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (
ftnlen)113);
errint_("#", &class__, (ftnlen)1);
errch_("#", column, (ftnlen)1, column_len);
errint_("#", recno, (ftnlen)1);
errint_("#", segno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(NOCLASS)", (ftnlen)14);
chkout_("EKUCEI", (ftnlen)6);
return 0;
}
return 0;
} /* ekucei_ */
/* $Procedure ZZEKDE05 ( EK, delete column entry, class 5 ) */
/* Subroutine */ int zzekde05_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_dnnt(doublereal *);
/* Local variables */
integer base, nrec;
extern integer zzekrp2n_(integer *, integer *, integer *);
integer next, unit;
extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen),
zzekgfwd_(integer *, integer *, integer *, integer *), zzekglnk_(
integer *, integer *, integer *, integer *), zzekpgpg_(integer *,
integer *, integer *, integer *), zzekslnk_(integer *, integer *,
integer *, integer *);
integer p;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer recno, nseen, ncols, nelts;
extern logical failed_(void);
extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *,
doublereal *), dasrdi_(integer *, integer *, integer *, integer *)
, dasudi_(integer *, integer *, integer *, integer *);
extern logical return_(void);
doublereal dpnelt;
integer datptr, nlinks, ptrloc;
extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *,
integer *), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *,
ftnlen), zzekdps_(integer *, integer *, integer *, integer *);
/* $ Abstract */
/* Delete a specified class 5 column entry from an EK record. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* PRIVATE */
/* UTILITY */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Boolean Enumerated Type */
/* ekbool.inc Version 1 21-DEC-1994 (NJB) */
/* Within the EK system, boolean values sometimes must be */
/* represented by integer or character codes. The codes and their */
/* meanings are listed below. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* Character code indicating `true': */
/* Character code indicating `false': */
/* End Include Section: EK Boolean Enumerated Type */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Page Parameters */
/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
/* These parameters apply to EK files using architecture 4. */
/* These files use a paged DAS file as their underlying file */
/* structure. */
/* In paged DAS EK files, data pages are structured: they contain */
/* metadata as well as data. The metadata is located in the last */
/* few addresses of each page, so as to interfere as little as */
/* possible with calculation of data addresses. */
/* Each data page belongs to exactly one segment. Some bookkeeping */
/* information, such as record pointers, is also stored in data */
/* pages. */
/* Each page contains a forward pointer that allows rapid lookup */
/* of data items that span multiple pages. Each page also keeps */
/* track of the current number of links from its parent segment */
/* to the page. Link counts enable pages to `know' when they */
/* are no longer in use by a segment; unused pages are deallocated */
/* and returned to the free list. */
/* The parameters in this include file depend on the parameters */
/* declared in the include file ekpage.inc. If those parameters */
/* change, this file must be updated. The specified parameter */
/* declarations we need from that file are: */
/* INTEGER PGSIZC */
/* PARAMETER ( PGSIZC = 1024 ) */
/* INTEGER PGSIZD */
/* PARAMETER ( PGSIZD = 128 ) */
/* INTEGER PGSIZI */
/* PARAMETER ( PGSIZI = 256 ) */
/* Character pages use an encoding mechanism to represent integer */
/* metadata. Each integer is encoded in five consecutive */
/* characters. */
/* Character data page parameters: */
/* Size of encoded integer: */
/* Usable page size: */
/* Location of character forward pointer: */
/* Location of character link count: */
/* Double precision data page parameters: */
/* Usable page size: */
/* Location of d.p. forward pointer: */
/* Location of d.p. link count: */
/* Integer data page parameters: */
/* Usable page size: */
/* Location of integer forward pointer: */
/* Location of integer link count: */
/* End Include Section: EK Data Page Parameters */
/* $ 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. */
/* Include Section: EK Record Pointer Parameters */
/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */
/* This file declares parameters used in EK record pointers. */
/* Each segment references data in a given record via two levels */
/* of indirection: a record number points to a record pointer, */
/* which is a structured array of metadata and data pointers. */
/* Record pointers always occupy contiguous ranges of integer */
/* addresses. */
/* The parameter declarations in this file depend on the assumption */
/* that integer pages contain 256 DAS integer words and that the */
/* maximum number of columns in a segment is 100. Record pointers */
/* are stored in integer data pages, so they must fit within the */
/* usable data area afforded by these pages. The size of the usable */
/* data area is given by the parameter IPSIZE which is declared in */
/* ekdatpag.inc. The assumed value of IPSIZE is 254. */
/* The first element of each record pointer is a status indicator. */
/* The meanings of status indicators depend on whether the parent EK */
/* is shadowed or not. For shadowed EKs, allowed status values and */
/* their meanings are: */
/* OLD The record has not been modified since */
/* the EK containing the record was opened. */
/* UPDATE The record is an update of a previously existing */
/* record. The original record is now on the */
/* modified record list. */
/* NEW The record has been added since the EK containing the */
/* record was opened. The record is not an update */
/* of a previously existing record. */
/* DELOLD This status applies only to a backup record. */
/* DELOLD status indicates that the record corresponds */
/* to a deleted OLD record in the source segment. */
/* DELNEW This status applies only to a backup record. */
/* DELNEW status indicates that the record corresponds */
/* to a deleted NEW record in the source segment. */
/* DELUPD This status applies only to a backup record. */
/* DELUPD status indicates that the record corresponds */
/* to a deleted UPDATEd record in the source segment. */
/* In EKs that are not shadowed, all records have status OLD. */
/* The following parameters refer to indices within the record */
/* pointer structure: */
/* Index of status indicator: */
/* Each record pointer contains a pointer to its companion: for a */
/* record belonging to a shadowed EK, this is the backup counterpart, */
/* or if the parent EK is itself a backup EK, a pointer to the */
/* record's source record. The pointer is UNINIT (see below) if the */
/* record is unmodified. */
/* Record companion pointers contain record numbers, not record */
/* base addresses. */
/* Index of record's companion pointer: */
/* Each data item is referenced by an integer. The meaning of */
/* this integer depends on the representation of data in the */
/* column to which the data item belongs. Actual lookup of a */
/* data item must be done by subroutines appropriate to the class of */
/* the column to which the item belongs. Note that data items don't */
/* necessarily occupy contiguous ranges of DAS addresses. */
/* Base address of data pointers: */
/* Maximum record pointer size: */
/* Data pointers are given the value UNINIT to start with; this */
/* indicates that the data item is uninitialized. UNINIT is */
/* distinct from the value NULL. NOBACK indicates an uninitialized */
/* backup column entry. */
/* End Include Section: EK Record Pointer Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Record pointer. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for write access. */
/* SEGDSC is the descriptor of the segment from which to */
/* delete the specified column entry. */
/* COLDSC is the descriptor of the column from which to */
/* delete the specified column entry. */
/* RECPTR is a pointer to the record containing the column */
/* entry to delete. */
/* $ Detailed_Output */
/* None. See the $Particulars section for a description of the */
/* effect of this routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. The file will not be modified. */
/* 2) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. The file may be corrupted. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine operates by side effects: it deletes a column entry */
/* from an EK segment. The status of the record containing the entry */
/* is set to `updated'. The deleted entry is marked as */
/* `uninitialized'. */
/* The link counts for the pages containing the deleted column entry */
/* are decremented. If the count for a page becomes zero, that page */
/* is freed. If the entry to be deleted is already uninitialized */
/* upon entry to this routine, no link counts are modified. The */
/* record containing the entry is still marked `updated' in this */
/* case. */
/* The changes made by this routine to the target EK file become */
/* permanent when the file is closed. Failure to close the file */
/* properly will leave it in an indeterminate state. */
/* $ Examples */
/* See EKDELR. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKDE05", (ftnlen)8);
}
/* Before trying to actually modify the file, do every error */
/* check we can. */
/* Is this file handle valid--is the file open for paged write */
/* access? Signal an error if not. */
zzekpgch_(handle, "WRITE", (ftnlen)5);
if (failed_()) {
chkout_("ZZEKDE05", (ftnlen)8);
return 0;
}
/* We'll need to know how many columns the segment has in order to */
/* compute the size of the record pointer. The record pointer */
/* contains DPTBAS items plus two elements for each column. */
ncols = segdsc[4];
nrec = segdsc[5];
/* Compute the data pointer location. If the data pointer is */
/* already set to `uninitialized', there's nothing to do. If */
/* the element is null, just set it to `uninitialized'. The */
/* presence of actual data obligates us to clean up, however. */
ptrloc = *recptr + 2 + coldsc[8];
dasrdi_(handle, &ptrloc, &ptrloc, &datptr);
if (datptr > 0) {
/* Get the element count for the entry. */
dasrdd_(handle, &datptr, &datptr, &dpnelt);
nelts = i_dnnt(&dpnelt);
/* Set the data pointer to indicate the item is uninitialized. */
dasudi_(handle, &ptrloc, &ptrloc, &c_n1);
/* Find the number of the page containing the column entry. */
zzekpgpg_(&c__2, &datptr, &p, &base);
/* Look up the forward pointer. This pointer will be valid */
/* if the column entry is continued on another page. */
zzekgfwd_(handle, &c__2, &p, &next);
/* Get the link count for the current page. If we have more */
/* than one link to the page, decrement the link count. If */
/* we're down to one link, this deletion will finish off the */
/* page: we'll deallocate it. */
zzekglnk_(handle, &c__2, &p, &nlinks);
if (nlinks > 1) {
i__1 = nlinks - 1;
zzekslnk_(handle, &c__2, &p, &i__1);
} else {
/* If we removed the last item from the page, we can delete */
/* the page. ZZEKDPS adjusts the segment's metadata */
/* to reflect the deallocation. */
zzekdps_(handle, segdsc, &c__2, &p);
}
/* Computing MIN */
i__1 = nelts, i__2 = base + 126 - datptr;
nseen = min(i__1,i__2);
while(nseen < nelts && ! failed_()) {
/* The column entry is continued on the page indicated by */
/* NEXT. */
/* Get the link count for the current page. If we have more */
/* than one link to the page, decrement the link count. If */
/* we're down to one link, this deletion will finish off the */
/* page: we'll deallocate it. */
p = next;
zzekgfwd_(handle, &c__2, &p, &next);
zzekglnk_(handle, &c__2, &p, &nlinks);
if (nlinks > 1) {
i__1 = nlinks - 1;
zzekslnk_(handle, &c__2, &p, &i__1);
} else {
/* If we removed the last item from the page, we can delete */
/* the page. ZZEKDPS adjusts the segment's metadata */
/* to reflect the deallocation. */
zzekdps_(handle, segdsc, &c__2, &p);
}
/* Computing MIN */
i__1 = nelts, i__2 = nseen + 126;
nseen = min(i__1,i__2);
}
} else if (datptr == -2) {
/* Mark the entry as `uninitialized'. */
dasudi_(handle, &ptrloc, &ptrloc, &c_n1);
} else if (datptr != -1) {
/* UNINIT was the last valid possibility. The data pointer is */
/* corrupted. */
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = "
"#; EK = #", (ftnlen)68);
errint_("#", &segdsc[1], (ftnlen)1);
errint_("#", &coldsc[8], (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKDE05", (ftnlen)8);
return 0;
}
/* Set the record's status to indicate that this record is updated. */
i__1 = *recptr + 1;
i__2 = *recptr + 1;
dasudi_(handle, &i__1, &i__2, &c__2);
chkout_("ZZEKDE05", (ftnlen)8);
return 0;
} /* zzekde05_ */
/* $Procedure ZZEKRD08 ( EK, read class 8 column entry ) */
/* Subroutine */ int zzekrd08_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr, doublereal *dval, logical *isnull)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer mdat[2], nrec;
extern integer zzekrp2n_(integer *, integer *, integer *);
integer unit;
char cflag[1];
integer q, r__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer recno, ncols, addrss, colidx, datbas, metloc, nflbas, offset;
logical nullok;
extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen), dasrdi_(integer *, integer *,
integer *, integer *), dasrdc_(integer *, integer *, integer *,
integer *, integer *, char *, ftnlen), dasrdd_(integer *, integer
*, integer *, doublereal *);
/* $ Abstract */
/* Read a column entry from a specified record in a class 8 column. */
/* Class 8 columns contain fixed-count, scalar, double precision */
/* values. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Boolean Enumerated Type */
/* ekbool.inc Version 1 21-DEC-1994 (NJB) */
/* Within the EK system, boolean values sometimes must be */
/* represented by integer or character codes. The codes and their */
/* meanings are listed below. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* Character code indicating `true': */
/* Character code indicating `false': */
/* End Include Section: EK Boolean Enumerated Type */
/* $ 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. */
/* Include Section: EK Column Class 8 Parameters */
/* ekclas08.inc Version 1 07-NOV-1995 (NJB) */
/* The following parameters give the offsets of items in the */
/* class 8 integer metadata array. */
/* Data array base address: */
/* Null flag array base address: */
/* Size of class 8 metadata array: */
/* End Include Section: EK Column Class 8 Parameters */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Page Parameters */
/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
/* These parameters apply to EK files using architecture 4. */
/* These files use a paged DAS file as their underlying file */
/* structure. */
/* In paged DAS EK files, data pages are structured: they contain */
/* metadata as well as data. The metadata is located in the last */
/* few addresses of each page, so as to interfere as little as */
/* possible with calculation of data addresses. */
/* Each data page belongs to exactly one segment. Some bookkeeping */
/* information, such as record pointers, is also stored in data */
/* pages. */
/* Each page contains a forward pointer that allows rapid lookup */
/* of data items that span multiple pages. Each page also keeps */
/* track of the current number of links from its parent segment */
/* to the page. Link counts enable pages to `know' when they */
/* are no longer in use by a segment; unused pages are deallocated */
/* and returned to the free list. */
/* The parameters in this include file depend on the parameters */
/* declared in the include file ekpage.inc. If those parameters */
/* change, this file must be updated. The specified parameter */
/* declarations we need from that file are: */
/* INTEGER PGSIZC */
/* PARAMETER ( PGSIZC = 1024 ) */
/* INTEGER PGSIZD */
/* PARAMETER ( PGSIZD = 128 ) */
/* INTEGER PGSIZI */
/* PARAMETER ( PGSIZI = 256 ) */
/* Character pages use an encoding mechanism to represent integer */
/* metadata. Each integer is encoded in five consecutive */
/* characters. */
/* Character data page parameters: */
/* Size of encoded integer: */
/* Usable page size: */
/* Location of character forward pointer: */
/* Location of character link count: */
/* Double precision data page parameters: */
/* Usable page size: */
/* Location of d.p. forward pointer: */
/* Location of d.p. link count: */
/* Integer data page parameters: */
/* Usable page size: */
/* Location of integer forward pointer: */
/* Location of integer link count: */
/* End Include Section: EK Data Page Parameters */
/* $ 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. */
/* Include Section: EK Das Paging Parameters */
/* ekpage.inc Version 4 25-AUG-1995 (NJB) */
/* The EK DAS paging system makes use of the integer portion */
/* of an EK file's DAS address space to store the few numbers */
/* required to describe the system's state. The allocation */
/* of DAS integer addresses is shown below. */
/* DAS integer array */
/* +--------------------------------------------+ */
/* | EK architecture code | Address = 1 */
/* +--------------------------------------------+ */
/* | Character page size (in DAS words) | */
/* +--------------------------------------------+ */
/* | Character page base address | */
/* +--------------------------------------------+ */
/* | Number of character pages in file | */
/* +--------------------------------------------+ */
/* | Number of character pages on free list | */
/* +--------------------------------------------+ */
/* | Character free list head pointer | Address = 6 */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for d.p. pages | 7--11 */
/* | | */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for integer pages | 12--16 */
/* | | */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | End Address = */
/* | Unused space | integer page */
/* | | end */
/* +--------------------------------------------+ */
/* | | Start Address = */
/* | First integer page | integer page */
/* | | base */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | */
/* | Last integer page | */
/* | | */
/* +--------------------------------------------+ */
/* The following parameters indicate positions of elements in the */
/* paging system metadata array: */
/* Number of metadata items per data type: */
/* Character metadata indices: */
/* Double precision metadata indices: */
/* Integer metadata indices: */
/* Size of metadata area: */
/* Page sizes, in units of DAS words of the appropriate type: */
/* Default page base addresses: */
/* End Include Section: EK Das Paging Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Record pointer. */
/* DVAL O Double precision value in column entry. */
/* ISNULL O Flag indicating whether column entry is null. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. */
/* SEGDSC is the descriptor of the segment from which data is */
/* to be read. */
/* COLDSC is the descriptor of the column from which data is */
/* to be read. */
/* RECPTR is a pointer to the record containing the column */
/* entry to be written. For class 8 columns, record */
/* pointers are identical to record numbers. */
/* $ Detailed_Output */
/* DVAL is the value read from the specified column entry. */
/* ISNULL is a logical flag indicating whether the entry is */
/* null. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If the ordinal position of the column specified by COLDSC */
/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */
/* 3) If an I/O error occurs while reading the indicated file, */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine is a utility for reading data from class 8 columns. */
/* $ Examples */
/* See EKRCED. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 09-NOV-1995 (NJB) */
/* -& */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* Make sure the column exists. */
ncols = segdsc[4];
colidx = coldsc[8];
metloc = coldsc[9];
nullok = coldsc[7] == 1;
if (colidx < 1 || colidx > ncols) {
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
chkin_("ZZEKRD08", (ftnlen)8);
setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37);
errint_("#", &colidx, (ftnlen)1);
errint_("#", &nrec, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKRD08", (ftnlen)8);
return 0;
}
/* Read the metadata block. There are two items in the block: */
/* 1) The base address of the first page of the data */
/* 2) The base address of the null flag array, if nulls are */
/* permitted. */
i__1 = metloc + 1;
i__2 = metloc + 2;
dasrdi_(handle, &i__1, &i__2, mdat);
datbas = mdat[0];
nflbas = mdat[1];
/* If null values are permitted, the first step is to get */
/* the null flag for the value of interest. Compute the */
/* address of this flag. */
/* There are CPSIZE null flags per page, and each page has size */
/* PGSIZC. The null flags start at the beginning of the page. */
if (nullok) {
q = (*recptr - 1) / 1014;
r__ = *recptr - q * 1014;
offset = r__ + (q << 10);
addrss = nflbas + offset;
dasrdc_(handle, &addrss, &addrss, &c__1, &c__1, cflag, (ftnlen)1);
*isnull = *(unsigned char *)cflag == 'T';
if (*isnull) {
return 0;
}
}
/* If we're still here, we'll read the data value. */
*isnull = FALSE_;
/* The address calculation for the value is analogous to that */
/* for the null flag. */
q = (*recptr - 1) / 126;
r__ = *recptr - q * 126;
offset = r__ + (q << 7);
addrss = datbas + offset;
dasrdd_(handle, &addrss, &addrss, dval);
return 0;
} /* zzekrd08_ */
/* $Procedure ZZEKPGCH ( EK, paging system access check ) */
/* Subroutine */ int zzekpgch_(integer *handle, char *access, ftnlen
access_len)
{
integer topc, topd, topi, unit;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer lastc, lastd, lasti, id;
extern logical failed_(void);
extern /* Subroutine */ int daslla_(integer *, integer *, integer *,
integer *), dasrdi_(integer *, integer *, integer *, integer *),
dassih_(integer *, char *, ftnlen), dashlu_(integer *, integer *),
errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen),
chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
integer npc, npd, npi;
/* $ Abstract */
/* Check that an EK is valid for a specified type of access by the */
/* paging system. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Das Paging Parameters */
/* ekpage.inc Version 4 25-AUG-1995 (NJB) */
/* The EK DAS paging system makes use of the integer portion */
/* of an EK file's DAS address space to store the few numbers */
/* required to describe the system's state. The allocation */
/* of DAS integer addresses is shown below. */
/* DAS integer array */
/* +--------------------------------------------+ */
/* | EK architecture code | Address = 1 */
/* +--------------------------------------------+ */
/* | Character page size (in DAS words) | */
/* +--------------------------------------------+ */
/* | Character page base address | */
/* +--------------------------------------------+ */
/* | Number of character pages in file | */
/* +--------------------------------------------+ */
/* | Number of character pages on free list | */
/* +--------------------------------------------+ */
/* | Character free list head pointer | Address = 6 */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for d.p. pages | 7--11 */
/* | | */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for integer pages | 12--16 */
/* | | */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | End Address = */
/* | Unused space | integer page */
/* | | end */
/* +--------------------------------------------+ */
/* | | Start Address = */
/* | First integer page | integer page */
/* | | base */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | */
/* | Last integer page | */
/* | | */
/* +--------------------------------------------+ */
/* The following parameters indicate positions of elements in the */
/* paging system metadata array: */
/* Number of metadata items per data type: */
/* Character metadata indices: */
/* Double precision metadata indices: */
/* Integer metadata indices: */
/* Size of metadata area: */
/* Page sizes, in units of DAS words of the appropriate type: */
/* Default page base addresses: */
/* End Include Section: EK Das Paging Parameters */
/* $ 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. */
/* Include Section: EK Architecture Version Parameters */
/* ekarch.inc Version 1 01-NOV-1995 (NJB) */
/* The following parameter indicates the EK file architecture */
/* version. EK files read by the EK system must have the */
/* architecture expected by the reader software; the architecture ID */
/* below is used to test for compatibility. */
/* Architecture code: */
/* End Include Section: EK Architecture Version Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* ACCESS I Access type. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. The specified file is to be */
/* checked to see whether it is a valid paged EK and */
/* whether it is open for the specified type of */
/* access. */
/* ACCESS is a short string indicating the type of access */
/* desired. Possible values are 'READ' and 'WRITE'. */
/* Leading and trailing blanks in ACCESS are ignored, */
/* and case is not significant. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If the EK architecture version is not current, the error */
/* SPICE(WRONGARCHITECTURE) is signalled. */
/* 3) If the DAS logical address ranges occupied by the EK are */
/* not consistent with those recorded by the paging system, */
/* the error SPICE(INVALIDFORMAT) is signalled. */
/* 4) If the EK is not open for the specified type of access, the */
/* error will be diagnosed by routines called by this routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine centralizes a validation check performed by many */
/* EK routines. The EK designated by HANDLE is tested to see */
/* whether some aspects of its structure are valid, and whether */
/* the specified type of access (read or write) is allowed. */
/* The tests performed are: */
/* - Is the file a DAS file open for the specified type of access? */
/* - Is the file's EK architecture version correct? */
/* - Are the DAS address ranges in use consistent with those */
/* recorded in the file by the paging system? */
/* If the file fails any test, an error is signalled. */
/* $ Examples */
/* See EKINSR. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
chkin_("ZZEKPGCH", (ftnlen)8);
/* Check whether the DAS is opened for the specified access method. */
dassih_(handle, access, access_len);
if (failed_()) {
chkout_("ZZEKPGCH", (ftnlen)8);
return 0;
}
/* Make sure the DAS file is of the right type. */
dasrdi_(handle, &c__1, &c__1, &id);
if (id != 8) {
dashlu_(handle, &unit);
setmsg_("File # has architecture #, which is invalid for paged acces"
"s. You are using EK software version #.", (ftnlen)99);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &id, (ftnlen)1);
errint_("#", &c__8, (ftnlen)1);
sigerr_("SPICE(WRONGARCHITECTURE)", (ftnlen)24);
chkout_("ZZEKPGCH", (ftnlen)8);
return 0;
}
/* Obtain the page counts. Set the `top' addresses. */
dasrdi_(handle, &c__4, &c__4, &npc);
dasrdi_(handle, &c__9, &c__9, &npd);
dasrdi_(handle, &c__14, &c__14, &npi);
topc = npc << 10;
topd = npd << 7;
topi = (npi << 8) + 256;
/* Verify that the last addresses in use are consistent with the */
/* `top' addresses known to this system. */
daslla_(handle, &lastc, &lastd, &lasti);
if (lastc > topc) {
dashlu_(handle, &unit);
setmsg_("File # has last char address #; `top' = #.", (ftnlen)42);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &lastc, (ftnlen)1);
errint_("#", &topc, (ftnlen)1);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("ZZEKPGCH", (ftnlen)8);
return 0;
} else if (lastd > topd) {
dashlu_(handle, &unit);
setmsg_("File # has last d.p. address #; `top' = #.", (ftnlen)42);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &lastd, (ftnlen)1);
errint_("#", &topd, (ftnlen)1);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("ZZEKPGCH", (ftnlen)8);
return 0;
} else if (lasti > topi) {
dashlu_(handle, &unit);
setmsg_("File # has last int. address #; `top' = #.", (ftnlen)42);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &lasti, (ftnlen)1);
errint_("#", &topi, (ftnlen)1);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("ZZEKPGCH", (ftnlen)8);
return 0;
}
chkout_("ZZEKPGCH", (ftnlen)8);
return 0;
} /* zzekpgch_ */
/* $Procedure DASWFR ( DAS write file record ) */
/* Subroutine */ int daswfr_(integer *handle, char *idword, char *ifname,
integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc,
ftnlen idword_len, ftnlen ifname_len)
{
/* Builtin functions */
integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wdue(cilist *), e_wdue(void);
/* Local variables */
integer free;
char tail[932];
integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern logical failed_(void);
integer oldcch, locncc, oldcrc;
extern /* Subroutine */ int dashfs_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *);
char locifn[60];
integer oldrch;
extern /* Subroutine */ int dassih_(integer *, char *, ftnlen);
integer lastla[3];
char locidw[8];
integer locncr, locnvc, oldrrc;
char format[8];
integer lastrc[3];
extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *,
integer *, ftnlen), chkout_(char *, ftnlen);
integer lastwd[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), dasufs_(integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *), setmsg_(char *, ftnlen);
integer iostat, locnvr;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
char ifn[60];
/* Fortran I/O blocks */
static cilist io___3 = { 1, 0, 1, 0, 1 };
static cilist io___13 = { 1, 0, 0, 0, 1 };
/* $ Abstract */
/* Update the contents of the file record of a specified DAS file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* IDWORD I ID word. */
/* IFNAME I DAS internal file name. */
/* NRESVR I Number of reserved records in file. */
/* NRESVC I Number of characters in use in reserved rec. area. */
/* NCOMR I Number of comment records in file. */
/* NCOMC I Number of characters in use in comment area. */
/* $ Detailed_Input */
/* HANDLE is a file handle for a DAS file open for writing. */
/* IDWORD is the `ID word' contained in the first eight */
/* characters of the file record. */
/* IFNAME is the internal file name of the DAS file. The */
/* maximum length of the internal file name is 60 */
/* characters. */
/* NRESVR is the number of reserved records in the DAS file */
/* specified by HANDLE. */
/* NRESVC is the number of characters in use in the reserved */
/* record area of the DAS file specified by HANDLE. */
/* NCOMR is the number of comment records in the DAS file */
/* specified by HANDLE. */
/* NCOMC is the number of characters in use in the comment area */
/* of the DAS file specified by HANDLE. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the handle passed to this routine is not the handle of an */
/* open DAS file, the error will be signaled by a routine called */
/* by this routine. */
/* 2) If the specified DAS file is not open for write access, the */
/* error will be diagnosed by a routine called by this routine. */
/* 3) If the attempt to read the file record fails, the error */
/* SPICE(DASREADFAIL) is signaled. */
/* 4) If the file write attempted by this routine fails, the error */
/* SPICE(DASFILEWRITEFAILED) is signaled. */
/* $ Files */
/* See the description of HANDLE under $Detailed_Input. */
/* $ Particulars */
/* This routine provides a convenient way of updating the internal */
/* file name of a DAS file. */
/* The `ID word' contained in the file record is a string of eight */
/* characters that identifies the file as a DAS file and optionally */
/* indicates a specific file format, for example, `EK'. */
/* $ Examples */
/* 1) Update the internal file name of an existing DAS file. */
/* C */
/* C Open the file for writing. */
/* C */
/* CALL DASOPW ( FNAME, HANDLE ) */
/* C */
/* C Retrieve the ID word and current reserved record */
/* C and comment area record and character counts. */
/* C */
/* CALL DASRFR ( HANDLE, */
/* . IDWORD, */
/* . IFNAME, */
/* . NRESVR, */
/* . NRESVC, */
/* . NCOMR, */
/* . NCOMC ) */
/* C */
/* C Set the internal file name and update the file */
/* C with it. */
/* C */
/* IFNAME = 'New internal file name' */
/* CALL DASWFR ( HANDLE, */
/* . IDWORD, */
/* . IFNAME, */
/* . NRESVR, */
/* . NRESVC, */
/* . NCOMR, */
/* . NCOMC ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */
/* This routine was modified to accomodate the preservation */
/* of the FTP validation and binary file format strings that */
/* are not part of the DAS file record. */
/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if these open routines ever */
/* change. */
/* Added a check of FAILED after the call to DASHLU which will */
/* check out and return if DASHLU fails. This is so that when in */
/* return mode of the error handling the READ following the call */
/* to DASHLU will not be executed. */
/* Reworded some of the descriptions contained in the */
/* $ Detailed_Output section of the header so that they were more */
/* clear. */
/* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* write DAS file record */
/* write DAS internal file name */
/* update DAS internal file name */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */
/* In order to preserve the additional information that */
/* now resides in the file record, this routine reads */
/* the entire record into local buffers, including the */
/* TAILEN characters that follow the actual data content. */
/* The contents of the local buffers that correspond to */
/* information brought in from the call sequence of the */
/* routine are ignored when the record is rewritten. */
/* However, the ID word, the file format string, and the */
/* trailing TAILEN characters that contain the FTP validation */
/* string are rewritten along with the input values. */
/* This routine does not simply replace the FTP validation */
/* string with the components from ZZFTPSTR, since that */
/* would possibly validate a corrupt file created using a newer */
/* Toolkit. */
/* The string arguments passed into this routine are now */
/* copied to local buffers of the appropriate length. */
/* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if these open routines ever */
/* change. */
/* Added a check of FAILED after the call to DASHLU which will */
/* check out and return if DASHLU fails. This is so that when in */
/* return mode of the error handling the READ following the call */
/* to DASHLU will not be executed. */
/* Reworded some of the descriptions contained in the */
/* $ Detailed_Output section of the header so that they were more */
/* clear. */
/* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* The parameter TAILEN determines the tail length of a DAS file */
/* record. This is the number of bytes (characters) that */
/* occupy the portion of the file record that follows the */
/* integer holding the first free address. For environments */
/* with a 32 bit word length, 1 byte characters, and DAS */
/* record sizes of 1024 bytes, we have: */
/* 8 bytes - IDWORD */
/* 60 bytes - IFNAME */
/* 4 bytes - NRESVR (32 bit integer) */
/* 4 bytes - NRESVC (32 bit integer) */
/* 4 bytes - NCOMR (32 bit integer) */
/* + 4 bytes - NCOMC (32 bit integer) */
/* --------- */
/* 84 bytes - (All file records utilize this space.) */
/* So the size of the remaining portion (or tail) of the DAS */
/* file record for computing enviroments as described above */
/* would be: */
/* 1024 bytes - DAS record size */
/* - 8 bytes - DAS Binary File Format Word */
/* - 84 bytes - (from above) */
/* ------------ */
/* 932 bytes - DAS file record tail length */
/* Note: environments that do not have a 32 bit word length, */
/* 1 byte characters, and a DAS record size of 1024 bytes, will */
/* require the adjustment of this parameter. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASWFR", (ftnlen)6);
}
/* Check to be sure that HANDLE is attached to a file that is open */
/* with write access. If the call fails, check out and return. */
dassih_(handle, "WRITE", (ftnlen)5);
/* Get the logical unit for this DAS file. */
dashlu_(handle, &unit);
if (failed_()) {
chkout_("DASWFR", (ftnlen)6);
return 0;
}
/* In order to maintain the integrity of the file ID word, the */
/* file FORMAT, and the FTP string if present, we need to */
/* read the entire file record into the appropriate sized local */
/* buffers. The values of the LOCxxx variables are simply */
/* ignored, since the caller passes new values in for updates. */
io___3.ciunit = unit;
iostat = s_rdue(&io___3);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, locidw, (ftnlen)8);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, locifn, (ftnlen)60);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locnvr, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locnvc, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locncr, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, (char *)&locncc, (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, format, (ftnlen)8);
if (iostat != 0) {
goto L100001;
}
iostat = do_uio(&c__1, tail, (ftnlen)932);
if (iostat != 0) {
goto L100001;
}
iostat = e_rdue();
L100001:
if (iostat != 0) {
setmsg_("Attempt to read the file record failed for file '#'. IOSTAT"
" = #", (ftnlen)63);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASREADFAIL)", (ftnlen)18);
chkout_("DASWFR", (ftnlen)6);
return 0;
}
/* Set the value of the internal file name and IDWORD before */
/* writing. This is to guarantee that their lengths are ok. */
s_copy(ifn, ifname, (ftnlen)60, ifname_len);
s_copy(locidw, idword, (ftnlen)8, idword_len);
io___13.ciunit = unit;
iostat = s_wdue(&io___13);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, locidw, (ftnlen)8);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, ifn, (ftnlen)60);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer));
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, format, (ftnlen)8);
if (iostat != 0) {
goto L100002;
}
iostat = do_uio(&c__1, tail, (ftnlen)932);
if (iostat != 0) {
goto L100002;
}
iostat = e_wdue();
L100002:
if (iostat != 0) {
setmsg_("Could not write file record. File was #. IOSTAT was #.", (
ftnlen)56);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &iostat, (ftnlen)1);
sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25);
chkout_("DASWFR", (ftnlen)6);
return 0;
}
/* Update the file summary, in case the values of the reserved */
/* record or comment area counts have changed. */
dashfs_(handle, &oldrrc, &oldrch, &oldcrc, &oldcch, &free, lastla, lastrc,
lastwd);
dasufs_(handle, nresvr, nresvc, ncomr, ncomc, &free, lastla, lastrc,
lastwd);
chkout_("DASWFR", (ftnlen)6);
return 0;
} /* daswfr_ */
/* $Procedure EKRCEC ( EK, read column entry element, character ) */
/* Subroutine */ int ekrcec_(integer *handle, integer *segno, integer *recno,
char *column, integer *nvals, char *cvals, logical *isnull, ftnlen
column_len, ftnlen cvals_len)
{
integer unit;
extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *,
integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *),
zzektrdp_(integer *, integer *, integer *, integer *);
extern integer zzekesiz_(integer *, integer *, integer *, integer *);
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
integer class__, cvlen;
logical found;
integer dtype;
extern logical failed_(void);
integer coldsc[11], segdsc[24];
extern /* Subroutine */ int dashlu_(integer *, integer *);
integer recptr;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), zzekrd03_(integer *,
integer *, integer *, integer *, integer *, char *, logical *,
ftnlen), zzekrd06_(integer *, integer *, integer *, integer *,
integer *, integer *, char *, logical *, logical *, ftnlen),
zzekrd09_(integer *, integer *, integer *, integer *, integer *,
char *, logical *, ftnlen);
/* $ Abstract */
/* Read data from a character column in a specified EK record. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* SEGNO I Index of segment containing record. */
/* RECNO I Record from which data is to be read. */
/* COLUMN I Column name. */
/* NVALS O Number of values in column entry. */
/* CVALS O Character values in column entry. */
/* ISNULL O Flag indicating whether column entry is null. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. The file may be open for */
/* read or write access. */
/* SEGNO is the index of the segment from which data is to */
/* be read. */
/* RECNO is the index of the record from which data is to be */
/* read. This record number is relative to the start */
/* of the segment indicated by SEGNO; the first */
/* record in the segment has index 1. */
/* COLUMN is the name of the column from which data is to be */
/* read. */
/* $ Detailed_Output */
/* NVALS, */
/* CVALS are, respectively, the number of values found in */
/* the specified column entry and the set of values */
/* themselves. The array CVALS must have sufficient */
/* string length to accommodate the longest string */
/* in the returned column entry. */
/* For columns having fixed-size entries, when a */
/* a column entry is null, NVALS is still set to the */
/* column entry size. For columns having variable- */
/* size entries, NVALS is set to 1 for null entries. */
/* ISNULL is a logical flag indicating whether the returned */
/* column entry is null. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If SEGNO is out of range, the error will diagnosed by routines */
/* called by this routine. */
/* 3) If RECNO is out of range, the error will diagnosed by routines */
/* called by this routine. */
/* 4) If COLUMN is not the name of a declared column, the error */
/* will be diagnosed by routines called by this routine. */
/* 5) If COLUMN specifies a column of whose data type is not */
/* character, the error SPICE(WRONGDATATYPE) will be */
/* signalled. */
/* 6) If COLUMN specifies a column of whose class is not */
/* a character class known to this routine, the error */
/* SPICE(NOCLASS) will be signalled. */
/* 7) If an attempt is made to read an uninitialized column entry, */
/* the error will be diagnosed by routines called by this */
/* routine. A null entry is considered to be initialized, but */
/* entries do not contain null values by default. */
/* 8) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* 9) If any element of the column entry would be truncated when */
/* assigned to an element of CVALS, the error will be diagnosed */
/* by routines called by this routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine is a utility that allows an EK file to be read */
/* directly without using the high-level query interface. */
/* $ Examples */
/* 1) Read the value in the third record of the column CCOL in */
/* the fifth segment of an EK file designated by HANDLE. */
/* CALL EKRCEC ( HANDLE, 5, 3, 'CCOL', N, CVAL, ISNULL ) */
/* $ Restrictions */
/* 1) EK files open for write access are not necessarily readable. */
/* In particular, a column entry can be read only if it has been */
/* initialized. The caller is responsible for determining */
/* when it is safe to read from files open for write access. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 20-JUN-1999 (WLT) */
/* Removed unbalanced call to CHKOUT. */
/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */
/* Bug fix: Record number, not record pointer, is now supplied */
/* to look up data in the class 9 case. Miscellaneous header */
/* changes were made as well. Check for string truncation on */
/* output has been added. */
/* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */
/* -& */
/* $ Index_Entries */
/* read character data from EK column */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */
/* Bug fix: Record number, not record pointer, is now supplied */
/* to look up data in the class 9 case. For class 9 columns, */
/* column entry locations are calculated directly from record */
/* numbers, no indirection is used. */
/* Miscellaneous header changes were made as well. */
/* The routines */
/* ZZEKRD03 */
/* ZZEKRD06 */
/* ZZEKRD09 */
/* now check for string truncation on output and signal errors */
/* if truncation occurs. */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* First step: find the descriptor for the named segment. Using */
/* this descriptor, get the column descriptor. */
zzeksdsc_(handle, segno, segdsc);
zzekcdsc_(handle, segdsc, column, coldsc, column_len);
if (failed_()) {
return 0;
}
/* This column had better be of character type. */
dtype = coldsc[1];
if (dtype != 1) {
chkin_("EKRCEC", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("Column # is of type #; EKRCEC only works with character col"
"umns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)95);
errch_("#", column, (ftnlen)1, column_len);
errint_("#", &dtype, (ftnlen)1);
errint_("#", recno, (ftnlen)1);
errint_("#", segno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
chkout_("EKRCEC", (ftnlen)6);
return 0;
}
/* Now it's time to read data from the file. Call the low-level */
/* reader appropriate to the column's class. */
class__ = coldsc[0];
if (class__ == 3) {
/* Look up the record pointer for the target record. */
zzektrdp_(handle, &segdsc[6], recno, &recptr);
zzekrd03_(handle, segdsc, coldsc, &recptr, &cvlen, cvals, isnull,
cvals_len);
*nvals = 1;
} else if (class__ == 6) {
zzektrdp_(handle, &segdsc[6], recno, &recptr);
*nvals = zzekesiz_(handle, segdsc, coldsc, &recptr);
zzekrd06_(handle, segdsc, coldsc, &recptr, &c__1, nvals, cvals,
isnull, &found, cvals_len);
} else if (class__ == 9) {
/* Records in class 9 columns are identified by a record number */
/* rather than a pointer. */
zzekrd09_(handle, segdsc, coldsc, recno, &cvlen, cvals, isnull,
cvals_len);
*nvals = 1;
} else {
/* This is an unsupported character column class. */
*segno = segdsc[1];
chkin_("EKRCEC", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("Class # from input column descriptor is not a supported cha"
"racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (
ftnlen)115);
errint_("#", &class__, (ftnlen)1);
errch_("#", column, (ftnlen)1, column_len);
errint_("#", recno, (ftnlen)1);
errint_("#", segno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(NOCLASS)", (ftnlen)14);
chkout_("EKRCEC", (ftnlen)6);
return 0;
}
return 0;
} /* ekrcec_ */
/* $Procedure ZZEKRD03 ( EK, read class 3 column entry elements ) */
/* Subroutine */ int zzekrd03_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr, integer *cvlen, char *cval, logical *isnull,
ftnlen cval_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_len(char *, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer nrec, bpos;
extern integer zzekrp2n_(integer *, integer *, integer *);
integer epos, unit;
extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *,
ftnlen), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_(
integer *, integer *, integer *, integer *);
integer b, e, l, n, p, pbase, avail;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
integer recno, ncols;
extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *,
integer *, integer *, char *, ftnlen), dasrdi_(integer *, integer
*, integer *, integer *);
char column[32];
integer colidx, datptr, relptr, ptrloc;
extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), zzekgei_(integer *, integer *, integer *);
/* $ Abstract */
/* Read a column entry from a specified record in a class 3 column. */
/* Class 3 columns contain scalar character values. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Boolean Enumerated Type */
/* ekbool.inc Version 1 21-DEC-1994 (NJB) */
/* Within the EK system, boolean values sometimes must be */
/* represented by integer or character codes. The codes and their */
/* meanings are listed below. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* Character code indicating `true': */
/* Character code indicating `false': */
/* End Include Section: EK Boolean Enumerated Type */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Column Name Size */
/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */
/* Size of column name, in characters. */
/* End Include Section: EK Column Name Size */
/* $ 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. */
/* Include Section: EK Data Page Parameters */
/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
/* These parameters apply to EK files using architecture 4. */
/* These files use a paged DAS file as their underlying file */
/* structure. */
/* In paged DAS EK files, data pages are structured: they contain */
/* metadata as well as data. The metadata is located in the last */
/* few addresses of each page, so as to interfere as little as */
/* possible with calculation of data addresses. */
/* Each data page belongs to exactly one segment. Some bookkeeping */
/* information, such as record pointers, is also stored in data */
/* pages. */
/* Each page contains a forward pointer that allows rapid lookup */
/* of data items that span multiple pages. Each page also keeps */
/* track of the current number of links from its parent segment */
/* to the page. Link counts enable pages to `know' when they */
/* are no longer in use by a segment; unused pages are deallocated */
/* and returned to the free list. */
/* The parameters in this include file depend on the parameters */
/* declared in the include file ekpage.inc. If those parameters */
/* change, this file must be updated. The specified parameter */
/* declarations we need from that file are: */
/* INTEGER PGSIZC */
/* PARAMETER ( PGSIZC = 1024 ) */
/* INTEGER PGSIZD */
/* PARAMETER ( PGSIZD = 128 ) */
/* INTEGER PGSIZI */
/* PARAMETER ( PGSIZI = 256 ) */
/* Character pages use an encoding mechanism to represent integer */
/* metadata. Each integer is encoded in five consecutive */
/* characters. */
/* Character data page parameters: */
/* Size of encoded integer: */
/* Usable page size: */
/* Location of character forward pointer: */
/* Location of character link count: */
/* Double precision data page parameters: */
/* Usable page size: */
/* Location of d.p. forward pointer: */
/* Location of d.p. link count: */
/* Integer data page parameters: */
/* Usable page size: */
/* Location of integer forward pointer: */
/* Location of integer link count: */
/* End Include Section: EK Data Page Parameters */
/* $ 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. */
/* Include Section: EK Record Pointer Parameters */
/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */
/* This file declares parameters used in EK record pointers. */
/* Each segment references data in a given record via two levels */
/* of indirection: a record number points to a record pointer, */
/* which is a structured array of metadata and data pointers. */
/* Record pointers always occupy contiguous ranges of integer */
/* addresses. */
/* The parameter declarations in this file depend on the assumption */
/* that integer pages contain 256 DAS integer words and that the */
/* maximum number of columns in a segment is 100. Record pointers */
/* are stored in integer data pages, so they must fit within the */
/* usable data area afforded by these pages. The size of the usable */
/* data area is given by the parameter IPSIZE which is declared in */
/* ekdatpag.inc. The assumed value of IPSIZE is 254. */
/* The first element of each record pointer is a status indicator. */
/* The meanings of status indicators depend on whether the parent EK */
/* is shadowed or not. For shadowed EKs, allowed status values and */
/* their meanings are: */
/* OLD The record has not been modified since */
/* the EK containing the record was opened. */
/* UPDATE The record is an update of a previously existing */
/* record. The original record is now on the */
/* modified record list. */
/* NEW The record has been added since the EK containing the */
/* record was opened. The record is not an update */
/* of a previously existing record. */
/* DELOLD This status applies only to a backup record. */
/* DELOLD status indicates that the record corresponds */
/* to a deleted OLD record in the source segment. */
/* DELNEW This status applies only to a backup record. */
/* DELNEW status indicates that the record corresponds */
/* to a deleted NEW record in the source segment. */
/* DELUPD This status applies only to a backup record. */
/* DELUPD status indicates that the record corresponds */
/* to a deleted UPDATEd record in the source segment. */
/* In EKs that are not shadowed, all records have status OLD. */
/* The following parameters refer to indices within the record */
/* pointer structure: */
/* Index of status indicator: */
/* Each record pointer contains a pointer to its companion: for a */
/* record belonging to a shadowed EK, this is the backup counterpart, */
/* or if the parent EK is itself a backup EK, a pointer to the */
/* record's source record. The pointer is UNINIT (see below) if the */
/* record is unmodified. */
/* Record companion pointers contain record numbers, not record */
/* base addresses. */
/* Index of record's companion pointer: */
/* Each data item is referenced by an integer. The meaning of */
/* this integer depends on the representation of data in the */
/* column to which the data item belongs. Actual lookup of a */
/* data item must be done by subroutines appropriate to the class of */
/* the column to which the item belongs. Note that data items don't */
/* necessarily occupy contiguous ranges of DAS addresses. */
/* Base address of data pointers: */
/* Maximum record pointer size: */
/* Data pointers are given the value UNINIT to start with; this */
/* indicates that the data item is uninitialized. UNINIT is */
/* distinct from the value NULL. NOBACK indicates an uninitialized */
/* backup column entry. */
/* End Include Section: EK Record Pointer Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Record pointer. */
/* CVLEN O Length of returned character value. */
/* CVAL O Character value in column entry. */
/* ISNULL O Flag indicating whether column entry is null. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. */
/* SEGDSC is the descriptor of the segment from which data is */
/* to be read. */
/* COLDSC is the descriptor of the column from which data is */
/* to be read. */
/* RECPTR is a pointer to the record containing the column */
/* entry to be written. */
/* $ Detailed_Output */
/* CVLEN is the length of the returned string value. This */
/* is the index of the last non-blank character of */
/* the string. This definition applies to both fixed- */
/* and variable-length strings. */
/* CVLEN is set to 1 if the column entry is null. */
/* CVAL is the value read from the specified column entry. */
/* If CVAL has insufficient length to hold the */
/* returned string value, the output value is */
/* truncated on the right. Entries that are shorter */
/* than the string length of CVAL are padded with */
/* trailing blanks. */
/* ISNULL is a logical flag indicating whether the entry is */
/* null. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If the specified column entry has not been initialized, the */
/* error SPICE(UNINITIALIZED) is signaled. */
/* 3) If the ordinal position of the column specified by COLDSC */
/* is out of range, the error SPICE(INVALIDINDEX) is signaled. */
/* 4) If the output string CVAL is too short to accommodate the */
/* returned string value, the output value is truncated on the */
/* right. No error is signaled. */
/* 5) If an I/O error occurs while reading the indicated file, */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine is a utility for reading data from class 3 columns. */
/* $ Examples */
/* See EKRCEC. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.3.0, 31-MAY-2010 (NJB) */
/* Bug fix: call to DASRDI was overwriting local memory. This */
/* problem did not affect operation of the routine except on */
/* the Mac/Intel/OSX/ifort/32-bit platform, on which it caused */
/* a segmentation fault when this routine was compiled with */
/* default optimization. */
/* - SPICELIB Version 1.2.0, 23-JUL-1999 (NJB) */
/* Error check for string truncation on output was removed. */
/* This error check interfered with the use of this routine */
/* (via a call to ZZEKRSC) within ZZEKJSRT, which relies on */
/* being able to read into a buffer initial substrings of scalar */
/* data. */
/* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */
/* Error check for string truncation on output was added. */
/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */
/* to SPICE(UNINITIALIZED). Error messages were enhanced so */
/* as to use column names rather than indices. Miscellaneous */
/* header fixes were made. */
/* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 23-JUL-1999 (NJB) */
/* Error check for string truncation on output was removed. */
/* This error check interfered with the use of this routine */
/* (via a call to ZZEKRSC) within ZZEKJSRT, which relies on */
/* being able to read into a buffer initial substrings of scalar */
/* data. */
/* - SPICELIB Version 1.1.0, 25-JUL-1997 (NJB) */
/* Error check for string truncation on output was added. */
/* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */
/* to SPICE(UNINITIALIZED), since the previous string exceeded */
/* the maximum allowed length for the short error message. */
/* Error messages were enhanced so as to use column names rather */
/* than indices. */
/* -& */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* Make sure the column exists. */
ncols = segdsc[4];
colidx = coldsc[8];
if (colidx < 1 || colidx > ncols) {
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
chkin_("ZZEKRD03", (ftnlen)8);
setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; "
"EK = #", (ftnlen)65);
errint_("#", &colidx, (ftnlen)1);
errint_("#", &nrec, (ftnlen)1);
errint_("#", &segdsc[1], (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKRD03", (ftnlen)8);
return 0;
}
/* Compute the data pointer location, and read both the pointer */
/* and the stored string size. */
ptrloc = *recptr + 2 + colidx;
dasrdi_(handle, &ptrloc, &ptrloc, &datptr);
if (datptr > 0) {
/* Read the value. This is slightly more complicated than */
/* the numeric cases, because the value may be spread across */
/* multiple pages. Also, we must not write past the end of the */
/* output string. */
/* We'll need the number of the page at which the first character */
/* of the string is stored. This page contains at least one */
/* character of the data value. */
zzekgei_(handle, &datptr, cvlen);
/* Set the data pointer to the start of the string data, skipping */
/* over the encoded string length. */
datptr += 5;
/* Computing MIN */
i__1 = *cvlen, i__2 = i_len(cval, cval_len);
n = min(i__1,i__2);
/* Read the available data from the page under consideration. */
zzekpgpg_(&c__1, &datptr, &p, &pbase);
relptr = datptr - pbase;
/* Computing MIN */
i__1 = n, i__2 = 1014 - relptr + 1;
avail = min(i__1,i__2);
b = datptr;
e = datptr + avail - 1;
bpos = 1;
epos = avail;
l = epos - bpos + 1;
dasrdc_(handle, &b, &e, &bpos, &epos, cval, cval_len);
n -= l;
while(n > 0) {
/* Read the forward page pointer from the current page; find */
/* the base address of the referenced page. */
i__1 = pbase + 1015;
zzekgei_(handle, &i__1, &p);
zzekpgbs_(&c__1, &p, &pbase);
avail = min(n,1014);
b = pbase + 1;
e = pbase + avail;
bpos = epos + 1;
epos += avail;
dasrdc_(handle, &b, &e, &bpos, &epos, cval, cval_len);
n -= avail;
bpos = epos + 1;
}
/* Blank-pad CVAL if required. */
if (i_len(cval, cval_len) > epos) {
i__1 = epos;
s_copy(cval + i__1, " ", cval_len - i__1, (ftnlen)1);
}
*isnull = FALSE_;
} else if (datptr == -2) {
/* The value is null. */
*isnull = TRUE_;
*cvlen = 1;
} else if (datptr == -1 || datptr == -3) {
/* The data value is absent. This is an error. */
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
zzekcnam_(handle, coldsc, column, (ftnlen)32);
chkin_("ZZEKRD03", (ftnlen)8);
setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C"
"OLUMN = #; RECNO = #; EK = #", (ftnlen)87);
errint_("#", &segdsc[1], (ftnlen)1);
errch_("#", column, (ftnlen)1, (ftnlen)32);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(UNINITIALIZED)", (ftnlen)20);
chkout_("ZZEKRD03", (ftnlen)8);
return 0;
} else {
/* The data pointer is corrupted. */
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
zzekcnam_(handle, coldsc, column, (ftnlen)32);
chkin_("ZZEKRD03", (ftnlen)8);
setmsg_("Data pointer is corrupted. SEGNO = #; COLUMN = #; RECNO = "
"#; EK = #", (ftnlen)68);
errint_("#", &segdsc[1], (ftnlen)1);
errch_("#", column, (ftnlen)1, (ftnlen)32);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKRD03", (ftnlen)8);
return 0;
}
return 0;
} /* zzekrd03_ */
/* $Procedure ZZEKFRX ( EK, find record in index ) */
/* Subroutine */ int zzekfrx_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr, integer *pos)
{
char cval[1024];
doublereal dval;
integer ival;
extern integer zzekrp2n_(integer *, integer *, integer *);
integer unit;
extern /* Subroutine */ int zzeklerc_(integer *, integer *, integer *,
char *, integer *, logical *, integer *, integer *, ftnlen),
zzeklerd_(integer *, integer *, integer *, doublereal *, integer *
, logical *, integer *, integer *), zzekleri_(integer *, integer *
, integer *, integer *, integer *, logical *, integer *, integer *
), chkin_(char *, ftnlen);
integer recno, cvlen;
logical found;
integer dtype, cmplen;
extern logical return_(void);
logical isnull;
extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *,
ftnlen), errfnm_(char *, integer *, ftnlen);
integer prvptr;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), zzekrsc_(integer *,
integer *, integer *, integer *, integer *, integer *, char *,
logical *, logical *, ftnlen), zzekrsd_(integer *, integer *,
integer *, integer *, integer *, doublereal *, logical *, logical
*), zzekrsi_(integer *, integer *, integer *, integer *, integer *
, integer *, logical *, logical *);
/* $ Abstract */
/* Find the ordinal position of a specified record in a specified, */
/* indexed EK column. */
/* $ 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 */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Query Limit Parameters */
/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */
/* Parameter MAXCON increased to 1000. */
/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */
/* Updated to support SELECT clause. */
/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */
/* These limits apply to character string queries input to the */
/* EK scanner. This limits are part of the EK system's user */
/* interface: the values should be advertised in the EK required */
/* reading document. */
/* Maximum length of an input query: MAXQRY. This value is */
/* currently set to twenty-five 80-character lines. */
/* Maximum number of columns that may be listed in the */
/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */
/* Maximum number of tables that may be listed in the `FROM */
/* clause' of a query: MAXTAB. */
/* Maximum number of relational expressions that may be listed */
/* in the `constraint clause' of a query: MAXCON. */
/* This limit applies to a query when it is represented in */
/* `normalized form': that is, the constraints have been */
/* expressed as a disjunction of conjunctions of relational */
/* expressions. The number of relational expressions in a query */
/* that has been expanded in this fashion may be greater than */
/* the number of relations in the query as orginally written. */
/* For example, the expression */
/* ( ( A LT 1 ) OR ( B GT 2 ) ) */
/* AND */
/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */
/* which contains 4 relational expressions, expands to the */
/* equivalent normalized constraint */
/* ( ( A LT 1 ) AND ( C NE 3 ) ) */
/* OR */
/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */
/* OR */
/* ( ( B GT 2 ) AND ( C NE 3 ) ) */
/* OR */
/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */
/* which contains eight relational expressions. */
/* MXJOIN is the maximum number of tables that can be joined. */
/* MXJCON is the maximum number of join constraints allowed. */
/* Maximum number of order-by columns that may be used in the */
/* `order-by clause' of a query: MAXORD. MAXORD = 10. */
/* Maximum number of tokens in a query: 500. Tokens are reserved */
/* words, column names, parentheses, and values. Literal strings */
/* and time values count as single tokens. */
/* Maximum number of numeric tokens in a query: */
/* Maximum total length of character tokens in a query: */
/* Maximum length of literal string values allowed in queries: */
/* MAXSTR. */
/* End Include Section: EK Query Limit Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Pointer to record to locate. */
/* POS O Ordinal position of record. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. The file may be open for */
/* reading or writing. */
/* SEGDSC is the segment descriptor of the segment */
/* containing the column to be searched. */
/* COLDSC is the column descriptor of the column to be */
/* searched. */
/* RECPTR is a pointer to the record whose ordinal position */
/* is to be found. */
/* $ Detailed_Output */
/* POS is the ordinal position in the specified column */
/* of the input record, where the order relation is */
/* specified by the column's index. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If an I/O error occurs while reading the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* Various EK write operations require the capability of locating */
/* the index key that maps to a given record number. An example is */
/* updating a column's index to reflect deletion of a specified */
/* record: the key that maps to the record must be deleted. */
/* Locating this key is the inverse of the problem that the index */
/* is meant to solve. */
/* $ Examples */
/* See ZZEKIXDL. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 31-MAY-2010 (NJB) */
/* Bug fix: substring bound out-of-range violation */
/* in reference to local variable CVAL has been */
/* corrected. This error could occur if the a */
/* class 3 column entry had length exceeding MAXSTR. */
/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKFRX", (ftnlen)7);
}
/* Determine the data type of the column, and look up the value */
/* associated with RECPTR. */
dtype = coldsc[1];
if (dtype == 1) {
zzekrsc_(handle, segdsc, coldsc, recptr, &c__1, &cvlen, cval, &isnull,
&found, (ftnlen)1024);
if (found && ! isnull) {
cmplen = min(cvlen,1024);
} else {
cmplen = 0;
}
} else if (dtype == 2 || dtype == 4) {
zzekrsd_(handle, segdsc, coldsc, recptr, &c__1, &dval, &isnull, &
found);
} else if (dtype == 3) {
zzekrsi_(handle, segdsc, coldsc, recptr, &c__1, &ival, &isnull, &
found);
} else {
dashlu_(handle, &unit);
setmsg_("File = #; COLIDX = #. Unrecognized data type code # found i"
"n descriptor.", (ftnlen)72);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &coldsc[8], (ftnlen)1);
errint_("#", &dtype, (ftnlen)1);
sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19);
chkout_("ZZEKFRX", (ftnlen)7);
return 0;
}
if (! found) {
/* We have a most heinous situation. We should always be able */
/* to find the value associated with a record. */
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
setmsg_("File = #; RECNO = #; COLIDX = #. Column entry was not found"
". This probably indicates a corrupted file or a bug in the "
"EK code.", (ftnlen)127);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errint_("#", &coldsc[8], (ftnlen)1);
sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19);
chkout_("ZZEKFRX", (ftnlen)7);
return 0;
}
/* Find the last column entry less than or equal to the one */
/* associated with the input record, where the order relation is */
/* dictionary ordering on (<column value>, <record number>) pairs. */
/* These ordered pairs are distinct, even if the column entries */
/* are not. Therefore, the ordinal position POS will actually be */
/* the ordinal position of our record. */
if (dtype == 1) {
zzeklerc_(handle, segdsc, coldsc, cval, recptr, &isnull, pos, &prvptr,
cmplen);
} else if (dtype == 2 || dtype == 4) {
zzeklerd_(handle, segdsc, coldsc, &dval, recptr, &isnull, pos, &
prvptr);
} else {
/* The data type is INT. (We've already checked for invalid */
/* types.) */
zzekleri_(handle, segdsc, coldsc, &ival, recptr, &isnull, pos, &
prvptr);
}
if (prvptr != *recptr) {
/* Big problem. This should never happen. */
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
setmsg_("File = #; RECNO = #; COLIDX = #. Record that was last less"
" than or equal to RECNO was not equal to RECNO. This probab"
"ly indicates a corrupted file or a bug in the EK code.", (
ftnlen)174);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errint_("#", &coldsc[8], (ftnlen)1);
sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19);
chkout_("ZZEKFRX", (ftnlen)7);
return 0;
}
chkout_("ZZEKFRX", (ftnlen)7);
return 0;
} /* zzekfrx_ */
/* $Procedure ZZEKSCMP ( EK, scalar value comparison ) */
logical zzekscmp_(integer *op, integer *handle, integer *segdsc, integer *
coldsc, integer *row, integer *eltidx, integer *dtype, char *cval,
doublereal *dval, integer *ival, logical *null, ftnlen cval_len)
{
/* System generated locals */
integer i__1;
logical ret_val;
/* Builtin functions */
integer i_len(char *, ftnlen);
logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen,
ftnlen);
/* Local variables */
char eltc[1024];
doublereal eltd;
integer elti, unit;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer cvlen;
logical found, enull;
extern logical failed_(void), matchi_(char *, char *, char *, char *,
ftnlen, ftnlen, ftnlen, ftnlen);
integer cmplen;
doublereal numval;
integer coltyp, strlen;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *,
ftnlen);
integer rel;
extern /* Subroutine */ int zzekrsc_(integer *, integer *, integer *,
integer *, integer *, integer *, char *, logical *, logical *,
ftnlen), zzekrsd_(integer *, integer *, integer *, integer *,
integer *, doublereal *, logical *, logical *), zzekrsi_(integer *
, integer *, integer *, integer *, integer *, integer *, logical *
, logical *);
/* $ Abstract */
/* Compare a specified scalar EK column entry with a scalar value. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* PRIVATE */
/* EK */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Operator Codes */
/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */
/* Within the EK system, operators used in EK queries are */
/* represented by integer codes. The codes and their meanings are */
/* listed below. */
/* Relational expressions in EK queries have the form */
/* <column name> <operator> <value> */
/* For columns containing numeric values, the operators */
/* EQ, GE, GT, LE, LT, NE */
/* may be used; these operators have the same meanings as their */
/* Fortran counterparts. For columns containing character values, */
/* the list of allowed operators includes those in the above list, */
/* and in addition includes the operators */
/* LIKE, UNLIKE */
/* which are used to compare strings to a template. In the character */
/* case, the meanings of the parameters */
/* GE, GT, LE, LT */
/* match those of the Fortran lexical functions */
/* LGE, LGT, LLE, LLT */
/* The additional unary operators */
/* ISNULL, NOTNUL */
/* are used to test whether a value of any type is null. */
/* End Include Section: EK Operator Codes */
/* $ 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. */
/* Include Section: EK Query Limit Parameters */
/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */
/* Parameter MAXCON increased to 1000. */
/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */
/* Updated to support SELECT clause. */
/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */
/* These limits apply to character string queries input to the */
/* EK scanner. This limits are part of the EK system's user */
/* interface: the values should be advertised in the EK required */
/* reading document. */
/* Maximum length of an input query: MAXQRY. This value is */
/* currently set to twenty-five 80-character lines. */
/* Maximum number of columns that may be listed in the */
/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */
/* Maximum number of tables that may be listed in the `FROM */
/* clause' of a query: MAXTAB. */
/* Maximum number of relational expressions that may be listed */
/* in the `constraint clause' of a query: MAXCON. */
/* This limit applies to a query when it is represented in */
/* `normalized form': that is, the constraints have been */
/* expressed as a disjunction of conjunctions of relational */
/* expressions. The number of relational expressions in a query */
/* that has been expanded in this fashion may be greater than */
/* the number of relations in the query as orginally written. */
/* For example, the expression */
/* ( ( A LT 1 ) OR ( B GT 2 ) ) */
/* AND */
/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */
/* which contains 4 relational expressions, expands to the */
/* equivalent normalized constraint */
/* ( ( A LT 1 ) AND ( C NE 3 ) ) */
/* OR */
/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */
/* OR */
/* ( ( B GT 2 ) AND ( C NE 3 ) ) */
/* OR */
/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */
/* which contains eight relational expressions. */
/* MXJOIN is the maximum number of tables that can be joined. */
/* MXJCON is the maximum number of join constraints allowed. */
/* Maximum number of order-by columns that may be used in the */
/* `order-by clause' of a query: MAXORD. MAXORD = 10. */
/* Maximum number of tokens in a query: 500. Tokens are reserved */
/* words, column names, parentheses, and values. Literal strings */
/* and time values count as single tokens. */
/* Maximum number of numeric tokens in a query: */
/* Maximum total length of character tokens in a query: */
/* Maximum length of literal string values allowed in queries: */
/* MAXSTR. */
/* End Include Section: EK Query Limit Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ 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. */
/* Include Section: EK Template Matching Wild Characters */
/* ekwild.inc Version 1 16-JAN-1995 (NJB) */
/* Within the EK system, templates used for pattern matching */
/* are those accepted by the SPICELIB routine MATCHW. MATCHW */
/* accepts two special characters: one representing wild */
/* strings and one representing wild characters. This include */
/* file defines those special characters for use within the EK */
/* system. */
/* Wild string symbol: this character matches any string. */
/* Wild character symbol: this character matches any character. */
/* End Include Section: EK Template Matching Wild Characters */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* OP I Relational operator code. */
/* HANDLE I EK file handle. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* ROW I ID of row containing column entry to compare. */
/* ELTIDX I Index of element in array-valued column entry. */
/* DTYPE I Data type of input value. */
/* CVAL I Character string to compare with column entry. */
/* DVAL I D.p. value to compare with column entry. */
/* IVAL I Integer value to compare with column entry. */
/* NULL I Flag indicating whether scalar is null. */
/* The function returns .TRUE. if and only if the specified column */
/* entry and input value of the corresponding data type satisfy the */
/* relation specified by the input argument OP. */
/* $ Detailed_Input */
/* OP is an integer code representing a binary relational */
/* operator. The possible values of OP are the */
/* parameters */
/* EQ */
/* GE */
/* GT */
/* LE */
/* LIKE */
/* LT */
/* NE */
/* ISNULL */
/* NOTNUL */
/* HANDLE is an EK file handle. The file may be open for */
/* reading or writing. */
/* SEGDSC is the EK segment descriptor of the column entry */
/* to be compared. */
/* COLDSC is an EK column descriptor for the column */
/* containing the entry to be compared. */
/* ROW is the identifier of the row containing the column */
/* entry to be compared. Note that these identifiers */
/* are polymorphic: their meaning is a function of */
/* the class of column that contains the entry of */
/* interest. */
/* ELTIDX is the index of the column entry element to be */
/* compared, if the column is array-valued. ELTIDX */
/* is ignored for scalar columns. */
/* DTYPE is the data type of the input scalar value. */
/* CVAL, */
/* DVAL, */
/* IVAL are, respectively, character, double precision, */
/* and integer scalar variables. The column entry */
/* is compared against whichever of these has the */
/* same data type as the entry; the other two */
/* variables are ignored. If the data type of the */
/* column entry is TIME, the entry is compared with */
/* the variable DVAL. */
/* NULL */
/* $ Detailed_Output */
/* The function returns .TRUE. if and only if the specified column */
/* entry and input value of the corresponding data type satisfy the */
/* relation specified by the input argument OP. */
/* If the specified column entry is null, it is considered to */
/* precede all non-null values, and the logical value of the */
/* expression */
/* <column element> OP <value> */
/* is determined accordingly. Null character values do not satisfy */
/* the relation */
/* <null column element> LIKE <character value> */
/* for any character value. */
/* $ Parameters */
/* Within the EK system, relational operators used in EK queries are */
/* represented by integer codes. The codes and their meanings are */
/* listed below. */
/* Relational expressions in EK queries have the form */
/* <column name> <operator> <value> */
/* For columns containing numeric values, the operators */
/* EQ, GE, GT, LE, LT, NE */
/* may be used; these operators have the same meanings as their */
/* Fortran counterparts. For columns containing character values, */
/* the list of allowed operators includes those in the above list, */
/* and in addition includes the operator */
/* LIKE */
/* which is used to compare strings to a template. In the character */
/* case, the meanings of the parameters */
/* GE, GT, LE, LT */
/* match those of the Fortran lexical functions */
/* LGE, LGT, LLE, LLT */
/* Null values are considered to precede all non-null values. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* The function value is .FALSE. in this case. */
/* 2) If an I/O error occurs while attempting to find the address */
/* range of the specified column entry element, the error will */
/* be diagnosed by routines called by this routine. The */
/* function value is .FALSE. in this case. */
/* 3) If any of SEGDSC, COLDSC, or ROW are invalid, this routine */
/* may fail in unpredictable, but possibly spectacular, ways. */
/* Except as described in this header section, no attempt is */
/* made to handle these errors. */
/* 4) If the data type code in the input column descriptor is not */
/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */
/* The function value is .FALSE. in this case. */
/* 5) If the specified column entry cannot be found, the error */
/* SPICE(INVALIDINDEX) is signalled. The function value is */
/* .FALSE. in this case. */
/* 6) If the relational operator code OP is not recognized, the */
/* error SPICE(UNNATURALRELATION) is signalled. The function */
/* value is .FALSE. in this case. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine is an EK utility intended to centralize a frequently */
/* performed comparison operation. */
/* $ Examples */
/* See ZZEKRMCH. */
/* $ Restrictions */
/* 1) This routine must execute quickly. Therefore, it checks in */
/* only if it detects an error. If an error is signalled by a */
/* routine called by this routine, this routine will not appear */
/* in the SPICELIB traceback display. Also, in the interest */
/* of speed, this routine does not test the value of the SPICELIB */
/* function RETURN upon entry. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 31-MAY-2009 (NJB) */
/* Bug fix: routine failed to account for the possibility */
/* that scalar string column entries can have unlimited */
/* length. Now at most the first MAXSTR characters of such */
/* an entry are used in comparisons. */
/* - SPICELIB Version 1.1.0, 21-DEC-2001 (NJB) */
/* Bug fix: routine now indicates "no match" when operator */
/* is LIKE or UNLIKE and column entry is null. */
/* - SPICELIB Version 1.0.0, 17-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in for speed. */
/* The function value defaults to .FALSE. */
ret_val = FALSE_;
/* Look up the specified column element. */
coltyp = coldsc[1];
if (coltyp == 1) {
/* We'll use at most the first MAXSTR characters of the input */
/* string. */
/* Computing MIN */
i__1 = i_len(cval, cval_len);
cvlen = min(i__1,1024);
/* Fetch the column entry to be compared. Note that ROW */
/* is a polymorphic identifier. See ZZEKRSC for details */
/* on how ROW is used. */
zzekrsc_(handle, segdsc, coldsc, row, eltidx, &strlen, eltc, &enull, &
found, (ftnlen)1024);
if (failed_()) {
/* Don't check out here because we haven't checked in. */
return ret_val;
}
/* Let CMPLEN be the string length to use in comparisons. */
if (found && ! enull) {
cmplen = min(strlen,1024);
} else {
cmplen = 0;
}
} else if (coltyp == 2 || coltyp == 4) {
zzekrsd_(handle, segdsc, coldsc, row, eltidx, &eltd, &enull, &found);
} else if (coltyp == 3) {
zzekrsi_(handle, segdsc, coldsc, row, eltidx, &elti, &enull, &found);
} else {
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("Data type code # not recognized.", (ftnlen)32);
errint_("#", &coltyp, (ftnlen)1);
sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
if (! found) {
dashlu_(handle, &unit);
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry eleme"
"nt was not found.", (ftnlen)76);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &coldsc[8], (ftnlen)1);
errint_("#", row, (ftnlen)1);
errint_("#", eltidx, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
/* Handle the ISNULL and NOTNUL operators, if perchance we see them. */
if (*op == 9) {
ret_val = enull;
return ret_val;
} else if (*op == 10) {
ret_val = ! enull;
return ret_val;
}
/* Find the order relation that applies to the input values. */
/* Null values precede all others. */
if (enull) {
if (*null) {
rel = 1;
} else {
rel = 5;
}
} else if (*null) {
if (enull) {
rel = 1;
} else {
rel = 3;
}
} else {
/* Compare the value we looked up with the input scalar value. */
if (coltyp == 1) {
if (*dtype != 1) {
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("Column type is #; value type is #.", (ftnlen)34);
errint_("#", &coltyp, (ftnlen)1);
errint_("#", dtype, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
if (l_lt(eltc, cval, cmplen, cvlen)) {
rel = 5;
} else if (l_gt(eltc, cval, cmplen, cvlen)) {
rel = 3;
} else {
rel = 1;
}
} else if (coltyp == 4) {
if (*dtype != 4 && *dtype != 2) {
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("Column type is #; value type is #.", (ftnlen)34);
errint_("#", &coltyp, (ftnlen)1);
errint_("#", dtype, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
if (eltd < *dval) {
rel = 5;
} else if (eltd > *dval) {
rel = 3;
} else {
rel = 1;
}
} else if (coltyp == 2) {
if (*dtype == 3) {
numval = (doublereal) (*ival);
} else if (*dtype == 2 || *dtype == 4) {
numval = *dval;
} else {
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("Column type is #; value type is #.", (ftnlen)34);
errint_("#", &coltyp, (ftnlen)1);
errint_("#", dtype, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
if (eltd < numval) {
rel = 5;
} else if (eltd > numval) {
rel = 3;
} else {
rel = 1;
}
} else if (coltyp == 3) {
if (*dtype == 3) {
numval = (doublereal) (*ival);
} else if (*dtype == 2) {
numval = *dval;
} else {
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("Column type is #; value type is #.", (ftnlen)34);
errint_("#", &coltyp, (ftnlen)1);
errint_("#", dtype, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
if ((doublereal) elti < numval) {
rel = 5;
} else if ((doublereal) elti > numval) {
rel = 3;
} else {
rel = 1;
}
} else {
/* Something untoward has happened in our column descriptor */
/* argument. */
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("The data type code # was not recognized.", (ftnlen)40);
errint_("#", &coltyp, (ftnlen)1);
sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
}
/* Determine the truth of the input relational expression. */
if (*op == 1) {
ret_val = rel == 1;
} else if (*op == 5) {
ret_val = rel == 5;
} else if (*op == 4) {
ret_val = rel != 3;
} else if (*op == 3) {
ret_val = rel == 3;
} else if (*op == 2) {
ret_val = rel != 5;
} else if (*op == 6) {
ret_val = rel != 1;
} else if (*op == 7 && *dtype == 1) {
if (*null || enull) {
ret_val = FALSE_;
} else {
ret_val = matchi_(eltc, cval, "*", "%", cmplen, cvlen, (ftnlen)1,
(ftnlen)1);
}
} else if (*op == 8 && *dtype == 1) {
if (*null || enull) {
ret_val = FALSE_;
} else {
ret_val = ! matchi_(eltc, cval, "*", "%", cmplen, cvlen, (ftnlen)
1, (ftnlen)1);
}
} else {
/* Sorry, we couldn't resist. */
chkin_("ZZEKSCMP", (ftnlen)8);
setmsg_("The relational operator # was not recognized or was not app"
"licable for data type #.", (ftnlen)83);
errint_("#", op, (ftnlen)1);
errint_("#", dtype, (ftnlen)1);
sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24);
chkout_("ZZEKSCMP", (ftnlen)8);
return ret_val;
}
return ret_val;
} /* zzekscmp_ */
/* $Procedure ZZEKRD04 ( EK, read class 4 column entry elements ) */
/* Subroutine */ int zzekrd04_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr, integer *beg, integer *end, integer *ivals,
logical *isnull, logical *found)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer base, nrec, nelt;
extern integer zzekrp2n_(integer *, integer *, integer *);
integer unit;
extern /* Subroutine */ int zzekgfwd_(integer *, integer *, integer *,
integer *), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_(
integer *, integer *, integer *, integer *);
integer p, nread;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer recno, ncols, ptemp, start;
extern logical failed_(void);
extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *,
integer *);
integer remain, colidx, datptr, maxidx, minidx, ptrloc;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *,
ftnlen);
/* $ Abstract */
/* Read a specified element range from a column entry in a specified */
/* record in a class 4 column. Class 4 columns have integer arrays */
/* as column entries. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* FILES */
/* UTILITY */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Boolean Enumerated Type */
/* ekbool.inc Version 1 21-DEC-1994 (NJB) */
/* Within the EK system, boolean values sometimes must be */
/* represented by integer or character codes. The codes and their */
/* meanings are listed below. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* Character code indicating `true': */
/* Character code indicating `false': */
/* End Include Section: EK Boolean Enumerated Type */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Page Parameters */
/* ekfilpar.inc Version 1 03-APR-1995 (NJB) */
/* These parameters apply to EK files using architecture 4. */
/* These files use a paged DAS file as their underlying file */
/* structure. */
/* In paged DAS EK files, data pages are structured: they contain */
/* metadata as well as data. The metadata is located in the last */
/* few addresses of each page, so as to interfere as little as */
/* possible with calculation of data addresses. */
/* Each data page belongs to exactly one segment. Some bookkeeping */
/* information, such as record pointers, is also stored in data */
/* pages. */
/* Each page contains a forward pointer that allows rapid lookup */
/* of data items that span multiple pages. Each page also keeps */
/* track of the current number of links from its parent segment */
/* to the page. Link counts enable pages to `know' when they */
/* are no longer in use by a segment; unused pages are deallocated */
/* and returned to the free list. */
/* The parameters in this include file depend on the parameters */
/* declared in the include file ekpage.inc. If those parameters */
/* change, this file must be updated. The specified parameter */
/* declarations we need from that file are: */
/* INTEGER PGSIZC */
/* PARAMETER ( PGSIZC = 1024 ) */
/* INTEGER PGSIZD */
/* PARAMETER ( PGSIZD = 128 ) */
/* INTEGER PGSIZI */
/* PARAMETER ( PGSIZI = 256 ) */
/* Character pages use an encoding mechanism to represent integer */
/* metadata. Each integer is encoded in five consecutive */
/* characters. */
/* Character data page parameters: */
/* Size of encoded integer: */
/* Usable page size: */
/* Location of character forward pointer: */
/* Location of character link count: */
/* Double precision data page parameters: */
/* Usable page size: */
/* Location of d.p. forward pointer: */
/* Location of d.p. link count: */
/* Integer data page parameters: */
/* Usable page size: */
/* Location of integer forward pointer: */
/* Location of integer link count: */
/* End Include Section: EK Data Page Parameters */
/* $ 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. */
/* Include Section: EK Record Pointer Parameters */
/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */
/* This file declares parameters used in EK record pointers. */
/* Each segment references data in a given record via two levels */
/* of indirection: a record number points to a record pointer, */
/* which is a structured array of metadata and data pointers. */
/* Record pointers always occupy contiguous ranges of integer */
/* addresses. */
/* The parameter declarations in this file depend on the assumption */
/* that integer pages contain 256 DAS integer words and that the */
/* maximum number of columns in a segment is 100. Record pointers */
/* are stored in integer data pages, so they must fit within the */
/* usable data area afforded by these pages. The size of the usable */
/* data area is given by the parameter IPSIZE which is declared in */
/* ekdatpag.inc. The assumed value of IPSIZE is 254. */
/* The first element of each record pointer is a status indicator. */
/* The meanings of status indicators depend on whether the parent EK */
/* is shadowed or not. For shadowed EKs, allowed status values and */
/* their meanings are: */
/* OLD The record has not been modified since */
/* the EK containing the record was opened. */
/* UPDATE The record is an update of a previously existing */
/* record. The original record is now on the */
/* modified record list. */
/* NEW The record has been added since the EK containing the */
/* record was opened. The record is not an update */
/* of a previously existing record. */
/* DELOLD This status applies only to a backup record. */
/* DELOLD status indicates that the record corresponds */
/* to a deleted OLD record in the source segment. */
/* DELNEW This status applies only to a backup record. */
/* DELNEW status indicates that the record corresponds */
/* to a deleted NEW record in the source segment. */
/* DELUPD This status applies only to a backup record. */
/* DELUPD status indicates that the record corresponds */
/* to a deleted UPDATEd record in the source segment. */
/* In EKs that are not shadowed, all records have status OLD. */
/* The following parameters refer to indices within the record */
/* pointer structure: */
/* Index of status indicator: */
/* Each record pointer contains a pointer to its companion: for a */
/* record belonging to a shadowed EK, this is the backup counterpart, */
/* or if the parent EK is itself a backup EK, a pointer to the */
/* record's source record. The pointer is UNINIT (see below) if the */
/* record is unmodified. */
/* Record companion pointers contain record numbers, not record */
/* base addresses. */
/* Index of record's companion pointer: */
/* Each data item is referenced by an integer. The meaning of */
/* this integer depends on the representation of data in the */
/* column to which the data item belongs. Actual lookup of a */
/* data item must be done by subroutines appropriate to the class of */
/* the column to which the item belongs. Note that data items don't */
/* necessarily occupy contiguous ranges of DAS addresses. */
/* Base address of data pointers: */
/* Maximum record pointer size: */
/* Data pointers are given the value UNINIT to start with; this */
/* indicates that the data item is uninitialized. UNINIT is */
/* distinct from the value NULL. NOBACK indicates an uninitialized */
/* backup column entry. */
/* End Include Section: EK Record Pointer Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Record pointer. */
/* BEG I Start element index. */
/* END I End element index. */
/* IVALS O Integer values in column entry. */
/* ISNULL O Flag indicating whether column entry is null. */
/* FOUND O Flag indicating whether elements were found. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. */
/* SEGDSC is the descriptor of the segment from which data is */
/* to be read. */
/* COLDSC is the descriptor of the column from which data is */
/* to be read. */
/* RECPTR is a pointer to the record containing the column */
/* entry to be written. */
/* BEG, */
/* END are, respectively, the start and end indices of */
/* the contiguous range of elements to be read from */
/* the specified column entry. */
/* $ Detailed_Output */
/* IVALS are the values read from the specified column */
/* entry. The mapping of elements of the column entry */
/* to elements of IVALS is as shown below: */
/* Column entry element IVALS element */
/* -------------------- ------------- */
/* BEG 1 */
/* BEG+1 2 */
/* . . */
/* . . */
/* . . */
/* END END-BEG+1 */
/* IVALS is valid only if the output argument */
/* FOUND is returned .TRUE. */
/* ISNULL is a logical flag indicating whether the entry is */
/* null. ISNULL is set on output whether or not */
/* the range of elements designated by BEG and END */
/* exists. */
/* FOUND is a logical flag indicating whether the range */
/* of elements designated by BEG and END exists. */
/* If the number of elements in the specified column */
/* entry is not at least END, FOUND will be returned */
/* .FALSE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If the specified column entry has not been initialized, the */
/* error SPICE(UNINITIALIZEDVALUE) is signalled. */
/* 3) If the ordinal position of the column specified by COLDSC */
/* is out of range, the error SPICE(INVALIDINDEX) is signalled. */
/* 4) If an I/O error occurs while reading the indicated file, */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine is a utility for reading data from class 4 columns. */
/* $ Examples */
/* See EKRCEI. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in ZZEKGFWD call. */
/* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in ZZEKGFWD call. */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
nrec = segdsc[5];
/* Make sure the column exists. */
ncols = segdsc[4];
colidx = coldsc[8];
if (colidx < 1 || colidx > ncols) {
chkin_("ZZEKRD04", (ftnlen)8);
setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37);
errint_("#", &colidx, (ftnlen)1);
errint_("#", &nrec, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKRD04", (ftnlen)8);
return 0;
}
/* Compute the data pointer location, and read the pointer. */
ptrloc = *recptr + 2 + colidx;
dasrdi_(handle, &ptrloc, &ptrloc, &datptr);
if (datptr > 0) {
/* The entry is non-null. */
*isnull = FALSE_;
/* Get the element count. Check for range specifications that */
/* can't be met. */
dasrdi_(handle, &datptr, &datptr, &nelt);
if (*beg < 1 || *beg > nelt) {
*found = FALSE_;
return 0;
} else if (*end < 1 || *end > nelt) {
*found = FALSE_;
return 0;
} else if (*end < *beg) {
*found = FALSE_;
return 0;
}
/* The request is valid, so read the data. The first step is to */
/* locate the element at index BEG. */
zzekpgpg_(&c__3, &datptr, &p, &base);
minidx = 1;
maxidx = base + 254 - datptr;
datptr += *beg;
while(maxidx < *beg) {
/* Locate the page on which the element is continued. */
i__1 = base + 255;
i__2 = base + 255;
dasrdi_(handle, &i__1, &i__2, &p);
/* Determine the highest-indexed element of the column entry */
/* located on the current page. */
zzekpgbs_(&c__3, &p, &base);
minidx = maxidx + 1;
/* Computing MIN */
i__1 = maxidx + 254;
maxidx = min(i__1,nelt);
/* The following assignment will set DATPTR to the correct */
/* value on the last pass through this loop. */
datptr = base + 1 + (*beg - minidx);
}
/* At this point, P is the page on which the element having index */
/* BEG is located. BASE is the base address of this page. */
/* MAXIDX is the highest index of any element on the current page. */
remain = *end - *beg + 1;
start = 1;
/* Decide how many elements to read from the current page, and */
/* read them. */
/* Computing MIN */
i__1 = remain, i__2 = base + 254 - datptr + 1;
nread = min(i__1,i__2);
i__1 = datptr + nread - 1;
dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]);
remain -= nread;
while(remain > 0 && ! failed_()) {
/* Locate the page on which the element is continued. */
zzekgfwd_(handle, &c__3, &p, &ptemp);
p = ptemp;
zzekpgbs_(&c__3, &p, &base);
datptr = base + 1;
start += nread;
nread = min(remain,254);
i__1 = datptr + nread - 1;
dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]);
remain -= nread;
}
*found = ! failed_();
} else if (datptr == -2) {
/* The value is null. */
*isnull = TRUE_;
*found = TRUE_;
} else if (datptr == -1) {
/* The data value is absent. This is an error. */
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
chkin_("ZZEKRD04", (ftnlen)8);
setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C"
"OLIDX = #; RECNO = #; EK = #", (ftnlen)87);
errint_("#", &segdsc[1], (ftnlen)1);
errint_("#", &colidx, (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25);
chkout_("ZZEKRD04", (ftnlen)8);
return 0;
} else {
/* The data pointer is corrupted. */
dashlu_(handle, &unit);
chkin_("ZZEKRD04", (ftnlen)8);
setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = "
"#; EK = #", (ftnlen)68);
errint_("#", &segdsc[1], (ftnlen)1);
errint_("#", &colidx, (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKRD04", (ftnlen)8);
return 0;
}
return 0;
} /* zzekrd04_ */
/* $Procedure ZZEKGCDP ( EK, get column data pointer ) */
/* Subroutine */ int zzekgcdp_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr, integer *datptr)
{
extern integer zzekrp2n_(integer *, integer *, integer *);
integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer recno, ncols;
extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *,
integer *);
integer colidx, ptrloc;
extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
/* $ Abstract */
/* Return the data pointer for a specified EK column entry. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Record Pointer Parameters */
/* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */
/* This file declares parameters used in EK record pointers. */
/* Each segment references data in a given record via two levels */
/* of indirection: a record number points to a record pointer, */
/* which is a structured array of metadata and data pointers. */
/* Record pointers always occupy contiguous ranges of integer */
/* addresses. */
/* The parameter declarations in this file depend on the assumption */
/* that integer pages contain 256 DAS integer words and that the */
/* maximum number of columns in a segment is 100. Record pointers */
/* are stored in integer data pages, so they must fit within the */
/* usable data area afforded by these pages. The size of the usable */
/* data area is given by the parameter IPSIZE which is declared in */
/* ekdatpag.inc. The assumed value of IPSIZE is 254. */
/* The first element of each record pointer is a status indicator. */
/* The meanings of status indicators depend on whether the parent EK */
/* is shadowed or not. For shadowed EKs, allowed status values and */
/* their meanings are: */
/* OLD The record has not been modified since */
/* the EK containing the record was opened. */
/* UPDATE The record is an update of a previously existing */
/* record. The original record is now on the */
/* modified record list. */
/* NEW The record has been added since the EK containing the */
/* record was opened. The record is not an update */
/* of a previously existing record. */
/* DELOLD This status applies only to a backup record. */
/* DELOLD status indicates that the record corresponds */
/* to a deleted OLD record in the source segment. */
/* DELNEW This status applies only to a backup record. */
/* DELNEW status indicates that the record corresponds */
/* to a deleted NEW record in the source segment. */
/* DELUPD This status applies only to a backup record. */
/* DELUPD status indicates that the record corresponds */
/* to a deleted UPDATEd record in the source segment. */
/* In EKs that are not shadowed, all records have status OLD. */
/* The following parameters refer to indices within the record */
/* pointer structure: */
/* Index of status indicator: */
/* Each record pointer contains a pointer to its companion: for a */
/* record belonging to a shadowed EK, this is the backup counterpart, */
/* or if the parent EK is itself a backup EK, a pointer to the */
/* record's source record. The pointer is UNINIT (see below) if the */
/* record is unmodified. */
/* Record companion pointers contain record numbers, not record */
/* base addresses. */
/* Index of record's companion pointer: */
/* Each data item is referenced by an integer. The meaning of */
/* this integer depends on the representation of data in the */
/* column to which the data item belongs. Actual lookup of a */
/* data item must be done by subroutines appropriate to the class of */
/* the column to which the item belongs. Note that data items don't */
/* necessarily occupy contiguous ranges of DAS addresses. */
/* Base address of data pointers: */
/* Maximum record pointer size: */
/* Data pointers are given the value UNINIT to start with; this */
/* indicates that the data item is uninitialized. UNINIT is */
/* distinct from the value NULL. NOBACK indicates an uninitialized */
/* backup column entry. */
/* End Include Section: EK Record Pointer Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Record pointer. */
/* DATPTR O Data pointer of column entry. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for read or write */
/* access. */
/* SEGDSC is the descriptor of the segment containing */
/* the specified column entry. */
/* COLDSC is the descriptor of the column containing */
/* the specified column entry. */
/* RECPTR is a pointer to the record containing the column */
/* entry whose data pointer is desired. */
/* $ Detailed_Output */
/* DATPTR is the data pointer of the specified column entry. */
/* When DATPTR is positive, it represents a pointer */
/* to a data value. The interpretation of the */
/* pointer depends on the class of the column entry. */
/* DATPTR may also take on the distinguished values */
/* UNINIT (indicated uninitialized entry) */
/* NULL (indicated null entry) */
/* NOBACK (indicated uninitialized backup entry) */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If an I/O error occurs while reading the indicated file, the */
/* error will be diagnosed by routines called by this routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine hides details of column entry data pointer access. */
/* $ Examples */
/* See ZZEKRFIL. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */
/* -& */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* Make sure the column exists. */
ncols = segdsc[4];
colidx = coldsc[8];
if (colidx < 1 || colidx > ncols) {
recno = zzekrp2n_(handle, &segdsc[1], recptr);
dashlu_(handle, &unit);
chkin_("ZZEKGCDP", (ftnlen)8);
setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; "
"EK = #", (ftnlen)65);
errint_("#", &colidx, (ftnlen)1);
errint_("#", &ncols, (ftnlen)1);
errint_("#", &segdsc[1], (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKGCDP", (ftnlen)8);
return 0;
}
/* Compute the data pointer location, and read the pointer. */
ptrloc = *recptr + 2 + colidx;
dasrdi_(handle, &ptrloc, &ptrloc, datptr);
return 0;
} /* zzekgcdp_ */
/* $Procedure DASA2L ( DAS, address to physical location ) */
/* Subroutine */ int dasa2l_(integer *handle, integer *type__, integer *
addrss, integer *clbase, integer *clsize, integer *recno, integer *
wordno)
{
/* Initialized data */
static integer next[3] = { 2,3,1 };
static integer prev[3] = { 3,1,2 };
static integer nw[3] = { 1024,128,256 };
static integer rngloc[3] = { 3,5,7 };
static logical first = TRUE_;
static integer nfiles = 0;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Local variables */
static integer free, nrec, fidx;
static logical fast;
static integer unit, i__, range[2], tbhan[20];
extern /* Subroutine */ int chkin_(char *, ftnlen);
static integer ncomc, ncomr, ndirs;
static logical known;
static integer hiaddr;
extern /* Subroutine */ int dasham_(integer *, char *, ftnlen);
static integer tbbase[60] /* was [3][20] */;
static char access[10];
static integer dscloc, dirrec[256];
extern /* Subroutine */ int dashfs_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *);
static logical samfil;
static integer mxaddr;
extern integer isrchi_(integer *, integer *, integer *);
static integer tbmxad[60] /* was [3][20] */;
static logical tbfast[20];
static integer mxclrc;
extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *,
integer *, ftnlen);
static integer lstrec[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen);
static integer prvhan;
extern /* Subroutine */ int chkout_(char *, ftnlen);
static integer nresvc, tbsize[60] /* was [3][20] */, nxtrec;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), dasrri_(integer *, integer *, integer *,
integer *, integer *);
static logical rdonly;
static integer lstwrd[3], nresvr, ntypes, curtyp, prvtyp;
/* $ Abstract */
/* Map a DAS address to a physical location in the DAS file */
/* it refers to. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* TRANSFORMATION */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* TYPE I Data type specifier. */
/* ADDRSS I DAS address of a word of data type TYPE. */
/* CLBASE, */
/* CLSIZE O Cluster base record number and size. */
/* RECNO, */
/* WORDNO O Record/word pair corresponding to ADDRSS. */
/* CHAR P Parameter indicating character data type. */
/* DP P Parameter indicating double precision data type. */
/* INT P Parameter indicating integer data type. */
/* $ Detailed_Input */
/* HANDLE is the file handle of an open DAS file. */
/* TYPE is a data type specifier. TYPE may be any of */
/* the parameters */
/* CHAR */
/* DP */
/* INT */
/* which indicate `character', `double precision', */
/* and `integer' respectively. */
/* ADDRSS is the address in a DAS of a word of data */
/* type TYPE. For each data type (double precision, */
/* integer, or character), addresses range */
/* from 1 to the maximum current value for that type, */
/* which is available from DAFRFR. */
/* $ Detailed_Output */
/* CLBASE, */
/* CLSIZE are, respectively, the base record number and */
/* size, in records, of the cluster containing the */
/* word corresponding to ADDRSS. The cluster spans */
/* records numbered CLBASE through CLBASE + */
/* CLSIZE - 1. */
/* RECNO, */
/* WORD are, respectively, the number of the physical */
/* record and the number of the word within the */
/* record that correspond to ADDRSS. Word numbers */
/* start at 1 and go up to NC, ND, or NI in */
/* character, double precision, or integer records */
/* respectively. */
/* $ Parameters */
/* CHAR, */
/* DP, */
/* INT are data type specifiers which indicate */
/* `character', `double precision', and `integer' */
/* respectively. These parameters are used in */
/* all DAS routines that require a data type */
/* specifier as input. */
/* $ Exceptions */
/* 1) If TYPE is not recognized, the error SPICE(DASINVALIDTYPE) */
/* will be signalled. */
/* 2) ADDRSS must be between 1 and LAST inclusive, where LAST */
/* is last address in the DAS for a word of the specified */
/* type. If ADDRSS is out of range, the error */
/* SPICE(DASNOSUCHADDRESS) will be signalled. */
/* 3) If this routine fails to find directory information for */
/* the input address, the error SPICE(NOSUCHRECORD) will be */
/* signalled. */
/* 4) If the input handle is invalid, the error will be diagnosed */
/* by routines called by this routine. */
/* If any of the above exceptions occur, the output arguments may */
/* contain bogus information. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* The DAS architecture allows a programmer to think of the data */
/* within a DAS file as three one-dimensional arrays: one of */
/* double precision numbers, one of integers, and one of characters. */
/* This model allows a programmer to ask the DAS system for the */
/* `nth double precision number (or integer, or character) in the */
/* file'. */
/* DAS files are Fortran direct access files, so to find the */
/* `nth double precision number', you must have the number of the */
/* record containing it and the `word number', or position, within */
/* the record of the double precision number. This routine finds */
/* the record/word number pair that specify the physical location */
/* in a DAS file corresponding to a DAS address. */
/* As opposed to DAFs, the mapping of addresses to physical locations */
/* for a DAS file depends on the organization of data in the file. */
/* Given a fixed set of DAS format parameters, the physical location */
/* of the nth double precision number can depend on how many integer */
/* and character records have been written prior to the record */
/* containing that double precision number. */
/* The cluster information output from this routine allows the */
/* caller to substantially reduce the number of directory reads */
/* required to read a from range of addresses that spans */
/* multiple physical records; the reading program only need call */
/* this routine once per cluster read, rather than once per */
/* physical record read. */
/* $ Examples */
/* 1) Use this routine to read integers from a range of */
/* addresses. This is done in the routine DASRDI. */
/* C */
/* C Decide how many integers to read. */
/* C */
/* NUMINT = LAST - FIRST + 1 */
/* NREAD = 0 */
/* C */
/* C Find out the physical location of the first */
/* C integer. If FIRST is invalid, DASA2L will take care */
/* C of the problem. */
/* C */
/* CALL DASA2L ( HANDLE, INT, FIRST, */
/* . CLBASE, CLSIZE, RECNO, WORDNO ) */
/* C */
/* C Read as much data from record RECNO as necessary. */
/* C */
/* N = MIN ( NUMINT, NWI - WORDNO + 1 ) */
/* CALL DASRRI ( HANDLE, RECNO, WORDNO, WORDNO + N-1, */
/* . DATA ) */
/* NREAD = N */
/* RECNO = RECNO + 1 */
/* C */
/* C Read from as many additional records as necessary. */
/* C */
/* DO WHILE ( NREAD .LT. NUMINT ) */
/* C */
/* C At this point, RECNO is the correct number of the */
/* C record to read from next. CLBASE is the number */
/* C of the first record of the cluster we're about */
/* C to read from. */
/* C */
/* IF ( RECNO .LT. ( CLBASE + CLSIZE ) ) THEN */
/* C */
/* C We can continue reading from the current */
/* C cluster. */
/* C */
/* N = MIN ( NUMINT - NREAD, NWI ) */
/* CALL DASRRI ( HANDLE, */
/* . RECNO, */
/* . 1, */
/* . N, */
/* . DATA ( NREAD + 1 ) ) */
/* NREAD = NREAD + N */
/* RECNO = RECNO + 1 */
/* ELSE */
/* C */
/* C We must find the next integer cluster to */
/* C read from. The first integer in this */
/* C cluster has address FIRST + NREAD. */
/* C */
/* CALL DASA2L ( HANDLE, */
/* . INT, */
/* . FIRST + NREAD, */
/* . CLBASE, */
/* . CLSIZE, */
/* . RECNO, */
/* . WORDNO ) */
/* END IF */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.1 20-NOV-2001 (NJB) */
/* Comment fix: diagram showing directory record pointers */
/* incorrectly showed element 2 of the record as a backward */
/* pointer. The element is actually a forward pointer. */
/* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */
/* Bug fix: calculation to determine whether file is segregated */
/* has been fixed. */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */
/* Re-written to optimize address calculations for segregated, */
/* read-only files. */
/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */
/* Fixed a typo in the $ Brief_I/O section of the header. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* map DAS logical address to physical location */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */
/* Bug fix: calculation to determine whether file is segregated */
/* has been fixed. An incorrect variable name used in a bound */
/* calculation resulted in an incorrect determination of whether */
/* a file was segregated, and caused arithmetic overflow for */
/* files with large maximum addresses. */
/* In the previous version, the number of DAS words in a cluster */
/* was incorrectly calculated as the product of the maximum */
/* address of the cluster's data type and the number of words of */
/* that data type in a DAS record. The correct product involves */
/* the number of records in the cluster and the number of words of */
/* that data type in a DAS record. */
/* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */
/* Re-written to optimize address calculations for segregated, */
/* read-only files. */
/* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */
/* Fixed a typo in the $ Brief_I/O section of the header. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Words per data record, for each data type: */
/* Directory pointer locations */
/* Directory address range locations */
/* Indices of lowest and highest addresses in a `range array': */
/* Location of first type descriptor */
/* Access word length */
/* File table size */
/* Local variables */
/* Saved variables */
/* Initial values */
/* NEXT and PREV map the DAS data type codes to their */
/* successors and predecessors, respectively. */
/* Discovery check-in is used in this routine. */
/* DAS files have the following general structure: */
/* +------------------------+ */
/* | file record | */
/* +------------------------+ */
/* | reserved records | */
/* | | */
/* +------------------------+ */
/* | comment records | */
/* | | */
/* | | */
/* | | */
/* +------------------------+ */
/* | first data directory | */
/* +------------------------+ */
/* | data records | */
/* | | */
/* | | */
/* | | */
/* | | */
/* +------------------------+ */
/* . */
/* . */
/* +------------------------+ */
/* | last data directory | */
/* +------------------------+ */
/* | data records | */
/* | | */
/* | | */
/* +------------------------+ */
/* Within each DAS data record, word numbers start at one and */
/* increase up to NWI, NWD, or NWC: the number of words in an */
/* integer, double precision, or character data record. */
/* +--------------------------------+ */
/* | | | ... | | */
/* +--------------------------------+ */
/* 1 2 NWD */
/* +--------------------------------+ */
/* | | | ... | | */
/* +--------------------------------+ */
/* 1 2 NWI */
/* +------------------------------------+ */
/* | | | ... | | */
/* +------------------------------------+ */
/* 1 2 NWC */
/* Directories are single records that describe the data */
/* types of data records that follow. The directories */
/* in a DAS file form a doubly linked list: each directory */
/* contains forward and backward pointers to the next and */
/* previous directories. */
/* Each directory also contains, for each data type, the lowest */
/* and highest logical address occurring in any of the records */
/* described by the directory. */
/* Following the pointers and address range information is */
/* a sequence of data type descriptors. These descriptors */
/* indicate the data type of data records following the */
/* directory record. Each descriptor gives the data type */
/* of a maximal set of contiguous data records, all having the */
/* same type. By `maximal set' we mean that no data records of */
/* the same type bound the set of records in question. */
/* Pictorially, the structure of a directory is as follows: */
/* +----------------------------------------------------+ */
/* | <pointers> | <address ranges> | <type descriptors> | */
/* +----------------------------------------------------+ */
/* where the <pointers> section looks like */
/* +-----------------------------------------+ */
/* | <backward pointer> | <forward pointer> | */
/* +-----------------------------------------+ */
/* the <address ranges> section looks like */
/* +-------------------------------------------+ */
/* | <char range> | <d.p. range> | <int range> | */
/* +-------------------------------------------+ */
/* and each range looks like one of: */
/* +------------------------------------------------+ */
/* | <lowest char address> | <highest char address> | */
/* +------------------------------------------------+ */
/* +------------------------------------------------+ */
/* | <lowest d.p. address> | <highest d.p. address> | */
/* +------------------------------------------------+ */
/* +------------------------------------------------+ */
/* | <lowest int address> | <highest int address> | */
/* +------------------------------------------------+ */
/* The type descriptors implement a run-length encoding */
/* scheme. The first element of the series of descriptors */
/* occupies two integers: it contains a type code and a count. */
/* The rest of the descriptors are just signed counts; the data */
/* types of the records they describe are deduced from the sign */
/* of the count and the data type of the previous descriptor. */
/* The method of finding the data type for a given descriptor */
/* in terms of its predecessor is as follows: if the sign of a */
/* descriptor is positive, the type of that descriptor is the */
/* successor of the type of the preceding descriptor in the */
/* sequence of types below. If the sign of a descriptor is */
/* negative, the type of the descriptor is the predecessor of the */
/* type of the preceding descriptor. */
/* C --> D --> I --> C */
/* For example, if the preceding type is `I', and a descriptor */
/* contains the number 16, the type of the descriptor is `C', */
/* whereas if the descriptor contained the number -800, the type */
/* of the descriptor would be `D'. */
/* Make sure the data type is valid. */
if (*type__ < 1 || *type__ > 3) {
chkin_("DASA2L", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("Invalid data type: #. File was #", (ftnlen)33);
errint_("#", type__, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(DASINVALIDTYPE)", (ftnlen)21);
chkout_("DASA2L", (ftnlen)6);
return 0;
}
/* Decide whether we're looking at the same file as we did on */
/* the last call. */
if (first) {
samfil = FALSE_;
fast = FALSE_;
prvhan = *handle;
first = FALSE_;
} else {
samfil = *handle == prvhan;
prvhan = *handle;
}
/* We have a special case if we're looking at a `fast' file */
/* that we saw on the last call. When we say a file is fast, */
/* we're implying that it's open for read access only and that it's */
/* segregated. In this case, we can do an address calculation */
/* without looking up any information from the file. */
if (samfil && fast) {
*clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ?
i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)666)];
*clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ?
i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)667)];
mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ?
i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)668)];
hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("nw", i__1, "dasa2l_", (ftnlen)669)];
/* Make sure that ADDRSS points to an existing location. */
if (*addrss < 1 || *addrss > mxaddr) {
chkin_("DASA2L", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("ADDRSS was #; valid range for type # is # to #. File w"
"as #", (ftnlen)59);
errint_("#", addrss, (ftnlen)1);
errint_("#", type__, (ftnlen)1);
errint_("#", &c__1, (ftnlen)1);
errint_("#", &mxaddr, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23);
chkout_("DASA2L", (ftnlen)6);
return 0;
}
} else {
/* If the current file is not the same one we looked at on the */
/* last call, find out whether the file is on record in our file */
/* table. Add the file to the table if necessary. Bump the */
/* oldest file in the table if there's no room. */
if (! samfil) {
fidx = isrchi_(handle, &nfiles, tbhan);
known = fidx > 0;
if (known) {
/* The file is in our list. */
fast = tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tbfast", i__1, "dasa2l_", (ftnlen)708)];
if (fast) {
/* This is a segregated, read-only file. Look up the */
/* saved information we'll need to calculate addresses. */
*clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 &&
0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2"
"l_", (ftnlen)715)];
*clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 &&
0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2"
"l_", (ftnlen)716)];
mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0
<= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_",
(ftnlen)717)];
hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <=
i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (
ftnlen)718)];
/* Make sure that ADDRSS points to an existing location. */
if (*addrss < 1 || *addrss > mxaddr) {
chkin_("DASA2L", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("ADDRSS was #; valid range for type # is # "
"to #. File was #", (ftnlen)60);
errint_("#", addrss, (ftnlen)1);
errint_("#", type__, (ftnlen)1);
errint_("#", &c__1, (ftnlen)1);
errint_("#", &mxaddr, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23);
chkout_("DASA2L", (ftnlen)6);
return 0;
}
}
/* FAST is set. */
}
/* KNOWN is set. */
}
/* SAMFIL, FAST, and KNOWN are set. If the file is the same one */
/* we saw on the last call, the state variables FAST, and KNOWN */
/* retain their values from the previous call. */
/* FIDX is set at this point only if we're looking at a known */
/* file. */
/* Unless the file is recognized and known to be a fast file, we */
/* look up all metadata for the file. */
if (! (known && fast)) {
if (! known) {
/* This file is not in our list. If the list is not full, */
/* append the file to the list. If the list is full, */
/* replace the oldest (first) file with this one. */
if (nfiles < 20) {
++nfiles;
fidx = nfiles;
} else {
fidx = 1;
}
tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tbhan", i__1, "dasa2l_", (ftnlen)781)] = *handle;
/* Find out whether the file is open for read or write */
/* access. We consider the file to be `slow' until we find */
/* out otherwise. The contents of the arrays TBHIGH, */
/* TBBASE, TBSIZE, and TBMXAD are left undefined for slow */
/* files. */
dasham_(handle, access, (ftnlen)10);
rdonly = s_cmp(access, "READ", (ftnlen)10, (ftnlen)4) == 0;
fast = FALSE_;
tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tbfast", i__1, "dasa2l_", (ftnlen)794)] = fast;
/* We'll set the flag KNOWN at the end of the outer IF */
/* block. */
} else {
/* We set RDONLY to .FALSE. for any known file that is */
/* not fast. It's actually possible for a read-only file */
/* to be unsegregated, but this is expected to be a rare */
/* case, one that's not worth complicating this routine */
/* further for. */
rdonly = FALSE_;
}
/* RDONLY is set. */
/* FIDX is now set whether or not the current file is known. */
/* Get the number of reserved records, comment records, and */
/* the current last address of the data type TYPE from the */
/* file summary. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, &tbmxad[(
i__1 = fidx * 3 - 3) < 60 && 0 <= i__1 ? i__1 : s_rnge(
"tbmxad", i__1, "dasa2l_", (ftnlen)821)], lstrec, lstwrd);
mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1
? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)831)];
/* Make sure that ADDRSS points to an existing location. */
if (*addrss < 1 || *addrss > mxaddr) {
chkin_("DASA2L", (ftnlen)6);
dashlu_(handle, &unit);
setmsg_("ADDRSS was #; valid range for type # is # to #. F"
"ile was #", (ftnlen)60);
errint_("#", addrss, (ftnlen)1);
errint_("#", type__, (ftnlen)1);
errint_("#", &c__1, (ftnlen)1);
errint_("#", &mxaddr, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23);
chkout_("DASA2L", (ftnlen)6);
return 0;
}
/* Find out which directory describes the cluster containing */
/* this word. To do this, we must traverse the directory */
/* list. The first directory record comes right after the */
/* last comment record. (Don't forget the file record when */
/* counting the predecessors of the directory record.) */
/* Note that we don't need to worry about not finding a */
/* directory record that contains the address we're looking */
/* for, since we've already checked that the address is in */
/* range. */
/* Keep track of the number of directory records we see. We'll */
/* use this later to determine whether we've got a segregated */
/* file. */
nrec = nresvr + ncomr + 2;
ndirs = 1;
i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 :
s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)872)] + 1;
dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <=
i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen)
872)], &i__3, range);
while(range[1] < *addrss) {
/* The record number of the next directory is the forward */
/* pointer in the current directory record. Update NREC */
/* with this pointer. Get the address range for the */
/* specified type covered by this next directory record. */
dasrri_(handle, &nrec, &c__2, &c__2, &nxtrec);
nrec = nxtrec;
++ndirs;
i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 :
s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)891)] + 1;
dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0
<= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (
ftnlen)891)], &i__3, range);
}
/* NREC is now the record number of the directory that contains */
/* the type descriptor for the address we're looking for. */
/* Our next task is to find the descriptor for the cluster */
/* containing the input address. To do this, we must examine */
/* the directory record in `left-to-right' order. As we do so, */
/* we'll keep track of the highest address of type TYPE */
/* occurring in the clusters whose descriptors we've seen. */
/* The variable HIADDR will contain this address. */
dasrri_(handle, &nrec, &c__1, &c__256, dirrec);
/* In the process of finding the physical location */
/* corresponding to ADDRSS, we'll find the record number of the */
/* base of the cluster containing ADDRSS. We'll start out by */
/* initializing this value with the number of the first data */
/* record of the next cluster. */
*clbase = nrec + 1;
/* We'll initialize HIADDR with the value preceding the lowest */
/* address of type TYPE described by the current directory. */
hiaddr = dirrec[(i__2 = rngloc[(i__1 = *type__ - 1) < 3 && 0 <=
i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen)
925)] - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec",
i__2, "dasa2l_", (ftnlen)925)] - 1;
/* Initialize the number of records described by the last seen */
/* type descriptor. This number, when added to CLBASE, should */
/* yield the number of the first record of the current cluster; */
/* that's why it's initialized to 0. */
*clsize = 0;
/* Now find the descriptor for the cluster containing ADDRSS. */
/* Read descriptors until we get to the one that describes the */
/* record containing ADDRSS. Keep track of descriptor data */
/* types as we go. Also count the descriptors. */
/* At this point, HIADDR is less than ADDRSS, so the loop will */
/* always be executed at least once. */
prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("prev", i__1, "dasa2l_", (ftnlen)944)];
dscloc = 10;
while(hiaddr < *addrss) {
/* Update CLBASE so that it is the record number of the */
/* first record of the current cluster. */
*clbase += *clsize;
/* Find the type of the current descriptor. */
if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 :
s_rnge("dirrec", i__1, "dasa2l_", (ftnlen)957)] > 0) {
curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("next", i__1, "dasa2l_", (ftnlen)958)];
} else {
curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("prev", i__1, "dasa2l_", (ftnlen)960)];
}
/* Forgetting to update PRVTYP is a Very Bad Thing (VBT). */
prvtyp = curtyp;
/* If the current descriptor is of the type we're interested */
/* in, update the highest address count. */
if (curtyp == *type__) {
hiaddr += nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("nw", i__1, "dasa2l_", (ftnlen)973)] * (
i__3 = dirrec[(i__2 = dscloc - 1) < 256 && 0 <=
i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", (
ftnlen)973)], abs(i__3));
}
/* Compute the number of records described by the current */
/* descriptor. Update the descriptor location. */
*clsize = (i__2 = dirrec[(i__1 = dscloc - 1) < 256 && 0 <=
i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", (
ftnlen)980)], abs(i__2));
++dscloc;
}
/* If we have an unknown read-only file, see whether the file */
/* is segregated. If it is, we'll be able to compute */
/* addresses much faster for subsequent reads to this file. */
if (rdonly && ! known) {
if (ndirs == 1) {
/* If this file is segregated, there are at most three */
/* cluster descriptors, and each one points to a cluster */
/* containing all records of the corresponding data type. */
/* For each data type having a non-zero maximum address, */
/* the size of the corresponding cluster must be large */
/* enough to hold all addresses of that type. */
ntypes = 0;
for (i__ = 1; i__ <= 3; ++i__) {
if (tbmxad[(i__1 = i__ + fidx * 3 - 4) < 60 && 0 <=
i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_"
, (ftnlen)1005)] > 0) {
++ntypes;
}
}
/* Now look at the first NTYPES cluster descriptors, */
/* collecting cluster bases and sizes as we go. */
mxclrc = nrec + 1;
prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ?
i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen)
1016)];
dscloc = 10;
fast = TRUE_;
while(dscloc <= ntypes + 9 && fast) {
/* Find the type of the current descriptor. */
if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ?
i__1 : s_rnge("dirrec", i__1, "dasa2l_", (
ftnlen)1025)] > 0) {
curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <=
i__1 ? i__1 : s_rnge("next", i__1, "dasa"
"2l_", (ftnlen)1026)];
} else {
curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <=
i__1 ? i__1 : s_rnge("prev", i__1, "dasa"
"2l_", (ftnlen)1028)];
}
prvtyp = curtyp;
tbbase[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <=
i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2l_"
, (ftnlen)1032)] = mxclrc;
tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <=
i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_"
, (ftnlen)1033)] = (i__3 = dirrec[(i__2 =
dscloc - 1) < 256 && 0 <= i__2 ? i__2 :
s_rnge("dirrec", i__2, "dasa2l_", (ftnlen)
1033)], abs(i__3));
mxclrc += tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60
&& 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1,
"dasa2l_", (ftnlen)1034)];
fast = tbmxad[(i__1 = curtyp + fidx * 3 - 4) < 60 &&
0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1,
"dasa2l_", (ftnlen)1037)] <= tbsize[(i__2 =
curtyp + fidx * 3 - 4) < 60 && 0 <= i__2 ?
i__2 : s_rnge("tbsize", i__2, "dasa2l_", (
ftnlen)1037)] * nw[(i__3 = curtyp - 1) < 3 &&
0 <= i__3 ? i__3 : s_rnge("nw", i__3, "dasa2"
"l_", (ftnlen)1037)];
++dscloc;
}
/* FAST is set. */
} else {
/* The file has more than one directory record. */
fast = FALSE_;
}
/* If the file was unknown, readonly, and had one directory */
/* record, we determined whether it was a fast file. */
} else {
/* The file was already known and wasn't fast, or is not */
/* readonly. */
fast = FALSE_;
}
/* FAST is set. */
}
/* This is the end of the `.NOT. ( KNOWN .AND. FAST )' case. */
/* At this point, we've set or looked up CLBASE, CLSIZE, MXADDR, */
/* and HIADDR. */
/* If the file was unknown, we set TBHAN, TBRDON, and TBFAST. */
/* If the file was unknown and turned out to be fast, we set */
/* TBBASE, TBSIZE, TBHIGH, and TBMXAD as well. */
/* At this point, it's safe to indicate that the file is known. */
known = TRUE_;
}
/* At this point, */
/* -- CLBASE is properly set: it is the record number of the */
/* first record of the cluster containing ADDRSS. */
/* -- CLSIZE is properly set: it is the size of the cluster */
/* containing ADDRSS. */
/* -- HIADDR is the last logical address in the cluster */
/* containing ADDRSS. */
/* Now we must find the physical record and word corresponding */
/* to ADDRSS. The structure of the cluster containing ADDRSS and */
/* HIADDR is shown below: */
/* +--------------------------------------+ */
/* | | Record # CLBASE */
/* +--------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------+ */
/* | |ADDRSS| | Record # RECNO */
/* +--------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------+ Record # */
/* | |HIADDR| */
/* +--------------------------------------+ CLBASE + CLSIZE - 1 */
*recno = *clbase + *clsize - 1 - (hiaddr - *addrss) / nw[(i__1 = *type__
- 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (
ftnlen)1122)];
*wordno = *addrss - (*addrss - 1) / nw[(i__1 = *type__ - 1) < 3 && 0 <=
i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)1125)] * nw[(
i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("nw", i__2,
"dasa2l_", (ftnlen)1125)];
return 0;
} /* dasa2l_ */
/* $Procedure ZZEKRSD ( EK, read scalar, double precision ) */
/* Subroutine */ int zzekrsd_(integer *handle, integer *segdsc, integer *
coldsc, integer *recptr, integer *eltidx, doublereal *dval, logical *
isnull, logical *found)
{
extern integer zzekrp2n_(integer *, integer *, integer *);
integer unit;
extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *,
ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen,
ftnlen);
integer class__, recno, segno, dtype;
extern /* Subroutine */ int dashlu_(integer *, integer *);
char column[32];
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), zzekrd02_(integer *,
integer *, integer *, integer *, doublereal *, logical *),
zzekrd05_(integer *, integer *, integer *, integer *, integer *,
integer *, doublereal *, logical *, logical *), zzekrd08_(integer
*, integer *, integer *, integer *, doublereal *, logical *);
/* $ Abstract */
/* Read scalar data from a double precision column in a specified EK */
/* record. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Column Name Size */
/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */
/* Size of column name, in characters. */
/* End Include Section: EK Column Name Size */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to EK file. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* RECPTR I Pointer to record from which data is to be read. */
/* ELTIDX I Index of column entry element to be read. */
/* DVAL O D.p. value in column entry. */
/* ISNULL O Flag indicating whether column entry is null. */
/* FOUND O Flag indicting whether entry element was found. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle. */
/* SEGDSC is the descriptor of the segment from which data is */
/* to be read. */
/* COLDSC is the column descriptor corresponding to the */
/* column from which data is to be read. */
/* RECPTR is a pointer to the record from which data is to be */
/* read. */
/* ELTIDX is the index of the column entry element to read. */
/* If the column entry is scalar, this argument is */
/* ignored. */
/* $ Detailed_Output */
/* DVAL is the specified column entry. DVAL is valid only */
/* when FOUND is set to .TRUE. */
/* ISNULL is a logical flag indicating whether the entry is */
/* null. ISNULL is valid only when FOUND is set to */
/* .TRUE. */
/* FOUND is a logical flag indicating whether the specified */
/* column entry element was found. For vector-valued */
/* columns, if ELTIDX refers to a non-existent */
/* column entry element, FOUND is set to .FALSE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. */
/* 2) If COLDSC is not the name of a declared column, the error */
/* will be diagnosed by routines called by this routine. */
/* 3) If COLDSC specifies a column of whose data type is not */
/* double precision, the error SPICE(WRONGDATATYPE) will be */
/* signalled. */
/* 4) If COLDSC specifies a column of whose class is not */
/* an double precision class known to this routine, the error */
/* SPICE(NOCLASS) will be signalled. */
/* 5) If the indicated column is array-valued, and if ELTIDX is */
/* non-positive, the error will be diagnosed by routines called */
/* by this routine. However, if ELTIDX is greater than the */
/* number of elements in the specified column entry, FOUND is */
/* set to .FALSE. and no error is signalled. */
/* 6) If an I/O error occurs while reading the indicated file, */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* The ZZEKRSx routines are low-level readers that expect column */
/* entries to be defined by descriptors. Since these routines do not */
/* look up descriptors, in cases where many successive accesses to */
/* the same segment and column are required, these routines are */
/* considerably more efficient than the high-level readers. */
/* These routines do not participate in tracing. */
/* $ Examples */
/* See ZZEKECMP. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */
/* -& */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* Nothing found to begin with. */
*found = FALSE_;
/* This column had better be of d.p. or TIME type. */
dtype = coldsc[1];
if (dtype != 2 && dtype != 4) {
zzekcnam_(handle, coldsc, column, (ftnlen)32);
dashlu_(handle, &unit);
segno = segdsc[1];
recno = zzekrp2n_(handle, &segdsc[1], recptr);
chkin_("ZZEKRSD", (ftnlen)7);
dashlu_(handle, &unit);
setmsg_("Column # is of type #; ZZEKRSD only works with DP or TIME c"
"olumns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)97);
errch_("#", column, (ftnlen)1, (ftnlen)32);
errint_("#", &dtype, (ftnlen)1);
errint_("#", &recno, (ftnlen)1);
errint_("#", &segno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
chkout_("ZZEKRSD", (ftnlen)7);
return 0;
}
/* Now it's time to read data from the file. Call the low-level */
/* reader appropriate to the column's class. */
class__ = coldsc[0];
if (class__ == 2) {
zzekrd02_(handle, segdsc, coldsc, recptr, dval, isnull);
*found = TRUE_;
} else if (class__ == 5) {
/* Class 5 columns contain d.p. array entries. */
zzekrd05_(handle, segdsc, coldsc, recptr, eltidx, eltidx, dval,
isnull, found);
} else if (class__ == 8) {
zzekrd08_(handle, segdsc, coldsc, recptr, dval, isnull);
*found = TRUE_;
} else {
/* This is an unsupported d.p. column class. */
zzekcnam_(handle, coldsc, column, (ftnlen)32);
dashlu_(handle, &unit);
segno = segdsc[1];
recno = zzekrp2n_(handle, &segdsc[1], recptr);
chkin_("ZZEKRSD", (ftnlen)7);
dashlu_(handle, &unit);
setmsg_("Class # from input column descriptor is not a supported d.p"
". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen)
110);
errint_("#", &class__, (ftnlen)1);
errch_("#", column, (ftnlen)1, (ftnlen)32);
errint_("#", &recno, (ftnlen)1);
errint_("#", &segno, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(NOCLASS)", (ftnlen)14);
chkout_("ZZEKRSD", (ftnlen)7);
return 0;
}
return 0;
} /* zzekrsd_ */
/* $Procedure ZZEKTR1S ( EK tree, one-shot load ) */
/* Subroutine */ int zzektr1s_(integer *handle, integer *tree, integer *size,
integer *values)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer base, page[256], nbig, node, subd, next, unit;
extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *,
integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_(
integer *, integer *, integer *);
extern integer zzektrbs_(integer *);
integer d__, i__, n, q, child, s;
extern integer zzektrsz_(integer *, integer *);
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer level, nkids, npred, nkeys, tsize, kidbas;
extern /* Subroutine */ int cleari_(integer *, integer *), dasudi_(
integer *, integer *, integer *, integer *);
integer basidx;
extern /* Subroutine */ int dashlu_(integer *, integer *);
integer bigsiz, nnodes, nsmall, stnbig[10], stnbas[10], stnode[10];
extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen);
extern logical return_(void);
integer maxsiz, reqsiz, stlsiz[10], stnext[10], stnkey[10], stsbsz[10],
subsiz, totnod;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer div, key;
/* $ Abstract */
/* One-shot tree load: insert an entire array into an empty */
/* tree. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Das Paging Parameters */
/* ekpage.inc Version 4 25-AUG-1995 (NJB) */
/* The EK DAS paging system makes use of the integer portion */
/* of an EK file's DAS address space to store the few numbers */
/* required to describe the system's state. The allocation */
/* of DAS integer addresses is shown below. */
/* DAS integer array */
/* +--------------------------------------------+ */
/* | EK architecture code | Address = 1 */
/* +--------------------------------------------+ */
/* | Character page size (in DAS words) | */
/* +--------------------------------------------+ */
/* | Character page base address | */
/* +--------------------------------------------+ */
/* | Number of character pages in file | */
/* +--------------------------------------------+ */
/* | Number of character pages on free list | */
/* +--------------------------------------------+ */
/* | Character free list head pointer | Address = 6 */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for d.p. pages | 7--11 */
/* | | */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for integer pages | 12--16 */
/* | | */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | End Address = */
/* | Unused space | integer page */
/* | | end */
/* +--------------------------------------------+ */
/* | | Start Address = */
/* | First integer page | integer page */
/* | | base */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | */
/* | Last integer page | */
/* | | */
/* +--------------------------------------------+ */
/* The following parameters indicate positions of elements in the */
/* paging system metadata array: */
/* Number of metadata items per data type: */
/* Character metadata indices: */
/* Double precision metadata indices: */
/* Integer metadata indices: */
/* Size of metadata area: */
/* Page sizes, in units of DAS words of the appropriate type: */
/* Default page base addresses: */
/* End Include Section: EK Das Paging Parameters */
/* $ 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. */
/* Include Section: EK Tree Parameters */
/* ektree.inc Version 3 22-OCT-1995 (NJB) */
/* The parameters in this file define the tree structure */
/* used by the EK system. This structure is a variant of the */
/* B*-tree structure described in Knuth's book, that is */
/* Knuth, Donald E. "The Art of Computer Programming, */
/* Volume 3/Sorting and Searching" 1973, pp 471-479. */
/* The trees used in the EK system differ from generic B*-trees */
/* primarily in the way keys are treated. Rather than storing */
/* unique primary key values in each node, EK trees store integer */
/* counts that represent the ordinal position of each data value, */
/* counting from the lowest indexed element in the subtree whose */
/* root is the node in question. Thus the keys are unique within */
/* a node but not across multiple nodes: in fact the Nth key in */
/* every leaf node is N. The absolute ordinal position of a data */
/* item is defined recursively as the sum of the key of the data item */
/* and the absolute ordinal position of the data item in the parent */
/* node that immediately precedes all elements of the node in */
/* question. This data structure allows EK trees to support lookup */
/* of data items based on their ordinal position in a data set. The */
/* two prime applications of this capability in the EK system are: */
/* 1) Using trees to index the records in a table, allowing */
/* the Nth record to be located efficiently. */
/* 2) Using trees to implement order vectors that can be */
/* maintained when insertions and deletions are done. */
/* Root node */
/* +--------------------------------------------+ */
/* | Tree version code | */
/* +--------------------------------------------+ */
/* | Number of nodes in tree | */
/* +--------------------------------------------+ */
/* | Number of keys in tree | */
/* +--------------------------------------------+ */
/* | Depth of tree | */
/* +--------------------------------------------+ */
/* | Number of keys in root | */
/* +--------------------------------------------+ */
/* | Space for n keys, | */
/* | | */
/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */
/* | | */
/* | where m is the max number of children per | */
/* | node in the child nodes | */
/* +--------------------------------------------+ */
/* | Space for n+1 child pointers, | */
/* | where n is as defined above. | */
/* +--------------------------------------------+ */
/* | Space for n data pointers, | */
/* | where n is as defined above. | */
/* +--------------------------------------------+ */
/* Child node */
/* +--------------------------------------------+ */
/* | Number of keys present in node | */
/* +--------------------------------------------+ */
/* | Space for m-1 keys | */
/* +--------------------------------------------+ */
/* | Space for m child pointers | */
/* +--------------------------------------------+ */
/* | Space for m-1 data pointers | */
/* +--------------------------------------------+ */
/* The following parameters give the maximum number of children */
/* allowed in the root and child nodes. During insertions, the */
/* number of children may overflow by 1. */
/* Maximum number of children allowed in a child node: */
/* Maximum number of keys allowed in a child node: */
/* Minimum number of children allowed in a child node: */
/* Minimum number of keys allowed in a child node: */
/* Maximum number of children allowed in the root node: */
/* Maximum number of keys allowed in the root node: */
/* Minimum number of children allowed in the root node: */
/* The following parameters indicate positions of elements in the */
/* tree node structures shown above. */
/* The following parameters are for the root node only: */
/* Location of version code: */
/* Version code: */
/* Location of node count: */
/* Location of total key count for the tree: */
/* Location of tree depth: */
/* Location of count of keys in root node: */
/* Base address of keys in the root node: */
/* Base address of child pointers in root node: */
/* Base address of data pointers in the root node (allow room for */
/* overflow): */
/* Size of root node: */
/* The following parameters are for child nodes only: */
/* Location of number of keys in node: */
/* Base address of keys in child nodes: */
/* Base address of child pointers in child nodes: */
/* Base address of data pointers in child nodes (allow room */
/* for overflow): */
/* Size of child node: */
/* A number of EK tree routines must declare stacks of fixed */
/* depth; this depth limit imposes a limit on the maximum depth */
/* that an EK tree can have. Because of the large branching */
/* factor of EK trees, the depth limit is of no practical */
/* importance: The number of keys that can be held in an EK */
/* tree of depth N is */
/* N-1 */
/* MXKIDC - 1 */
/* MXKIDR * ------------- */
/* MXKIDC - 1 */
/* This formula yields a capacity of over 1 billion keys for a */
/* tree of depth 6. */
/* End Include Section: EK Tree Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* TREE I Root of tree. */
/* SIZE I Size of tree. */
/* VALUES I Values to insert. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for write access. */
/* TREE is the root node number of the tree of interest. */
/* The tree must be empty. */
/* SIZE is the size of the tree to create: SIZE is the */
/* number of values that will be inserted into the */
/* tree. */
/* VALUES is an array of integer values to be inserted into */
/* the tree. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. The file will not be modified. */
/* 2) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* 3) If the input tree is not empty, the error SPICE(NONEMPTYTREE) */
/* is signalled. */
/* 4) If the depth of the tree needed to hold the number of values */
/* indicated by SIZE exceeds the maximum depth limit, the error */
/* SPICE(COUNTTOOLARGE) is signalled. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine creates an EK tree and loads the tree with the */
/* integer values supplied in the array VALUES. The ordinal */
/* positions of the values in the tree correspond to the positions */
/* of the values in the input array: for example, the 10th element */
/* of the array is pointed to by the key 10. */
/* This routine loads a tree much faster than can be done by */
/* sequentially loading the set of values by successive calls to */
/* ZZEKTRIN. On the other hand, the caller must declare an array */
/* large enough to hold all of the values to be loaded. Note that */
/* a partially full tree cannot be extended using this routine. */
/* $ Examples */
/* See EKFFLD. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */
/* 3/Sorting and Searching" 1973, pp 471-479. */
/* EK trees are closely related to the B* trees described by */
/* Knuth. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */
/* Removed redundant calls to CHKIN */
/* - Beta Version 1.0.0, 22-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKTR1S", (ftnlen)8);
}
/* Make sure the input tree is empty. */
tsize = zzektrsz_(handle, tree);
if (tsize > 0) {
dashlu_(handle, &unit);
setmsg_("Tree has size #; should be empty.EK = #; TREE = #.", (ftnlen)
50);
errint_("#", &tsize, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
sigerr_("SPICE(NONEMPTYTREE)", (ftnlen)19);
chkout_("ZZEKTR1S", (ftnlen)8);
return 0;
}
/* Compute the tree depth required. The largest tree of a given */
/* depth D contains the root node plus S(D) child nodes, where */
/* S(1) = 1 */
/* and if D is at least 2, */
/* D - 2 */
/* ____ */
/* \ i */
/* S(D) = MAX_SIZE * / MAX_SIZE */
/* Root ---- Child */
/* i = 0 */
/* D - 2 */
/* ____ */
/* \ i */
/* = MXKIDR * / MXKIDC */
/* ---- */
/* i = 0 */
/* D-1 */
/* MXKIDC - 1 */
/* = MXKIDR * ------------- */
/* MXKIDC - 1 */
/* If all of these nodes are full, the number of keys that */
/* can be held in this tree is */
/* MXKEYR + S(D) * MXKEYC */
/* We want the minimum value of D such that this expression */
/* is greater than or equal to SIZE. */
tsize = 82;
d__ = 1;
s = 1;
while(tsize < *size) {
++d__;
if (d__ == 2) {
s = 82;
} else {
/* For computational purposes, the relationship */
/* S(D+1) = MXKIDR + MXKIDC * S(D) */
/* is handy. */
s = s * 63 + 83;
}
tsize = s * 62 + 82;
}
/* If the tree must be deeper than we expected, we've a problem. */
if (d__ > 10) {
dashlu_(handle, &unit);
setmsg_("Tree has depth #; max supported depth is #.EK = #; TREE = #."
, (ftnlen)60);
errint_("#", &d__, (ftnlen)1);
errint_("#", &c__10, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
sigerr_("SPICE(COUNTTOOLARGE)", (ftnlen)20);
chkout_("ZZEKTR1S", (ftnlen)8);
return 0;
}
/* The basic error checks are done. At this point, we can build the */
/* tree. */
/* The approach is to fill in the tree in a top-down fashion. */
/* We decide how big each subtree of the root will be; this */
/* information allows us to decide which keys actually belong */
/* in the root. Having filled in the root, we repeat the process */
/* for each subtree of the root in left-to-right order. */
/* We use a stack to keep track of the ancestors of the */
/* node we're currently considering. The table below shows the */
/* items we save on the stack and the stack variables associated */
/* with those items: */
/* Item Stack Variable */
/* ---- --------------- */
/* Node number STNODE */
/* Size, in keys, of the */
/* subtree headed by node STSBSZ */
/* Number of keys in node STNKEY */
/* Larger subtree size STLSIZ */
/* Number of large subtrees STNBIG */
/* Index of next subtree to visit STNEXT */
/* Base index of node STNBAS */
node = *tree;
subsiz = *size;
next = 1;
level = 1;
basidx = 0;
while(level > 0) {
/* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */
if (next == 1) {
/* This node has not been visited yet. We'll fill in this */
/* node before proceeding to fill in its descendants. The */
/* first step is to compute the number and sizes of the */
/* subtrees of this node. */
/* Decide the large subtree size and the number of subtrees of */
/* this node. The depth SUBD of the subtrees of this node is */
/* D - LEVEL. Each subtree has size bounded by the sizes of */
/* the subtree of depth SUBD in which all nodes contain MNKEYC */
/* keys and the by the subtree of depth SUBD in which all nodes */
/* contain MXKEYC keys. If this node is not the root and is */
/* not a leaf node, the number of subtrees must be between */
/* MNKIDC and MXKIDC. */
if (level == 1) {
/* We're working on the root. The number of subtrees is */
/* anywhere between 0 and MXKIDR, inclusive. We'll create */
/* a tree with the minimum number of subtrees of the root. */
if (d__ > 1) {
/* We'll find the number of subtrees of maximum size */
/* that we would need to hold the non-root keys of the */
/* tree. We'll then determine the actual required sizes */
/* of these subtrees. */
subd = d__ - 1;
nnodes = 0;
i__1 = subd;
for (i__ = 1; i__ <= i__1; ++i__) {
nnodes = nnodes * 63 + 1;
}
maxsiz = nnodes * 62;
/* If we had NKIDS subtrees of size MAXSIZ, NKIDS */
/* would be the smallest integer such that */
/* ( NKIDS - 1 ) + NKIDS * MAXSIZ > SUBSIZ */
/* - */
/* or equivalently, */
/* NKIDS * ( MAXSIZ + 1 ) > SUBSIZ + 1 */
/* - */
/* We'll compute this value of NKIDS. */
q = subsiz + 1;
div = maxsiz + 1;
nkids = (q + div - 1) / div;
/* The minimum number of keys we must store in child */
/* nodes is the number of keys in the tree, minus those */
/* that can be accommodated in the root: */
n = subsiz - (nkids - 1);
/* Now we can figure out how large the subtrees would */
/* have to be in order to hold N keys, if all subtrees */
/* had the same size. */
bigsiz = (n + nkids - 1) / nkids;
/* We may have more capacity than we need if all subtrees */
/* have size BIGSIZ. So, we'll allow some subtrees to */
/* have size BIGSIZ-1. Not all subtrees can have the */
/* smaller size (otherwise BIGSIZ would have been */
/* smaller). The first NBIG subtrees will have the */
/* larger size. */
nsmall = nkids * bigsiz - n;
nbig = nkids - nsmall;
nkeys = nkids - 1;
} else {
/* All keys are in the root. */
nkeys = *size;
nkids = 0;
}
/* Read in the root page. */
zzekpgri_(handle, tree, page);
/* We have enough information to fill in the root node. */
/* We'll allocate nodes for the immediate children. */
/* There is one key `between' each child pointer. */
i__1 = nkeys;
for (i__ = 1; i__ <= i__1; ++i__) {
/* The Ith key may be found by considering the number */
/* of keys in the subtree between the Ith key and its */
/* predecessor in the root. */
if (i__ == 1) {
npred = 0;
} else {
npred = page[(i__2 = i__ + 3) < 256 && 0 <= i__2 ?
i__2 : s_rnge("page", i__2, "zzektr1s_", (
ftnlen)480)];
}
if (d__ > 1) {
/* The tree contains subtrees. */
if (i__ <= nbig) {
key = npred + bigsiz + 1;
} else {
key = npred + bigsiz;
}
} else {
key = i__;
}
page[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)499)] = key;
page[(i__2 = i__ + 171) < 256 && 0 <= i__2 ? i__2 :
s_rnge("page", i__2, "zzektr1s_", (ftnlen)500)] =
values[key - 1];
}
totnod = 1;
i__1 = nkids;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Allocate a node for the Ith child. Store pointers */
/* to these nodes. */
zzekpgal_(handle, &c__3, &child, &base);
page[(i__2 = i__ + 87) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)513)] = child;
++totnod;
}
/* Fill in the root's metadata. There is one item that */
/* we'll have to fill in when we're done: the number of */
/* nodes in the tree. We know the rest of the information */
/* now. */
page[2] = *size;
page[3] = d__;
page[4] = nkeys;
page[1] = 0;
/* Write out the root. */
zzekpgwi_(handle, tree, page);
} else if (level < d__) {
/* The current node is a non-leaf child node. */
cleari_(&c__256, page);
/* The tree headed by this node has depth D-LEVEL+1 and */
/* must hold SUBSIZ keys. We must figure out the size */
/* and number of subtrees of the current node. Unlike in */
/* the case of the root, we must have between MNKIDC */
/* and MXKIDC subtrees of this node. We start out by */
/* computing the required subtree size if there were */
/* exactly MNKIDC subtrees. In this case, the total */
/* number of keys in the subtrees would be */
/* SUBSIZ - MNKEYC */
n = subsiz - 41;
reqsiz = (n + 40) / 41;
/* Compute the maximum allowable number of keys in */
/* a subtree. */
subd = d__ - level;
nnodes = 0;
i__1 = subd;
for (i__ = 1; i__ <= i__1; ++i__) {
nnodes = nnodes * 63 + 1;
}
maxsiz = nnodes * 62;
/* If the number REQSIZ we came up with is a valid size, */
/* we'll be able to get the correct number of children */
/* by using subtrees of size REQSIZ and REQSIZ-1. Note */
/* that it's impossible for REQSIZ to be too small, */
/* since the smallest possible number of subtrees is */
/* MNKIDC. */
if (reqsiz <= maxsiz) {
/* Decide how many large and small subtrees we need. */
nkids = 42;
bigsiz = reqsiz;
nsmall = bigsiz * nkids - n;
nbig = nkids - nsmall;
} else {
/* See how many subtrees of size MAXSIZ it would take */
/* to hold the requisite number of keys. We know the */
/* number is more than MNKIDC. If we have NKIDS */
/* subtrees of size MAXSIZ, the total number of */
/* keys in the subtree headed by NODE is */
/* ( NKIDS - 1 ) + ( NKIDS * MAXSIZ ) */
/* or */
/* NKIDS * ( MAXSIZ + 1 ) - 1 */
/* We must find the smallest value of NKIDS such */
/* that the above quantity is greater than or equal */
/* to SUBSIZ. */
q = subsiz + 1;
div = maxsiz + 1;
nkids = (q + div - 1) / div;
/* We know that NKIDS subtrees of size MAXSIZ, plus */
/* NKIDS-1 keys in NODE, can hold at least SUBSIZ */
/* keys. We now want to find the smallest subtree */
/* size such that NKIDS subtrees of that size, */
/* together with the NKIDS-1 keys in NODE, contain */
/* at least SUBSIZ keys. The size we seek will */
/* become BIGSIZ, the larger of the two subtree */
/* sizes we'll use. So BIGSIZ is the smallest */
/* integer such that */
/* ( NKIDS - 1 ) + ( NKIDS * BIGSIZ ) > SUBSIZ */
/* - */
/* or equivalently */
/* BIGSIZ * NKIDS > SUBSIZ - NKIDS + 1 */
/* - */
q = subsiz - nkids + 1;
div = nkids;
bigsiz = (q + div - 1) / div;
nsmall = bigsiz * nkids - q;
nbig = nkids - nsmall;
}
/* Fill in the keys for the current node. */
nkeys = nkids - 1;
i__1 = nkeys;
for (i__ = 1; i__ <= i__1; ++i__) {
/* The Ith key may be found by considering the number */
/* of keys in the subtree between the Ith key and its */
/* predecessor in the current node. */
if (i__ == 1) {
npred = basidx;
} else {
npred = basidx + page[(i__2 = i__ - 1) < 256 && 0 <=
i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_"
, (ftnlen)652)];
}
if (i__ <= nbig) {
key = npred + bigsiz + 1;
} else {
key = npred + bigsiz;
}
page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)661)] = key -
basidx;
page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 :
s_rnge("page", i__2, "zzektr1s_", (ftnlen)662)] =
values[key - 1];
}
i__1 = nkids;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Allocate a node for the Ith child. Store pointers */
/* to these nodes. */
zzekpgal_(handle, &c__3, &child, &base);
page[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)674)] = child;
++totnod;
}
/* We can now fill in the metadata for the current node. */
page[0] = nkeys;
zzekpgwi_(handle, &node, page);
}
/* Unless the current node is a leaf node, prepare to visit */
/* the first child of the current node. */
if (level < d__) {
/* Push our current state. */
stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnode", i__1, "zzektr1s_", (ftnlen)696)] = node;
stsbsz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stsbsz", i__1, "zzektr1s_", (ftnlen)697)] = subsiz;
stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnkey", i__1, "zzektr1s_", (ftnlen)698)] = nkeys;
stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stlsiz", i__1, "zzektr1s_", (ftnlen)699)] = bigsiz;
stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnbig", i__1, "zzektr1s_", (ftnlen)700)] = nbig;
stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnext", i__1, "zzektr1s_", (ftnlen)701)] = 2;
stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnbas", i__1, "zzektr1s_", (ftnlen)702)] = basidx;
/* NEXT is already set to 1. BASIDX is set, since the */
/* base index of the first child is that of the parent. */
if (level == 1) {
kidbas = 88;
} else {
kidbas = 64;
}
++level;
node = page[(i__1 = kidbas) < 256 && 0 <= i__1 ? i__1 :
s_rnge("page", i__1, "zzektr1s_", (ftnlen)715)];
subsiz = bigsiz;
} else if (level > 1) {
/* The current node is a child leaf node. There are no */
/* calculations to do; we simply assign keys and pointers, */
/* write out metadata, and pop our state. */
nkeys = subsiz;
i__1 = nkeys;
for (i__ = 1; i__ <= i__1; ++i__) {
key = basidx + i__;
page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)730)] = i__;
page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 :
s_rnge("page", i__2, "zzektr1s_", (ftnlen)731)] =
values[key - 1];
}
/* We can now fill in the metadata for the current node. */
page[0] = nkeys;
zzekpgwi_(handle, &node, page);
/* A leaf node is a subtree unto itself, and we're */
/* done with this subtree. Pop our state. */
--level;
if (level >= 1) {
node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)750)
];
nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnkey", i__1, "zzektr1s_", (
ftnlen)751)];
bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)752)];
nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)753)
];
next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)754)
];
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)755)];
nkids = nkeys + 1;
/* Read in the current node. */
zzekpgri_(handle, &node, page);
}
} else {
/* The only node is the root. Pop out. */
level = 0;
}
/* We've decided which node to go to next at this point. */
/* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */
} else {
/* The current node has been visited already. Visit the */
/* next child, if there is one. */
if (next <= nkids) {
/* Prepare to visit the next child of the current node. */
stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnext", i__1, "zzektr1s_", (ftnlen)787)] = next + 1;
if (level == 1) {
kidbas = 88;
} else {
kidbas = 64;
}
node = page[(i__1 = kidbas + next - 1) < 256 && 0 <= i__1 ?
i__1 : s_rnge("page", i__1, "zzektr1s_", (ftnlen)797)]
;
if (next <= nbig) {
subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)801)];
} else {
subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)803)] - 1;
}
if (next <= nbig + 1) {
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)809)] + (next - 1) * stlsiz[(i__2 = level
- 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz",
i__2, "zzektr1s_", (ftnlen)809)] + (next - 1);
} else {
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)815)] + nbig * stlsiz[(i__2 = level - 1) <
10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz", i__2,
"zzektr1s_", (ftnlen)815)] + (next - nbig - 1) * (
stlsiz[(i__3 = level - 1) < 10 && 0 <= i__3 ?
i__3 : s_rnge("stlsiz", i__3, "zzektr1s_", (
ftnlen)815)] - 1) + (next - 1);
}
++level;
next = 1;
/* LEVEL, NEXT, NODE, SUBSIZ, and BASIDX are set. */
} else {
/* We're done with the current subtree. Pop the stack. */
--level;
if (level >= 1) {
node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)836)
];
nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnkey", i__1, "zzektr1s_", (
ftnlen)837)];
bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)838)];
nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)839)
];
next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)840)
];
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)841)];
nkids = nkeys + 1;
/* Read in the current node. */
zzekpgri_(handle, &node, page);
}
}
}
/* On this pass through the loop, we either--- */
/* - Visited a node for the first time and filled in the */
/* node. */
/* - Advanced to a new node that has not yet been visited. */
/* - Exited from a completed subtree. */
/* Each of these actions can be performed a finite number of */
/* times. Therefore, we made progress toward loop termination. */
}
/* The last chore is setting the total number of nodes in the root. */
base = zzektrbs_(tree);
i__1 = base + 2;
i__2 = base + 2;
dasudi_(handle, &i__1, &i__2, &totnod);
chkout_("ZZEKTR1S", (ftnlen)8);
return 0;
} /* zzektr1s_ */
/* $Procedure DASSDR ( DAS, segregate data records ) */
/* Subroutine */ int dassdr_(integer *handle)
{
/* Initialized data */
static integer next[3] = { 2,3,1 };
static integer prev[3] = { 3,1,2 };
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer base;
char crec[1024];
doublereal drec[128];
integer free, irec[256], lrec, dest;
logical more;
integer unit, type__, i__, j, n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer ncomc;
extern /* Subroutine */ int maxai_(integer *, integer *, integer *,
integer *);
char savec[1024];
doublereal saved[128];
integer recno, savei[256];
extern integer sumai_(integer *, integer *);
integer ncomr, total, lword, count[4], ltype, start;
extern logical failed_(void);
extern /* Subroutine */ int dasadi_(integer *, integer *, integer *),
cleari_(integer *, integer *);
integer drbase;
extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *,
ftnlen, ftnlen), dasiod_(char *, integer *, integer *, doublereal
*, ftnlen), dasllc_(integer *), dasrdi_(integer *, integer *,
integer *, integer *), dashfs_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *),
dasudi_(integer *, integer *, integer *, integer *);
integer minadr, maxadr, scrhan, lastla[3];
extern /* Subroutine */ int dassih_(integer *, char *, ftnlen), dashlu_(
integer *, integer *), daswbr_(integer *), dasrri_(integer *,
integer *, integer *, integer *, integer *);
integer offset;
extern /* Subroutine */ int dasioi_(char *, integer *, integer *, integer
*, ftnlen);
integer lastrc[3];
extern /* Subroutine */ int dasops_(integer *), dasufs_(integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *), chkout_(char *, ftnlen);
integer lastwd[3], nresvc;
extern logical return_(void);
integer nresvr, savtyp, prvtyp, loc, pos;
/* $ Abstract */
/* Segregate the data records in a DAS file into clusters, using */
/* one cluster per data type present in the file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* ORDER */
/* SORT */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If a Fortran read attempted by this routine fails, the */
/* error will be diagnosed by routines called by this routine. */
/* The state of the DAS file undergoing re-ordering will be */
/* indeterminate. */
/* 3) If a Fortran write attempted by this routine fails, the */
/* error will be diagnosed by routines called by this routine. */
/* The state of the DAS file undergoing re-ordering will be */
/* indeterminate. */
/* 4) If any other I/O error occurs during the re-arrangement of */
/* the records in the indicated DAS file, the error will be */
/* diagnosed by routines called by this routine. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* Normally, there should be no need for routines outside of */
/* SPICELIB to call this routine. */
/* The effect of this routine is to re-arrange the data records */
/* in a DAS file so that the file contains a single cluster for */
/* each data type present in the file: in the general case, there */
/* will be a single cluster of each of the integer, double */
/* precision, and character data types. */
/* The relative order of data records of a given type is not */
/* affected by this re-ordering. After the re-ordering, the DAS */
/* file contains a single directory record that has one descriptor */
/* for each cluster. After that point, the order in the file of the */
/* sets of data records of the various data types will be: */
/* +-------+ */
/* | CHAR | */
/* +-------+ */
/* | DP | */
/* +-------+ */
/* | INT | */
/* +-------+ */
/* Files that contain multiple directory records will have all but */
/* the first directory record moved to the end of the file when the */
/* re-ordering is complete. These records are not visible to the */
/* DAS system and will be overwritten if data is subsequently added */
/* to the DAS file. */
/* The purpose of segregating a DAS file's data records into three */
/* clusters is to make read access more efficient: when a DAS file */
/* contains a single directory with at most three cluster type */
/* descriptors, mapping logical to physical addresses can be done */
/* in constant time. */
/* $ Examples */
/* 1) Segregate data records in a DAS file designated by */
/* HANDLE: */
/* CALL DASSDR ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */
/* Added test of FAILED after each DAS call, or sequence of calls, */
/* which returns immediately if FAILED is true. This fixes a bug */
/* where DASOPS signals an error and then DASSDR has a */
/* segmentation fault. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */
/* Bug fix: call to CLEARD replaced with call to */
/* CLEARI. */
/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) (MJS) */
/* Bug fix: extraneous commas removed from argument lists */
/* in calls to DASADI. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* segregate the data records in a DAS file */
/* -& */
/* $ Revisions */
/* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */
/* Added test of failed after each DAS call, or sequence of calls, */
/* which returns immediately if FAILED is true. This fixes a bug */
/* where DASOPS signals an error and then DASSDR has a */
/* segmentation fault. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */
/* Bug fix: call to CLEARD replaced with call to */
/* CLEARI. */
/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) */
/* Bug fix: extraneous commas removed from argument lists */
/* in calls to DASADI. This bug had no visible effect on */
/* VAX and Sun systems, but generated a compile error under */
/* Lahey Fortran. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Data type parameters */
/* Directory pointer locations (backward and forward): */
/* Directory address range location base */
/* Location of first type descriptor */
/* Local variables */
/* Saved variables */
/* NEXT and PREV map the DAS data type codes to their */
/* successors and predecessors, respectively. */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASSDR", (ftnlen)6);
}
/* Before starting, make sure that this DAS file is open for */
/* writing. */
dassih_(handle, "WRITE", (ftnlen)5);
/* Get the logical unit for this file. */
dashlu_(handle, &unit);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Write out any buffered records that belong to the file. */
daswbr_(handle);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* We're going to re-order the physical records in the DAS file, */
/* starting with the first record after the first directory. */
/* The other directory records are moved to the end of the file */
/* as a result of the re-ordering. */
/* The re-ordering algorithm is based on that used in the REORDx */
/* routines. To use this algorithm, we'll build an order vector */
/* for the records to be ordered; we'll construct this order vector */
/* in a scratch DAS file. First, we'll traverse the directories */
/* to build up a sort of inverse order vector that tells us the */
/* final destination and data type of each data record; from this */
/* inverse vector we can easily build a true order vector. The */
/* cycles of the true order vector can be traversed without */
/* repetitive searching, and with a minimum of assignment of the */
/* contents of data records to temporary variables. */
/* Allocate a scratch DAS file to keep our vectors in. */
dasops_(&scrhan);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Now build up our `inverse order vector'. This array is an */
/* inverse order vector only in loose sense: it actually consists */
/* of an integer array that contains a sequence of pairs of integers, */
/* the first of which indicates a data type, and the second of which */
/* is an ordinal number. There is one pair for each data record in */
/* the file. The ordinal number gives the ordinal position of the */
/* record described by the number pair, relative to the other records */
/* of the same type. Directory records are considered to have type */
/* `directory', which is represented by the code DIR. */
/* We also must maintain a count of records of each type. */
cleari_(&c__4, count);
/* Get the file summary for the DAS file to be segregated. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Find the record and word positions LREC and LWORD of the last */
/* descriptor in the file, and also find the type of the descriptor */
/* LTYPE. */
maxai_(lastrc, &c__3, &lrec, &loc);
lword = 0;
for (i__ = 1; i__ <= 3; ++i__) {
if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc",
i__1, "dassdr_", (ftnlen)451)] == lrec && lastwd[(i__2 = i__
- 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dassd"
"r_", (ftnlen)451)] > lword) {
lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastwd", i__1, "dassdr_", (ftnlen)454)];
ltype = i__;
}
}
/* The first directory starts after the last comment record. */
recno = nresvr + ncomr + 2;
while(recno <= lrec && recno > 0) {
/* Read the directory record. */
dasrri_(handle, &recno, &c__1, &c__256, irec);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Increment the directory count. */
++count[3];
/* Add the data type (`directory') and count (1) of the current */
/* record to the inverse order vector. */
dasadi_(&scrhan, &c__1, &c__4);
dasadi_(&scrhan, &c__1, &count[3]);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Set up our `finite state machine' that tells us the data */
/* types of the records described by the last read directory. */
type__ = irec[8];
prvtyp = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"prev", i__1, "dassdr_", (ftnlen)498)];
/* Now traverse the directory and update the inverse order */
/* vector based on the descriptors we find. */
more = TRUE_;
i__ = 10;
while(more) {
/* Obtain the count for the current descriptor. */
n = (i__2 = irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 :
s_rnge("irec", i__1, "dassdr_", (ftnlen)512)], abs(i__2));
/* Update our inverse order vector to describe the positions */
/* of the N records described by the current descriptor. */
i__1 = n;
for (j = 1; j <= i__1; ++j) {
dasadi_(&scrhan, &c__1, &type__);
i__3 = count[(i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 :
s_rnge("count", i__2, "dassdr_", (ftnlen)521)] + j;
dasadi_(&scrhan, &c__1, &i__3);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* Adjust the count of records of data type TYPE. */
count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("count"
, i__1, "dassdr_", (ftnlen)533)] = count[(i__2 = type__ -
1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dass"
"dr_", (ftnlen)533)] + n;
/* Find the next type. */
++i__;
if (i__ > 256 || recno == lrec && i__ > lword) {
more = FALSE_;
} else {
if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)547)] > 0) {
type__ = next[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("next", i__1, "dassdr_", (ftnlen)548)];
} else if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 :
s_rnge("irec", i__1, "dassdr_", (ftnlen)550)] < 0) {
type__ = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("prev", i__1, "dassdr_", (ftnlen)551)];
} else {
more = FALSE_;
}
}
}
/* The forward pointer in this directory tells us where the */
/* next directory record is. When there are no more directory */
/* records, this pointer will be zero. */
recno = irec[1];
}
/* At this point, the inverse order vector is set up. The array */
/* COUNT contains counts of the number of records of each type we've */
/* seen. Set TOTAL to the total number of records that we've going */
/* to permute. */
total = sumai_(count, &c__4);
/* The next step is to build a true order vector. Let BASE be */
/* the base address for the order vector; this address is the */
/* last logical address of the inverse order vector. */
base = total << 1;
/* We'll store the actual order vector in locations BASE + 1 */
/* through BASE + TOTAL. In addition, we'll build a parallel array */
/* that contains, for each element of the order vector, the type of */
/* data corresponding to that element. This type vector will */
/* reside in locations BASE + TOTAL + 1 through BASE + 2*TOTAL. */
/* Before setting the values of the order vector and its parallel */
/* type vector, we'll allocate space in the scratch DAS file by */
/* zeroing out the locations we plan to use. After this, locations */
/* BASE+1 through BASE + 2*TOTAL can be written to in random access */
/* fashion using DASUDI. */
i__1 = total << 1;
for (i__ = 1; i__ <= i__1; ++i__) {
dasadi_(&scrhan, &c__1, &c__0);
}
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* We note that the way to construct the inverse of a permutation */
/* SIGMA in a single loop is suggested by the relation */
/* -1 */
/* SIGMA ( SIGMA(I) ) = I */
/* We'll use this method. In our case, our order vector plays */
/* the role of */
/* -1 */
/* SIGMA */
/* and the `inverse order vector' plays the role of SIGMA. We'll */
/* exclude the first directory from the order vector, since it's */
/* an exception: we wish to reserve this record. Since the first */
/* element of the order vector (logically) contains the index 1, we */
/* can ignore it. */
i__1 = total;
for (i__ = 2; i__ <= i__1; ++i__) {
i__2 = (i__ << 1) - 1;
i__3 = (i__ << 1) - 1;
dasrdi_(&scrhan, &i__2, &i__3, &type__);
i__2 = i__ << 1;
i__3 = i__ << 1;
dasrdi_(&scrhan, &i__2, &i__3, &dest);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Set DEST to the destination location, measured as an offset */
/* from the last comment record, of the Ith record by adding */
/* on the count of the predecessors of the block of records of */
/* TYPE. */
for (j = 1; j <= 3; ++j) {
if (type__ > j) {
dest += count[(i__2 = j - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge(
"count", i__2, "dassdr_", (ftnlen)648)];
}
}
/* The destination offset of each record should be incremented to */
/* allow room for the first directory record. However, we don't */
/* need to do this for directory records; they'll already have */
/* this offset accounted for. */
if (type__ != 4) {
++dest;
}
/* The value of element DEST of the order vector is I. */
/* Write this value to location BASE + DEST. */
i__2 = base + dest;
i__3 = base + dest;
dasudi_(&scrhan, &i__2, &i__3, &i__);
/* We want the ith element of the order vector to give us the */
/* number of the record to move to position i (offset from the */
/* last comment record), but we want the corresponding element */
/* of the type array to give us the type of the record currently */
/* occupying position i. */
i__2 = base + i__ + total;
i__3 = base + i__ + total;
dasudi_(&scrhan, &i__2, &i__3, &type__);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* Ok, here's what we've got in the scratch file that's still of */
/* interest: */
/* -- In integer logical addresses BASE + 1 : BASE + TOTAL, */
/* we have an order vector. The Ith element of this */
/* vector indicates the record that should be moved to */
/* location DRBASE + I in the DAS file we're re-ordering, */
/* where DRBASE is the base address of the data records */
/* (the first directory record follows the record having this */
/* index). */
/* -- In integer logical addresses BASE + TOTAL + 1 : BASE + */
/* 2*TOTAL, we have data type indicators for the records to */
/* be re-ordered. The type for the Ith record in the file, */
/* counted from the last comment record, is located in logical */
/* address BASE + TOTAL + I. */
drbase = nresvr + ncomr + 1;
/* As we traverse the order vector, we flip the sign of elements */
/* we've accessed, so that we can tell when we encounter an element */
/* of a cycle that we've already traversed. */
/* Traverse the order vector. The variable START indicates the */
/* first element to look at. Ignore the first element; it's a */
/* singleton cycle. */
start = 2;
while(start < total) {
/* Traverse the current cycle of the order vector. */
/* We `make a hole' in the file by saving the record in position */
/* START, then we traverse the cycle in reverse order, filling in */
/* the hole at the ith position with the record whose number is */
/* the ith element of the order vector. At the end, we deposit */
/* the saved record into the `hole' left behind by the last */
/* record we moved. */
/* We're going to read and write records to and from the DAS file */
/* directly, rather than going through the buffering system. */
/* This will allow us to avoid any untoward interactions between */
/* the buffers for different data types. */
i__1 = base + total + start;
i__2 = base + total + start;
dasrdi_(&scrhan, &i__1, &i__2, &savtyp);
i__1 = base + start;
i__2 = base + start;
dasrdi_(&scrhan, &i__1, &i__2, &offset);
/* Save the record at the location DRBASE + START. */
if (savtyp == 1) {
i__1 = drbase + start;
dasioc_("READ", &unit, &i__1, savec, (ftnlen)4, (ftnlen)1024);
} else if (savtyp == 2) {
i__1 = drbase + start;
dasiod_("READ", &unit, &i__1, saved, (ftnlen)4);
} else {
i__1 = drbase + start;
dasioi_("READ", &unit, &i__1, savei, (ftnlen)4);
}
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Let I be the index of the record that we are going to move */
/* data into next. I is an offset from the last comment record. */
i__ = start;
while(offset != start) {
/* Mark the order vector element by writing its negative */
/* back to the location it came from. */
i__1 = base + i__;
i__2 = base + i__;
i__3 = -offset;
dasudi_(&scrhan, &i__1, &i__2, &i__3);
/* Move the record at location */
/* DRBASE + OFFSET */
/* to location */
/* DRBASE + I */
/* There is no need to do anything about the corresponding */
/* elements of the type vector; we won't need them again. */
/* The read and write operations, as well as the temporary */
/* record required to perform the move, are dependent on the */
/* data type of the record to be moved. */
i__1 = base + total + offset;
i__2 = base + total + offset;
dasrdi_(&scrhan, &i__1, &i__2, &type__);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Only pick records up if we're going to put them down in */
/* a location other than their original one. */
if (i__ != offset) {
if (type__ == 1) {
i__1 = drbase + offset;
dasioc_("READ", &unit, &i__1, crec, (ftnlen)4, (ftnlen)
1024);
i__1 = drbase + i__;
dasioc_("WRITE", &unit, &i__1, crec, (ftnlen)5, (ftnlen)
1024);
} else if (type__ == 2) {
i__1 = drbase + offset;
dasiod_("READ", &unit, &i__1, drec, (ftnlen)4);
i__1 = drbase + i__;
dasiod_("WRITE", &unit, &i__1, drec, (ftnlen)5);
} else {
i__1 = drbase + offset;
dasioi_("READ", &unit, &i__1, irec, (ftnlen)4);
i__1 = drbase + i__;
dasioi_("WRITE", &unit, &i__1, irec, (ftnlen)5);
}
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* OFFSET is the index of the next order vector element to */
/* look at. */
i__ = offset;
i__1 = base + i__;
i__2 = base + i__;
dasrdi_(&scrhan, &i__1, &i__2, &offset);
i__1 = base + i__ + total;
i__2 = base + i__ + total;
dasrdi_(&scrhan, &i__1, &i__2, &type__);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* The last value of I is the location in the cycle that element */
/* START followed. Therefore, the saved record corresponding */
/* to index START should be written to this location. */
if (savtyp == 1) {
i__1 = drbase + i__;
dasioc_("WRITE", &unit, &i__1, savec, (ftnlen)5, (ftnlen)1024);
} else if (savtyp == 2) {
i__1 = drbase + i__;
dasiod_("WRITE", &unit, &i__1, saved, (ftnlen)5);
} else {
i__1 = drbase + i__;
dasioi_("WRITE", &unit, &i__1, savei, (ftnlen)5);
}
/* Mark the order vector element by writing its negative */
/* back to the location it came from. */
i__1 = base + i__;
i__2 = base + i__;
i__3 = -start;
dasudi_(&scrhan, &i__1, &i__2, &i__3);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Update START so that it points to the first element of a cycle */
/* of the order vector that has not yet been traversed. This will */
/* be the first positive element of the order vector in a location */
/* indexed higher than the current value of START. Note that */
/* this way of updating START guarantees that we don't have to */
/* backtrack to find an element in the next cycle. */
offset = -1;
while(offset < 0 && start < total) {
++start;
i__1 = base + start;
i__2 = base + start;
dasrdi_(&scrhan, &i__1, &i__2, &offset);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* At this point, START is the index of an element in the order */
/* vector that belongs to a cycle where no routine has gone */
/* before, or else START is the last index in the order vector, */
/* in which case we're done. */
}
/* At this point, the records in the DAS are organized as follows: */
/* +----------------------------------+ */
/* | File record | ( 1 ) */
/* +----------------------------------+ */
/* | Reserved records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Comment records | ( 0 or more ) */
/* | | */
/* | | */
/* +----------------------------------+ */
/* | First directory record | ( 1 ) */
/* +----------------------------------+ */
/* | Character data records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Double precision data records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Integer data records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Additional directory records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* Not all of the indicated components must be present; only the */
/* file record and first directory record will exist in all cases. */
/* The `additional directory records' at the end of the file serve */
/* no purpose; if more data is appended to the file, they will be */
/* overwritten. */
/* The last step in preparing the file is to fill in the first */
/* directory record with the correct information, and to update */
/* the file summary. */
recno = drbase + 1;
cleari_(&c__256, irec);
/* Set the logical address ranges in the directory record, for each */
/* data type. */
for (type__ = 1; type__ <= 3; ++type__) {
maxadr = lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastla", i__1, "dassdr_", (ftnlen)957)];
if (maxadr > 0) {
minadr = 1;
} else {
minadr = 0;
}
irec[(i__1 = type__ << 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("irec",
i__1, "dassdr_", (ftnlen)965)] = minadr;
irec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)966)] = maxadr;
}
/* Set the descriptors in the directory. Determine which type */
/* comes first: the order of priority is character, double */
/* precision, integer. */
pos = 9;
for (type__ = 1; type__ <= 3; ++type__) {
if (lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("las"
"tla", i__1, "dassdr_", (ftnlen)979)] > 0) {
if (pos == 9) {
/* This is the first type for which any data is present. */
/* We must enter a type code at position BEGDSC in the */
/* directory, and we must enter a count at position */
/* BEGDSC+1. */
irec[8] = type__;
irec[9] = count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 :
s_rnge("count", i__1, "dassdr_", (ftnlen)989)];
lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastrc", i__1, "dassdr_", (ftnlen)990)] = recno;
lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastwd", i__1, "dassdr_", (ftnlen)991)] = 10;
pos += 2;
prvtyp = type__;
} else {
/* Place an appropriately signed count at location POS in */
/* the directory. */
if (type__ == next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ?
i__1 : s_rnge("next", i__1, "dassdr_", (ftnlen)1000)])
{
irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)1001)] = count[(
i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 :
s_rnge("count", i__2, "dassdr_", (ftnlen)1001)];
} else {
irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)1003)] = -count[(
i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 :
s_rnge("count", i__2, "dassdr_", (ftnlen)1003)];
}
lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastrc", i__1, "dassdr_", (ftnlen)1006)] = recno;
lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastwd", i__1, "dassdr_", (ftnlen)1007)] = pos;
++pos;
prvtyp = type__;
}
}
}
/* Since we've done away with all but the first directory, the first */
/* free record is decremented by 1 less than the directory count. */
free = free - count[3] + 1;
/* Write out the new directory record. Don't use the DAS buffered */
/* write mechanism; this could trash the file by dumping buffered */
/* records in the wrong places. */
dasioi_("WRITE", &unit, &recno, irec, (ftnlen)5);
/* Write out the updated file summary. */
dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
/* Clean up the DAS data buffers: we don't want buffered scratch */
/* file records hanging around there. Then get rid of the scratch */
/* file. */
daswbr_(&scrhan);
dasllc_(&scrhan);
chkout_("DASSDR", (ftnlen)6);
return 0;
} /* dassdr_ */
/* $Procedure ZZEKTRLK ( EK tree, locate key ) */
/* Subroutine */ int zzektrlk_(integer *handle, integer *tree, integer *key,
integer *idx, integer *node, integer *noffst, integer *level, integer
*value)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
static logical leaf;
static integer page[256], prev, unit, plus;
extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *);
static integer child;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static integer depth;
static logical found;
static integer minus;
static char access[15];
static integer datbas, oldhan;
extern /* Subroutine */ int dasham_(integer *, char *, ftnlen);
static integer oldidx, oldmax, oldnod, oldnof, oldtre, oldkey, oldval;
extern integer lstlei_(integer *, integer *, integer *);
static integer oldlvl, newkey, prvkey, totkey;
static logical samkey, samtre, rdonly;
extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
/* $ Abstract */
/* Locate a specified key. Return metadata describing the node */
/* containing the key. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Das Paging Parameters */
/* ekpage.inc Version 4 25-AUG-1995 (NJB) */
/* The EK DAS paging system makes use of the integer portion */
/* of an EK file's DAS address space to store the few numbers */
/* required to describe the system's state. The allocation */
/* of DAS integer addresses is shown below. */
/* DAS integer array */
/* +--------------------------------------------+ */
/* | EK architecture code | Address = 1 */
/* +--------------------------------------------+ */
/* | Character page size (in DAS words) | */
/* +--------------------------------------------+ */
/* | Character page base address | */
/* +--------------------------------------------+ */
/* | Number of character pages in file | */
/* +--------------------------------------------+ */
/* | Number of character pages on free list | */
/* +--------------------------------------------+ */
/* | Character free list head pointer | Address = 6 */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for d.p. pages | 7--11 */
/* | | */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for integer pages | 12--16 */
/* | | */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | End Address = */
/* | Unused space | integer page */
/* | | end */
/* +--------------------------------------------+ */
/* | | Start Address = */
/* | First integer page | integer page */
/* | | base */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | */
/* | Last integer page | */
/* | | */
/* +--------------------------------------------+ */
/* The following parameters indicate positions of elements in the */
/* paging system metadata array: */
/* Number of metadata items per data type: */
/* Character metadata indices: */
/* Double precision metadata indices: */
/* Integer metadata indices: */
/* Size of metadata area: */
/* Page sizes, in units of DAS words of the appropriate type: */
/* Default page base addresses: */
/* End Include Section: EK Das Paging Parameters */
/* $ 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. */
/* Include Section: EK Tree Parameters */
/* ektree.inc Version 3 22-OCT-1995 (NJB) */
/* The parameters in this file define the tree structure */
/* used by the EK system. This structure is a variant of the */
/* B*-tree structure described in Knuth's book, that is */
/* Knuth, Donald E. "The Art of Computer Programming, */
/* Volume 3/Sorting and Searching" 1973, pp 471-479. */
/* The trees used in the EK system differ from generic B*-trees */
/* primarily in the way keys are treated. Rather than storing */
/* unique primary key values in each node, EK trees store integer */
/* counts that represent the ordinal position of each data value, */
/* counting from the lowest indexed element in the subtree whose */
/* root is the node in question. Thus the keys are unique within */
/* a node but not across multiple nodes: in fact the Nth key in */
/* every leaf node is N. The absolute ordinal position of a data */
/* item is defined recursively as the sum of the key of the data item */
/* and the absolute ordinal position of the data item in the parent */
/* node that immediately precedes all elements of the node in */
/* question. This data structure allows EK trees to support lookup */
/* of data items based on their ordinal position in a data set. The */
/* two prime applications of this capability in the EK system are: */
/* 1) Using trees to index the records in a table, allowing */
/* the Nth record to be located efficiently. */
/* 2) Using trees to implement order vectors that can be */
/* maintained when insertions and deletions are done. */
/* Root node */
/* +--------------------------------------------+ */
/* | Tree version code | */
/* +--------------------------------------------+ */
/* | Number of nodes in tree | */
/* +--------------------------------------------+ */
/* | Number of keys in tree | */
/* +--------------------------------------------+ */
/* | Depth of tree | */
/* +--------------------------------------------+ */
/* | Number of keys in root | */
/* +--------------------------------------------+ */
/* | Space for n keys, | */
/* | | */
/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */
/* | | */
/* | where m is the max number of children per | */
/* | node in the child nodes | */
/* +--------------------------------------------+ */
/* | Space for n+1 child pointers, | */
/* | where n is as defined above. | */
/* +--------------------------------------------+ */
/* | Space for n data pointers, | */
/* | where n is as defined above. | */
/* +--------------------------------------------+ */
/* Child node */
/* +--------------------------------------------+ */
/* | Number of keys present in node | */
/* +--------------------------------------------+ */
/* | Space for m-1 keys | */
/* +--------------------------------------------+ */
/* | Space for m child pointers | */
/* +--------------------------------------------+ */
/* | Space for m-1 data pointers | */
/* +--------------------------------------------+ */
/* The following parameters give the maximum number of children */
/* allowed in the root and child nodes. During insertions, the */
/* number of children may overflow by 1. */
/* Maximum number of children allowed in a child node: */
/* Maximum number of keys allowed in a child node: */
/* Minimum number of children allowed in a child node: */
/* Minimum number of keys allowed in a child node: */
/* Maximum number of children allowed in the root node: */
/* Maximum number of keys allowed in the root node: */
/* Minimum number of children allowed in the root node: */
/* The following parameters indicate positions of elements in the */
/* tree node structures shown above. */
/* The following parameters are for the root node only: */
/* Location of version code: */
/* Version code: */
/* Location of node count: */
/* Location of total key count for the tree: */
/* Location of tree depth: */
/* Location of count of keys in root node: */
/* Base address of keys in the root node: */
/* Base address of child pointers in root node: */
/* Base address of data pointers in the root node (allow room for */
/* overflow): */
/* Size of root node: */
/* The following parameters are for child nodes only: */
/* Location of number of keys in node: */
/* Base address of keys in child nodes: */
/* Base address of child pointers in child nodes: */
/* Base address of data pointers in child nodes (allow room */
/* for overflow): */
/* Size of child node: */
/* A number of EK tree routines must declare stacks of fixed */
/* depth; this depth limit imposes a limit on the maximum depth */
/* that an EK tree can have. Because of the large branching */
/* factor of EK trees, the depth limit is of no practical */
/* importance: The number of keys that can be held in an EK */
/* tree of depth N is */
/* N-1 */
/* MXKIDC - 1 */
/* MXKIDR * ------------- */
/* MXKIDC - 1 */
/* This formula yields a capacity of over 1 billion keys for a */
/* tree of depth 6. */
/* End Include Section: EK Tree Parameters */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* TREE I Root of tree. */
/* KEY I Key corresponding to value. */
/* IDX O Node-relative index of KEY. */
/* NODE O Node containing key. */
/* NOFFST O Offset of NODE. */
/* LEVEL O Level of NODE. */
/* VALUE O Value associated with KEY. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for write access. */
/* TREE is the root node number of the tree of interest. */
/* KEY is an absolute key. In EK trees, absolute keys are */
/* just ordinal positions relative to the leftmost */
/* element of the tree, with the leftmost element */
/* having position 1. So setting KEY to 10, for */
/* example, indicates that the output VALUE is the */
/* 10th item in the tree. */
/* KEY must be in the range 1 : NKEYS, where */
/* NKEYS is the number of keys in the tree. */
/* $ Detailed_Output */
/* IDX is the node-relative index of KEY: this is the */
/* ordinal position of KEY relative to other keys */
/* in the same node. */
/* NODE is the number of the node containing KEY. */
/* NOFFST is the offset of NODE. This is the count of the */
/* keys that precede every key in the subtree headed */
/* by NODE. Adding NOFFST to any relative key stored */
/* in NODE will convert that key to an absolute key. */
/* LEVEL is the level of NODE in the tree. The root is at */
/* level 1, children of the root are at level 2, and */
/* so on. */
/* VALUE is the integer value associated with the input key. */
/* Normally, this value is a data pointer. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. The file will not be modified. */
/* 2) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* 3) If the input key is out of range, the error */
/* SPICE(INDEXOUTOFRANGE) is signalled. */
/* 4) If the tree traversal fails to terminate at the leaf node */
/* level, the error SPICE(BUG) is signalled. */
/* 5) If the key is in range, but the key is not found, the error */
/* SPICE(BUG) is signalled. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine obtains the value assocated with a key, and also */
/* returns metadata describing the node containing the key and the */
/* key's position in the node. */
/* $ Examples */
/* See ZZEKTRUI. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */
/* 3/Sorting and Searching" 1973, pp 471-479. */
/* EK trees are closely related to the B* trees described by */
/* Knuth. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Use discovery check-in in this puppy. */
/* Nothing found to begin with. */
found = FALSE_;
if (first) {
/* Find out the access method for the current file. */
dasham_(handle, access, (ftnlen)15);
rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0;
samkey = FALSE_;
samtre = FALSE_;
leaf = FALSE_;
first = FALSE_;
} else {
/* See whether we're looking at the same key, or at least */
/* the same tree, as last time. Note that for the tree to */
/* be guaranteed to be the same, it must belong to a file open */
/* for read access only. */
if (*handle != oldhan) {
dasham_(handle, access, (ftnlen)15);
rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0;
samtre = FALSE_;
samkey = FALSE_;
} else {
samtre = *tree == oldtre && rdonly;
samkey = *key == oldkey && samtre;
}
}
/* If we're lucky enough to be getting a request for the previously */
/* returned key, we're set. If we've been asked for a key that is */
/* very close to the previously requested key, we still may make */
/* out pretty well. */
if (samkey) {
/* It's the same key as last time. */
*idx = oldidx;
*node = oldnod;
*noffst = oldnof;
*level = oldlvl;
*value = oldval;
return 0;
} else if (samtre && leaf) {
/* Compute the margins around the old key. Keys that fall within */
/* the interval defined by the old key and these margins are on */
/* the same page as the old key. */
plus = oldmax - oldidx;
minus = oldidx - 1;
if (*key <= oldkey + plus && *key >= oldkey - minus) {
/* The requested key lies on the same page as the old key. */
*level = oldlvl;
if (*level == 1) {
datbas = 172;
} else {
datbas = 128;
}
*idx = oldidx + (*key - oldkey);
*node = oldnod;
*noffst = oldnof;
*value = page[(i__1 = datbas + *idx - 1) < 256 && 0 <= i__1 ?
i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)315)];
oldidx = *idx;
oldkey = *key;
oldval = *value;
return 0;
}
}
/* If we arrived here, we have some actual work to do. */
/* Start out by looking at the root page. Save the tree depth; */
/* we'll use this for error checking. */
zzekpgri_(handle, tree, page);
depth = page[3];
*level = 1;
/* Find out how many keys are in the tree. If KEY is outside */
/* this range, we won't find it. */
totkey = page[2];
if (*key < 1 || *key > totkey) {
chkin_("ZZEKTRLK", (ftnlen)8);
dashlu_(handle, &unit);
setmsg_("Key = #; valid range = 1:#. Tree = #, file = #", (ftnlen)46);
errint_("#", key, (ftnlen)1);
errint_("#", &totkey, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22);
chkout_("ZZEKTRLK", (ftnlen)8);
return 0;
}
/* Find the last key at this level that is less than or equal to */
/* the requested key. */
prev = lstlei_(key, &page[4], &page[5]);
if (prev > 0) {
prvkey = page[(i__1 = prev + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"page", i__1, "zzektrlk_", (ftnlen)365)];
} else {
prvkey = 0;
}
/* If we were lucky enough to get an exact match, set our outputs */
/* and return. The key offset in the root is zero. */
if (prvkey == *key) {
*noffst = 0;
*idx = prev;
*node = *tree;
*value = page[(i__1 = *idx + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"page", i__1, "zzektrlk_", (ftnlen)379)];
oldhan = *handle;
oldtre = *tree;
oldkey = *key;
oldnof = *noffst;
oldnod = *node;
oldidx = *idx;
oldlvl = *level;
oldval = *value;
oldmax = page[4];
leaf = *level == depth;
/* The root has no parent or siblings, so these values */
/* remain set to zero. The same is true of the parent keys. */
return 0;
}
/* Still here? Traverse the pointer path until we find the key */
/* or run out of progeny. */
child = page[(i__1 = prev + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge("page",
i__1, "zzektrlk_", (ftnlen)405)];
*noffst = prvkey;
while(child > 0 && ! found) {
/* Look up the child node. */
zzekpgri_(handle, &child, page);
++(*level);
if (*level > depth) {
chkin_("ZZEKTRLK", (ftnlen)8);
dashlu_(handle, &unit);
setmsg_("Runaway node pointer chain. Key = #; valid range = 1:#"
". Tree = #, file = #", (ftnlen)75);
errint_("#", key, (ftnlen)1);
errint_("#", &totkey, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKTRLK", (ftnlen)8);
return 0;
}
/* Find the last key at this level that is less than or equal to */
/* the requested key. Since the keys we're looking at now are */
/* ordinal positions relative to the subtree whose root is the */
/* current node, we must subtract from KEY the position of the */
/* node preceding the first key of this subtree. */
newkey = *key - *noffst;
prev = lstlei_(&newkey, page, &page[1]);
if (prev > 0) {
prvkey = page[(i__1 = prev) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"page", i__1, "zzektrlk_", (ftnlen)445)];
} else {
prvkey = 0;
}
/* If we were lucky enough to get an exact match, set our outputs */
/* and return. The key offset for the current node is stored */
/* in NOFFST. */
if (prvkey == newkey) {
found = TRUE_;
*idx = prev;
*node = child;
*value = page[(i__1 = *idx + 127) < 256 && 0 <= i__1 ? i__1 :
s_rnge("page", i__1, "zzektrlk_", (ftnlen)460)];
oldhan = *handle;
oldtre = *tree;
oldkey = *key;
oldnof = *noffst;
oldnod = *node;
oldidx = *idx;
oldlvl = *level;
oldval = *value;
oldmax = page[0];
leaf = *level == depth;
} else {
child = page[(i__1 = prev + 64) < 256 && 0 <= i__1 ? i__1 :
s_rnge("page", i__1, "zzektrlk_", (ftnlen)476)];
*noffst = prvkey + *noffst;
}
}
/* If we found the key, our outputs are already set. If not, we've */
/* got trouble. */
if (! found) {
chkin_("ZZEKTRLK", (ftnlen)8);
dashlu_(handle, &unit);
setmsg_("Key #; valid range = 1:#. Tree = #, file = #. Key was not "
"found. This probably indicates a corrupted file or a bug in"
" the EK code.", (ftnlen)132);
errint_("#", key, (ftnlen)1);
errint_("#", &totkey, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKTRLK", (ftnlen)8);
return 0;
}
return 0;
} /* zzektrlk_ */
/* $Procedure ZZEKCDSC ( Private: EK, return column descriptor ) */
/* Subroutine */ int zzekcdsc_(integer *handle, integer *segdsc, char *column,
integer *coldsc, ftnlen column_len)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer unit, i__;
char cname[32];
integer mbase;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
integer ncols;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
integer dscbas;
extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *,
integer *, integer *, char *, ftnlen);
integer nambas;
extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *,
integer *), dashlu_(integer *, integer *), setmsg_(char *, ftnlen)
, errint_(char *, integer *, ftnlen), errfnm_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen);
/* $ 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. */
/* Look up the column descriptor for a column of a given name */
/* in a specified segment. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Column Name Size */
/* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */
/* Size of column name, in characters. */
/* End Include Section: EK Column Name Size */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle attached to an EK file. */
/* SEGDSC I Segment descriptor. */
/* COLUMN I Name of column. */
/* COLDSC O Descriptor for specified column. */
/* $ Detailed_Input */
/* HANDLE is an EK file handle for the file containing the */
/* column of interest. The EK may be open for read */
/* or write access. */
/* SEGDSC is the descriptor of the segment containing the */
/* column for which a descriptor is desired. */
/* COLUMN is the name of the column whose descriptor is */
/* desired. Case and white space are not significant. */
/* $ Detailed_Output */
/* COLDSC is the descriptor of the column belonging to the */
/* specified file and segment and having name COLUMN. */
/* See the include file ekcoldsc.inc for details */
/* regarding the structure of EK column descriptors. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input column name does not match any column in the */
/* designated segment, the error SPICE(BUG) is signalled. It */
/* is the caller's responsibility to call this routine with */
/* valid input arguments. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine exists for the sole purpose of centralizing code */
/* used to perform column descriptor look-ups. */
/* $ Examples */
/* See the EKACEx routines. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
/* Get the segment's integer metadata's base address. */
mbase = segdsc[2];
/* Get the number of columns. */
ncols = segdsc[4];
/* Search linearly through the column descriptors, looking for */
/* a column name match. It's an error if we don't find the input */
/* name. */
found = FALSE_;
i__ = 1;
while(i__ <= ncols && ! found) {
dscbas = mbase + 24 + (i__ - 1) * 11;
/* Get the character base address of the column name from the */
/* current descriptor. */
i__1 = dscbas + 1;
i__2 = dscbas + 11;
dasrdi_(handle, &i__1, &i__2, coldsc);
nambas = coldsc[4];
/* Look up the name and compare. */
i__1 = nambas + 1;
i__2 = nambas + 32;
dasrdc_(handle, &i__1, &i__2, &c__1, &c__32, cname, (ftnlen)32);
if (eqstr_(cname, column, (ftnlen)32, column_len)) {
found = TRUE_;
} else {
++i__;
}
}
if (! found) {
dashlu_(handle, &unit);
chkin_("ZZEKCDSC", (ftnlen)8);
setmsg_("Descriptor for column # was not found. Segment base = #; fi"
"le = #.", (ftnlen)66);
errch_("#", column, (ftnlen)1, column_len);
errint_("#", &mbase, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKCDSC", (ftnlen)8);
return 0;
}
return 0;
} /* zzekcdsc_ */
/* $Procedure ZZEKVMCH ( EK, vector match ) */
logical zzekvmch_(integer *ncnstr, logical *active, integer *lhans, integer *
lsdscs, integer *lcdscs, integer *lrows, integer *lelts, integer *ops,
integer *rhans, integer *rsdscs, integer *rcdscs, integer *rrows,
integer *relts)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
logical ret_val;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
char cval[1024*2];
integer hans[2], elts[2];
logical null[2];
integer unit, rows[2];
extern integer zzekecmp_(integer *, integer *, integer *, integer *,
integer *);
integer i__, n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer cvlen[2];
logical found;
extern /* Subroutine */ int movei_(integer *, integer *, integer *);
extern logical matchi_(char *, char *, char *, char *, ftnlen, ftnlen,
ftnlen, ftnlen);
integer cldscs[22] /* was [11][2] */, cmplen[2], sgdscs[48] /*
was [24][2] */;
extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *,
ftnlen), errfnm_(char *, integer *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer rel;
extern /* Subroutine */ int zzekrsc_(integer *, integer *, integer *,
integer *, integer *, integer *, char *, logical *, logical *,
ftnlen);
/* $ Abstract */
/* Determine whether a vector of constraints involving comparisons of */
/* specified EK column elements is satisfied. */
/* $ 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 */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ 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. */
/* Include Section: EK Boolean Enumerated Type */
/* ekbool.inc Version 1 21-DEC-1994 (NJB) */
/* Within the EK system, boolean values sometimes must be */
/* represented by integer or character codes. The codes and their */
/* meanings are listed below. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* Character code indicating `true': */
/* Character code indicating `false': */
/* End Include Section: EK Boolean Enumerated Type */
/* $ 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. */
/* Include Section: EK Operator Codes */
/* ekopcd.inc Version 1 30-DEC-1994 (NJB) */
/* Within the EK system, operators used in EK queries are */
/* represented by integer codes. The codes and their meanings are */
/* listed below. */
/* Relational expressions in EK queries have the form */
/* <column name> <operator> <value> */
/* For columns containing numeric values, the operators */
/* EQ, GE, GT, LE, LT, NE */
/* may be used; these operators have the same meanings as their */
/* Fortran counterparts. For columns containing character values, */
/* the list of allowed operators includes those in the above list, */
/* and in addition includes the operators */
/* LIKE, UNLIKE */
/* which are used to compare strings to a template. In the character */
/* case, the meanings of the parameters */
/* GE, GT, LE, LT */
/* match those of the Fortran lexical functions */
/* LGE, LGT, LLE, LLT */
/* The additional unary operators */
/* ISNULL, NOTNUL */
/* are used to test whether a value of any type is null. */
/* End Include Section: EK Operator Codes */
/* $ 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. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ 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. */
/* Include Section: EK Column Descriptor Parameters */
/* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */
/* Note: The column descriptor size parameter CDSCSZ is */
/* declared separately in the include section CDSIZE$INC.FOR. */
/* Offset of column descriptors, relative to start of segment */
/* integer address range. This number, when added to the last */
/* integer address preceding the segment, yields the DAS integer */
/* base address of the first column descriptor. Currently, this */
/* offset is exactly the size of a segment descriptor. The */
/* parameter SDSCSZ, which defines the size of a segment descriptor, */
/* is declared in the include file eksegdsc.inc. */
/* Size of column descriptor */
/* Indices of various pieces of column descriptors: */
/* CLSIDX is the index of the column's class code. (We use the */
/* word `class' to distinguish this item from the column's data */
/* type.) */
/* TYPIDX is the index of the column's data type code (CHR, INT, DP, */
/* or TIME). The type is actually implied by the class, but it */
/* will frequently be convenient to look up the type directly. */
/* LENIDX is the index of the column's string length value, if the */
/* column has character type. A value of IFALSE in this element of */
/* the descriptor indicates that the strings have variable length. */
/* SIZIDX is the index of the column's element size value. This */
/* descriptor element is meaningful for columns with fixed-size */
/* entries. For variable-sized columns, this value is IFALSE. */
/* NAMIDX is the index of the base address of the column's name. */
/* IXTIDX is the data type of the column's index. IXTIDX */
/* contains a type value only if the column is indexed. For columns */
/* that are not indexed, the location IXTIDX contains the boolean */
/* value IFALSE. */
/* IXPIDX is a pointer to the column's index. IXTPDX contains a */
/* meaningful value only if the column is indexed. The */
/* interpretation of the pointer depends on the data type of the */
/* index. */
/* NFLIDX is the index of a flag indicating whether nulls are */
/* permitted in the column. The value at location NFLIDX is */
/* ITRUE if nulls are permitted and IFALSE otherwise. */
/* ORDIDX is the index of the column's ordinal position in the */
/* list of columns belonging to the column's parent segment. */
/* METIDX is the index of the column's integer metadata pointer. */
/* This pointer is a DAS integer address. */
/* The last position in the column descriptor is reserved. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Column Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Segment Descriptor Parameters */
/* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */
/* All `base addresses' referred to below are the addresses */
/* *preceding* the item the base applies to. This convention */
/* enables simplied address calculations in many cases. */
/* Size of segment descriptor. Note: the include file ekcoldsc.inc */
/* must be updated if this parameter is changed. The parameter */
/* CDOFF in that file should be kept equal to SDSCSZ. */
/* Index of the segment type code: */
/* Index of the segment's number. This number is the segment's */
/* index in the list of segments contained in the EK to which */
/* the segment belongs. */
/* Index of the DAS integer base address of the segment's integer */
/* meta-data: */
/* Index of the DAS character base address of the table name: */
/* Index of the segment's column count: */
/* Index of the segment's record count: */
/* Index of the root page number of the record tree: */
/* Index of the root page number of the character data page tree: */
/* Index of the root page number of the double precision data page */
/* tree: */
/* Index of the root page number of the integer data page tree: */
/* Index of the `modified' flag: */
/* Index of the `initialized' flag: */
/* Index of the shadowing flag: */
/* Index of the companion file handle: */
/* Index of the companion segment number: */
/* The next three items are, respectively, the page numbers of the */
/* last character, d.p., and integer data pages allocated by the */
/* segment: */
/* The next three items are, respectively, the page-relative */
/* indices of the last DAS word in use in the segment's */
/* last character, d.p., and integer data pages: */
/* Index of the DAS character base address of the column name list: */
/* The last descriptor element is reserved for future use. No */
/* parameter is defined to point to this location. */
/* End Include Section: EK Segment Descriptor Parameters */
/* $ 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. */
/* Include Section: EK Template Matching Wild Characters */
/* ekwild.inc Version 1 16-JAN-1995 (NJB) */
/* Within the EK system, templates used for pattern matching */
/* are those accepted by the SPICELIB routine MATCHW. MATCHW */
/* accepts two special characters: one representing wild */
/* strings and one representing wild characters. This include */
/* file defines those special characters for use within the EK */
/* system. */
/* Wild string symbol: this character matches any string. */
/* Wild character symbol: this character matches any character. */
/* End Include Section: EK Template Matching Wild Characters */
/* $ 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. */
/* Include Section: EK Query Limit Parameters */
/* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */
/* Parameter MAXCON increased to 1000. */
/* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */
/* Updated to support SELECT clause. */
/* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */
/* These limits apply to character string queries input to the */
/* EK scanner. This limits are part of the EK system's user */
/* interface: the values should be advertised in the EK required */
/* reading document. */
/* Maximum length of an input query: MAXQRY. This value is */
/* currently set to twenty-five 80-character lines. */
/* Maximum number of columns that may be listed in the */
/* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */
/* Maximum number of tables that may be listed in the `FROM */
/* clause' of a query: MAXTAB. */
/* Maximum number of relational expressions that may be listed */
/* in the `constraint clause' of a query: MAXCON. */
/* This limit applies to a query when it is represented in */
/* `normalized form': that is, the constraints have been */
/* expressed as a disjunction of conjunctions of relational */
/* expressions. The number of relational expressions in a query */
/* that has been expanded in this fashion may be greater than */
/* the number of relations in the query as orginally written. */
/* For example, the expression */
/* ( ( A LT 1 ) OR ( B GT 2 ) ) */
/* AND */
/* ( ( C NE 3 ) OR ( D EQ 4 ) ) */
/* which contains 4 relational expressions, expands to the */
/* equivalent normalized constraint */
/* ( ( A LT 1 ) AND ( C NE 3 ) ) */
/* OR */
/* ( ( A LT 1 ) AND ( D EQ 4 ) ) */
/* OR */
/* ( ( B GT 2 ) AND ( C NE 3 ) ) */
/* OR */
/* ( ( B GT 2 ) AND ( D EQ 4 ) ) */
/* which contains eight relational expressions. */
/* MXJOIN is the maximum number of tables that can be joined. */
/* MXJCON is the maximum number of join constraints allowed. */
/* Maximum number of order-by columns that may be used in the */
/* `order-by clause' of a query: MAXORD. MAXORD = 10. */
/* Maximum number of tokens in a query: 500. Tokens are reserved */
/* words, column names, parentheses, and values. Literal strings */
/* and time values count as single tokens. */
/* Maximum number of numeric tokens in a query: */
/* Maximum total length of character tokens in a query: */
/* Maximum length of literal string values allowed in queries: */
/* MAXSTR. */
/* End Include Section: EK Query Limit Parameters */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* NCNSTR I Number of join constraints. */
/* ACTIVE I Array of flags indicating applicable constraints. */
/* LHANS I Handles of EKs for columns on LHS's of constraints. */
/* LSDSCS I Descriptors of segments on LHS's of constraints. */
/* LCDSCS I Column descriptors for LHS's of constraints. */
/* LROWS I Row numbers for LHS's of constraints. */
/* LCOLS I Column names for LHS's of constraints. */
/* LELTS I Column element indices for LHS's of constraints. */
/* OPS I Code for relational operator in constraints. */
/* RHAN I Handles of EKs for columns on RHS's of constraints. */
/* RSDSCS I Descriptors of segments on RHS's of constraints. */
/* RCDSCS I Column descriptors for RHS's of constraints. */
/* RROWS I Row numbers for RHS's of constraints. */
/* RCOLS I Column names for RHS's of constraints. */
/* RELTS I Column element indices for RHS's of constraints. */
/* The function returns .TRUE. if and only if all of the relational */
/* constraints specified by the input arguments are satisfied. */
/* $ Detailed_Input */
/* NCNSTR is the number of input join constraints. Each */
/* input constraint relates two EK column entries; */
/* abstractly, the form of the constraints is: */
/* <col entry 1> <relational op> <col entry 2> */
/* The compared entries are defined by handles, */
/* segment base addresses, column descriptors, and row */
/* numbers. */
/* ACTIVE is an array of logical flags indicating which */
/* constraints are currently applicable. The Nth */
/* element of ACTIVE indicates whether or not to apply */
/* the Nth constraint: if ACTIVE(N) is .TRUE., the */
/* constraint is applicable, otherwise it isn't. */
/* The elements of the other input arguments that */
/* define constraints are defined when the */
/* corresponding element of ACTIVE is .TRUE. For */
/* example, when the second constraint is not active, */
/* the second column descriptor in LDSCRS may not be */
/* defined. */
/* LHANS is an array of EK file handles for the left-hand- */
/* sides of the constraints. */
/* LSDSCS is an array of segment descriptors for the */
/* left-hand-sides of the constraints. */
/* LDSCRS is an array of column descriptors for the */
/* left-hand-sides of the constraints. */
/* LROWS is an array of row numbers for the left-hand-sides */
/* of the constraints. */
/* LELTS is an array of column entry element indices for the */
/* left-hand-sides of the constraints. These */
/* indices are ignored unless the columns they apply */
/* to are array-valued. */
/* OPS is an array of relational operators used in the */
/* input constraints. The elements of OPS are any of */
/* the integer parameters */
/* EQ, GE, GT, LE, LT, NE, LIKE, ISNULL, NOTNUL */
/* The Ith element of OPS corresponds to the Ith */
/* constraint. */
/* RHANS is an array of EK file handles for the right-hand- */
/* sides of the constraints. */
/* RSDSCS is an array of segment descriptors for the */
/* right-hand-sides of the constraints. */
/* RDSCRS is an array of column descriptors for the */
/* right-hand-sides of the constraints. */
/* RROWS is an array of row numbers for the right-hand-sides */
/* of the constraints. */
/* RELTS is an array of column entry element indices for the */
/* right-hand-sides of the constraints. These */
/* indices are ignored unless the columns they apply */
/* to are array-valued. */
/* $ Detailed_Output */
/* The function returns .TRUE. if and only if all of the relational */
/* constraints specified by the input arguments are satisfied. */
/* $ Parameters */
/* Within the EK system, operators used in EK queries are */
/* represented by integer codes. The codes and their meanings are */
/* listed below. */
/* Relational expressions in EK queries have the form */
/* <column name> <operator> <value> */
/* For columns containing numeric values, the operators */
/* EQ, GE, GT, LE, LT, NE */
/* may be used; these operators have the same meanings as their */
/* Fortran counterparts. For columns containing character values, */
/* the list of allowed operators includes those in the above list, */
/* and in addition includes the operator */
/* LIKE */
/* which is used to compare strings to a template. In the character */
/* case, the meanings of the parameters */
/* GE, GT, LE, LT */
/* match those of the Fortran lexical functions */
/* LGE, LGT, LLE, LLT */
/* The additional unary operators */
/* ISNULL, NOTNUL */
/* are used to test whether a value of any type is null. */
/* $ Exceptions */
/* 1) If any of the input file handles is invalid, the error */
/* will be diagnosed by routines called by this routine. */
/* The function value is .FALSE. in this case. */
/* 2) If an I/O error occurs while attempting to find the address */
/* range of a column entry element, the error will */
/* be diagnosed by routines called by this routine. The */
/* function value is .FALSE. in this case. */
/* 3) If any of the input segment descriptors, column descriptors, */
/* or row numbers are invalid, this routine may fail in */
/* unpredictable, but possibly spectacular, ways. Except */
/* as described in this header section, no attempt is made to */
/* handle these errors. */
/* 4) If the data type code in an input column descriptor is not */
/* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */
/* The function value is .FALSE. in this case. */
/* 5) If a relational operator code is not recognized, the */
/* error SPICE(UNNATURALRELATION) is signalled. */
/* The function value is .FALSE. in this case. */
/* $ Files */
/* See the descriptions of the arguments LHAN and RHAN in */
/* $Detailed_Input. */
/* $ Particulars */
/* This routine is an EK utility intended to centralize a frequently */
/* performed comparison operation. */
/* $ Examples */
/* See EKSRCH. */
/* $ Restrictions */
/* 1) This routine must execute quickly. Therefore, it checks in */
/* only if it detects an error. If an error is signalled by a */
/* routine called by this routine, this routine will not appear */
/* in the SPICELIB traceback display. Also, in the interest */
/* of speed, this routine does not test the value of the SPICELIB */
/* function RETURN upon entry. */
/* 2) This routine depends on the requested comparison to have */
/* been semantically checked. Semantically invalid comparisons */
/* are treated as bugs. */
/* 3) Only the first MAXSTR characters of character strings are */
/* used in comparisons. */
/* C */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 01-JUN-2010 (NJB) */
/* Bug fix: subscript out of range error caused by */
/* column entry strings longer than MAXLEN has been */
/* corrected. Also updated Restrictions header section. */
/* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Use discovery check-in for speed. Don't check RETURN. */
/* The function value defaults to .TRUE. As we test the constraints, */
/* we may find one that the input row vector doesn't satisfy, at */
/* which point we can terminate the comparison. */
ret_val = TRUE_;
n = 1;
while(n <= *ncnstr && ret_val) {
if (active[n - 1]) {
/* Apply the Nth join constraint to the input row vector. */
/* Compare the entries in the two rows in the columns indicated */
/* by the Nth column descriptor pair. To do this, find the */
/* address ranges for each column entry. We don't check the */
/* found flag because every column entry has at least one */
/* element. */
/* We'll start out setting REL to EQ. If we find out */
/* otherwise, we'll change it. */
hans[0] = lhans[n - 1];
hans[1] = rhans[n - 1];
movei_(&lsdscs[n * 24 - 24], &c__24, sgdscs);
movei_(&rsdscs[n * 24 - 24], &c__24, &sgdscs[24]);
rows[0] = lrows[n - 1];
rows[1] = rrows[n - 1];
elts[0] = lelts[n - 1];
elts[1] = relts[n - 1];
movei_(&lcdscs[n * 11 - 11], &c__11, cldscs);
movei_(&rcdscs[n * 11 - 11], &c__11, &cldscs[11]);
rel = zzekecmp_(hans, sgdscs, cldscs, rows, elts);
/* Determine the truth of the Nth input relational expression, */
/* and set ZZEKVMCH accordingly. */
if (ops[n - 1] == 1) {
ret_val = rel == 1;
} else if (ops[n - 1] == 5) {
ret_val = rel == 5;
} else if (ops[n - 1] == 4) {
ret_val = rel != 3;
} else if (ops[n - 1] == 3) {
ret_val = rel == 3;
} else if (ops[n - 1] == 2) {
ret_val = rel != 5;
} else if (ops[n - 1] == 6) {
ret_val = rel != 1;
} else if (ops[n - 1] == 7 && cldscs[1] == 1) {
for (i__ = 1; i__ <= 2; ++i__) {
zzekrsc_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("hans", i__1, "zzekvmch_", (ftnlen)399)], &
sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= i__2 ?
i__2 : s_rnge("sgdscs", i__2, "zzekvmch_", (
ftnlen)399)], &cldscs[(i__3 = i__ * 11 - 11) < 22
&& 0 <= i__3 ? i__3 : s_rnge("cldscs", i__3,
"zzekvmch_", (ftnlen)399)], &rows[(i__4 = i__ - 1)
< 2 && 0 <= i__4 ? i__4 : s_rnge("rows", i__4,
"zzekvmch_", (ftnlen)399)], &elts[(i__5 = i__ - 1)
< 2 && 0 <= i__5 ? i__5 : s_rnge("elts", i__5,
"zzekvmch_", (ftnlen)399)], &cvlen[(i__6 = i__ -
1) < 2 && 0 <= i__6 ? i__6 : s_rnge("cvlen", i__6,
"zzekvmch_", (ftnlen)399)], cval + (((i__7 = i__
- 1) < 2 && 0 <= i__7 ? i__7 : s_rnge("cval",
i__7, "zzekvmch_", (ftnlen)399)) << 10), &null[(
i__8 = i__ - 1) < 2 && 0 <= i__8 ? i__8 : s_rnge(
"null", i__8, "zzekvmch_", (ftnlen)399)], &found,
(ftnlen)1024);
if (! found) {
dashlu_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("hans", i__1, "zzekvmch_", (
ftnlen)412)], &unit);
chkin_("ZZEKVMCH", (ftnlen)8);
setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. "
"Column entry element was not found.", (
ftnlen)79);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &cldscs[(i__1 = i__ * 11 - 3) < 22 && 0
<= i__1 ? i__1 : s_rnge("cldscs", i__1, "zze"
"kvmch_", (ftnlen)419)], (ftnlen)1);
errint_("#", &rows[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("rows", i__1, "zzekvmch_", (
ftnlen)420)], (ftnlen)1);
errint_("#", &elts[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("elts", i__1, "zzekvmch_", (
ftnlen)421)], (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKVMCH", (ftnlen)8);
return ret_val;
}
if (found && ! null[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("null", i__1, "zzekvmch_", (ftnlen)
428)]) {
/* Computing MIN */
i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2
: s_rnge("cvlen", i__2, "zzekvmch_", (ftnlen)
430)];
cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen)
430)] = min(i__3,1024);
} else {
cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen)
432)] = 0;
}
}
ret_val = matchi_(cval, cval + 1024, "*", "%", cmplen[0],
cmplen[1], (ftnlen)1, (ftnlen)1);
} else if (ops[n - 1] == 8 && cldscs[1] == 1) {
for (i__ = 1; i__ <= 2; ++i__) {
zzekrsc_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("hans", i__1, "zzekvmch_", (ftnlen)450)], &
sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= i__2 ?
i__2 : s_rnge("sgdscs", i__2, "zzekvmch_", (
ftnlen)450)], &cldscs[(i__3 = i__ * 11 - 11) < 22
&& 0 <= i__3 ? i__3 : s_rnge("cldscs", i__3,
"zzekvmch_", (ftnlen)450)], &rows[(i__4 = i__ - 1)
< 2 && 0 <= i__4 ? i__4 : s_rnge("rows", i__4,
"zzekvmch_", (ftnlen)450)], &elts[(i__5 = i__ - 1)
< 2 && 0 <= i__5 ? i__5 : s_rnge("elts", i__5,
"zzekvmch_", (ftnlen)450)], &cvlen[(i__6 = i__ -
1) < 2 && 0 <= i__6 ? i__6 : s_rnge("cvlen", i__6,
"zzekvmch_", (ftnlen)450)], cval + (((i__7 = i__
- 1) < 2 && 0 <= i__7 ? i__7 : s_rnge("cval",
i__7, "zzekvmch_", (ftnlen)450)) << 10), &null[(
i__8 = i__ - 1) < 2 && 0 <= i__8 ? i__8 : s_rnge(
"null", i__8, "zzekvmch_", (ftnlen)450)], &found,
(ftnlen)1024);
if (! found) {
dashlu_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("hans", i__1, "zzekvmch_", (
ftnlen)463)], &unit);
chkin_("ZZEKVMCH", (ftnlen)8);
setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. "
"Column entry element was not found.", (
ftnlen)79);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", &cldscs[(i__1 = i__ * 11 - 3) < 22 && 0
<= i__1 ? i__1 : s_rnge("cldscs", i__1, "zze"
"kvmch_", (ftnlen)470)], (ftnlen)1);
errint_("#", &rows[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("rows", i__1, "zzekvmch_", (
ftnlen)471)], (ftnlen)1);
errint_("#", &elts[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("elts", i__1, "zzekvmch_", (
ftnlen)472)], (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKVMCH", (ftnlen)8);
return ret_val;
}
if (found && ! null[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("null", i__1, "zzekvmch_", (ftnlen)
480)]) {
/* Computing MIN */
i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2
: s_rnge("cvlen", i__2, "zzekvmch_", (ftnlen)
482)];
cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen)
482)] = min(i__3,1024);
} else {
cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen)
484)] = 0;
}
}
ret_val = ! matchi_(cval, cval + 1024, "*", "%", cmplen[0],
cmplen[1], (ftnlen)1, (ftnlen)1);
} else {
/* Sorry, we couldn't resist. */
ret_val = FALSE_;
chkin_("ZZEKVMCH", (ftnlen)8);
setmsg_("The relational operator # was not recognized.", (
ftnlen)45);
errint_("#", &ops[n - 1], (ftnlen)1);
sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24);
chkout_("ZZEKVMCH", (ftnlen)8);
return ret_val;
}
}
/* We've completed the test for the Nth constraint, if that */
/* constraint was active. */
++n;
}
return ret_val;
} /* zzekvmch_ */