/* $Procedure EKINSR ( EK, insert record into segment ) */
/* Subroutine */ int ekinsr_(integer *handle, integer *segno, integer *recno)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Local variables */
integer base, nrec, size, room;
extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen),
zzekrbck_(char *, integer *, integer *, integer *, integer *,
ftnlen), zzekmloc_(integer *, integer *, integer *, integer *),
zzekpgbs_(integer *, integer *, integer *), zzektrin_(integer *,
integer *, integer *, integer *);
integer p, mbase;
extern /* Subroutine */ int chkin_(char *, ftnlen), filli_(integer *,
integer *, integer *);
integer ncols, lastp, lastw;
extern logical failed_(void);
integer coldsc[11], mp;
extern logical return_(void);
integer nlinks, recbas, recptr[254], segdsc[24];
logical isshad;
extern /* Subroutine */ int chkout_(char *, ftnlen), dasrdi_(integer *,
integer *, integer *, integer *), setmsg_(char *, ftnlen),
errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen),
cleari_(integer *, integer *), ekshdw_(integer *, logical *),
dasudi_(integer *, integer *, integer *, integer *), zzekaps_(
integer *, integer *, integer *, logical *, integer *, integer *);
/* $ Abstract */
/* Add a new, empty record to a specified E-kernel segment at */
/* a specified index. */
/* $ 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 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 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. */
/* SEGNO I Segment number. */
/* RECNO I Record number. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for write access. */
/* SEGNO is the number of the segment to which the record */
/* is to be added. */
/* RECNO is the index of the new record. RECNO must be */
/* in the range 1 : (NREC+1), where NREC is the */
/* number of records in the segment prior to the */
/* insertion. If RECNO is equal to NREC+1, the */
/* new record is appended. Otherwise, the new */
/* record has the ordinal position specified by */
/* RECNO, and the records previously occupying */
/* positions RECNO : NREC have their indexes */
/* incremented by 1. */
/* $ 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 SEGNO is out of range, the error SPICE(INVALIDINDEX) */
/* will be signalled. The file will not be modified. */
/* 3) If RECNO is out of range, the error SPICE(INVALIDINDEX) */
/* will be signalled. The file will not be modified. */
/* 4) 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 adds a new, empty */
/* record structure to an EK segment at a specified ordinal position. */
/* After a record has been inserted into a segment by this routine, */
/* the record must be populated with data using the EKACEx */
/* routines. EKs are valid only when all of their column entries */
/* are initialized. */
/* To append a record to a segment, use the routine EKAPPR. */
/* This routine cannot be used with the "fast write" suite of */
/* routines. See the EK Required Reading for a discussion of the */
/* fast writers. */
/* When a record is inserted into an EK file that is not shadowed, */
/* the status of the record starts out set to OLD. The status */
/* does not change when data is added to the record. */
/* If the target EK is shadowed, the new record will be given the */
/* status NEW. Updating column values in the record does not change */
/* its status. When changes are committed, the status is set to OLD. */
/* If a rollback is performed before changes are committed, the */
/* record is deleted. Closing the target file without committing */
/* changes implies a rollback. */
/* $ Examples */
/* 1) Insert a record into a specified E-kernel segment at a */
/* specified ordinal position. */
/* Suppose we have an E-kernel named ORDER_DB.EK which contains */
/* records of orders for data products. The E-kernel has a */
/* table called DATAORDERS that consists of the set of columns */
/* listed below: */
/* DATAORDERS */
/* Column Name Data Type */
/* ----------- --------- */
/* ORDER_ID INTEGER */
/* CUSTOMER_ID INTEGER */
/* LAST_NAME CHARACTER*(*) */
/* FIRST_NAME CHARACTER*(*) */
/* ORDER_DATE TIME */
/* COST DOUBLE PRECISION */
/* The order database also has a table of items that have been */
/* ordered. The columns of this table are shown below: */
/* DATAITEMS */
/* Column Name Data Type */
/* ----------- --------- */
/* ITEM_ID INTEGER */
/* ORDER_ID INTEGER */
/* ITEM_NAME CHARACTER*(*) */
/* DESCRIPTION CHARACTER*(*) */
/* PRICE DOUBLE PRECISION */
/* We'll suppose that the file ORDER_DB.EK contains two segments, */
/* the first containing the DATAORDERS table and the second */
/* containing the DATAITEMS table. */
/* If we wanted to insert a new record into the DATAORDERS */
/* table in position 1, we'd make the following calls: */
/* C */
/* C Open the database for write access. */
/* C */
/* CALL EKOPW ( 'ORDER_DB.EK', HANDLE ) */
/* C */
/* C Insert a new, empty record into the DATAORDERS */
/* C table at record number 1. This moves the existing */
/* C records down, so the old record 1 becomes record 2, */
/* C and so on. Recall that the DATAORDERS table */
/* C is in segment number 1. */
/* C */
/* RECNO = 1 */
/* SEGNO = 1 */
/* CALL EKINSR ( HANDLE, SEGNO, RECNO ) */
/* C */
/* C At this point, the new record is empty. A valid EK */
/* C cannot contain empty records. We fill in the data */
/* C here. Data items are filled in one column at a time. */
/* C The order in which the columns are filled in is not */
/* C important. We use the EKACEx (add column entry) */
/* C routines to fill in column entries. We'll assume */
/* C that no entries are null. All entries are scalar, */
/* C so the entry size is 1. */
/* C */
/* ISNULL = .FALSE. */
/* ESIZE = 1 */
/* C */
/* C The following variables will contain the data for */
/* C the new record. */
/* C */
/* ORDID = 10011 */
/* CUSTID = 531 */
/* LNAME = 'Scientist' */
/* FNAME = 'Joe' */
/* ODATE = '1995-SEP-20' */
/* COST = 0.D0 */
/* C */
/* C Note that the names of the routines called */
/* C correspond to the data types of the columns: the */
/* C last letter of the routine name is C, I, or D, */
/* C depending on the data type. Time values are */
/* C converted to ET for storage. */
/* C */
/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'ORDER_ID', */
/* . SIZE, ORDID, ISNULL ) */
/* CALL EKACEI ( HANDLE, SEGNO, RECNO, 'CUSTOMER_ID', */
/* . SIZE, CUSTID, ISNULL ) */
/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'LAST_NAME', */
/* . SIZE, LNAME, ISNULL ) */
/* CALL EKACEC ( HANDLE, SEGNO, RECNO, 'FIRST_NAME', */
/* . SIZE, FNAME, ISNULL ) */
/* CALL UTC2ET ( ODATE, ET ) */
/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'ORDER_DATE', */
/* . SIZE, ET, ISNULL ) */
/* CALL EKACED ( HANDLE, SEGNO, RECNO, 'COST', */
/* . SIZE, COST, ISNULL ) */
/* C */
/* C Close the file to make the update permanent. */
/* C */
/* CALL EKCLS ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 09-JAN-2002 (NJB) */
/* Documentation change: instances of the phrase "fast load" */
/* were replaced with "fast write." */
/* - Beta Version 1.0.0, 19-DEC-1995 (NJB) */
/* -& */
/* $ Index_Entries */
/* insert record into EK segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("EKINSR", (ftnlen)6);
}
/* Before trying to actually write anything, 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_("EKINSR", (ftnlen)6);
return 0;
}
/* Look up the integer metadata page and page base for the segment. */
/* Given the base address, we can read the pertinent metadata in */
/* one shot. */
zzekmloc_(handle, segno, &mp, &mbase);
if (failed_()) {
chkout_("EKINSR", (ftnlen)6);
return 0;
}
i__1 = mbase + 1;
i__2 = mbase + 24;
dasrdi_(handle, &i__1, &i__2, segdsc);
/* 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];
size = ncols + 2;
/* We're assuming the record pointer can fit on an integer page. */
/* If this is not the case, we've got a bug. */
if (size > 254) {
setmsg_("Record pointer requires # integer words; EK software assume"
"s size is <= #. This is an EK software bug. Contact NAIF.",
(ftnlen)118);
errint_("#", &size, (ftnlen)1);
errint_("#", &c__254, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("EKINSR", (ftnlen)6);
return 0;
}
/* Check the number of records already present. RECNO must not */
/* exceed this count by more than 1. */
nrec = segdsc[5];
if (*recno < 1 || *recno > nrec + 1) {
setmsg_("Record number = #; valid range is 1:#.", (ftnlen)38);
errint_("#", recno, (ftnlen)1);
i__1 = nrec + 1;
errint_("#", &i__1, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("EKINSR", (ftnlen)6);
return 0;
}
/* Find the last integer data page and the last word in use in that */
/* page. If there's enough room, we can store the record pointer */
/* in the current page. */
lastp = segdsc[17];
lastw = segdsc[20];
room = 254 - lastw;
/* Initialize the record pointer: set the record's status and */
/* set the data pointers to indicate no data is present. To */
/* determine the status, we must know whether the parent file is */
/* shadowed. */
cleari_(&c__254, recptr);
filli_(&c_n1, &c__252, recptr);
ekshdw_(handle, &isshad);
if (isshad) {
recptr[0] = 3;
} else {
recptr[0] = 1;
}
/* Find a place to write the record pointer. */
if (size <= room) {
/* Just write the record pointer into the current integer page. */
zzekpgbs_(&c__3, &lastp, &base);
recbas = base + lastw;
i__1 = recbas + 1;
i__2 = recbas + size;
dasudi_(handle, &i__1, &i__2, recptr);
/* Update the page's metadata to reflect the addition. The */
/* page gains a link. */
i__1 = base + 256;
i__2 = base + 256;
dasrdi_(handle, &i__1, &i__2, &nlinks);
i__1 = base + 256;
i__2 = base + 256;
i__3 = nlinks + 1;
dasudi_(handle, &i__1, &i__2, &i__3);
/* The last integer word in use has changed too. */
segdsc[20] += size;
} else {
/* Allocate an integer page. */
zzekaps_(handle, segdsc, &c__3, &c_false, &p, &recbas);
/* Write out the record pointer. */
i__1 = recbas + 1;
i__2 = recbas + size;
dasudi_(handle, &i__1, &i__2, recptr);
/* Update the page's metadata to reflect the addition. The */
/* page starts out with one link. */
i__1 = recbas + 256;
i__2 = recbas + 256;
dasudi_(handle, &i__1, &i__2, &c__1);
/* Update the segment's metadata to reflect the addition of a */
/* data page. The last page in use is the one we just wrote to. */
/* The last word in use is the last word of the record pointer. */
segdsc[17] = p;
segdsc[20] = size;
}
/* Update the segment's metadata to reflect the addition of the */
/* new record. The base address of the record is inserted into */
/* the data record tree at index RECNO. The record count gets */
/* incremented. */
zzektrin_(handle, &segdsc[6], recno, &recbas);
++segdsc[5];
/* If the segment is shadowed but no backup segment exists yet, we */
/* need to create one. We'll let ZZEKRBCK take care of the details. */
/* Note that for data additions, the input argument COLDSC is */
/* ignored. */
zzekrbck_("ADD", handle, segdsc, coldsc, recno, (ftnlen)3);
/* Write out the updated segment descriptor. */
i__1 = mbase + 1;
i__2 = mbase + 24;
dasudi_(handle, &i__1, &i__2, segdsc);
chkout_("EKINSR", (ftnlen)6);
return 0;
} /* ekinsr_ */
/* $Procedure DASSDR ( DAS, segregate data records ) */
/* Subroutine */ int dassdr_(integer *handle)
{
/* Initialized data */
static integer next[3] = { 2,3,1 };
static integer prev[3] = { 3,1,2 };
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer base;
char crec[1024];
doublereal drec[128];
integer free, irec[256], lrec, dest;
logical more;
integer unit, type__, i__, j, n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer ncomc;
extern /* Subroutine */ int maxai_(integer *, integer *, integer *,
integer *);
char savec[1024];
doublereal saved[128];
integer recno, savei[256];
extern integer sumai_(integer *, integer *);
integer ncomr, total, lword, count[4], ltype, start;
extern logical failed_(void);
extern /* Subroutine */ int dasadi_(integer *, integer *, integer *),
cleari_(integer *, integer *);
integer drbase;
extern /* Subroutine */ int dasioc_(char *, integer *, integer *, char *,
ftnlen, ftnlen), dasiod_(char *, integer *, integer *, doublereal
*, ftnlen), dasllc_(integer *), dasrdi_(integer *, integer *,
integer *, integer *), dashfs_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *, integer *, integer *),
dasudi_(integer *, integer *, integer *, integer *);
integer minadr, maxadr, scrhan, lastla[3];
extern /* Subroutine */ int dassih_(integer *, char *, ftnlen), dashlu_(
integer *, integer *), daswbr_(integer *), dasrri_(integer *,
integer *, integer *, integer *, integer *);
integer offset;
extern /* Subroutine */ int dasioi_(char *, integer *, integer *, integer
*, ftnlen);
integer lastrc[3];
extern /* Subroutine */ int dasops_(integer *), dasufs_(integer *,
integer *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *), chkout_(char *, ftnlen);
integer lastwd[3], nresvc;
extern logical return_(void);
integer nresvr, savtyp, prvtyp, loc, pos;
/* $ Abstract */
/* Segregate the data records in a DAS file into clusters, using */
/* one cluster per data type present in the file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* DAS */
/* FILES */
/* ORDER */
/* SORT */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If a Fortran read attempted by this routine fails, the */
/* error will be diagnosed by routines called by this routine. */
/* The state of the DAS file undergoing re-ordering will be */
/* indeterminate. */
/* 3) If a Fortran write attempted by this routine fails, the */
/* error will be diagnosed by routines called by this routine. */
/* The state of the DAS file undergoing re-ordering will be */
/* indeterminate. */
/* 4) If any other I/O error occurs during the re-arrangement of */
/* the records in the indicated DAS file, the error will be */
/* diagnosed by routines called by this routine. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* Normally, there should be no need for routines outside of */
/* SPICELIB to call this routine. */
/* The effect of this routine is to re-arrange the data records */
/* in a DAS file so that the file contains a single cluster for */
/* each data type present in the file: in the general case, there */
/* will be a single cluster of each of the integer, double */
/* precision, and character data types. */
/* The relative order of data records of a given type is not */
/* affected by this re-ordering. After the re-ordering, the DAS */
/* file contains a single directory record that has one descriptor */
/* for each cluster. After that point, the order in the file of the */
/* sets of data records of the various data types will be: */
/* +-------+ */
/* | CHAR | */
/* +-------+ */
/* | DP | */
/* +-------+ */
/* | INT | */
/* +-------+ */
/* Files that contain multiple directory records will have all but */
/* the first directory record moved to the end of the file when the */
/* re-ordering is complete. These records are not visible to the */
/* DAS system and will be overwritten if data is subsequently added */
/* to the DAS file. */
/* The purpose of segregating a DAS file's data records into three */
/* clusters is to make read access more efficient: when a DAS file */
/* contains a single directory with at most three cluster type */
/* descriptors, mapping logical to physical addresses can be done */
/* in constant time. */
/* $ Examples */
/* 1) Segregate data records in a DAS file designated by */
/* HANDLE: */
/* CALL DASSDR ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */
/* Added test of FAILED after each DAS call, or sequence of calls, */
/* which returns immediately if FAILED is true. This fixes a bug */
/* where DASOPS signals an error and then DASSDR has a */
/* segmentation fault. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */
/* Bug fix: call to CLEARD replaced with call to */
/* CLEARI. */
/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) (MJS) */
/* Bug fix: extraneous commas removed from argument lists */
/* in calls to DASADI. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* segregate the data records in a DAS file */
/* -& */
/* $ Revisions */
/* - EKLIB Version 2.0.0, 17-NOV-1993 (KRG) */
/* Added test of failed after each DAS call, or sequence of calls, */
/* which returns immediately if FAILED is true. This fixes a bug */
/* where DASOPS signals an error and then DASSDR has a */
/* segmentation fault. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* - EKLIB Version 1.2.0, 07-OCT-1993 (NJB) (HAN) (MJS) */
/* Bug fix: call to CLEARD replaced with call to */
/* CLEARI. */
/* - EKLIB Version 1.1.0, 08-JUL-1993 (NJB) */
/* Bug fix: extraneous commas removed from argument lists */
/* in calls to DASADI. This bug had no visible effect on */
/* VAX and Sun systems, but generated a compile error under */
/* Lahey Fortran. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Data type parameters */
/* Directory pointer locations (backward and forward): */
/* Directory address range location base */
/* Location of first type descriptor */
/* Local variables */
/* Saved variables */
/* NEXT and PREV map the DAS data type codes to their */
/* successors and predecessors, respectively. */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASSDR", (ftnlen)6);
}
/* Before starting, make sure that this DAS file is open for */
/* writing. */
dassih_(handle, "WRITE", (ftnlen)5);
/* Get the logical unit for this file. */
dashlu_(handle, &unit);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Write out any buffered records that belong to the file. */
daswbr_(handle);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* We're going to re-order the physical records in the DAS file, */
/* starting with the first record after the first directory. */
/* The other directory records are moved to the end of the file */
/* as a result of the re-ordering. */
/* The re-ordering algorithm is based on that used in the REORDx */
/* routines. To use this algorithm, we'll build an order vector */
/* for the records to be ordered; we'll construct this order vector */
/* in a scratch DAS file. First, we'll traverse the directories */
/* to build up a sort of inverse order vector that tells us the */
/* final destination and data type of each data record; from this */
/* inverse vector we can easily build a true order vector. The */
/* cycles of the true order vector can be traversed without */
/* repetitive searching, and with a minimum of assignment of the */
/* contents of data records to temporary variables. */
/* Allocate a scratch DAS file to keep our vectors in. */
dasops_(&scrhan);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Now build up our `inverse order vector'. This array is an */
/* inverse order vector only in loose sense: it actually consists */
/* of an integer array that contains a sequence of pairs of integers, */
/* the first of which indicates a data type, and the second of which */
/* is an ordinal number. There is one pair for each data record in */
/* the file. The ordinal number gives the ordinal position of the */
/* record described by the number pair, relative to the other records */
/* of the same type. Directory records are considered to have type */
/* `directory', which is represented by the code DIR. */
/* We also must maintain a count of records of each type. */
cleari_(&c__4, count);
/* Get the file summary for the DAS file to be segregated. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Find the record and word positions LREC and LWORD of the last */
/* descriptor in the file, and also find the type of the descriptor */
/* LTYPE. */
maxai_(lastrc, &c__3, &lrec, &loc);
lword = 0;
for (i__ = 1; i__ <= 3; ++i__) {
if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc",
i__1, "dassdr_", (ftnlen)451)] == lrec && lastwd[(i__2 = i__
- 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dassd"
"r_", (ftnlen)451)] > lword) {
lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastwd", i__1, "dassdr_", (ftnlen)454)];
ltype = i__;
}
}
/* The first directory starts after the last comment record. */
recno = nresvr + ncomr + 2;
while(recno <= lrec && recno > 0) {
/* Read the directory record. */
dasrri_(handle, &recno, &c__1, &c__256, irec);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Increment the directory count. */
++count[3];
/* Add the data type (`directory') and count (1) of the current */
/* record to the inverse order vector. */
dasadi_(&scrhan, &c__1, &c__4);
dasadi_(&scrhan, &c__1, &count[3]);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Set up our `finite state machine' that tells us the data */
/* types of the records described by the last read directory. */
type__ = irec[8];
prvtyp = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"prev", i__1, "dassdr_", (ftnlen)498)];
/* Now traverse the directory and update the inverse order */
/* vector based on the descriptors we find. */
more = TRUE_;
i__ = 10;
while(more) {
/* Obtain the count for the current descriptor. */
n = (i__2 = irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 :
s_rnge("irec", i__1, "dassdr_", (ftnlen)512)], abs(i__2));
/* Update our inverse order vector to describe the positions */
/* of the N records described by the current descriptor. */
i__1 = n;
for (j = 1; j <= i__1; ++j) {
dasadi_(&scrhan, &c__1, &type__);
i__3 = count[(i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 :
s_rnge("count", i__2, "dassdr_", (ftnlen)521)] + j;
dasadi_(&scrhan, &c__1, &i__3);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* Adjust the count of records of data type TYPE. */
count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("count"
, i__1, "dassdr_", (ftnlen)533)] = count[(i__2 = type__ -
1) < 4 && 0 <= i__2 ? i__2 : s_rnge("count", i__2, "dass"
"dr_", (ftnlen)533)] + n;
/* Find the next type. */
++i__;
if (i__ > 256 || recno == lrec && i__ > lword) {
more = FALSE_;
} else {
if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)547)] > 0) {
type__ = next[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("next", i__1, "dassdr_", (ftnlen)548)];
} else if (irec[(i__1 = i__ - 1) < 256 && 0 <= i__1 ? i__1 :
s_rnge("irec", i__1, "dassdr_", (ftnlen)550)] < 0) {
type__ = prev[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("prev", i__1, "dassdr_", (ftnlen)551)];
} else {
more = FALSE_;
}
}
}
/* The forward pointer in this directory tells us where the */
/* next directory record is. When there are no more directory */
/* records, this pointer will be zero. */
recno = irec[1];
}
/* At this point, the inverse order vector is set up. The array */
/* COUNT contains counts of the number of records of each type we've */
/* seen. Set TOTAL to the total number of records that we've going */
/* to permute. */
total = sumai_(count, &c__4);
/* The next step is to build a true order vector. Let BASE be */
/* the base address for the order vector; this address is the */
/* last logical address of the inverse order vector. */
base = total << 1;
/* We'll store the actual order vector in locations BASE + 1 */
/* through BASE + TOTAL. In addition, we'll build a parallel array */
/* that contains, for each element of the order vector, the type of */
/* data corresponding to that element. This type vector will */
/* reside in locations BASE + TOTAL + 1 through BASE + 2*TOTAL. */
/* Before setting the values of the order vector and its parallel */
/* type vector, we'll allocate space in the scratch DAS file by */
/* zeroing out the locations we plan to use. After this, locations */
/* BASE+1 through BASE + 2*TOTAL can be written to in random access */
/* fashion using DASUDI. */
i__1 = total << 1;
for (i__ = 1; i__ <= i__1; ++i__) {
dasadi_(&scrhan, &c__1, &c__0);
}
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* We note that the way to construct the inverse of a permutation */
/* SIGMA in a single loop is suggested by the relation */
/* -1 */
/* SIGMA ( SIGMA(I) ) = I */
/* We'll use this method. In our case, our order vector plays */
/* the role of */
/* -1 */
/* SIGMA */
/* and the `inverse order vector' plays the role of SIGMA. We'll */
/* exclude the first directory from the order vector, since it's */
/* an exception: we wish to reserve this record. Since the first */
/* element of the order vector (logically) contains the index 1, we */
/* can ignore it. */
i__1 = total;
for (i__ = 2; i__ <= i__1; ++i__) {
i__2 = (i__ << 1) - 1;
i__3 = (i__ << 1) - 1;
dasrdi_(&scrhan, &i__2, &i__3, &type__);
i__2 = i__ << 1;
i__3 = i__ << 1;
dasrdi_(&scrhan, &i__2, &i__3, &dest);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Set DEST to the destination location, measured as an offset */
/* from the last comment record, of the Ith record by adding */
/* on the count of the predecessors of the block of records of */
/* TYPE. */
for (j = 1; j <= 3; ++j) {
if (type__ > j) {
dest += count[(i__2 = j - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge(
"count", i__2, "dassdr_", (ftnlen)648)];
}
}
/* The destination offset of each record should be incremented to */
/* allow room for the first directory record. However, we don't */
/* need to do this for directory records; they'll already have */
/* this offset accounted for. */
if (type__ != 4) {
++dest;
}
/* The value of element DEST of the order vector is I. */
/* Write this value to location BASE + DEST. */
i__2 = base + dest;
i__3 = base + dest;
dasudi_(&scrhan, &i__2, &i__3, &i__);
/* We want the ith element of the order vector to give us the */
/* number of the record to move to position i (offset from the */
/* last comment record), but we want the corresponding element */
/* of the type array to give us the type of the record currently */
/* occupying position i. */
i__2 = base + i__ + total;
i__3 = base + i__ + total;
dasudi_(&scrhan, &i__2, &i__3, &type__);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* Ok, here's what we've got in the scratch file that's still of */
/* interest: */
/* -- In integer logical addresses BASE + 1 : BASE + TOTAL, */
/* we have an order vector. The Ith element of this */
/* vector indicates the record that should be moved to */
/* location DRBASE + I in the DAS file we're re-ordering, */
/* where DRBASE is the base address of the data records */
/* (the first directory record follows the record having this */
/* index). */
/* -- In integer logical addresses BASE + TOTAL + 1 : BASE + */
/* 2*TOTAL, we have data type indicators for the records to */
/* be re-ordered. The type for the Ith record in the file, */
/* counted from the last comment record, is located in logical */
/* address BASE + TOTAL + I. */
drbase = nresvr + ncomr + 1;
/* As we traverse the order vector, we flip the sign of elements */
/* we've accessed, so that we can tell when we encounter an element */
/* of a cycle that we've already traversed. */
/* Traverse the order vector. The variable START indicates the */
/* first element to look at. Ignore the first element; it's a */
/* singleton cycle. */
start = 2;
while(start < total) {
/* Traverse the current cycle of the order vector. */
/* We `make a hole' in the file by saving the record in position */
/* START, then we traverse the cycle in reverse order, filling in */
/* the hole at the ith position with the record whose number is */
/* the ith element of the order vector. At the end, we deposit */
/* the saved record into the `hole' left behind by the last */
/* record we moved. */
/* We're going to read and write records to and from the DAS file */
/* directly, rather than going through the buffering system. */
/* This will allow us to avoid any untoward interactions between */
/* the buffers for different data types. */
i__1 = base + total + start;
i__2 = base + total + start;
dasrdi_(&scrhan, &i__1, &i__2, &savtyp);
i__1 = base + start;
i__2 = base + start;
dasrdi_(&scrhan, &i__1, &i__2, &offset);
/* Save the record at the location DRBASE + START. */
if (savtyp == 1) {
i__1 = drbase + start;
dasioc_("READ", &unit, &i__1, savec, (ftnlen)4, (ftnlen)1024);
} else if (savtyp == 2) {
i__1 = drbase + start;
dasiod_("READ", &unit, &i__1, saved, (ftnlen)4);
} else {
i__1 = drbase + start;
dasioi_("READ", &unit, &i__1, savei, (ftnlen)4);
}
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Let I be the index of the record that we are going to move */
/* data into next. I is an offset from the last comment record. */
i__ = start;
while(offset != start) {
/* Mark the order vector element by writing its negative */
/* back to the location it came from. */
i__1 = base + i__;
i__2 = base + i__;
i__3 = -offset;
dasudi_(&scrhan, &i__1, &i__2, &i__3);
/* Move the record at location */
/* DRBASE + OFFSET */
/* to location */
/* DRBASE + I */
/* There is no need to do anything about the corresponding */
/* elements of the type vector; we won't need them again. */
/* The read and write operations, as well as the temporary */
/* record required to perform the move, are dependent on the */
/* data type of the record to be moved. */
i__1 = base + total + offset;
i__2 = base + total + offset;
dasrdi_(&scrhan, &i__1, &i__2, &type__);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Only pick records up if we're going to put them down in */
/* a location other than their original one. */
if (i__ != offset) {
if (type__ == 1) {
i__1 = drbase + offset;
dasioc_("READ", &unit, &i__1, crec, (ftnlen)4, (ftnlen)
1024);
i__1 = drbase + i__;
dasioc_("WRITE", &unit, &i__1, crec, (ftnlen)5, (ftnlen)
1024);
} else if (type__ == 2) {
i__1 = drbase + offset;
dasiod_("READ", &unit, &i__1, drec, (ftnlen)4);
i__1 = drbase + i__;
dasiod_("WRITE", &unit, &i__1, drec, (ftnlen)5);
} else {
i__1 = drbase + offset;
dasioi_("READ", &unit, &i__1, irec, (ftnlen)4);
i__1 = drbase + i__;
dasioi_("WRITE", &unit, &i__1, irec, (ftnlen)5);
}
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* OFFSET is the index of the next order vector element to */
/* look at. */
i__ = offset;
i__1 = base + i__;
i__2 = base + i__;
dasrdi_(&scrhan, &i__1, &i__2, &offset);
i__1 = base + i__ + total;
i__2 = base + i__ + total;
dasrdi_(&scrhan, &i__1, &i__2, &type__);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* The last value of I is the location in the cycle that element */
/* START followed. Therefore, the saved record corresponding */
/* to index START should be written to this location. */
if (savtyp == 1) {
i__1 = drbase + i__;
dasioc_("WRITE", &unit, &i__1, savec, (ftnlen)5, (ftnlen)1024);
} else if (savtyp == 2) {
i__1 = drbase + i__;
dasiod_("WRITE", &unit, &i__1, saved, (ftnlen)5);
} else {
i__1 = drbase + i__;
dasioi_("WRITE", &unit, &i__1, savei, (ftnlen)5);
}
/* Mark the order vector element by writing its negative */
/* back to the location it came from. */
i__1 = base + i__;
i__2 = base + i__;
i__3 = -start;
dasudi_(&scrhan, &i__1, &i__2, &i__3);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
/* Update START so that it points to the first element of a cycle */
/* of the order vector that has not yet been traversed. This will */
/* be the first positive element of the order vector in a location */
/* indexed higher than the current value of START. Note that */
/* this way of updating START guarantees that we don't have to */
/* backtrack to find an element in the next cycle. */
offset = -1;
while(offset < 0 && start < total) {
++start;
i__1 = base + start;
i__2 = base + start;
dasrdi_(&scrhan, &i__1, &i__2, &offset);
if (failed_()) {
chkout_("DASSDR", (ftnlen)6);
return 0;
}
}
/* At this point, START is the index of an element in the order */
/* vector that belongs to a cycle where no routine has gone */
/* before, or else START is the last index in the order vector, */
/* in which case we're done. */
}
/* At this point, the records in the DAS are organized as follows: */
/* +----------------------------------+ */
/* | File record | ( 1 ) */
/* +----------------------------------+ */
/* | Reserved records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Comment records | ( 0 or more ) */
/* | | */
/* | | */
/* +----------------------------------+ */
/* | First directory record | ( 1 ) */
/* +----------------------------------+ */
/* | Character data records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Double precision data records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Integer data records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* | Additional directory records | ( 0 or more ) */
/* | | */
/* +----------------------------------+ */
/* Not all of the indicated components must be present; only the */
/* file record and first directory record will exist in all cases. */
/* The `additional directory records' at the end of the file serve */
/* no purpose; if more data is appended to the file, they will be */
/* overwritten. */
/* The last step in preparing the file is to fill in the first */
/* directory record with the correct information, and to update */
/* the file summary. */
recno = drbase + 1;
cleari_(&c__256, irec);
/* Set the logical address ranges in the directory record, for each */
/* data type. */
for (type__ = 1; type__ <= 3; ++type__) {
maxadr = lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastla", i__1, "dassdr_", (ftnlen)957)];
if (maxadr > 0) {
minadr = 1;
} else {
minadr = 0;
}
irec[(i__1 = type__ << 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("irec",
i__1, "dassdr_", (ftnlen)965)] = minadr;
irec[(i__1 = (type__ << 1) + 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)966)] = maxadr;
}
/* Set the descriptors in the directory. Determine which type */
/* comes first: the order of priority is character, double */
/* precision, integer. */
pos = 9;
for (type__ = 1; type__ <= 3; ++type__) {
if (lastla[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("las"
"tla", i__1, "dassdr_", (ftnlen)979)] > 0) {
if (pos == 9) {
/* This is the first type for which any data is present. */
/* We must enter a type code at position BEGDSC in the */
/* directory, and we must enter a count at position */
/* BEGDSC+1. */
irec[8] = type__;
irec[9] = count[(i__1 = type__ - 1) < 4 && 0 <= i__1 ? i__1 :
s_rnge("count", i__1, "dassdr_", (ftnlen)989)];
lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastrc", i__1, "dassdr_", (ftnlen)990)] = recno;
lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastwd", i__1, "dassdr_", (ftnlen)991)] = 10;
pos += 2;
prvtyp = type__;
} else {
/* Place an appropriately signed count at location POS in */
/* the directory. */
if (type__ == next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ?
i__1 : s_rnge("next", i__1, "dassdr_", (ftnlen)1000)])
{
irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)1001)] = count[(
i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 :
s_rnge("count", i__2, "dassdr_", (ftnlen)1001)];
} else {
irec[(i__1 = pos - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"irec", i__1, "dassdr_", (ftnlen)1003)] = -count[(
i__2 = type__ - 1) < 4 && 0 <= i__2 ? i__2 :
s_rnge("count", i__2, "dassdr_", (ftnlen)1003)];
}
lastrc[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastrc", i__1, "dassdr_", (ftnlen)1006)] = recno;
lastwd[(i__1 = type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"lastwd", i__1, "dassdr_", (ftnlen)1007)] = pos;
++pos;
prvtyp = type__;
}
}
}
/* Since we've done away with all but the first directory, the first */
/* free record is decremented by 1 less than the directory count. */
free = free - count[3] + 1;
/* Write out the new directory record. Don't use the DAS buffered */
/* write mechanism; this could trash the file by dumping buffered */
/* records in the wrong places. */
dasioi_("WRITE", &unit, &recno, irec, (ftnlen)5);
/* Write out the updated file summary. */
dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
/* Clean up the DAS data buffers: we don't want buffered scratch */
/* file records hanging around there. Then get rid of the scratch */
/* file. */
daswbr_(&scrhan);
dasllc_(&scrhan);
chkout_("DASSDR", (ftnlen)6);
return 0;
} /* dassdr_ */
/* $Procedure ZZEKTR13 ( EK tree, 1-3 split ) */
/* Subroutine */ int zzektr13_(integer *handle, integer *tree)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer base, root;
extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *,
integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_(
integer *, integer *, integer *);
integer i__, child[2], delta;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer rpage[256];
extern /* Subroutine */ int movei_(integer *, integer *, integer *);
integer c1page[256], c2page[256], middle;
extern /* Subroutine */ int cleari_(integer *, integer *), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen);
integer nrkeys;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
/* $ Abstract */
/* Execute a 1-3 split: split the root node to create two new */
/* children, leaving a single key in the root. */
/* $ 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 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 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 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. */
/* $ 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. */
/* $ 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 the indicated file, the */
/* error will be diagnosed by routines called by this routine. */
/* 3) If the number of keys in the root does not correspond to an */
/* overflow of exactly 1 key, the error SPICE(BUG) is signalled. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* Insertions into an EK tree start at a leaf node. If the node */
/* overflows, the EK system attempts to shuffle keys at the leaf */
/* level to resolve the overflow. That attempt failing, the system */
/* delegates the problem upward to the next higher level. Overflow */
/* may occur there as well; if it does, the problem gets passed */
/* upward again. If the root overflows, the system makes room by */
/* executing what's called a `1-3' split: the root gets two new */
/* children, and all but one of the keys in the root are moved into */
/* the new children. The former children of the root become */
/* children of the two new children of the root. */
/* After the 1-3 split, the tree is balanced and all invariants */
/* relating to key counts are restored. */
/* The tree grows taller by one level as a result of a 1-3 split; */
/* this is the only circumstance under which the tree grows taller. */
/* Below are the gory details concerning the actions of this routine. */
/* All of the parameters referred to here (in capital letters) are */
/* defined in the include file ektree.inc. */
/* In a 1-3 split: */
/* - The leftmost MNKEYC keys of the root are moved into the */
/* new left child. */
/* - The data values associated with the first MNKEYC keys of the */
/* root are moved along with the keys. */
/* - The left child pointers associated with the first MNKEYC keys */
/* of the root are moved along with the keys. */
/* - The right child pointer of the key at location MNKEYC+1 in */
/* the root is moved to location MYKEYC+1 in the child pointer */
/* array of the left child. */
/* - The rightmost MNKEYC keys of the root are moved into the */
/* new right child. */
/* - The data values associated with the last MNKEYC keys of the */
/* root are moved along with the keys. */
/* - The left child pointers associated with the last MNKEYC keys */
/* of the root are moved along with the keys. */
/* - The right child pointer of the last in the root is moved to */
/* location MYKEYC+1 in the child pointer array of the right */
/* child. */
/* - The left child pointer of the one key left in the root */
/* points to the new left child. */
/* - The right child pointer of the one key left in the root */
/* points to the new right child. */
/* As the above list shows, each of the new children of the root */
/* contains the minimum allowed number of keys that a child node */
/* may have. Thus the size constraints on child nodes are met. */
/* The root must be non-empty unless the tree is empty; this */
/* condition is also met. */
/* $ Examples */
/* See ZZEKTRIN. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */
/* -& */
/* Local variables */
/* Use discovery check-in for speed. */
root = *tree;
zzekpgri_(handle, &root, rpage);
nrkeys = rpage[4];
/* The number of keys in the root must correspond exactly to an */
/* overflow level of 1 key. */
if (nrkeys != 83) {
chkin_("ZZEKTR13", (ftnlen)8);
setmsg_("Number of keys in root = #; should be #.", (ftnlen)40);
errint_("#", &nrkeys, (ftnlen)1);
errint_("#", &c__83, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZEKTR13", (ftnlen)8);
return 0;
}
/* Allocate two new pages; these will become children of the root. */
/* Each one will be assigned MNKEYC keys. */
for (i__ = 1; i__ <= 2; ++i__) {
zzekpgal_(handle, &c__3, &child[(i__1 = i__ - 1) < 2 && 0 <= i__1 ?
i__1 : s_rnge("child", i__1, "zzektr13_", (ftnlen)221)], &
base);
}
/* Set the key count in the first child. */
cleari_(&c__256, c1page);
c1page[0] = 41;
/* Copy in the keys, data pointers, and child pointers from the */
/* first MNKEYC locations in the root. Also take the left child */
/* pointer of the middle key. */
movei_(&rpage[5], &c__41, &c1page[1]);
movei_(&rpage[172], &c__41, &c1page[128]);
movei_(&rpage[88], &c__42, &c1page[64]);
/* Set up the key count in the second child. */
cleari_(&c__256, c2page);
c2page[0] = 41;
/* Copy in the keys, data pointers, and child pointers from the */
/* last MNKEYC locations in the root. Also take the last right */
/* child pointer. */
middle = 42;
movei_(&rpage[(i__1 = middle + 5) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"rpage", i__1, "zzektr13_", (ftnlen)254)], &c__41, &c2page[1]);
movei_(&rpage[(i__1 = middle + 172) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"rpage", i__1, "zzektr13_", (ftnlen)255)], &c__41, &c2page[128]);
movei_(&rpage[(i__1 = middle + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"rpage", i__1, "zzektr13_", (ftnlen)256)], &c__42, &c2page[64]);
/* The keys in this second node must be adjusted to account for the */
/* loss of the predecessors assigned to the subtree headed by the */
/* left child, as well as of the middle key. */
delta = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"rpage", i__1, "zzektr13_", (ftnlen)263)];
for (i__ = 1; i__ <= 41; ++i__) {
c2page[(i__1 = i__) < 256 && 0 <= i__1 ? i__1 : s_rnge("c2page", i__1,
"zzektr13_", (ftnlen)266)] = c2page[(i__2 = i__) < 256 && 0
<= i__2 ? i__2 : s_rnge("c2page", i__2, "zzektr13_", (ftnlen)
266)] - delta;
}
/* Now the root must be updated. The root now contains just 1 */
/* key; that key should be shifted left to the first key location. */
/* There are two child pointers; these point to the children just */
/* created. The depth of the tree has increased, as well as the */
/* number of nodes in the tree. */
rpage[5] = rpage[(i__1 = middle + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge(
"rpage", i__1, "zzektr13_", (ftnlen)276)];
rpage[172] = rpage[(i__1 = middle + 171) < 256 && 0 <= i__1 ? i__1 :
s_rnge("rpage", i__1, "zzektr13_", (ftnlen)277)];
rpage[88] = child[0];
rpage[89] = child[1];
rpage[4] = 1;
++rpage[3];
rpage[1] += 2;
cleari_(&c__82, &rpage[6]);
cleari_(&c__82, &rpage[173]);
cleari_(&c__82, &rpage[90]);
/* Write out our updates. */
zzekpgwi_(handle, &root, rpage);
zzekpgwi_(handle, child, c1page);
zzekpgwi_(handle, &child[1], c2page);
return 0;
} /* zzektr13_ */
/* $Procedure ZZEKAC01 ( EK, add class 1 column to segment ) */
/* Subroutine */ int zzekac01_(integer *handle, integer *segdsc, integer *
coldsc, integer *ivals, logical *nlflgs, integer *rcptrs, integer *
wkindx)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer page[256], tree, from;
extern /* Subroutine */ int zzektr1s_(integer *, integer *, integer *,
integer *), zzekcnam_(integer *, integer *, char *, ftnlen),
zzekordi_(integer *, logical *, logical *, integer *, integer *),
zzekpgwi_(integer *, integer *, integer *), zzekspsh_(integer *,
integer *), zzektrit_(integer *, integer *);
integer i__, n, p, mbase, ndata, pbase;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
integer class__, nnull, nrows;
extern logical return_(void);
char column[32];
integer adrbuf[254], bufptr, colidx, dscbas, idxtyp, nulptr, nwrite,
remain, to;
logical indexd, nullok;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), cleari_(integer *, integer *), dasudi_(integer *,
integer *, integer *, integer *), zzekaps_(integer *, integer *,
integer *, logical *, integer *, integer *);
/* $ Abstract */
/* Add an entire class 1 column to an EK 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 */
/* $ 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 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 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 new EK file. */
/* SEGDSC I Segment descriptor. */
/* COLDSC I Column descriptor. */
/* IVALS I Integer values to add to column. */
/* NLFLGS I Array of null flags for column entries. */
/* RCPTRS I Array of record pointers for segment. */
/* WKINDX I-O Work space for column index. */
/* $ Detailed_Input */
/* HANDLE the handle of an EK file that is open for writing. */
/* A `begin segment for fast load' operation must */
/* have already been performed for the designated */
/* segment. */
/* SEGDSC is a descriptor for the segment to which data is */
/* to be added. The segment descriptor is not */
/* updated by this routine, but some fields in the */
/* descriptor will become invalid after this routine */
/* returns. */
/* COLDSC is a descriptor for the column to be added. The */
/* column attributes must be filled in, but any */
/* pointers may be uninitialized. */
/* IVALS is an array containing the entire set of column */
/* entries for the specified column. The entries */
/* are listed in row-order: the column entry for the */
/* first row of the segment is first, followed by the */
/* column entry for the second row, and so on. The */
/* number of column entries must match the declared */
/* number of rows in the segment. Elements must be */
/* allocated for each column entry, including null */
/* entries. */
/* NLFLGS is an array of logical flags indicating whether */
/* the corresponding entries are null. If the Ith */
/* element of NLFLGS is .FALSE., the Ith column entry */
/* defined by IVALS is added to the specified segment */
/* in the specified kernel file. */
/* If the Ith element of NLFGLS is .TRUE., the */
/* contents of the Ith column entry are undefined. */
/* NLFLGS is used only for columns that allow null */
/* values; it's ignored for other columns. */
/* RCPTRS is an array of record pointers for the input */
/* segment. These pointers are base addresses of the */
/* `record pointer structures' for the segment. */
/* These pointers are used instead of record numbers */
/* in column indexes: the indexes map ordinal */
/* positions to record pointers. */
/* WKINDX is a work space array used for building a column */
/* index. If the column is indexed, the dimension of */
/* WKINDX must be at NROWS, where NROWS is the number */
/* of rows in the column. If the column is not */
/* indexed, this work space is not used, so the */
/* dimension may be any positive value. */
/* $ 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 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 column. This routine */
/* writes the entire contents of the specified column in one shot. */
/* This routine creates columns much more efficiently than can be */
/* done by sequential calls to EKACEI, but has the drawback that */
/* the caller must use more memory for the routine's inputs. This */
/* routine cannot be used to add data to a partially completed */
/* column. */
/* $ Examples */
/* See EKACLI. */
/* $ Restrictions */
/* 1) This routine assumes the EK scratch area has been set up */
/* properly for a fast load operation. This routine writes */
/* to the EK scratch area as well. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */
/* Bug fix: case of 100% null data values is now handled */
/* correctly. Previous version line was changed from "Beta" */
/* to "SPICELIB." */
/* - SPICELIB Version 1.0.0, 25-SEP-1995 (NJB) */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 22-JUL-1996 (NJB) */
/* Bug fix: case of 100% null data values is now handled */
/* correctly. The test to determine when to write a page */
/* was fixed to handle this case. */
/* Previous version line was changed from "Beta" */
/* to "SPICELIB." */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKAC01", (ftnlen)8);
}
/* Grab the column's attributes. */
class__ = coldsc[0];
idxtyp = coldsc[5];
nulptr = coldsc[7];
colidx = coldsc[8];
nullok = nulptr != -1;
indexd = idxtyp != -1;
/* This column had better be class 1. */
if (class__ != 1) {
zzekcnam_(handle, coldsc, column, (ftnlen)32);
setmsg_("Column class code # found in descriptor for column #. Clas"
"s should be 1.", (ftnlen)73);
errint_("#", &class__, (ftnlen)1);
errch_("#", column, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(NOCLASS)", (ftnlen)14);
chkout_("ZZEKAC01", (ftnlen)8);
return 0;
}
/* If the column is indexed, the index type should be 1; we don't */
/* know how to create any other type of index. */
if (indexd && idxtyp != 1) {
zzekcnam_(handle, coldsc, column, (ftnlen)32);
setmsg_("Index type code # found in descriptor for column #. Code s"
"hould be 1.", (ftnlen)70);
errint_("#", &idxtyp, (ftnlen)1);
errch_("#", column, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(UNRECOGNIZEDTYPE)", (ftnlen)23);
chkout_("ZZEKAC01", (ftnlen)8);
return 0;
}
/* Push the column's ordinal index on the stack. This allows us */
/* to identify the column the addresses belong to. */
zzekspsh_(&c__1, &colidx);
/* Find the number of rows in the segment. */
nrows = segdsc[5];
/* Decide how many pages we'll need to store the data. Also */
/* record the number of data values to write. */
if (nullok) {
/* Count the non-null rows; these are the ones that will take */
/* up space. */
nnull = 0;
i__1 = nrows;
for (i__ = 1; i__ <= i__1; ++i__) {
if (nlflgs[i__ - 1]) {
++nnull;
}
}
ndata = nrows - nnull;
} else {
ndata = nrows;
}
if (ndata > 0) {
/* There's some data to write, so allocate a page. Also */
/* prepare a data buffer to be written out as a page. */
zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase);
cleari_(&c__256, page);
}
/* Write the input data out to the target file a page at a time. */
/* Null values don't get written. */
/* While we're at it, we'll push onto the EK stack the addresses */
/* of the column entries. We use the constant NULL rather than an */
/* address to represent null entries. */
/* We'll use FROM to indicate the element of IVALS we're */
/* considering, TO to indicate the element of PAGE to write */
/* to, and BUFPTR to indicate the element of ADRBUF to write */
/* addresses to. The variable N indicates the number of data */
/* items in the current page. */
remain = nrows;
from = 1;
to = 1;
bufptr = 1;
nwrite = 0;
n = 0;
while(remain > 0) {
if (nullok && nlflgs[from - 1]) {
adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge(
"adrbuf", i__1, "zzekac01_", (ftnlen)378)] = -2;
} else {
adrbuf[(i__1 = bufptr - 1) < 254 && 0 <= i__1 ? i__1 : s_rnge(
"adrbuf", i__1, "zzekac01_", (ftnlen)382)] = to + pbase;
page[(i__1 = to - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page",
i__1, "zzekac01_", (ftnlen)383)] = ivals[from - 1];
++to;
++nwrite;
++n;
}
++from;
--remain;
if (bufptr == 254 || remain == 0) {
/* The address buffer is full or we're out of input values */
/* to look at, so push the buffer contents on the stack. */
zzekspsh_(&bufptr, adrbuf);
bufptr = 1;
} else {
++bufptr;
}
if (n == 254 || nwrite == ndata && ndata != 0) {
/* Either the current data page is full, or we've buffered */
/* the last of the available data. It's time to write out the */
/* current page. First set the link count. */
page[255] = n;
/* Write out the data page. */
zzekpgwi_(handle, &p, page);
/* If there's more data to write, allocate another page. */
if (nwrite < ndata) {
zzekaps_(handle, segdsc, &c__3, &c_false, &p, &pbase);
cleari_(&c__256, page);
n = 0;
to = 1;
}
}
}
/* If the column is supposed to have an index, now is the time to */
/* build that index. We'll find the order vector for the input */
/* values, overwrite the elements of the order vector with the */
/* corresponding elements of the input array of record pointers, then */
/* load this sorted copy of the record pointer array into a tree in */
/* one shot. */
if (indexd) {
zzekordi_(ivals, &nullok, nlflgs, &nrows, wkindx);
i__1 = nrows;
for (i__ = 1; i__ <= i__1; ++i__) {
wkindx[i__ - 1] = rcptrs[wkindx[i__ - 1] - 1];
}
zzektrit_(handle, &tree);
zzektr1s_(handle, &tree, &nrows, wkindx);
/* Update the segment's metadata to point to the index. The */
/* pointer indicates the root page of the tree. */
mbase = segdsc[2];
dscbas = mbase + 24 + (colidx - 1) * 11;
i__1 = dscbas + 7;
i__2 = dscbas + 7;
dasudi_(handle, &i__1, &i__2, &tree);
}
chkout_("ZZEKAC01", (ftnlen)8);
return 0;
} /* zzekac01_ */
/* $Procedure ZZEKINQC ( Private: EK, insert into query, character ) */
/* Subroutine */ int zzekinqc_(char *value, integer *length, integer *lexbeg,
integer *lexend, integer *eqryi, char *eqryc, integer *descr, ftnlen
value_len, ftnlen eqryc_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 free, init, size, room;
extern /* Subroutine */ int zzekreqi_(integer *, char *, integer *,
ftnlen), zzekweqi_(char *, integer *, integer *, ftnlen);
integer l;
extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *,
integer *), setmsg_(char *, ftnlen), sigerr_(char *, ftnlen),
chkout_(char *, ftnlen), errint_(char *, integer *, 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. */
/* Insert a character value into a specified encoded EK query, and */
/* obtain a descriptor for the stored 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 */
/* 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 Encoded Query Internal Parameters */
/* ekquery.inc Version 3 16-NOV-1995 (NJB) */
/* Updated to reflect increased value of MAXCON in */
/* ekqlimit.inc. */
/* ekquery.inc Version 2 03-AUG-1995 (NJB) */
/* Updated to support representation of the SELECT clause. */
/* ekquery.inc Version 1 12-JAN-1995 (NJB) */
/* An encoded EK query is an abstract data type implemented */
/* as an integer cell, along with a double precision cell and */
/* a character string. The d.p. cell and string contain numeric */
/* and string values from the query string represented by the */
/* encoded query. */
/* The parameters in this file are intended for use only by the */
/* EK encoded query access routines. Callers of EK routines should */
/* not use these parameters. */
/* The following parameters are indices of specified elements */
/* in the integer portion of the encoded query. */
/* Encoded query architecture type: */
/* `Name resolution' consists of: */
/* - Verifying existence of tables: any table names listed */
/* in the FROM clause of a query must be loaded. */
/* - Validating table aliases used to qualify column names. */
/* - Verifying existence of columns and obtaining data types */
/* for columns. */
/* - Setting data type codes for literal values in the encoded */
/* query. */
/* - Checking consistency of operators and operand data types. */
/* - Making sure unqualified column names are unambiguous. */
/* - For constraints, mapping the table names used to qualify */
/* column names to the ordinal position in the FROM clause */
/* of the corresponding table. */
/* Initialization status---this flag indicates whether the encoded */
/* query has been initialized. Values are ITRUE or IFALSE. See the */
/* include file ekbool.inc for parameter values. */
/* Parse status---this flag indicates whether the parsing operation */
/* that produced an encoded query has been completed. Values are */
/* ITRUE or IFALSE. */
/* Name resolution status---this flag indicates whether names */
/* have been resolved in an encoded query. Values are ITRUE or */
/* IFALSE. */
/* Time resolution status---this flag indicates whether time values */
/* have been resolved in an encoded query. Time resolution */
/* consists of converting strings representing time values to ET. */
/* Values of the status are ITRUE or IFALSE. */
/* Semantic check status---this flag indicates whether semantic */
/* checking of constraints has been performed. */
/* Number of tables specified in FROM clause: */
/* Number of constraints in query: */
/* A special value is used to indicate the `maximal' constraint--- */
/* one that logically cannot be satisfied. If the constraints */
/* are equivalent to the maximal constraint, the location EQNCNS */
/* is assigned the value EQMXML */
/* Number of constraint conjunctions: */
/* Number of order-by columns: */
/* Number of SELECT columns: */
/* Size of double precision buffer: */
/* `Free' pointer into double precision buffer: */
/* Size of character string buffer: */
/* `Free' pointer into character string buffer: */
/* The following four base pointers will be valid after a query */
/* has been parsed: */
/* Base pointer for SELECT column descriptors: */
/* Base pointer for constraint descriptors: */
/* Base pointer for conjunction sizes: */
/* Base pointer for order-by column descriptors: */
/* After the quantities named above, the integer array contains */
/* series of descriptors for tables, constraints, and order-by */
/* columns, as well as a list of `conjunction sizes'---that is, */
/* the sizes of the groups of constraints that form conjunctions, */
/* after the input query has been re-arranged as a disjunction of */
/* conjunctions of constraints. */
/* The offsets of specific elements within descriptors are */
/* parameterized. The base addresses of the descriptors themselves */
/* must be calculated using the counts and sizes of the items */
/* preceding them. */
/* A diagram of the structure of the variable-size portion of the */
/* integer array is shown below: */
/* +-------------------------------------+ */
/* | Fixed-size portion of encoded query | */
/* +-------------------------------------+ */
/* | Encoded FROM clause | */
/* +-------------------------------------+ */
/* | Encoded constraint clause | */
/* +-------------------------------------+ */
/* | Conjunction sizes | */
/* +-------------------------------------+ */
/* | Encoded ORDER BY clause | */
/* +-------------------------------------+ */
/* | Encoded SELECT clause | */
/* +-------------------------------------+ */
/* Value Descriptors */
/* ---------------- */
/* In order to discuss the various descriptors below, we'll make use */
/* of sub-structures called `value descriptors'. These descriptors */
/* come in two flavors: character and double precision. For */
/* strings, a descriptor is a set of begin and end pointers that */
/* indicate the location of the string in the character portion of an */
/* encoded query, along with the begin and end pointers for the */
/* corresponding lexeme in the original query. The pointers are set */
/* to zero when they are not in use, for example if they refer to an */
/* optional lexeme that did not appear in the input query. */
/* All value descriptors start with a data type indicator; values */
/* are from ektype.inc. Integer and time values are referred to */
/* by double precision descriptors. */
/* Parameters for string value descriptor elements: */
/* Numeric value descriptors are similar to those for string values, */
/* the difference being that they have only one pointer to the value */
/* they represent. This pointer is the index of the value in the */
/* encoded query's numeric buffer. */
/* All value descriptors have the same size. In order to allow */
/* table descriptors to have the same size as value descriptors, */
/* we include an extra element in the descriptor. */
/* Column Descriptors */
/* ----------------- */
/* Each column descriptor consists of a character descriptor for the */
/* name of the column, followed by an index, which gives the ordinal */
/* position of the column in the logical table to which the column */
/* belongs. The index element is filled in during name resolution. */
/* Table Descriptors */
/* ----------------- */
/* Each table descriptor consists of a character descriptor for the */
/* name of the table, followed by an index, which gives the ordinal */
/* position of the table in the FROM clause in the original query. */
/* The index element is filled in during name resolution. Aliases */
/* and table names have identical descriptor structures. */
/* Constraint descriptors */
/* ------------------ */
/* Each constraint is characterized by: */
/* - A code indicating whether the constraint compares values */
/* in two columns or the value in a column and a literal */
/* value. The values of this element are EQCOL and EQVAL. */
/* - A descriptor for the table used to qualify the */
/* column name on the left side of the constraint. */
/* - A character value descriptor for the column name on the left */
/* side of the query. */
/* - An operator code indicating the relational operator used */
/* in the constraint. */
/* If the constraint compares values from two columns, the */
/* next items are table and column name descriptors that apply to */
/* the column named on the right side of the relational operator. */
/* If the constraint has a literal value on the right side, the */
/* operator code is followed by... */
/* - a value descriptor. */
/* - Size of a constraint descriptor: */
/* Conjunction sizes */
/* ----------------- */
/* The size of each conjunction of constraints occupies a single */
/* integer. */
/* Order-by Column Descriptors */
/* --------------------------- */
/* Each order-by column descriptor contains descriptors for */
/* the table containing the column and for the name of the column */
/* itself; one additional element is used to indicate the direction */
/* of the ordering (ascending vs descending). */
/* - The last integer in the descriptor indicates whether the */
/* order direction is ascending or descending. */
/* - Size of an order-by column descriptor: */
/* Codes indicating sense of ordering (ascending vs descending): */
/* SELECT Column Descriptors */
/* --------------------------- */
/* Each SELECT column descriptor contains descriptors for */
/* the table containing the column and for the name of the column */
/* itself. */
/* - Size of a SELECT column descriptor: */
/* Miscellaneous parameters: */
/* EQIMIN is the minimum size of the integer portion of */
/* an encoded query. EQIMIN depends on the parameters */
/* MAXTAB */
/* MAXCON */
/* MAXORD */
/* MAXSEL */
/* all of which are declared in the include file ekqlimit.inc. */
/* The functional definition of EQIMIN is: */
/* INTEGER EQIMIN */
/* PARAMETER ( EQIMIN = EQVBAS */
/* . + MAXTAB * EQVDSZ * 2 */
/* . + MAXCON * EQCDSZ */
/* . + MAXCON */
/* . + MAXORD * EQODSZ */
/* . + MAXSEL * EQSDSZ ) */
/* End Include Section: EK Encoded Query Internal 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 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* VALUE I Character value. */
/* LENGTH I Length of item to insert. */
/* LEXBEG, */
/* LEXEND I Begin and end positions of value's lexeme. */
/* EQRYI I-O Integer portion of encoded query. */
/* EQRYC I-O Character portion of encoded query. */
/* DESCR O Descriptor for value. */
/* $ Detailed_Input */
/* VALUE is a character value to be inserted into an */
/* encoded query. */
/* LENGTH indicates the length of the input character value. */
/* If LENGTH exceeds LEN(VALUE), the stored value */
/* is padded with trailing blanks. This allows */
/* faithful representation of literal strings. */
/* LEXBEG, */
/* LEXEND are the begin and end character positions in the */
/* original query of the lexeme that generated the */
/* input value. These indices may be used for error */
/* correction. */
/* EQRYI is the integer portion of an encoded EK query */
/* EQRYC is the character portion of an encoded EK query. */
/* $ Detailed_Output */
/* EQRYI is the integer portion of an encoded EK query, */
/* updated to reflect the addition of a value to the */
/* encoded query's character buffer. */
/* EQRYC is the character portion of an encoded EK query, */
/* with the input value added. */
/* DESCR is a descriptor for the input value. The */
/* descriptor contains EQVDSZ elements. */
/* $ Parameters */
/* See the INCLUDE files. */
/* $ Exceptions */
/* 1) If the input query is uninitialized, the error */
/* SPICE(NOTINITIALIZED) will be signalled. */
/* 2) If the input character count LENGTH is non-positive, the */
/* error SPICE(INVALIDCOUNT) is signalled. */
/* 3) If there is insufficient space in the encoded query's */
/* character component, the error SPICE(BUFFERTOOSMALL) is */
/* signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine should always be used to insert character values */
/* into an encoded query; the insertion should never be done */
/* directly. */
/* $ Examples */
/* See ZZEKNRML. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
zzekreqi_(eqryi, "INITIALIZED", &init, (ftnlen)11);
if (init != 1) {
chkin_("ZZEKINQC", (ftnlen)8);
setmsg_("Encoded query must be initialized before it may be written.",
(ftnlen)59);
sigerr_("SPICE(NOTINITIALIZED)", (ftnlen)21);
chkout_("ZZEKINQC", (ftnlen)8);
return 0;
}
/* Check the input length value. */
if (*length < 1) {
chkin_("ZZEKINQC", (ftnlen)8);
setmsg_("Length of string value was #; must be > 0.", (ftnlen)42);
errint_("#", length, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZEKINQC", (ftnlen)8);
return 0;
}
/* Get the character free pointer; make sure there's enough room. */
zzekreqi_(eqryi, "FREE_CHR", &free, (ftnlen)8);
zzekreqi_(eqryi, "CHR_BUF_SIZE", &size, (ftnlen)12);
room = size - free + 1;
if (*length > room) {
chkin_("ZZEKINQC", (ftnlen)8);
setmsg_("Out of room in character portion of encoded query; only # e"
"lements were available; # are needed.", (ftnlen)96);
errint_("#", &room, (ftnlen)1);
errint_("#", length, (ftnlen)1);
sigerr_("SPICE(BUFFERTOOSMALL)", (ftnlen)21);
chkout_("ZZEKINQC", (ftnlen)8);
return 0;
}
/* Insert the value into the character portion of the encoded query. */
/* Computing MIN */
i__1 = *length, i__2 = i_len(value, value_len);
l = min(i__1,i__2);
s_copy(eqryc + (free - 1), value, eqryc_len - (free - 1), l);
/* Fill in the descriptor. */
cleari_(&c__6, descr);
descr[0] = 1;
descr[1] = *lexbeg;
descr[2] = *lexend;
descr[3] = free;
descr[4] = free + *length - 1;
/* Update the character free pointer. */
i__1 = free + *length;
zzekweqi_("FREE_CHR", &i__1, eqryi, (ftnlen)8);
return 0;
} /* zzekinqc_ */
/* $Procedure ZZEKTR1S ( EK tree, one-shot load ) */
/* Subroutine */ int zzektr1s_(integer *handle, integer *tree, integer *size,
integer *values)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer base, page[256], nbig, node, subd, next, unit;
extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *,
integer *), zzekpgri_(integer *, integer *, integer *), zzekpgwi_(
integer *, integer *, integer *);
extern integer zzektrbs_(integer *);
integer d__, i__, n, q, child, s;
extern integer zzektrsz_(integer *, integer *);
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer level, nkids, npred, nkeys, tsize, kidbas;
extern /* Subroutine */ int cleari_(integer *, integer *), dasudi_(
integer *, integer *, integer *, integer *);
integer basidx;
extern /* Subroutine */ int dashlu_(integer *, integer *);
integer bigsiz, nnodes, nsmall, stnbig[10], stnbas[10], stnode[10];
extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen);
extern logical return_(void);
integer maxsiz, reqsiz, stlsiz[10], stnext[10], stnkey[10], stsbsz[10],
subsiz, totnod;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer div, key;
/* $ Abstract */
/* One-shot tree load: insert an entire array into an empty */
/* tree. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* EK */
/* $ Keywords */
/* EK */
/* PRIVATE */
/* $ Declarations */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include Section: EK Das Paging Parameters */
/* ekpage.inc Version 4 25-AUG-1995 (NJB) */
/* The EK DAS paging system makes use of the integer portion */
/* of an EK file's DAS address space to store the few numbers */
/* required to describe the system's state. The allocation */
/* of DAS integer addresses is shown below. */
/* DAS integer array */
/* +--------------------------------------------+ */
/* | EK architecture code | Address = 1 */
/* +--------------------------------------------+ */
/* | Character page size (in DAS words) | */
/* +--------------------------------------------+ */
/* | Character page base address | */
/* +--------------------------------------------+ */
/* | Number of character pages in file | */
/* +--------------------------------------------+ */
/* | Number of character pages on free list | */
/* +--------------------------------------------+ */
/* | Character free list head pointer | Address = 6 */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for d.p. pages | 7--11 */
/* | | */
/* +--------------------------------------------+ */
/* | | Addresses = */
/* | Metadata for integer pages | 12--16 */
/* | | */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | End Address = */
/* | Unused space | integer page */
/* | | end */
/* +--------------------------------------------+ */
/* | | Start Address = */
/* | First integer page | integer page */
/* | | base */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | | */
/* | Last integer page | */
/* | | */
/* +--------------------------------------------+ */
/* The following parameters indicate positions of elements in the */
/* paging system metadata array: */
/* Number of metadata items per data type: */
/* Character metadata indices: */
/* Double precision metadata indices: */
/* Integer metadata indices: */
/* Size of metadata area: */
/* Page sizes, in units of DAS words of the appropriate type: */
/* Default page base addresses: */
/* End Include Section: EK Das Paging Parameters */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include Section: EK Tree Parameters */
/* ektree.inc Version 3 22-OCT-1995 (NJB) */
/* The parameters in this file define the tree structure */
/* used by the EK system. This structure is a variant of the */
/* B*-tree structure described in Knuth's book, that is */
/* Knuth, Donald E. "The Art of Computer Programming, */
/* Volume 3/Sorting and Searching" 1973, pp 471-479. */
/* The trees used in the EK system differ from generic B*-trees */
/* primarily in the way keys are treated. Rather than storing */
/* unique primary key values in each node, EK trees store integer */
/* counts that represent the ordinal position of each data value, */
/* counting from the lowest indexed element in the subtree whose */
/* root is the node in question. Thus the keys are unique within */
/* a node but not across multiple nodes: in fact the Nth key in */
/* every leaf node is N. The absolute ordinal position of a data */
/* item is defined recursively as the sum of the key of the data item */
/* and the absolute ordinal position of the data item in the parent */
/* node that immediately precedes all elements of the node in */
/* question. This data structure allows EK trees to support lookup */
/* of data items based on their ordinal position in a data set. The */
/* two prime applications of this capability in the EK system are: */
/* 1) Using trees to index the records in a table, allowing */
/* the Nth record to be located efficiently. */
/* 2) Using trees to implement order vectors that can be */
/* maintained when insertions and deletions are done. */
/* Root node */
/* +--------------------------------------------+ */
/* | Tree version code | */
/* +--------------------------------------------+ */
/* | Number of nodes in tree | */
/* +--------------------------------------------+ */
/* | Number of keys in tree | */
/* +--------------------------------------------+ */
/* | Depth of tree | */
/* +--------------------------------------------+ */
/* | Number of keys in root | */
/* +--------------------------------------------+ */
/* | Space for n keys, | */
/* | | */
/* | n = 2 * INT( ( 2*m - 2 )/3 ) | */
/* | | */
/* | where m is the max number of children per | */
/* | node in the child nodes | */
/* +--------------------------------------------+ */
/* | Space for n+1 child pointers, | */
/* | where n is as defined above. | */
/* +--------------------------------------------+ */
/* | Space for n data pointers, | */
/* | where n is as defined above. | */
/* +--------------------------------------------+ */
/* Child node */
/* +--------------------------------------------+ */
/* | Number of keys present in node | */
/* +--------------------------------------------+ */
/* | Space for m-1 keys | */
/* +--------------------------------------------+ */
/* | Space for m child pointers | */
/* +--------------------------------------------+ */
/* | Space for m-1 data pointers | */
/* +--------------------------------------------+ */
/* The following parameters give the maximum number of children */
/* allowed in the root and child nodes. During insertions, the */
/* number of children may overflow by 1. */
/* Maximum number of children allowed in a child node: */
/* Maximum number of keys allowed in a child node: */
/* Minimum number of children allowed in a child node: */
/* Minimum number of keys allowed in a child node: */
/* Maximum number of children allowed in the root node: */
/* Maximum number of keys allowed in the root node: */
/* Minimum number of children allowed in the root node: */
/* The following parameters indicate positions of elements in the */
/* tree node structures shown above. */
/* The following parameters are for the root node only: */
/* Location of version code: */
/* Version code: */
/* Location of node count: */
/* Location of total key count for the tree: */
/* Location of tree depth: */
/* Location of count of keys in root node: */
/* Base address of keys in the root node: */
/* Base address of child pointers in root node: */
/* Base address of data pointers in the root node (allow room for */
/* overflow): */
/* Size of root node: */
/* The following parameters are for child nodes only: */
/* Location of number of keys in node: */
/* Base address of keys in child nodes: */
/* Base address of child pointers in child nodes: */
/* Base address of data pointers in child nodes (allow room */
/* for overflow): */
/* Size of child node: */
/* A number of EK tree routines must declare stacks of fixed */
/* depth; this depth limit imposes a limit on the maximum depth */
/* that an EK tree can have. Because of the large branching */
/* factor of EK trees, the depth limit is of no practical */
/* importance: The number of keys that can be held in an EK */
/* tree of depth N is */
/* N-1 */
/* MXKIDC - 1 */
/* MXKIDR * ------------- */
/* MXKIDC - 1 */
/* This formula yields a capacity of over 1 billion keys for a */
/* tree of depth 6. */
/* End Include Section: EK Tree Parameters */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include Section: EK Data Types */
/* ektype.inc Version 1 27-DEC-1994 (NJB) */
/* Within the EK system, data types of EK column contents are */
/* represented by integer codes. The codes and their meanings */
/* are listed below. */
/* Integer codes are also used within the DAS system to indicate */
/* data types; the EK system makes no assumptions about compatibility */
/* between the codes used here and those used in the DAS system. */
/* Character type: */
/* Double precision type: */
/* Integer type: */
/* `Time' type: */
/* Within the EK system, time values are represented as ephemeris */
/* seconds past J2000 (TDB), and double precision numbers are used */
/* to store these values. However, since time values require special */
/* treatment both on input and output, and since the `TIME' column */
/* has a special role in the EK specification and code, time values */
/* are identified as a type distinct from double precision numbers. */
/* End Include Section: EK Data Types */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* TREE I Root of tree. */
/* SIZE I Size of tree. */
/* VALUES I Values to insert. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for write access. */
/* TREE is the root node number of the tree of interest. */
/* The tree must be empty. */
/* SIZE is the size of the tree to create: SIZE is the */
/* number of values that will be inserted into the */
/* tree. */
/* VALUES is an array of integer values to be inserted into */
/* the tree. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is invalid, the error will be diagnosed by routines */
/* called by this routine. The file will not be modified. */
/* 2) If an I/O error occurs while reading or writing the indicated */
/* file, the error will be diagnosed by routines called by this */
/* routine. */
/* 3) If the input tree is not empty, the error SPICE(NONEMPTYTREE) */
/* is signalled. */
/* 4) If the depth of the tree needed to hold the number of values */
/* indicated by SIZE exceeds the maximum depth limit, the error */
/* SPICE(COUNTTOOLARGE) is signalled. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine creates an EK tree and loads the tree with the */
/* integer values supplied in the array VALUES. The ordinal */
/* positions of the values in the tree correspond to the positions */
/* of the values in the input array: for example, the 10th element */
/* of the array is pointed to by the key 10. */
/* This routine loads a tree much faster than can be done by */
/* sequentially loading the set of values by successive calls to */
/* ZZEKTRIN. On the other hand, the caller must declare an array */
/* large enough to hold all of the values to be loaded. Note that */
/* a partially full tree cannot be extended using this routine. */
/* $ Examples */
/* See EKFFLD. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */
/* 3/Sorting and Searching" 1973, pp 471-479. */
/* EK trees are closely related to the B* trees described by */
/* Knuth. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.1.0, 18-JUN-1999 (WLT) */
/* Removed redundant calls to CHKIN */
/* - Beta Version 1.0.0, 22-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Non-SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKTR1S", (ftnlen)8);
}
/* Make sure the input tree is empty. */
tsize = zzektrsz_(handle, tree);
if (tsize > 0) {
dashlu_(handle, &unit);
setmsg_("Tree has size #; should be empty.EK = #; TREE = #.", (ftnlen)
50);
errint_("#", &tsize, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
sigerr_("SPICE(NONEMPTYTREE)", (ftnlen)19);
chkout_("ZZEKTR1S", (ftnlen)8);
return 0;
}
/* Compute the tree depth required. The largest tree of a given */
/* depth D contains the root node plus S(D) child nodes, where */
/* S(1) = 1 */
/* and if D is at least 2, */
/* D - 2 */
/* ____ */
/* \ i */
/* S(D) = MAX_SIZE * / MAX_SIZE */
/* Root ---- Child */
/* i = 0 */
/* D - 2 */
/* ____ */
/* \ i */
/* = MXKIDR * / MXKIDC */
/* ---- */
/* i = 0 */
/* D-1 */
/* MXKIDC - 1 */
/* = MXKIDR * ------------- */
/* MXKIDC - 1 */
/* If all of these nodes are full, the number of keys that */
/* can be held in this tree is */
/* MXKEYR + S(D) * MXKEYC */
/* We want the minimum value of D such that this expression */
/* is greater than or equal to SIZE. */
tsize = 82;
d__ = 1;
s = 1;
while(tsize < *size) {
++d__;
if (d__ == 2) {
s = 82;
} else {
/* For computational purposes, the relationship */
/* S(D+1) = MXKIDR + MXKIDC * S(D) */
/* is handy. */
s = s * 63 + 83;
}
tsize = s * 62 + 82;
}
/* If the tree must be deeper than we expected, we've a problem. */
if (d__ > 10) {
dashlu_(handle, &unit);
setmsg_("Tree has depth #; max supported depth is #.EK = #; TREE = #."
, (ftnlen)60);
errint_("#", &d__, (ftnlen)1);
errint_("#", &c__10, (ftnlen)1);
errfnm_("#", &unit, (ftnlen)1);
errint_("#", tree, (ftnlen)1);
sigerr_("SPICE(COUNTTOOLARGE)", (ftnlen)20);
chkout_("ZZEKTR1S", (ftnlen)8);
return 0;
}
/* The basic error checks are done. At this point, we can build the */
/* tree. */
/* The approach is to fill in the tree in a top-down fashion. */
/* We decide how big each subtree of the root will be; this */
/* information allows us to decide which keys actually belong */
/* in the root. Having filled in the root, we repeat the process */
/* for each subtree of the root in left-to-right order. */
/* We use a stack to keep track of the ancestors of the */
/* node we're currently considering. The table below shows the */
/* items we save on the stack and the stack variables associated */
/* with those items: */
/* Item Stack Variable */
/* ---- --------------- */
/* Node number STNODE */
/* Size, in keys, of the */
/* subtree headed by node STSBSZ */
/* Number of keys in node STNKEY */
/* Larger subtree size STLSIZ */
/* Number of large subtrees STNBIG */
/* Index of next subtree to visit STNEXT */
/* Base index of node STNBAS */
node = *tree;
subsiz = *size;
next = 1;
level = 1;
basidx = 0;
while(level > 0) {
/* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */
if (next == 1) {
/* This node has not been visited yet. We'll fill in this */
/* node before proceeding to fill in its descendants. The */
/* first step is to compute the number and sizes of the */
/* subtrees of this node. */
/* Decide the large subtree size and the number of subtrees of */
/* this node. The depth SUBD of the subtrees of this node is */
/* D - LEVEL. Each subtree has size bounded by the sizes of */
/* the subtree of depth SUBD in which all nodes contain MNKEYC */
/* keys and the by the subtree of depth SUBD in which all nodes */
/* contain MXKEYC keys. If this node is not the root and is */
/* not a leaf node, the number of subtrees must be between */
/* MNKIDC and MXKIDC. */
if (level == 1) {
/* We're working on the root. The number of subtrees is */
/* anywhere between 0 and MXKIDR, inclusive. We'll create */
/* a tree with the minimum number of subtrees of the root. */
if (d__ > 1) {
/* We'll find the number of subtrees of maximum size */
/* that we would need to hold the non-root keys of the */
/* tree. We'll then determine the actual required sizes */
/* of these subtrees. */
subd = d__ - 1;
nnodes = 0;
i__1 = subd;
for (i__ = 1; i__ <= i__1; ++i__) {
nnodes = nnodes * 63 + 1;
}
maxsiz = nnodes * 62;
/* If we had NKIDS subtrees of size MAXSIZ, NKIDS */
/* would be the smallest integer such that */
/* ( NKIDS - 1 ) + NKIDS * MAXSIZ > SUBSIZ */
/* - */
/* or equivalently, */
/* NKIDS * ( MAXSIZ + 1 ) > SUBSIZ + 1 */
/* - */
/* We'll compute this value of NKIDS. */
q = subsiz + 1;
div = maxsiz + 1;
nkids = (q + div - 1) / div;
/* The minimum number of keys we must store in child */
/* nodes is the number of keys in the tree, minus those */
/* that can be accommodated in the root: */
n = subsiz - (nkids - 1);
/* Now we can figure out how large the subtrees would */
/* have to be in order to hold N keys, if all subtrees */
/* had the same size. */
bigsiz = (n + nkids - 1) / nkids;
/* We may have more capacity than we need if all subtrees */
/* have size BIGSIZ. So, we'll allow some subtrees to */
/* have size BIGSIZ-1. Not all subtrees can have the */
/* smaller size (otherwise BIGSIZ would have been */
/* smaller). The first NBIG subtrees will have the */
/* larger size. */
nsmall = nkids * bigsiz - n;
nbig = nkids - nsmall;
nkeys = nkids - 1;
} else {
/* All keys are in the root. */
nkeys = *size;
nkids = 0;
}
/* Read in the root page. */
zzekpgri_(handle, tree, page);
/* We have enough information to fill in the root node. */
/* We'll allocate nodes for the immediate children. */
/* There is one key `between' each child pointer. */
i__1 = nkeys;
for (i__ = 1; i__ <= i__1; ++i__) {
/* The Ith key may be found by considering the number */
/* of keys in the subtree between the Ith key and its */
/* predecessor in the root. */
if (i__ == 1) {
npred = 0;
} else {
npred = page[(i__2 = i__ + 3) < 256 && 0 <= i__2 ?
i__2 : s_rnge("page", i__2, "zzektr1s_", (
ftnlen)480)];
}
if (d__ > 1) {
/* The tree contains subtrees. */
if (i__ <= nbig) {
key = npred + bigsiz + 1;
} else {
key = npred + bigsiz;
}
} else {
key = i__;
}
page[(i__2 = i__ + 4) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)499)] = key;
page[(i__2 = i__ + 171) < 256 && 0 <= i__2 ? i__2 :
s_rnge("page", i__2, "zzektr1s_", (ftnlen)500)] =
values[key - 1];
}
totnod = 1;
i__1 = nkids;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Allocate a node for the Ith child. Store pointers */
/* to these nodes. */
zzekpgal_(handle, &c__3, &child, &base);
page[(i__2 = i__ + 87) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)513)] = child;
++totnod;
}
/* Fill in the root's metadata. There is one item that */
/* we'll have to fill in when we're done: the number of */
/* nodes in the tree. We know the rest of the information */
/* now. */
page[2] = *size;
page[3] = d__;
page[4] = nkeys;
page[1] = 0;
/* Write out the root. */
zzekpgwi_(handle, tree, page);
} else if (level < d__) {
/* The current node is a non-leaf child node. */
cleari_(&c__256, page);
/* The tree headed by this node has depth D-LEVEL+1 and */
/* must hold SUBSIZ keys. We must figure out the size */
/* and number of subtrees of the current node. Unlike in */
/* the case of the root, we must have between MNKIDC */
/* and MXKIDC subtrees of this node. We start out by */
/* computing the required subtree size if there were */
/* exactly MNKIDC subtrees. In this case, the total */
/* number of keys in the subtrees would be */
/* SUBSIZ - MNKEYC */
n = subsiz - 41;
reqsiz = (n + 40) / 41;
/* Compute the maximum allowable number of keys in */
/* a subtree. */
subd = d__ - level;
nnodes = 0;
i__1 = subd;
for (i__ = 1; i__ <= i__1; ++i__) {
nnodes = nnodes * 63 + 1;
}
maxsiz = nnodes * 62;
/* If the number REQSIZ we came up with is a valid size, */
/* we'll be able to get the correct number of children */
/* by using subtrees of size REQSIZ and REQSIZ-1. Note */
/* that it's impossible for REQSIZ to be too small, */
/* since the smallest possible number of subtrees is */
/* MNKIDC. */
if (reqsiz <= maxsiz) {
/* Decide how many large and small subtrees we need. */
nkids = 42;
bigsiz = reqsiz;
nsmall = bigsiz * nkids - n;
nbig = nkids - nsmall;
} else {
/* See how many subtrees of size MAXSIZ it would take */
/* to hold the requisite number of keys. We know the */
/* number is more than MNKIDC. If we have NKIDS */
/* subtrees of size MAXSIZ, the total number of */
/* keys in the subtree headed by NODE is */
/* ( NKIDS - 1 ) + ( NKIDS * MAXSIZ ) */
/* or */
/* NKIDS * ( MAXSIZ + 1 ) - 1 */
/* We must find the smallest value of NKIDS such */
/* that the above quantity is greater than or equal */
/* to SUBSIZ. */
q = subsiz + 1;
div = maxsiz + 1;
nkids = (q + div - 1) / div;
/* We know that NKIDS subtrees of size MAXSIZ, plus */
/* NKIDS-1 keys in NODE, can hold at least SUBSIZ */
/* keys. We now want to find the smallest subtree */
/* size such that NKIDS subtrees of that size, */
/* together with the NKIDS-1 keys in NODE, contain */
/* at least SUBSIZ keys. The size we seek will */
/* become BIGSIZ, the larger of the two subtree */
/* sizes we'll use. So BIGSIZ is the smallest */
/* integer such that */
/* ( NKIDS - 1 ) + ( NKIDS * BIGSIZ ) > SUBSIZ */
/* - */
/* or equivalently */
/* BIGSIZ * NKIDS > SUBSIZ - NKIDS + 1 */
/* - */
q = subsiz - nkids + 1;
div = nkids;
bigsiz = (q + div - 1) / div;
nsmall = bigsiz * nkids - q;
nbig = nkids - nsmall;
}
/* Fill in the keys for the current node. */
nkeys = nkids - 1;
i__1 = nkeys;
for (i__ = 1; i__ <= i__1; ++i__) {
/* The Ith key may be found by considering the number */
/* of keys in the subtree between the Ith key and its */
/* predecessor in the current node. */
if (i__ == 1) {
npred = basidx;
} else {
npred = basidx + page[(i__2 = i__ - 1) < 256 && 0 <=
i__2 ? i__2 : s_rnge("page", i__2, "zzektr1s_"
, (ftnlen)652)];
}
if (i__ <= nbig) {
key = npred + bigsiz + 1;
} else {
key = npred + bigsiz;
}
page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)661)] = key -
basidx;
page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 :
s_rnge("page", i__2, "zzektr1s_", (ftnlen)662)] =
values[key - 1];
}
i__1 = nkids;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Allocate a node for the Ith child. Store pointers */
/* to these nodes. */
zzekpgal_(handle, &c__3, &child, &base);
page[(i__2 = i__ + 63) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)674)] = child;
++totnod;
}
/* We can now fill in the metadata for the current node. */
page[0] = nkeys;
zzekpgwi_(handle, &node, page);
}
/* Unless the current node is a leaf node, prepare to visit */
/* the first child of the current node. */
if (level < d__) {
/* Push our current state. */
stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnode", i__1, "zzektr1s_", (ftnlen)696)] = node;
stsbsz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stsbsz", i__1, "zzektr1s_", (ftnlen)697)] = subsiz;
stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnkey", i__1, "zzektr1s_", (ftnlen)698)] = nkeys;
stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stlsiz", i__1, "zzektr1s_", (ftnlen)699)] = bigsiz;
stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnbig", i__1, "zzektr1s_", (ftnlen)700)] = nbig;
stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnext", i__1, "zzektr1s_", (ftnlen)701)] = 2;
stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnbas", i__1, "zzektr1s_", (ftnlen)702)] = basidx;
/* NEXT is already set to 1. BASIDX is set, since the */
/* base index of the first child is that of the parent. */
if (level == 1) {
kidbas = 88;
} else {
kidbas = 64;
}
++level;
node = page[(i__1 = kidbas) < 256 && 0 <= i__1 ? i__1 :
s_rnge("page", i__1, "zzektr1s_", (ftnlen)715)];
subsiz = bigsiz;
} else if (level > 1) {
/* The current node is a child leaf node. There are no */
/* calculations to do; we simply assign keys and pointers, */
/* write out metadata, and pop our state. */
nkeys = subsiz;
i__1 = nkeys;
for (i__ = 1; i__ <= i__1; ++i__) {
key = basidx + i__;
page[(i__2 = i__) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"page", i__2, "zzektr1s_", (ftnlen)730)] = i__;
page[(i__2 = i__ + 127) < 256 && 0 <= i__2 ? i__2 :
s_rnge("page", i__2, "zzektr1s_", (ftnlen)731)] =
values[key - 1];
}
/* We can now fill in the metadata for the current node. */
page[0] = nkeys;
zzekpgwi_(handle, &node, page);
/* A leaf node is a subtree unto itself, and we're */
/* done with this subtree. Pop our state. */
--level;
if (level >= 1) {
node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)750)
];
nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnkey", i__1, "zzektr1s_", (
ftnlen)751)];
bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)752)];
nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)753)
];
next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)754)
];
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)755)];
nkids = nkeys + 1;
/* Read in the current node. */
zzekpgri_(handle, &node, page);
}
} else {
/* The only node is the root. Pop out. */
level = 0;
}
/* We've decided which node to go to next at this point. */
/* At this point, LEVEL, NEXT, NODE, SUBSIZ and BASIDX are set. */
} else {
/* The current node has been visited already. Visit the */
/* next child, if there is one. */
if (next <= nkids) {
/* Prepare to visit the next child of the current node. */
stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"stnext", i__1, "zzektr1s_", (ftnlen)787)] = next + 1;
if (level == 1) {
kidbas = 88;
} else {
kidbas = 64;
}
node = page[(i__1 = kidbas + next - 1) < 256 && 0 <= i__1 ?
i__1 : s_rnge("page", i__1, "zzektr1s_", (ftnlen)797)]
;
if (next <= nbig) {
subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)801)];
} else {
subsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)803)] - 1;
}
if (next <= nbig + 1) {
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)809)] + (next - 1) * stlsiz[(i__2 = level
- 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz",
i__2, "zzektr1s_", (ftnlen)809)] + (next - 1);
} else {
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)815)] + nbig * stlsiz[(i__2 = level - 1) <
10 && 0 <= i__2 ? i__2 : s_rnge("stlsiz", i__2,
"zzektr1s_", (ftnlen)815)] + (next - nbig - 1) * (
stlsiz[(i__3 = level - 1) < 10 && 0 <= i__3 ?
i__3 : s_rnge("stlsiz", i__3, "zzektr1s_", (
ftnlen)815)] - 1) + (next - 1);
}
++level;
next = 1;
/* LEVEL, NEXT, NODE, SUBSIZ, and BASIDX are set. */
} else {
/* We're done with the current subtree. Pop the stack. */
--level;
if (level >= 1) {
node = stnode[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnode", i__1, "zzektr1s_", (ftnlen)836)
];
nkeys = stnkey[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnkey", i__1, "zzektr1s_", (
ftnlen)837)];
bigsiz = stlsiz[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stlsiz", i__1, "zzektr1s_", (
ftnlen)838)];
nbig = stnbig[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnbig", i__1, "zzektr1s_", (ftnlen)839)
];
next = stnext[(i__1 = level - 1) < 10 && 0 <= i__1 ? i__1
: s_rnge("stnext", i__1, "zzektr1s_", (ftnlen)840)
];
basidx = stnbas[(i__1 = level - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("stnbas", i__1, "zzektr1s_", (
ftnlen)841)];
nkids = nkeys + 1;
/* Read in the current node. */
zzekpgri_(handle, &node, page);
}
}
}
/* On this pass through the loop, we either--- */
/* - Visited a node for the first time and filled in the */
/* node. */
/* - Advanced to a new node that has not yet been visited. */
/* - Exited from a completed subtree. */
/* Each of these actions can be performed a finite number of */
/* times. Therefore, we made progress toward loop termination. */
}
/* The last chore is setting the total number of nodes in the root. */
base = zzektrbs_(tree);
i__1 = base + 2;
i__2 = base + 2;
dasudi_(handle, &i__1, &i__2, &totnod);
chkout_("ZZEKTR1S", (ftnlen)8);
return 0;
} /* zzektr1s_ */
/* $Procedure ZZEKVADR ( Compute row vector address ) */
/* Subroutine */ int zzekvadr_0_(int n__, integer *njrs, integer *bases,
integer *rwvidx, integer *rwvbas, integer *sgvbas)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
static integer rbas[200];
extern /* Subroutine */ int zzekstop_(integer *);
static integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static integer ntabs, svbas[200];
extern /* Subroutine */ int cleari_(integer *, integer *);
static integer begidx[200], reloff, addrss;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
extern integer lstlei_(integer *, integer *, integer *);
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen);
static integer jrsidx;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
static integer maxrwv, svnjrs, top, nsv;
extern /* Subroutine */ int zzeksrd_(integer *, integer *, integer *);
/* $ Abstract */
/* Given a union of EK join row sets and a row vector index, */
/* compute the EK scratch area base address of the row vector having */
/* the specified index. Also return the base address of the row */
/* vector's parent segment vector. */
/* $ 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 */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Entry points */
/* -------- --- -------------------------------------------------- */
/* NJRS I ZZEKVSET */
/* BASES I ZZEKVSET */
/* RWVIDX I ZZEKVACL */
/* RWVBAS O ZZEKVACL */
/* SGVBAS O ZZEKVACL */
/* MXJOIN P Maximum number of tables that can be joined. */
/* MXJRS P Maximum number of join row sets allowed in union. */
/* $ Detailed_Input */
/* See the entry points for a discussion of their arguments. */
/* $ Detailed_Output */
/* See the entry points for a discussion of their arguments. */
/* $ Parameters */
/* MXJOIN is the maximum number of tables that can be joined. */
/* MXJRS is the maximum number of join row sets allowed in */
/* in the input union identified by BASES and NJRS. */
/* $ Exceptions */
/* 1) This is an umbrella routine which contains declarations */
/* for its entry points. This routine should never be called */
/* directly. If it is, the error SPICE(BOGUSENTRY) will be */
/* signalled. */
/* See the entry points for discussions of the exceptions specific */
/* to those entry points. */
/* $ Files */
/* 1) This routine uses the EK scratch area, which employs a scratch */
/* DAS file. */
/* $ Particulars */
/* In the course of query resolution, the EK system builds a set of */
/* data structures called `join row sets' that represent the rows */
/* that satisfy the query constraints. These rows belong to a table */
/* formed by taking the Cartesian product of the tables in the FROM */
/* clause of the query. One join row set is formed for each */
/* conjunction of join constraints; the total number of join row sets */
/* is equal to the number of conjunctions of join constraints in */
/* the query. Join row sets are described below. */
/* This group of routines allows the EK system to view the rows */
/* matching a query as a sequence of vectors, where each vector is an */
/* n-tuple of row numbers designating rows in segments of the */
/* Cartesian product of tables specified in the input query. These */
/* vectors are called `row vectors'. Each row vector also points to */
/* a vector of segments that contain the rows represented by the row */
/* vector. */
/* These routines centralize the calculations needed to locate the */
/* nth row vector. */
/* Each join row set consists of: */
/* - a base address in the scratch area */
/* - a table count */
/* - a segment vector count */
/* - a set of segment vectors */
/* - a set of segment vector row vector base addresses */
/* (these are relative to the base of the join row set) */
/* - a set of segment vector row vector counts */
/* - a set of row vectors, augmented by offsets of their */
/* parent segment vectors (these offsets are at the */
/* end of each row vector) */
/* The layout of a join row set in the EK scratch area is shown */
/* below: */
/* +--------------------------------------------+ */
/* | join row set size | 1 element */
/* +--------------------------------------------+ */
/* | number of row vectors in join row set | 1 element */
/* +--------------------------------------------+ */
/* | table count (TC) | 1 element */
/* +--------------------------------------------+ */
/* | segment vector count (SVC) | 1 element */
/* +--------------------------------------------+ */
/* | segment vector 1 | TC elements */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | segment vector SVC | TC elements */
/* +--------------------------------------------+ */
/* | segment vector 1 row set base address | 1 element */
/* +--------------------------------------------+ */
/* | segment vector 1 row count (RC_1) | 1 element */
/* +--------------------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* | segment vector SVC row set base address | 1 element */
/* +--------------------------------------------+ */
/* | segment vector SVC row count (RC_SVC) | 1 element */
/* +--------------------------------------------+ */
/* | Augmented row vectors for segment vector 1 | TC*(RC_1 + 1 ) */
/* +--------------------------------------------+ elements */
/* . */
/* . */
/* . */
/* +--------------------------------------------+ */
/* |Augmented row vectors for segment vector SVC| TC*(RC_SVC + 1) */
/* +--------------------------------------------+ elements */
/* $ Examples */
/* 1) For a given join row set union, initialize the addressing */
/* routines, then look up row vectors. */
/* C */
/* C Tell the addressing routines where the join row set */
/* C union is. NJRS is the number of join row sets in */
/* C the union, BASES is an array of EK scratch area base */
/* C addresses of each join row set. A base address is */
/* C the predecessor of the first address actually */
/* C occupied by a join row set. */
/* C */
/* CALL ZZEKVSET ( NJRS, BASES ) */
/* C */
/* C Find the base address of the each row vector, as well */
/* C as the base address of the corresponding segment */
/* C vector. */
/* C */
/* DO I = 1, NJRS */
/* CALL EKVCAL ( I, RWVBAS, SGVBAS ) */
/* [Do something with the row vector....] */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */
/* Filled in Particulars section of header in entry point */
/* ZZEKVCAL. Changed previous version line's product from "Beta" */
/* to "SPICELIB" both here and in ZZEKVCAL. */
/* - SPICELIB Version 1.0.0, 28-SEP-1994 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* EK row vector address calculation */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Include Section: EK Join Row Set Parameters */
/* JRS$INC Version 1 17-SEP-1994 (NJB) */
/* Base-relative index of join row set size */
/* Index of row vector count */
/* Index of table count */
/* Index of segment vector count */
/* Base address of first segment vector */
/* End Include Section: EK Join Row Set Parameters */
/* Local variables */
/* Saved variables */
/* Standard SPICE error handling. */
/* Parameter adjustments */
if (bases) {
}
/* Function Body */
switch(n__) {
case 1: goto L_zzekvset;
case 2: goto L_zzekvcal;
}
if (return_()) {
return 0;
} else {
chkin_("ZZEKVADR", (ftnlen)8);
}
/* Never come here. */
sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
chkout_("ZZEKVADR", (ftnlen)8);
return 0;
/* $Procedure ZZEKVSET ( Row vector address calculation set-up ) */
L_zzekvset:
/* $ Abstract */
/* Given a union of EK join row sets, prepare EKVCAL to */
/* compute addresses of row vectors in that union. */
/* $ 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 */
/* UTILITY */
/* $ Declarations */
/* INTEGER NJRS */
/* INTEGER BASES ( * ) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* NJRS I Number of join row sets in union. */
/* BASES I EK scratch area base addresses of join row sets. */
/* $ Detailed_Input */
/* NJRS is the number of join row sets in a join row set */
/* for which address calculations will be performed. */
/* BASES is an array of base addresses of the join row sets */
/* comprising the union. These addresses are the */
/* predecessors of the addresses actually occupied by */
/* the join row sets. There are NJRS base addresses */
/* in the array. The order in which addresses are */
/* listed in BASES determines the order of the union */
/* of the row vectors: the first row vector in the */
/* join row set whose base address is BASES(1) has */
/* index 1, and so on. The last row vector in the */
/* join row set whose base address is BASES(NJRS) has */
/* the highest index of any row vector in the union. */
/* $ Detailed_Output */
/* None. See $Particulars for a discussion of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the join row set count is less than 1 or greater than */
/* MXJRS, the error SPICE(INVALIDCOUNT) is signalled. */
/* 2) If any base address is less than zero or greater than TOP, */
/* the EK scratch area stack top, the error */
/* SPICE(BADADDRESS) is signalled. */
/* 3) If the table count for any join row set is less than 1 or */
/* greater than MXJOIN, the error SPICE(INVALIDCOUNT) is */
/* signalled. */
/* 4) If the table count for any join row set unequal to the count */
/* for the first join row set, the error SPICE(INVALIDCOUNT) is */
/* signalled. */
/* 5) If any join row set has a row vector count that is less than */
/* zero or greater than TOP, the EK scratch area stack top, the */
/* error SPICE(BADADDRESS) is signalled. */
/* 6) If any join row set has a segment vector count that is less */
/* than zero or greater than TOP, the EK scratch area stack top, */
/* the error SPICE(BADADDRESS) is signalled. */
/* $ Files */
/* 1) This routine uses the EK scratch area, which employs a scratch */
/* DAS file. */
/* $ Particulars */
/* This routine speeds up EK row vectors address calculations by */
/* centralizating the activities that need be performed only once */
/* for a series of address calculations for a given join row set */
/* union. */
/* $ Examples */
/* See the $Examples section of ZZEKVADR. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - Beta Version 1.0.0, 28-SEP-1994 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* EK row vector address calculation */
/* -& */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKVSET", (ftnlen)8);
}
/* Validate join row set count. */
if (*njrs < 1 || *njrs > 200) {
setmsg_("Number of join row sets was #; valid range is 1:#", (ftnlen)
49);
errint_("#", njrs, (ftnlen)1);
errint_("#", &c__200, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
}
/* Validate the join row set bases. */
zzekstop_(&top);
i__1 = *njrs;
for (i__ = 1; i__ <= i__1; ++i__) {
if (bases[i__ - 1] < 0 || bases[i__ - 1] > top) {
setmsg_("Base address # was #; valid range is 1:#", (ftnlen)40);
errint_("#", &i__, (ftnlen)1);
errint_("#", &bases[i__ - 1], (ftnlen)1);
errint_("#", &top, (ftnlen)1);
sigerr_("SPICE(BADADDRESS)", (ftnlen)17);
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
}
svbas[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("svbas",
i__2, "zzekvadr_", (ftnlen)526)] = bases[i__ - 1];
}
/* Validate and save the table count. It's an error for this */
/* count not to be identical for all of the join row sets in the */
/* union. */
addrss = bases[0] + 3;
zzeksrd_(&addrss, &addrss, &ntabs);
if (ntabs < 1 || ntabs > 10) {
setmsg_("Table count for first join row set was #; valid range is 1:#"
, (ftnlen)60);
errint_("#", &ntabs, (ftnlen)1);
errint_("#", &c__10, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
}
i__1 = *njrs;
for (i__ = 2; i__ <= i__1; ++i__) {
addrss = bases[i__ - 1] + 3;
zzeksrd_(&addrss, &addrss, &j);
if (j != ntabs) {
setmsg_("Join row set # contains # tables; first join row set co"
"ntains # tables. These counts are supposed to match.", (
ftnlen)108);
errint_("#", &i__, (ftnlen)1);
errint_("#", &j, (ftnlen)1);
errint_("#", &ntabs, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
}
}
/* Validate the row vector counts for each join row set. */
/* These counts must be in range. Save the start indices of */
/* the row vectors in each join row set. */
cleari_(&c__200, begidx);
begidx[0] = 1;
i__1 = *njrs;
for (i__ = 1; i__ <= i__1; ++i__) {
addrss = bases[i__ - 1] + 2;
zzeksrd_(&addrss, &addrss, &j);
if (j < 0 || j > top) {
setmsg_("Join row set # has row count #; valid range is 0:#", (
ftnlen)50);
errint_("#", &i__, (ftnlen)1);
errint_("#", &j, (ftnlen)1);
errint_("#", &top, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
}
if (i__ < *njrs) {
begidx[(i__2 = i__) < 200 && 0 <= i__2 ? i__2 : s_rnge("begidx",
i__2, "zzekvadr_", (ftnlen)598)] = begidx[(i__3 = i__ - 1)
< 200 && 0 <= i__3 ? i__3 : s_rnge("begidx", i__3, "zze"
"kvadr_", (ftnlen)598)] + j;
}
}
/* Retain the index of the last row vector. */
maxrwv = begidx[(i__1 = *njrs - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge(
"begidx", i__1, "zzekvadr_", (ftnlen)608)] + j;
/* Save the base addresses of the row vectors in each join row set. */
/* Validate the segment vector counts while we're at it. */
i__1 = *njrs;
for (i__ = 1; i__ <= i__1; ++i__) {
addrss = bases[i__ - 1] + 4;
zzeksrd_(&addrss, &addrss, &nsv);
if (nsv < 0) {
setmsg_("Join row set # has segment vector count #; count must b"
"e non-negative.", (ftnlen)70);
errint_("#", &i__, (ftnlen)1);
errint_("#", &nsv, (ftnlen)1);
errint_("#", &top, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
}
rbas[(i__2 = i__ - 1) < 200 && 0 <= i__2 ? i__2 : s_rnge("rbas", i__2,
"zzekvadr_", (ftnlen)633)] = addrss + nsv * (ntabs + 2);
}
/* Retain the count of join row sets in the union. */
svnjrs = *njrs;
chkout_("ZZEKVSET", (ftnlen)8);
return 0;
/* $Procedure ZZEKVCAL ( Row vector address calculation ) */
L_zzekvcal:
/* $ Abstract */
/* Find the EK scratch area base address of a row vector and the */
/* corresponding segment vector, where the row vector has a */
/* specified index within a union of join row sets. */
/* $ 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 */
/* UTILITY */
/* $ Declarations */
/* INTEGER RWVIDX */
/* INTEGER RWVBAS */
/* INTEGER SGVBAS */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* RWVIDX I Index of row vector. */
/* RWVBAS O EK scratch area base address of row vector. */
/* SGVBAS O Base address of parent segment vector. */
/* $ Detailed_Input */
/* RWVIDX is the index of a row vector in a join row set */
/* union. The union is presumed to have been */
/* specified by a call to ZZEKVSET. */
/* $ Detailed_Output */
/* RWVBAS is the EK scratch area base address of the row */
/* vector specified by RWVIDX. This address is */
/* the predecessor of the first address occupied by */
/* the row vector. The row vector occupies NTAB */
/* consecutive addresses, where NTAB is the common */
/* table count for all join row sets in the union */
/* containing the specified row vector. */
/* SGVBAS is the EK scratch area base address of the segment */
/* vector corresponding to the specified row vector. */
/* The segment vector also occupies NTAB consecutive */
/* addresses. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input index is less than 1 or greater than */
/* the highest index in the join row set union being addressed, */
/* the error SPICE(INVALIDINDEX) is signalled. */
/* $ Files */
/* 1) This routine uses the EK scratch area, which employs a scratch */
/* DAS file. */
/* $ Particulars */
/* See header of umbrella routine ZZEKVADR. */
/* $ Examples */
/* See the $Examples section of ZZEKVADR. */
/* $ Restrictions */
/* 1) ZZEKVSET must be called before this routine is called for the */
/* first time. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 06-SEP-2006 (NJB) */
/* Filled in Particulars section of header. Changed */
/* previous version line's product from "Beta" to "SPICELIB." */
/* - SPICELIB Version 1.0.0, 22-SEP-1994 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* EK row vector address calculation */
/* -& */
/* Use discovery check-in for speed; don't check RETURN. */
/* If the index is out of range, that's an error. */
if (*rwvidx < 1 || *rwvidx > maxrwv) {
chkin_("ZZEKVCAL", (ftnlen)8);
setmsg_("Row vector index was #; valid range is 0:#", (ftnlen)42);
errint_("#", rwvidx, (ftnlen)1);
errint_("#", &maxrwv, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("ZZEKVCAL", (ftnlen)8);
return 0;
}
/* Identify the join row set containing the indicated row. Our error */
/* check guarantees a non-zero result. */
jrsidx = lstlei_(rwvidx, &svnjrs, begidx);
/* Compute the offset of the indicated row vector relative to the */
/* first row vector in the parent join row set. This offset is one */
/* less than the relative index of the row vector, multiplied by */
/* the augmented row vector size. */
reloff = (*rwvidx - begidx[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 :
s_rnge("begidx", i__1, "zzekvadr_", (ftnlen)814)]) * (ntabs + 1);
/* Find the base address of the row vector. */
*rwvbas = rbas[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge(
"rbas", i__1, "zzekvadr_", (ftnlen)819)] + reloff;
/* Compute the base address of the parent segment vector. The base- */
/* relative address of the segment vector is stored at the end of the */
/* row vector. */
i__1 = *rwvbas + ntabs + 1;
i__2 = *rwvbas + ntabs + 1;
zzeksrd_(&i__1, &i__2, sgvbas);
*sgvbas = svbas[(i__1 = jrsidx - 1) < 200 && 0 <= i__1 ? i__1 : s_rnge(
"svbas", i__1, "zzekvadr_", (ftnlen)828)] + *sgvbas;
return 0;
} /* zzekvadr_ */
/* $Procedure ZZEKTRIT ( EK tree, initialize ) */
/* Subroutine */ int zzektrit_(integer *handle, integer *tree)
{
integer base, page[256];
extern /* Subroutine */ int zzekpgal_(integer *, integer *, integer *,
integer *), zzekpgwi_(integer *, integer *, integer *);
integer p;
extern /* Subroutine */ int chkin_(char *, ftnlen), cleari_(integer *,
integer *), chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Initialize an EK tree, returning the root of the 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 O Root of tree. */
/* $ Detailed_Input */
/* HANDLE is a file handle of an EK open for write access. */
/* $ Detailed_Output */
/* TREE is the root node number of the tree created by */
/* this routine. The root node number is used by the */
/* EK tree routines to identify the tree. */
/* $ 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. */
/* $ Files */
/* See the EK Required Reading for a discussion of the EK file */
/* format. */
/* $ Particulars */
/* This routine is used to create a new, empty EK tree. The */
/* tree has a root node, but no keys are contained in the root. */
/* The metadata area of the tree is initialized. */
/* $ Examples */
/* See EKBSEG. */
/* $ 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, 20-OCT-1995 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZEKTRIT", (ftnlen)8);
}
/* Start out by allocating a DAS integer page. We'll write the root */
/* node out to this page. */
zzekpgal_(handle, &c__3, &p, &base);
page[0] = 1;
page[1] = 1;
page[2] = 0;
page[4] = 0;
page[3] = 1;
/* Set all keys to zero; set all child and data pointers to null. */
cleari_(&c__82, &page[5]);
cleari_(&c__82, &page[172]);
cleari_(&c__83, &page[88]);
/* Write out the page. */
zzekpgwi_(handle, &p, page);
/* The identifier we return is just the page number of the tree's */
/* root. */
*tree = p;
chkout_("ZZEKTRIT", (ftnlen)8);
return 0;
} /* zzektrit_ */
/* $Procedure COMMNT ( Comment utility program ) */
/* Main program */ MAIN__(void)
{
/* Initialized data */
static logical insbln = TRUE_;
static char maintl[20] = "COMMNT Options ";
static char mainvl[20*5] = "QUIT " "ADD_COMMENTS "
"READ_COMMENTS " "EXTRACT_COMMENTS " "DELETE_COMMENTS "
" ";
static char maintx[40*5] = "Quit. "
"Add comments to a binary file. " "Read the comments in"
" a binary file. " "Extract comments from a binary file. "
"Delete the comments in a binary file. ";
static char mainnm[1*5] = "Q" "A" "R" "E" "D";
/* System generated locals */
address a__1[3];
integer i__1[3], i__2, i__3, i__4, i__5;
cllist cl__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen), f_clos(cllist *);
/* Local variables */
static char arch[3];
static logical done;
static char line[1000];
static logical more;
static integer iopt;
static char type__[4];
static integer i__;
extern /* Subroutine */ int dasdc_(integer *);
extern integer cardi_(integer *);
static integer r__;
extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *,
ftnlen, ftnlen), chkin_(char *, ftnlen), spcec_(integer *,
integer *), spcdc_(integer *), errch_(char *, char *, ftnlen,
ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen,
ftnlen, ftnlen), reset_(void);
extern integer rtrim_(char *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int dafhof_(integer *);
static integer handle;
extern /* Subroutine */ int dafcls_(integer *), dasacu_(integer *, char *,
char *, logical *, integer *, ftnlen, ftnlen), cleari_(integer *,
integer *), delfil_(char *, ftnlen), dasecu_(integer *, integer *
, logical *), scardi_(integer *, integer *), dashof_(integer *);
static logical fileok;
extern /* Subroutine */ int clcomm_(void), getfat_(char *, char *, char *,
ftnlen, ftnlen, ftnlen), cnfirm_(char *, logical *, ftnlen);
static char fnmtbl[128*2], messag[1000], errmsg[320], messgs[1000*7],
option[20], prmtbl[80*2], statbl[3*2];
extern logical exists_(char *, ftnlen);
static integer comlun;
static char status[1000*2];
static integer numfnm;
static char prmpts[80*2];
static integer numopn, opnset[7], tblidx[2];
static logical comnts, contnu, ndfnms, tryagn;
extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen),
erract_(char *, char *, ftnlen, ftnlen), errprt_(char *, char *,
ftnlen, ftnlen), tostdo_(char *, ftnlen), ssizei_(integer *,
integer *), getopt_(char *, integer *, char *, char *, integer *,
ftnlen, ftnlen, ftnlen), getfnm_(char *, char *, char *, logical *
, char *, ftnlen, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen)
, sigerr_(char *, ftnlen), txtopr_(char *, integer *, ftnlen),
dafopw_(char *, integer *, ftnlen), dasopw_(char *, integer *,
ftnlen), dascls_(integer *), dafopr_(char *, integer *, ftnlen),
spcrfl_(integer *, char *, logical *, ftnlen), spcrnl_(char *,
logical *, ftnlen), dasopr_(char *, integer *, ftnlen), txtopn_(
char *, integer *, ftnlen), chkout_(char *, ftnlen);
static logical eoc;
static char tkv[12];
/* $ Abstract */
/* NAIF Toolkit utility program for adding, reading, extracting, */
/* and deleting comments from a binary 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 */
/* SPC */
/* DAS */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* J.E. McLean (JPL) */
/* M.J. Spencer (JPL) */
/* $ Version */
/* - Version 6.0.1, 08-MAY-2001 (BVS) */
/* Increased LINLEN from 255 to 1000 to make it consistent */
/* with SPICELIB's SPC* and SUPPORT's DAF* internal line sizes. */
/* - Version 5.0.1, 21-JUL-1997 (WLT) */
/* Modified the banner at start up so that the version of the */
/* toolkit used to link COMMNT will be displayed. */
/* In addition all WRITE statements were replaced by calls to */
/* TOSTDO. */
/* - Version 5.0.0, 05-MAY-1994 (KRG) */
/* Modified the program to use the new file type identification */
/* capability that was added to spicelib. No file type menu is */
/* necessary now, as the file type is determined during the */
/* execution of the program. */
/* The prompts for the begin and end markers used to extract a */
/* subset of text lines from an input comment file which were then */
/* placed into the comment area of a SPICE binary kernel file have */
/* been removed. The entire input comment file is now placed into */
/* the comment area of the binary kernel file. This change */
/* simplifies the user interaction with the program. */
/* Added support for the new PCK binary kernel files. */
/* If an error occurs during the extraction of comments to a file, */
/* the file that was being created is deleted. We cannot know */
/* whether the file had been successfully created before the error */
/* occurred. */
/* - Version 4.0.0, 11-DEC-1992 (KRG) */
/* Added code to support the E-Kernel, and redesigned the */
/* user interface. */
/* - Version 3.1.0, 19-NOV-1991 (MJS) */
/* Variable QUIT initialized to FALSE. */
/* - Version 3.0.1, 10-AUG-1991 (CHA) (NJB) */
/* Updated comments to reflect status as a Toolkit */
/* utility program. Message indicating that no comments */
/* were found in the specified file was changed to include */
/* the file name. */
/* - Version 2.0.0, 28-JUN-1991 (JEM) */
/* The option to read the comments from the comment */
/* area of a binary SPK or CK was added to the menu. */
/* - Version 1.0.0, 05-APR-1991 (JEM) */
/* -& */
/* SPICELIB functions */
/* Parameters */
/* Set the version of the comment program. This should be updated */
/* every time a change is made, and it should agree with the */
/* version number in the header. */
/* Set a value for the logical unit which represents the standard */
/* output device, commonly a terminal. A value of 6 is widely used, */
/* but the Fortran standard does not specify a value, so it may be */
/* different for different Fortran implementations. */
/* Lower bound for a SPICELIB CELL data structure. */
/* Maximum number of open binary files allowed. */
/* Set a value for a replacement marker. */
/* Set a value for a filename prompt. */
/* File types */
/* Set a value for the length of a text line. */
/* Set a value for the length of an error message. */
/* Set a value for the length of a filename. */
/* Set a length for the prompts in the prompt table. */
/* Set a length for the status of a file: 'OLD' or 'NEW'. */
/* Set the length for the architecture of a file. */
/* Set the length for the type of a file. */
/* Set a length for the option values. */
/* Set a length for the title of a menu. */
/* Set a length for an option name (what is typed to select it) */
/* for a menu. */
/* Set the length of the text description of an option on a menu. */
/* The number of options available on the main menu. */
/* Set up some mnemonics for indexing the prompts in the prompt */
/* table. */
/* Set the maximum size of the filename table: this must be the */
/* number of distinct ``types'' of files that the program may */
/* require. */
/* Set up some mnemonics for indexing the messages in the message */
/* table. */
/* Set the maximum size of the message table: There should be a */
/* message for each ``type'' of action that the program can take. */
/* Set up some mnemonics for the OK and not OK status messages. */
/* Set the maximum number of status messages that are available. */
/* We need to have TKVLEN characters to hold the current version */
/* of the toolkit. */
/* Variables */
/* We want to insert a blank line between additions if there are */
/* already comments in the binary file. We indicate this by giving */
/* the variable INSBLN the value .TRUE.. */
/* Define the main menu title ... */
/* Define the main menu option values ... */
/* Define the main menu descriptive text for each option ... */
/* Define the main menu option names ... */
/* Register the COMMNT main program with the SPICELIB error handler. */
chkin_("COMMNT", (ftnlen)6);
clcomm_();
tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)12);
r__ = rtrim_(tkv, (ftnlen)12);
/* Set the error action to 'RETURN'. We don't want the program */
/* to abort if an error is signalled. We check FAILED where */
/* necessary. If an error is signalled, we'll just handle the */
/* error, display an appropriate message, then call RESET at the */
/* end of the loop to continue. */
erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6);
/* Set the error messages that we want to have displayed. We will */
/* diaplay the SPICELIB short and long error messages. This is done */
/* to ensure that some sort of an error message is displayed if an */
/* error occurs. In several places, long error messages are not set, */
/* so if only the long error messages were displayed, it would be */
/* possible to have an error signalled and not see any error */
/* information. This is not a very useful thing. */
errprt_("SET", "NONE, SHORT, LONG, TRACEBACK", (ftnlen)3, (ftnlen)28);
/* Set up the prompt table for the different types of files. */
s_copy(prmtbl + 80, "Enter the name of the comment file to be #.", (
ftnlen)80, (ftnlen)43);
s_copy(prmtbl, "Enter the name of the binary file.", (ftnlen)80, (ftnlen)
34);
/* Set up the message table for the different ``types'' of */
/* operations. The message table contains generic messages which will */
/* have their missing parts filled in after the option and file type */
/* havve been selected. */
s_copy(messgs, "Reading the comment area of the # file.", (ftnlen)1000, (
ftnlen)39);
s_copy(messgs + 1000, "Adding comments to the # file.", (ftnlen)1000, (
ftnlen)30);
s_copy(messgs + 2000, "Extracting comments from the # file.", (ftnlen)
1000, (ftnlen)36);
s_copy(messgs + 3000, "Deleting the comment area of # file.", (ftnlen)
1000, (ftnlen)36);
s_copy(messgs + 4000, "Quitting the program.", (ftnlen)1000, (ftnlen)21);
s_copy(messgs + 5000, "The comments were successfully #.", (ftnlen)1000, (
ftnlen)33);
s_copy(messgs + 6000, "The comments were NOT successfully #.", (ftnlen)
1000, (ftnlen)37);
/* Display a brief commercial with the name of the program and the */
/* version. */
s_copy(line, " Welcome to COMMNT Version: #", (ftnlen)1000, (ftnlen)31);
repmc_(line, "#", "6.0.1", line, (ftnlen)1000, (ftnlen)1, (ftnlen)5, (
ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
/* Writing concatenation */
i__1[0] = 23, a__1[0] = " (Spice Toolkit ";
i__1[1] = r__, a__1[1] = tkv;
i__1[2] = 1, a__1[2] = ")";
s_cat(line, a__1, i__1, &c__3, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
/* Initialize the CELL oriented set for collecting open DAF or DAS */
/* files in the event of an error. */
ssizei_(&c__1, opnset);
/* While there is still more to do ... */
done = FALSE_;
while(! done) {
/* We initialize a few things here, so that they get reset for */
/* every trip through the loop. */
/* Initialize the logical flags that we use. */
comnts = FALSE_;
contnu = TRUE_;
eoc = FALSE_;
ndfnms = FALSE_;
/* Initialize the filename table, ... */
s_copy(fnmtbl, " ", (ftnlen)128, (ftnlen)1);
s_copy(fnmtbl + 128, " ", (ftnlen)128, (ftnlen)1);
/* the file status table, ... */
s_copy(statbl, " ", (ftnlen)3, (ftnlen)1);
s_copy(statbl + 3, " ", (ftnlen)3, (ftnlen)1);
/* the table indices, ... */
tblidx[0] = 0;
tblidx[1] = 0;
/* set the number of file names to zero, ... */
numfnm = 0;
/* the prompts in the prompt table, ... */
s_copy(prmpts, " ", (ftnlen)80, (ftnlen)1);
s_copy(prmpts + 80, " ", (ftnlen)80, (ftnlen)1);
/* the message, and the option. */
s_copy(messag, " ", (ftnlen)1000, (ftnlen)1);
s_copy(option, " ", (ftnlen)20, (ftnlen)1);
/* Set the status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)1000);
/* Get the option to be performed from the main menu. */
getopt_(maintl, &c__5, mainnm, maintx, &iopt, (ftnlen)20, (ftnlen)1, (
ftnlen)40);
s_copy(option, mainvl + ((i__2 = iopt - 1) < 5 && 0 <= i__2 ? i__2 :
s_rnge("mainvl", i__2, "commnt_", (ftnlen)502)) * 20, (ftnlen)
20, (ftnlen)20);
/* Set up the messages and other information for the option */
/* selected. */
if (contnu) {
if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) {
ndfnms = TRUE_;
numfnm = 2;
s_copy(messag, messgs + 1000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 2;
s_copy(prmpts, prmtbl + 80, (ftnlen)80, (ftnlen)80);
repmc_(prmpts, "#", "added", prmpts, (ftnlen)80, (ftnlen)1, (
ftnlen)5, (ftnlen)80);
s_copy(statbl + 3, "OLD", (ftnlen)3, (ftnlen)3);
tblidx[1] = 1;
s_copy(prmpts + 80, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "added", status, (ftnlen)1000, (ftnlen)1,
(ftnlen)5, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "added", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000);
} else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13)
== 0) {
ndfnms = TRUE_;
numfnm = 1;
s_copy(messag, messgs, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "read", status, (ftnlen)1000, (ftnlen)1, (
ftnlen)4, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "read", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)4, (ftnlen)1000);
} else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
16) == 0) {
ndfnms = TRUE_;
numfnm = 2;
s_copy(messag, messgs + 2000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
tblidx[1] = 2;
s_copy(prmpts + 80, prmtbl + 80, (ftnlen)80, (ftnlen)80);
repmc_(prmpts + 80, "#", "created", prmpts + 80, (ftnlen)80, (
ftnlen)1, (ftnlen)7, (ftnlen)80);
s_copy(statbl + 3, "NEW", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "extracted", status, (ftnlen)1000, (
ftnlen)1, (ftnlen)9, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "extracted", status + 1000, (
ftnlen)1000, (ftnlen)1, (ftnlen)9, (ftnlen)1000);
} else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
15) == 0) {
ndfnms = TRUE_;
numfnm = 1;
s_copy(messag, messgs + 3000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "deleted", status, (ftnlen)1000, (ftnlen)
1, (ftnlen)7, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "deleted", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)7, (ftnlen)1000);
} else if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
s_copy(messag, messgs + 4000, (ftnlen)1000, (ftnlen)1000);
}
}
/* Collect any filenames that we may need. */
if (contnu && ndfnms) {
/* we always need at least one filename if we get to here. */
i__ = 1;
more = TRUE_;
while(more) {
fileok = FALSE_;
tryagn = TRUE_;
while(tryagn) {
tostdo_(" ", (ftnlen)1);
tostdo_(prmpts + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ?
i__2 : s_rnge("prmpts", i__2, "commnt_", (ftnlen)
614)) * 80, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
getfnm_("Filename? ", statbl + ((i__3 = tblidx[(i__2 =
i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("tblidx"
, i__2, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <=
i__3 ? i__3 : s_rnge("statbl", i__3, "commnt_", (
ftnlen)617)) * 3, fnmtbl + (((i__5 = tblidx[(i__4
= i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("tbl"
"idx", i__4, "commnt_", (ftnlen)617)] - 1) < 2 &&
0 <= i__5 ? i__5 : s_rnge("fnmtbl", i__5, "commn"
"t_", (ftnlen)617)) << 7), &fileok, errmsg, (
ftnlen)10, (ftnlen)3, (ftnlen)128, (ftnlen)320);
/* If the filename is OK, increment the filename index */
/* and leave the try again loop. Otherwise, write out the */
/* error message, and give the opportunity to go around */
/* again. */
if (fileok) {
++i__;
tryagn = FALSE_;
} else {
tostdo_(" ", (ftnlen)1);
tostdo_(errmsg, (ftnlen)320);
tostdo_(" ", (ftnlen)1);
cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20);
if (! tryagn) {
contnu = FALSE_;
more = FALSE_;
}
}
}
if (i__ > numfnm) {
more = FALSE_;
}
}
}
/* Get the file architecture and type. */
if (contnu && ndfnms) {
getfat_(fnmtbl, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4);
if (failed_()) {
contnu = FALSE_;
}
}
/* Check to see that we got back a valid architecture and type. */
if (contnu && ndfnms) {
if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__,
"?", (ftnlen)4, (ftnlen)1) == 0) {
contnu = FALSE_;
setmsg_("The architecture and type of the binary file '#' co"
"uld not be determined. A common error is to give the"
" name of a text file instead of the name of a binary"
" file.", (ftnlen)161);
errch_("#", fnmtbl, (ftnlen)1, (ftnlen)128);
sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20);
}
}
/* Customize the message. We know we can do this, because we */
/* need files, and so we don't have the QUIT message. */
if (contnu && ndfnms) {
repmc_(messag, "#", type__, messag, (ftnlen)1000, (ftnlen)1, (
ftnlen)4, (ftnlen)1000);
}
/* Process the option that was selected so long ago. */
if (contnu) {
if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
done = TRUE_;
} else if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12)
== 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
(ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
/* Open the text file which contains the comments to be */
/* added to the binary file. */
txtopr_(fnmtbl + 128, &comlun, (ftnlen)128);
if (! failed_()) {
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
{
/* Open the binary file, add the comments, and close */
/* the binary file. */
dasopw_(fnmtbl, &handle, (ftnlen)128);
dasacu_(&comlun, " ", " ", &insbln, &handle, (ftnlen)
1, (ftnlen)1);
dascls_(&handle);
}
/* Close the comment file. */
cl__1.cerr = 0;
cl__1.cunit = comlun;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13)
== 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no comments found in the fil"
"e.", (ftnlen)41);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no commentfound in the file.",
(ftnlen)39);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no comments found in the fil"
"e.", (ftnlen)41);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dasopr_(fnmtbl, &handle, (ftnlen)128);
dasecu_(&handle, &c__6, &comnts);
dascls_(&handle);
if (! comnts) {
s_copy(line, "There were no comments found in the fi"
"le.", (ftnlen)1000, (ftnlen)41);
tostdo_(line, (ftnlen)1000);
}
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
16) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
(ftnlen)128, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
/* Open the text file. */
txtopn_(fnmtbl + 128, &comlun, (ftnlen)128);
if (! failed_()) {
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
{
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dasopr_(fnmtbl, &handle, (ftnlen)128);
dasecu_(&handle, &comlun, &comnts);
dascls_(&handle);
if (! comnts) {
s_copy(line, "There were no comments found in th"
"e file.", (ftnlen)1000, (ftnlen)41);
tostdo_(line, (ftnlen)1000);
}
}
/* Close the text file that we opened. */
cl__1.cerr = 0;
cl__1.cunit = comlun;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
15) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dasopw_(fnmtbl, &handle, (ftnlen)128);
dasdc_(&handle);
dascls_(&handle);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
}
}
/* If anything failed, close any binary files that might still be */
/* open and reset the error handling before getting the next */
/* option. */
if (failed_()) {
/* Before we can attempt to perform any clean up actions if an */
/* error occurred, we need to reset the SPICELIB error handling */
/* mechanism so that we can call the SPICELIB routines that we */
/* need to. */
reset_();
/* Clear out any binary file handles in the open set, OPNSET. */
scardi_(&c__0, opnset);
cleari_(&c__1, &opnset[6]);
/* Get the handles for any DAF files which may still be open. */
dafhof_(opnset);
numopn = cardi_(opnset);
if (numopn > 0) {
i__2 = numopn;
for (i__ = 1; i__ <= i__2; ++i__) {
dafcls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
s_rnge("opnset", i__3, "commnt_", (ftnlen)1100)])
;
}
}
/* Clear out any binary file handles in the open set, OPNSET. */
scardi_(&c__0, opnset);
cleari_(&c__1, &opnset[6]);
/* Get the handles for any DAS files which may still be open. */
dashof_(opnset);
numopn = cardi_(opnset);
if (numopn > 0) {
i__2 = numopn;
for (i__ = 1; i__ <= i__2; ++i__) {
dascls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
s_rnge("opnset", i__3, "commnt_", (ftnlen)1121)])
;
}
}
/* If there was an error and we were extracting comments to a */
/* file, then we should delete the file that was created, */
/* because we do not know whether the extraction was completed */
/* successfully. */
if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)16) ==
0) {
if (exists_(fnmtbl + 128, (ftnlen)128)) {
delfil_(fnmtbl + 128, (ftnlen)128);
}
}
/* Finally, reset the error handling, and go get the next */
/* option. This is just to be sure. */
reset_();
}
}
chkout_("COMMNT", (ftnlen)6);
return 0;
} /* MAIN__ */
