Exemplo n.º 1
0
Arquivo: getfat.c Projeto: Dbelsa/coft
/* $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_ */
Exemplo n.º 2
0
Arquivo: ekucei.c Projeto: Dbelsa/coft
/* $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_ */
Exemplo n.º 3
0
/* $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_ */
Exemplo n.º 4
0
/* $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_ */
Exemplo n.º 5
0
/* $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_ */
Exemplo n.º 6
0
Arquivo: daswfr.c Projeto: Dbelsa/coft
/* $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_ */
Exemplo n.º 7
0
Arquivo: ekrcec.c Projeto: Dbelsa/coft
/* $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_ */
Exemplo n.º 8
0
/* $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_ */
Exemplo n.º 9
0
/* $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_ */
Exemplo n.º 10
0
/* $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_ */
Exemplo n.º 11
0
/* $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_ */
Exemplo n.º 12
0
/* $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_ */
Exemplo n.º 13
0
/* $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_ */
Exemplo n.º 14
0
/* $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_ */
Exemplo n.º 15
0
/* $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_ */
Exemplo n.º 16
0
Arquivo: dassdr.c Projeto: Dbelsa/coft
/* $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_ */
Exemplo n.º 17
0
/* $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_ */
Exemplo n.º 18
0
/* $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_ */
Exemplo n.º 19
0
/* $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_ */