/* $Procedure ZZEKDE05 ( EK, delete column entry, class 5 ) */ /* Subroutine */ int zzekde05_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ integer i_dnnt(doublereal *); /* Local variables */ integer base, nrec; extern integer zzekrp2n_(integer *, integer *, integer *); integer next, unit; extern /* Subroutine */ int zzekpgch_(integer *, char *, ftnlen), zzekgfwd_(integer *, integer *, integer *, integer *), zzekglnk_( integer *, integer *, integer *, integer *), zzekpgpg_(integer *, integer *, integer *, integer *), zzekslnk_(integer *, integer *, integer *, integer *); integer p; extern /* Subroutine */ int chkin_(char *, ftnlen); integer recno, nseen, ncols, nelts; extern logical failed_(void); extern /* Subroutine */ int dasrdd_(integer *, integer *, integer *, doublereal *), dasrdi_(integer *, integer *, integer *, integer *) , dasudi_(integer *, integer *, integer *, integer *); extern logical return_(void); doublereal dpnelt; integer datptr, nlinks, ptrloc; extern /* Subroutine */ int chkout_(char *, ftnlen), dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), zzekdps_(integer *, integer *, integer *, integer *); /* $ Abstract */ /* Delete a specified class 5 column entry from an EK record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* PRIVATE */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* SEGDSC is the descriptor of the segment from which to */ /* delete the specified column entry. */ /* COLDSC is the descriptor of the column from which to */ /* delete the specified column entry. */ /* RECPTR is a pointer to the record containing the column */ /* entry to delete. */ /* $ Detailed_Output */ /* None. See the $Particulars section for a description of the */ /* effect of this routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. The file will not be modified. */ /* 2) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. The file may be corrupted. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it deletes a column entry */ /* from an EK segment. The status of the record containing the entry */ /* is set to `updated'. The deleted entry is marked as */ /* `uninitialized'. */ /* The link counts for the pages containing the deleted column entry */ /* are decremented. If the count for a page becomes zero, that page */ /* is freed. If the entry to be deleted is already uninitialized */ /* upon entry to this routine, no link counts are modified. The */ /* record containing the entry is still marked `updated' in this */ /* case. */ /* The changes made by this routine to the target EK file become */ /* permanent when the file is closed. Failure to close the file */ /* properly will leave it in an indeterminate state. */ /* $ Examples */ /* See EKDELR. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 28-SEP-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKDE05", (ftnlen)8); } /* Before trying to actually modify the file, do every error */ /* check we can. */ /* Is this file handle valid--is the file open for paged write */ /* access? Signal an error if not. */ zzekpgch_(handle, "WRITE", (ftnlen)5); if (failed_()) { chkout_("ZZEKDE05", (ftnlen)8); return 0; } /* We'll need to know how many columns the segment has in order to */ /* compute the size of the record pointer. The record pointer */ /* contains DPTBAS items plus two elements for each column. */ ncols = segdsc[4]; nrec = segdsc[5]; /* Compute the data pointer location. If the data pointer is */ /* already set to `uninitialized', there's nothing to do. If */ /* the element is null, just set it to `uninitialized'. The */ /* presence of actual data obligates us to clean up, however. */ ptrloc = *recptr + 2 + coldsc[8]; dasrdi_(handle, &ptrloc, &ptrloc, &datptr); if (datptr > 0) { /* Get the element count for the entry. */ dasrdd_(handle, &datptr, &datptr, &dpnelt); nelts = i_dnnt(&dpnelt); /* Set the data pointer to indicate the item is uninitialized. */ dasudi_(handle, &ptrloc, &ptrloc, &c_n1); /* Find the number of the page containing the column entry. */ zzekpgpg_(&c__2, &datptr, &p, &base); /* Look up the forward pointer. This pointer will be valid */ /* if the column entry is continued on another page. */ zzekgfwd_(handle, &c__2, &p, &next); /* Get the link count for the current page. If we have more */ /* than one link to the page, decrement the link count. If */ /* we're down to one link, this deletion will finish off the */ /* page: we'll deallocate it. */ zzekglnk_(handle, &c__2, &p, &nlinks); if (nlinks > 1) { i__1 = nlinks - 1; zzekslnk_(handle, &c__2, &p, &i__1); } else { /* If we removed the last item from the page, we can delete */ /* the page. ZZEKDPS adjusts the segment's metadata */ /* to reflect the deallocation. */ zzekdps_(handle, segdsc, &c__2, &p); } /* Computing MIN */ i__1 = nelts, i__2 = base + 126 - datptr; nseen = min(i__1,i__2); while(nseen < nelts && ! failed_()) { /* The column entry is continued on the page indicated by */ /* NEXT. */ /* Get the link count for the current page. If we have more */ /* than one link to the page, decrement the link count. If */ /* we're down to one link, this deletion will finish off the */ /* page: we'll deallocate it. */ p = next; zzekgfwd_(handle, &c__2, &p, &next); zzekglnk_(handle, &c__2, &p, &nlinks); if (nlinks > 1) { i__1 = nlinks - 1; zzekslnk_(handle, &c__2, &p, &i__1); } else { /* If we removed the last item from the page, we can delete */ /* the page. ZZEKDPS adjusts the segment's metadata */ /* to reflect the deallocation. */ zzekdps_(handle, segdsc, &c__2, &p); } /* Computing MIN */ i__1 = nelts, i__2 = nseen + 126; nseen = min(i__1,i__2); } } else if (datptr == -2) { /* Mark the entry as `uninitialized'. */ dasudi_(handle, &ptrloc, &ptrloc, &c_n1); } else if (datptr != -1) { /* UNINIT was the last valid possibility. The data pointer is */ /* corrupted. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " "#; EK = #", (ftnlen)68); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &coldsc[8], (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKDE05", (ftnlen)8); return 0; } /* Set the record's status to indicate that this record is updated. */ i__1 = *recptr + 1; i__2 = *recptr + 1; dasudi_(handle, &i__1, &i__2, &c__2); chkout_("ZZEKDE05", (ftnlen)8); return 0; } /* zzekde05_ */
/* $Procedure DASWFR ( DAS write file record ) */ /* Subroutine */ int daswfr_(integer *handle, char *idword, char *ifname, integer *nresvr, integer *nresvc, integer *ncomr, integer *ncomc, ftnlen idword_len, ftnlen ifname_len) { /* Builtin functions */ integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wdue(cilist *), e_wdue(void); /* Local variables */ integer free; char tail[932]; integer unit; extern /* Subroutine */ int chkin_(char *, ftnlen); extern logical failed_(void); integer oldcch, locncc, oldcrc; extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *); char locifn[60]; integer oldrch; extern /* Subroutine */ int dassih_(integer *, char *, ftnlen); integer lastla[3]; char locidw[8]; integer locncr, locnvc, oldrrc; char format[8]; integer lastrc[3]; extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen), chkout_(char *, ftnlen); integer lastwd[3]; extern /* Subroutine */ int sigerr_(char *, ftnlen), dasufs_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *), setmsg_(char *, ftnlen); integer iostat, locnvr; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); char ifn[60]; /* Fortran I/O blocks */ static cilist io___3 = { 1, 0, 1, 0, 1 }; static cilist io___13 = { 1, 0, 0, 0, 1 }; /* $ Abstract */ /* Update the contents of the file record of a specified DAS file. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAS */ /* $ Keywords */ /* DAS */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I DAS file handle. */ /* IDWORD I ID word. */ /* IFNAME I DAS internal file name. */ /* NRESVR I Number of reserved records in file. */ /* NRESVC I Number of characters in use in reserved rec. area. */ /* NCOMR I Number of comment records in file. */ /* NCOMC I Number of characters in use in comment area. */ /* $ Detailed_Input */ /* HANDLE is a file handle for a DAS file open for writing. */ /* IDWORD is the `ID word' contained in the first eight */ /* characters of the file record. */ /* IFNAME is the internal file name of the DAS file. The */ /* maximum length of the internal file name is 60 */ /* characters. */ /* NRESVR is the number of reserved records in the DAS file */ /* specified by HANDLE. */ /* NRESVC is the number of characters in use in the reserved */ /* record area of the DAS file specified by HANDLE. */ /* NCOMR is the number of comment records in the DAS file */ /* specified by HANDLE. */ /* NCOMC is the number of characters in use in the comment area */ /* of the DAS file specified by HANDLE. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the handle passed to this routine is not the handle of an */ /* open DAS file, the error will be signaled by a routine called */ /* by this routine. */ /* 2) If the specified DAS file is not open for write access, the */ /* error will be diagnosed by a routine called by this routine. */ /* 3) If the attempt to read the file record fails, the error */ /* SPICE(DASREADFAIL) is signaled. */ /* 4) If the file write attempted by this routine fails, the error */ /* SPICE(DASFILEWRITEFAILED) is signaled. */ /* $ Files */ /* See the description of HANDLE under $Detailed_Input. */ /* $ Particulars */ /* This routine provides a convenient way of updating the internal */ /* file name of a DAS file. */ /* The `ID word' contained in the file record is a string of eight */ /* characters that identifies the file as a DAS file and optionally */ /* indicates a specific file format, for example, `EK'. */ /* $ Examples */ /* 1) Update the internal file name of an existing DAS file. */ /* C */ /* C Open the file for writing. */ /* C */ /* CALL DASOPW ( FNAME, HANDLE ) */ /* C */ /* C Retrieve the ID word and current reserved record */ /* C and comment area record and character counts. */ /* C */ /* CALL DASRFR ( HANDLE, */ /* . IDWORD, */ /* . IFNAME, */ /* . NRESVR, */ /* . NRESVC, */ /* . NCOMR, */ /* . NCOMC ) */ /* C */ /* C Set the internal file name and update the file */ /* C with it. */ /* C */ /* IFNAME = 'New internal file name' */ /* CALL DASWFR ( HANDLE, */ /* . IDWORD, */ /* . IFNAME, */ /* . NRESVR, */ /* . NRESVC, */ /* . NCOMR, */ /* . NCOMC ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* F.S. Turner (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */ /* This routine was modified to accomodate the preservation */ /* of the FTP validation and binary file format strings that */ /* are not part of the DAS file record. */ /* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ /* Removed references to specific DAS file open routines in the */ /* $ Detailed_Input section of the header. This was done in order */ /* to minimize documentation changes if these open routines ever */ /* change. */ /* Added a check of FAILED after the call to DASHLU which will */ /* check out and return if DASHLU fails. This is so that when in */ /* return mode of the error handling the READ following the call */ /* to DASHLU will not be executed. */ /* Reworded some of the descriptions contained in the */ /* $ Detailed_Output section of the header so that they were more */ /* clear. */ /* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* write DAS file record */ /* write DAS internal file name */ /* update DAS internal file name */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 3.0.0, 11-DEC-2001 (FST) */ /* In order to preserve the additional information that */ /* now resides in the file record, this routine reads */ /* the entire record into local buffers, including the */ /* TAILEN characters that follow the actual data content. */ /* The contents of the local buffers that correspond to */ /* information brought in from the call sequence of the */ /* routine are ignored when the record is rewritten. */ /* However, the ID word, the file format string, and the */ /* trailing TAILEN characters that contain the FTP validation */ /* string are rewritten along with the input values. */ /* This routine does not simply replace the FTP validation */ /* string with the components from ZZFTPSTR, since that */ /* would possibly validate a corrupt file created using a newer */ /* Toolkit. */ /* The string arguments passed into this routine are now */ /* copied to local buffers of the appropriate length. */ /* - SPICELIB Version 2.0.0, 27-OCT-1993 (KRG) */ /* Removed references to specific DAS file open routines in the */ /* $ Detailed_Input section of the header. This was done in order */ /* to minimize documentation changes if these open routines ever */ /* change. */ /* Added a check of FAILED after the call to DASHLU which will */ /* check out and return if DASHLU fails. This is so that when in */ /* return mode of the error handling the READ following the call */ /* to DASHLU will not be executed. */ /* Reworded some of the descriptions contained in the */ /* $ Detailed_Output section of the header so that they were more */ /* clear. */ /* - SPICELIB Version 1.0.0, 24-NOV-1992 (NJB) (WLT) */ /* -& */ /* SPICELIB functions */ /* Local Parameters */ /* The parameter TAILEN determines the tail length of a DAS file */ /* record. This is the number of bytes (characters) that */ /* occupy the portion of the file record that follows the */ /* integer holding the first free address. For environments */ /* with a 32 bit word length, 1 byte characters, and DAS */ /* record sizes of 1024 bytes, we have: */ /* 8 bytes - IDWORD */ /* 60 bytes - IFNAME */ /* 4 bytes - NRESVR (32 bit integer) */ /* 4 bytes - NRESVC (32 bit integer) */ /* 4 bytes - NCOMR (32 bit integer) */ /* + 4 bytes - NCOMC (32 bit integer) */ /* --------- */ /* 84 bytes - (All file records utilize this space.) */ /* So the size of the remaining portion (or tail) of the DAS */ /* file record for computing enviroments as described above */ /* would be: */ /* 1024 bytes - DAS record size */ /* - 8 bytes - DAS Binary File Format Word */ /* - 84 bytes - (from above) */ /* ------------ */ /* 932 bytes - DAS file record tail length */ /* Note: environments that do not have a 32 bit word length, */ /* 1 byte characters, and a DAS record size of 1024 bytes, will */ /* require the adjustment of this parameter. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("DASWFR", (ftnlen)6); } /* Check to be sure that HANDLE is attached to a file that is open */ /* with write access. If the call fails, check out and return. */ dassih_(handle, "WRITE", (ftnlen)5); /* Get the logical unit for this DAS file. */ dashlu_(handle, &unit); if (failed_()) { chkout_("DASWFR", (ftnlen)6); return 0; } /* In order to maintain the integrity of the file ID word, the */ /* file FORMAT, and the FTP string if present, we need to */ /* read the entire file record into the appropriate sized local */ /* buffers. The values of the LOCxxx variables are simply */ /* ignored, since the caller passes new values in for updates. */ io___3.ciunit = unit; iostat = s_rdue(&io___3); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, locidw, (ftnlen)8); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, locifn, (ftnlen)60); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, (char *)&locnvr, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, (char *)&locnvc, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, (char *)&locncr, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, (char *)&locncc, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, format, (ftnlen)8); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__1, tail, (ftnlen)932); if (iostat != 0) { goto L100001; } iostat = e_rdue(); L100001: if (iostat != 0) { setmsg_("Attempt to read the file record failed for file '#'. IOSTAT" " = #", (ftnlen)63); errfnm_("#", &unit, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DASREADFAIL)", (ftnlen)18); chkout_("DASWFR", (ftnlen)6); return 0; } /* Set the value of the internal file name and IDWORD before */ /* writing. This is to guarantee that their lengths are ok. */ s_copy(ifn, ifname, (ftnlen)60, ifname_len); s_copy(locidw, idword, (ftnlen)8, idword_len); io___13.ciunit = unit; iostat = s_wdue(&io___13); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, locidw, (ftnlen)8); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, ifn, (ftnlen)60); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, (char *)&(*nresvr), (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, (char *)&(*nresvc), (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, (char *)&(*ncomr), (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, (char *)&(*ncomc), (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, format, (ftnlen)8); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__1, tail, (ftnlen)932); if (iostat != 0) { goto L100002; } iostat = e_wdue(); L100002: if (iostat != 0) { setmsg_("Could not write file record. File was #. IOSTAT was #.", ( ftnlen)56); errfnm_("#", &unit, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25); chkout_("DASWFR", (ftnlen)6); return 0; } /* Update the file summary, in case the values of the reserved */ /* record or comment area counts have changed. */ dashfs_(handle, &oldrrc, &oldrch, &oldcrc, &oldcch, &free, lastla, lastrc, lastwd); dasufs_(handle, nresvr, nresvc, ncomr, ncomc, &free, lastla, lastrc, lastwd); chkout_("DASWFR", (ftnlen)6); return 0; } /* daswfr_ */
/* $Procedure DASIOD ( DAS, Fortran I/O, double precision ) */ /* Subroutine */ int dasiod_(char *action, integer *unit, integer *recno, doublereal *record, ftnlen action_len) { /* Builtin functions */ integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void), s_wdue(cilist *), e_wdue(void); /* Local variables */ extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); extern logical eqstr_(char *, char *, ftnlen, ftnlen); extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); /* Fortran I/O blocks */ static cilist io___2 = { 1, 0, 1, 0, 0 }; static cilist io___3 = { 1, 0, 0, 0, 0 }; /* $ Abstract */ /* Perform Fortran reads and writes of double precision records. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAS */ /* $ Keywords */ /* DAS */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* ACTION I Action to take (read or write). */ /* UNIT I Fortran unit connected to DAS file. */ /* RECNO I Number of record to read or write. */ /* RECORD I-O DAS double precision record. */ /* $ Detailed_Input */ /* ACTION is a character string specifying whether to read */ /* from or write to the specified DAS file. Possible */ /* values are: */ /* 'READ' */ /* 'WRITE' */ /* Case and leading or trailing blanks are not */ /* significant. */ /* UNIT is the Fortran unit number connected to the DAS */ /* file that is to be read or written. Given the */ /* handle of the DAS file, the unit number can be */ /* obtained using DASHLU. */ /* RECNO is the Fortran record number of the record to be */ /* read or written. */ /* RECORD is a double precision array whose contents are to */ /* be written to record RECNO, if ACTION is WRITE. */ /* $ Detailed_Output */ /* RECORD is a double precision array whose contents are to */ /* be set equal to those of record RECNO, if ACTION */ /* is READ. */ /* $ Parameters */ /* NWD is the number of elements in a DAS double precision */ /* record. */ /* $ Exceptions */ /* 1) If the value of ACTION is not recognized, the error */ /* SPICE(UNRECOGNIZEDACTION) is signalled. */ /* 2) If a Fortran read error occurs, the error */ /* SPICE(DASFILEREADFAILED) is signalled. */ /* 3) If a Fortran write error occurs, the error */ /* SPICE(DASFILEWRITEFAILED) is signalled. */ /* $ Files */ /* See the description of the argument UNIT in $Detailed_Input. */ /* $ Particulars */ /* Normally, routines outside of SPICELIB will not need to call this */ /* routine directly. Writes to DAS files should be performed using */ /* the DASADx and DASUDx routines; reads should be performed using */ /* the DASRDx routines. */ /* This routines centralizes I/O and the concommitant error handling */ /* for DAS character records. */ /* Although most DAS routines use file handles to indentify DAS */ /* files, this routine uses Fortran logical units for this purpose. */ /* Using unit numbers allows the DASIOx routines to be called from */ /* any DAS routine, including entry points of DASFM. (DASFM */ /* contains as entry points the routines DASHLU and DASLUH, which */ /* map between handles and unit numbers.) */ /* $ Examples */ /* 1) Read and print to the screen double precision records */ /* number 10 through 20 from the DAS file designated by HANDLE. */ /* DOUBLE PRECISION RECORD ( NWD ) */ /* . */ /* . */ /* . */ /* CALL DASHLU ( HANDLE, UNIT ) */ /* CALL DASHFN ( HANDLE, NAME ) */ /* DO I = 1, 20 */ /* CALL DASIOD ( 'READ', UNIT, 10, RECORD ) */ /* LABEL = 'Contents of the # record in DAS file #: ' */ /* CALL REPMOT ( LABEL, '#', I, 'L', LABEL ) */ /* CALL REPMC ( LABEL, '#', NAME, LABEL ) */ /* WRITE (*,*) LABEL */ /* WRITE (*,*) ' ' */ /* WRITE (*,*) RECORD */ /* END DO */ /* 2) Write the contents of the array RECORD to record number */ /* 10 in the DAS file designated by HANDLE. */ /* DOUBLE PRECISION RECORD ( NWD ) */ /* . */ /* . */ /* . */ /* CALL DASHLU ( HANDLE, UNIT ) */ /* CALL DASIOD ( 'WRITE', UNIT, 10, RECORD ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 30-JUN-1992 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* perform Fortran reads of double precision records */ /* perform Fortran writes of double precision records */ /* perform low-level I/O for DAS routines */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ if (return_()) { return 0; } if (eqstr_(action, "READ", action_len, (ftnlen)4)) { /* We're supposed to read the file. */ io___2.ciunit = *unit; io___2.cirec = *recno; iostat = s_rdue(&io___2); if (iostat != 0) { goto L100001; } iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof( doublereal)); if (iostat != 0) { goto L100001; } iostat = e_rdue(); L100001: if (iostat != 0) { chkin_("DASIOD", (ftnlen)6); setmsg_("Could not read DAS double precision record. File = # Re" "cord number = #. IOSTAT = #.", (ftnlen)83); errfnm_("#", unit, (ftnlen)1); errint_("#", recno, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DASFILEREADFAILED)", (ftnlen)24); chkout_("DASIOD", (ftnlen)6); return 0; } } else if (eqstr_(action, "WRITE", action_len, (ftnlen)5)) { /* We're supposed to write to the file. */ io___3.ciunit = *unit; io___3.cirec = *recno; iostat = s_wdue(&io___3); if (iostat != 0) { goto L100002; } iostat = do_uio(&c__128, (char *)&record[0], (ftnlen)sizeof( doublereal)); if (iostat != 0) { goto L100002; } iostat = e_wdue(); L100002: if (iostat != 0) { chkin_("DASIOD", (ftnlen)6); setmsg_("Could not write DAS double precision record. File = # R" "ecord number = #. IOSTAT = #.", (ftnlen)84); errfnm_("#", unit, (ftnlen)1); errint_("#", recno, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DASFILEWRITEFAILED)", (ftnlen)25); chkout_("DASIOD", (ftnlen)6); return 0; } } else { /* The requested action is a little too weird. */ chkin_("DASIOD", (ftnlen)6); setmsg_("Action was #; should be READ or WRITE", (ftnlen)37); errch_("#", action, (ftnlen)1, action_len); sigerr_("SPICE(UNRECOGNIZEDACTION)", (ftnlen)25); chkout_("DASIOD", (ftnlen)6); return 0; } return 0; } /* dasiod_ */
/* $Procedure ZZEKPGCH ( EK, paging system access check ) */ /* Subroutine */ int zzekpgch_(integer *handle, char *access, ftnlen access_len) { integer topc, topd, topi, unit; extern /* Subroutine */ int chkin_(char *, ftnlen); integer lastc, lastd, lasti, id; extern logical failed_(void); extern /* Subroutine */ int daslla_(integer *, integer *, integer *, integer *), dasrdi_(integer *, integer *, integer *, integer *), dassih_(integer *, char *, ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); integer npc, npd, npi; /* $ Abstract */ /* Check that an EK is valid for a specified type of access by the */ /* paging system. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Das Paging Parameters */ /* ekpage.inc Version 4 25-AUG-1995 (NJB) */ /* The EK DAS paging system makes use of the integer portion */ /* of an EK file's DAS address space to store the few numbers */ /* required to describe the system's state. The allocation */ /* of DAS integer addresses is shown below. */ /* DAS integer array */ /* +--------------------------------------------+ */ /* | EK architecture code | Address = 1 */ /* +--------------------------------------------+ */ /* | Character page size (in DAS words) | */ /* +--------------------------------------------+ */ /* | Character page base address | */ /* +--------------------------------------------+ */ /* | Number of character pages in file | */ /* +--------------------------------------------+ */ /* | Number of character pages on free list | */ /* +--------------------------------------------+ */ /* | Character free list head pointer | Address = 6 */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for d.p. pages | 7--11 */ /* | | */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for integer pages | 12--16 */ /* | | */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | End Address = */ /* | Unused space | integer page */ /* | | end */ /* +--------------------------------------------+ */ /* | | Start Address = */ /* | First integer page | integer page */ /* | | base */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | */ /* | Last integer page | */ /* | | */ /* +--------------------------------------------+ */ /* The following parameters indicate positions of elements in the */ /* paging system metadata array: */ /* Number of metadata items per data type: */ /* Character metadata indices: */ /* Double precision metadata indices: */ /* Integer metadata indices: */ /* Size of metadata area: */ /* Page sizes, in units of DAS words of the appropriate type: */ /* Default page base addresses: */ /* End Include Section: EK Das Paging Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Architecture Version Parameters */ /* ekarch.inc Version 1 01-NOV-1995 (NJB) */ /* The following parameter indicates the EK file architecture */ /* version. EK files read by the EK system must have the */ /* architecture expected by the reader software; the architecture ID */ /* below is used to test for compatibility. */ /* Architecture code: */ /* End Include Section: EK Architecture Version Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* ACCESS I Access type. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. The specified file is to be */ /* checked to see whether it is a valid paged EK and */ /* whether it is open for the specified type of */ /* access. */ /* ACCESS is a short string indicating the type of access */ /* desired. Possible values are 'READ' and 'WRITE'. */ /* Leading and trailing blanks in ACCESS are ignored, */ /* and case is not significant. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the EK architecture version is not current, the error */ /* SPICE(WRONGARCHITECTURE) is signalled. */ /* 3) If the DAS logical address ranges occupied by the EK are */ /* not consistent with those recorded by the paging system, */ /* the error SPICE(INVALIDFORMAT) is signalled. */ /* 4) If the EK is not open for the specified type of access, the */ /* error will be diagnosed by routines called by this routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine centralizes a validation check performed by many */ /* EK routines. The EK designated by HANDLE is tested to see */ /* whether some aspects of its structure are valid, and whether */ /* the specified type of access (read or write) is allowed. */ /* The tests performed are: */ /* - Is the file a DAS file open for the specified type of access? */ /* - Is the file's EK architecture version correct? */ /* - Are the DAS address ranges in use consistent with those */ /* recorded in the file by the paging system? */ /* If the file fails any test, an error is signalled. */ /* $ Examples */ /* See EKINSR. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ chkin_("ZZEKPGCH", (ftnlen)8); /* Check whether the DAS is opened for the specified access method. */ dassih_(handle, access, access_len); if (failed_()) { chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* Make sure the DAS file is of the right type. */ dasrdi_(handle, &c__1, &c__1, &id); if (id != 8) { dashlu_(handle, &unit); setmsg_("File # has architecture #, which is invalid for paged acces" "s. You are using EK software version #.", (ftnlen)99); errfnm_("#", &unit, (ftnlen)1); errint_("#", &id, (ftnlen)1); errint_("#", &c__8, (ftnlen)1); sigerr_("SPICE(WRONGARCHITECTURE)", (ftnlen)24); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* Obtain the page counts. Set the `top' addresses. */ dasrdi_(handle, &c__4, &c__4, &npc); dasrdi_(handle, &c__9, &c__9, &npd); dasrdi_(handle, &c__14, &c__14, &npi); topc = npc << 10; topd = npd << 7; topi = (npi << 8) + 256; /* Verify that the last addresses in use are consistent with the */ /* `top' addresses known to this system. */ daslla_(handle, &lastc, &lastd, &lasti); if (lastc > topc) { dashlu_(handle, &unit); setmsg_("File # has last char address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lastc, (ftnlen)1); errint_("#", &topc, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } else if (lastd > topd) { dashlu_(handle, &unit); setmsg_("File # has last d.p. address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lastd, (ftnlen)1); errint_("#", &topd, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } else if (lasti > topi) { dashlu_(handle, &unit); setmsg_("File # has last int. address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lasti, (ftnlen)1); errint_("#", &topi, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* zzekpgch_ */
/* $Procedure ZZEKTRLK ( EK tree, locate key ) */ /* Subroutine */ int zzektrlk_(integer *handle, integer *tree, integer *key, integer *idx, integer *node, integer *noffst, integer *level, integer *value) { /* Initialized data */ static logical first = TRUE_; /* System generated locals */ integer i__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, char *, integer); /* Local variables */ static logical leaf; static integer page[256], prev, unit, plus; extern /* Subroutine */ int zzekpgri_(integer *, integer *, integer *); static integer child; extern /* Subroutine */ int chkin_(char *, ftnlen); static integer depth; static logical found; static integer minus; static char access[15]; static integer datbas, oldhan; extern /* Subroutine */ int dasham_(integer *, char *, ftnlen); static integer oldidx, oldmax, oldnod, oldnof, oldtre, oldkey, oldval; extern integer lstlei_(integer *, integer *, integer *); static integer oldlvl, newkey, prvkey, totkey; static logical samkey, samtre, rdonly; extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); /* $ Abstract */ /* Locate a specified key. Return metadata describing the node */ /* containing the key. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Das Paging Parameters */ /* ekpage.inc Version 4 25-AUG-1995 (NJB) */ /* The EK DAS paging system makes use of the integer portion */ /* of an EK file's DAS address space to store the few numbers */ /* required to describe the system's state. The allocation */ /* of DAS integer addresses is shown below. */ /* DAS integer array */ /* +--------------------------------------------+ */ /* | EK architecture code | Address = 1 */ /* +--------------------------------------------+ */ /* | Character page size (in DAS words) | */ /* +--------------------------------------------+ */ /* | Character page base address | */ /* +--------------------------------------------+ */ /* | Number of character pages in file | */ /* +--------------------------------------------+ */ /* | Number of character pages on free list | */ /* +--------------------------------------------+ */ /* | Character free list head pointer | Address = 6 */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for d.p. pages | 7--11 */ /* | | */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for integer pages | 12--16 */ /* | | */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | End Address = */ /* | Unused space | integer page */ /* | | end */ /* +--------------------------------------------+ */ /* | | Start Address = */ /* | First integer page | integer page */ /* | | base */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | */ /* | Last integer page | */ /* | | */ /* +--------------------------------------------+ */ /* The following parameters indicate positions of elements in the */ /* paging system metadata array: */ /* Number of metadata items per data type: */ /* Character metadata indices: */ /* Double precision metadata indices: */ /* Integer metadata indices: */ /* Size of metadata area: */ /* Page sizes, in units of DAS words of the appropriate type: */ /* Default page base addresses: */ /* End Include Section: EK Das Paging Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Tree Parameters */ /* ektree.inc Version 3 22-OCT-1995 (NJB) */ /* The parameters in this file define the tree structure */ /* used by the EK system. This structure is a variant of the */ /* B*-tree structure described in Knuth's book, that is */ /* Knuth, Donald E. "The Art of Computer Programming, */ /* Volume 3/Sorting and Searching" 1973, pp 471-479. */ /* The trees used in the EK system differ from generic B*-trees */ /* primarily in the way keys are treated. Rather than storing */ /* unique primary key values in each node, EK trees store integer */ /* counts that represent the ordinal position of each data value, */ /* counting from the lowest indexed element in the subtree whose */ /* root is the node in question. Thus the keys are unique within */ /* a node but not across multiple nodes: in fact the Nth key in */ /* every leaf node is N. The absolute ordinal position of a data */ /* item is defined recursively as the sum of the key of the data item */ /* and the absolute ordinal position of the data item in the parent */ /* node that immediately precedes all elements of the node in */ /* question. This data structure allows EK trees to support lookup */ /* of data items based on their ordinal position in a data set. The */ /* two prime applications of this capability in the EK system are: */ /* 1) Using trees to index the records in a table, allowing */ /* the Nth record to be located efficiently. */ /* 2) Using trees to implement order vectors that can be */ /* maintained when insertions and deletions are done. */ /* Root node */ /* +--------------------------------------------+ */ /* | Tree version code | */ /* +--------------------------------------------+ */ /* | Number of nodes in tree | */ /* +--------------------------------------------+ */ /* | Number of keys in tree | */ /* +--------------------------------------------+ */ /* | Depth of tree | */ /* +--------------------------------------------+ */ /* | Number of keys in root | */ /* +--------------------------------------------+ */ /* | Space for n keys, | */ /* | | */ /* | n = 2 * INT( ( 2*m - 2 )/3 ) | */ /* | | */ /* | where m is the max number of children per | */ /* | node in the child nodes | */ /* +--------------------------------------------+ */ /* | Space for n+1 child pointers, | */ /* | where n is as defined above. | */ /* +--------------------------------------------+ */ /* | Space for n data pointers, | */ /* | where n is as defined above. | */ /* +--------------------------------------------+ */ /* Child node */ /* +--------------------------------------------+ */ /* | Number of keys present in node | */ /* +--------------------------------------------+ */ /* | Space for m-1 keys | */ /* +--------------------------------------------+ */ /* | Space for m child pointers | */ /* +--------------------------------------------+ */ /* | Space for m-1 data pointers | */ /* +--------------------------------------------+ */ /* The following parameters give the maximum number of children */ /* allowed in the root and child nodes. During insertions, the */ /* number of children may overflow by 1. */ /* Maximum number of children allowed in a child node: */ /* Maximum number of keys allowed in a child node: */ /* Minimum number of children allowed in a child node: */ /* Minimum number of keys allowed in a child node: */ /* Maximum number of children allowed in the root node: */ /* Maximum number of keys allowed in the root node: */ /* Minimum number of children allowed in the root node: */ /* The following parameters indicate positions of elements in the */ /* tree node structures shown above. */ /* The following parameters are for the root node only: */ /* Location of version code: */ /* Version code: */ /* Location of node count: */ /* Location of total key count for the tree: */ /* Location of tree depth: */ /* Location of count of keys in root node: */ /* Base address of keys in the root node: */ /* Base address of child pointers in root node: */ /* Base address of data pointers in the root node (allow room for */ /* overflow): */ /* Size of root node: */ /* The following parameters are for child nodes only: */ /* Location of number of keys in node: */ /* Base address of keys in child nodes: */ /* Base address of child pointers in child nodes: */ /* Base address of data pointers in child nodes (allow room */ /* for overflow): */ /* Size of child node: */ /* A number of EK tree routines must declare stacks of fixed */ /* depth; this depth limit imposes a limit on the maximum depth */ /* that an EK tree can have. Because of the large branching */ /* factor of EK trees, the depth limit is of no practical */ /* importance: The number of keys that can be held in an EK */ /* tree of depth N is */ /* N-1 */ /* MXKIDC - 1 */ /* MXKIDR * ------------- */ /* MXKIDC - 1 */ /* This formula yields a capacity of over 1 billion keys for a */ /* tree of depth 6. */ /* End Include Section: EK Tree Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* TREE I Root of tree. */ /* KEY I Key corresponding to value. */ /* IDX O Node-relative index of KEY. */ /* NODE O Node containing key. */ /* NOFFST O Offset of NODE. */ /* LEVEL O Level of NODE. */ /* VALUE O Value associated with KEY. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for write access. */ /* TREE is the root node number of the tree of interest. */ /* KEY is an absolute key. In EK trees, absolute keys are */ /* just ordinal positions relative to the leftmost */ /* element of the tree, with the leftmost element */ /* having position 1. So setting KEY to 10, for */ /* example, indicates that the output VALUE is the */ /* 10th item in the tree. */ /* KEY must be in the range 1 : NKEYS, where */ /* NKEYS is the number of keys in the tree. */ /* $ Detailed_Output */ /* IDX is the node-relative index of KEY: this is the */ /* ordinal position of KEY relative to other keys */ /* in the same node. */ /* NODE is the number of the node containing KEY. */ /* NOFFST is the offset of NODE. This is the count of the */ /* keys that precede every key in the subtree headed */ /* by NODE. Adding NOFFST to any relative key stored */ /* in NODE will convert that key to an absolute key. */ /* LEVEL is the level of NODE in the tree. The root is at */ /* level 1, children of the root are at level 2, and */ /* so on. */ /* VALUE is the integer value associated with the input key. */ /* Normally, this value is a data pointer. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. The file will not be modified. */ /* 2) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* 3) If the input key is out of range, the error */ /* SPICE(INDEXOUTOFRANGE) is signalled. */ /* 4) If the tree traversal fails to terminate at the leaf node */ /* level, the error SPICE(BUG) is signalled. */ /* 5) If the key is in range, but the key is not found, the error */ /* SPICE(BUG) is signalled. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine obtains the value assocated with a key, and also */ /* returns metadata describing the node containing the key and the */ /* key's position in the node. */ /* $ Examples */ /* See ZZEKTRUI. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* 1) Knuth, Donald E. "The Art of Computer Programming, Volume */ /* 3/Sorting and Searching" 1973, pp 471-479. */ /* EK trees are closely related to the B* trees described by */ /* Knuth. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 26-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Use discovery check-in in this puppy. */ /* Nothing found to begin with. */ found = FALSE_; if (first) { /* Find out the access method for the current file. */ dasham_(handle, access, (ftnlen)15); rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0; samkey = FALSE_; samtre = FALSE_; leaf = FALSE_; first = FALSE_; } else { /* See whether we're looking at the same key, or at least */ /* the same tree, as last time. Note that for the tree to */ /* be guaranteed to be the same, it must belong to a file open */ /* for read access only. */ if (*handle != oldhan) { dasham_(handle, access, (ftnlen)15); rdonly = s_cmp(access, "READ", (ftnlen)15, (ftnlen)4) == 0; samtre = FALSE_; samkey = FALSE_; } else { samtre = *tree == oldtre && rdonly; samkey = *key == oldkey && samtre; } } /* If we're lucky enough to be getting a request for the previously */ /* returned key, we're set. If we've been asked for a key that is */ /* very close to the previously requested key, we still may make */ /* out pretty well. */ if (samkey) { /* It's the same key as last time. */ *idx = oldidx; *node = oldnod; *noffst = oldnof; *level = oldlvl; *value = oldval; return 0; } else if (samtre && leaf) { /* Compute the margins around the old key. Keys that fall within */ /* the interval defined by the old key and these margins are on */ /* the same page as the old key. */ plus = oldmax - oldidx; minus = oldidx - 1; if (*key <= oldkey + plus && *key >= oldkey - minus) { /* The requested key lies on the same page as the old key. */ *level = oldlvl; if (*level == 1) { datbas = 172; } else { datbas = 128; } *idx = oldidx + (*key - oldkey); *node = oldnod; *noffst = oldnof; *value = page[(i__1 = datbas + *idx - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)315)]; oldidx = *idx; oldkey = *key; oldval = *value; return 0; } } /* If we arrived here, we have some actual work to do. */ /* Start out by looking at the root page. Save the tree depth; */ /* we'll use this for error checking. */ zzekpgri_(handle, tree, page); depth = page[3]; *level = 1; /* Find out how many keys are in the tree. If KEY is outside */ /* this range, we won't find it. */ totkey = page[2]; if (*key < 1 || *key > totkey) { chkin_("ZZEKTRLK", (ftnlen)8); dashlu_(handle, &unit); setmsg_("Key = #; valid range = 1:#. Tree = #, file = #", (ftnlen)46); errint_("#", key, (ftnlen)1); errint_("#", &totkey, (ftnlen)1); errint_("#", tree, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22); chkout_("ZZEKTRLK", (ftnlen)8); return 0; } /* Find the last key at this level that is less than or equal to */ /* the requested key. */ prev = lstlei_(key, &page[4], &page[5]); if (prev > 0) { prvkey = page[(i__1 = prev + 4) < 256 && 0 <= i__1 ? i__1 : s_rnge( "page", i__1, "zzektrlk_", (ftnlen)365)]; } else { prvkey = 0; } /* If we were lucky enough to get an exact match, set our outputs */ /* and return. The key offset in the root is zero. */ if (prvkey == *key) { *noffst = 0; *idx = prev; *node = *tree; *value = page[(i__1 = *idx + 171) < 256 && 0 <= i__1 ? i__1 : s_rnge( "page", i__1, "zzektrlk_", (ftnlen)379)]; oldhan = *handle; oldtre = *tree; oldkey = *key; oldnof = *noffst; oldnod = *node; oldidx = *idx; oldlvl = *level; oldval = *value; oldmax = page[4]; leaf = *level == depth; /* The root has no parent or siblings, so these values */ /* remain set to zero. The same is true of the parent keys. */ return 0; } /* Still here? Traverse the pointer path until we find the key */ /* or run out of progeny. */ child = page[(i__1 = prev + 88) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)405)]; *noffst = prvkey; while(child > 0 && ! found) { /* Look up the child node. */ zzekpgri_(handle, &child, page); ++(*level); if (*level > depth) { chkin_("ZZEKTRLK", (ftnlen)8); dashlu_(handle, &unit); setmsg_("Runaway node pointer chain. Key = #; valid range = 1:#" ". Tree = #, file = #", (ftnlen)75); errint_("#", key, (ftnlen)1); errint_("#", &totkey, (ftnlen)1); errint_("#", tree, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKTRLK", (ftnlen)8); return 0; } /* Find the last key at this level that is less than or equal to */ /* the requested key. Since the keys we're looking at now are */ /* ordinal positions relative to the subtree whose root is the */ /* current node, we must subtract from KEY the position of the */ /* node preceding the first key of this subtree. */ newkey = *key - *noffst; prev = lstlei_(&newkey, page, &page[1]); if (prev > 0) { prvkey = page[(i__1 = prev) < 256 && 0 <= i__1 ? i__1 : s_rnge( "page", i__1, "zzektrlk_", (ftnlen)445)]; } else { prvkey = 0; } /* If we were lucky enough to get an exact match, set our outputs */ /* and return. The key offset for the current node is stored */ /* in NOFFST. */ if (prvkey == newkey) { found = TRUE_; *idx = prev; *node = child; *value = page[(i__1 = *idx + 127) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)460)]; oldhan = *handle; oldtre = *tree; oldkey = *key; oldnof = *noffst; oldnod = *node; oldidx = *idx; oldlvl = *level; oldval = *value; oldmax = page[0]; leaf = *level == depth; } else { child = page[(i__1 = prev + 64) < 256 && 0 <= i__1 ? i__1 : s_rnge("page", i__1, "zzektrlk_", (ftnlen)476)]; *noffst = prvkey + *noffst; } } /* If we found the key, our outputs are already set. If not, we've */ /* got trouble. */ if (! found) { chkin_("ZZEKTRLK", (ftnlen)8); dashlu_(handle, &unit); setmsg_("Key #; valid range = 1:#. Tree = #, file = #. Key was not " "found. This probably indicates a corrupted file or a bug in" " the EK code.", (ftnlen)132); errint_("#", key, (ftnlen)1); errint_("#", &totkey, (ftnlen)1); errint_("#", tree, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKTRLK", (ftnlen)8); return 0; } return 0; } /* zzektrlk_ */
/* $Procedure READLN ( Read a text line from a logical unit ) */ /* Subroutine */ int readln_(integer *unit, char *line, logical *eof, ftnlen line_len) { /* System generated locals */ cilist ci__1; /* Builtin functions */ integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void); /* Local variables */ extern /* Subroutine */ int chkin_(char *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); /* $ Abstract */ /* This routine will read a single line of text from the Fortran */ /* logical unit UNIT, reporting the end of file if it occurs. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* ASCII */ /* TEXT */ /* FILES */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* UNIT I The Fortran unit number to use for input. */ /* LINE O The line read from the file. */ /* EOF O A logical flag indicating the end of file. */ /* $ Detailed_Input */ /* UNIT The Fortran unit number for the input. This may */ /* be either the unit number for the terminal, or the */ /* unit number of a previously opened text file. */ /* $ Detailed_Output */ /* LINE On output, this will contain the next text line */ /* encountered when reading from UNIT. */ /* If the length of the character string LINE is shorter */ /* than the length of the current line in the text file, the */ /* line is truncated on the right by the Fortran READ */ /* statement, filling LINE with the first LEN(LINE) */ /* characters from the current line in the file. */ /* If an error or the end of file occurs during the */ /* attempt to read from UNIT, the value of this variable */ /* is not guaranteed. */ /* EOF On output, this variable will be set to .TRUE. if the */ /* end of file ( IOSTAT < 0 ) is encountered during the */ /* attempt to read from unit UNIT. Otherwise, this */ /* variable will be set to .FALSE.. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If an error occurs while attempting to read from the text */ /* file attached to UNIT, the error SPICE(FILEREADFAILED) will */ /* be signalled. */ /* This routine only checks in with the error handler in the event */ /* that an error occurred. (Discovery check in) */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine will read a single line, a text record, from the */ /* logical unit UNIT. UNIT may be the terminal, or it may be a */ /* logical unit number obtained from a Fortran OPEN or INQUIRE */ /* statement. This routine will set a logical flag, EOF, on output */ /* if the end of the file is encountered during the read attempt. */ /* $ Examples */ /* CALL READLN ( UNIT, LINE, EOF ) */ /* IF ( EOF ) THEN */ /* < The end of file, deal with it appropriately > */ /* END IF */ /* You now have a line of text from unit UNIT. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* $ Version */ /* - SPICELIB 1.0.0, 20-DEC-1995 (KRG) */ /* The routine graduated */ /* - Beta Version 1.0.1, 22-NOV-1994 (KRG) */ /* Cleaned up the comments a little bit. No code changes. */ /* - Beta Version 1.0.0, 17-DEC-1992 (KRG) */ /* -& */ /* $ Index_Entries */ /* read a text line from a logical unit */ /* -& */ /* Local variables */ /* Standard SPICE error handling. */ /* Read in the next line from the text file attached to UNIT. */ ci__1.cierr = 1; ci__1.ciend = 1; ci__1.ciunit = *unit; ci__1.cifmt = "(A)"; iostat = s_rsfe(&ci__1); if (iostat != 0) { goto L100001; } iostat = do_fio(&c__1, line, line_len); if (iostat != 0) { goto L100001; } iostat = e_rsfe(); L100001: /* Check to see if we got a read error, and signal it if we did. */ if (iostat > 0) { chkin_("READLN", (ftnlen)6); setmsg_("Error reading from file: #. IOSTAT = #.", (ftnlen)39); errfnm_("#", unit, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); chkout_("READLN", (ftnlen)6); return 0; } /* Check to see if we got the end of file, and set the logical */ /* flag EOF if we did. */ if (iostat < 0) { *eof = TRUE_; } else { *eof = FALSE_; } return 0; } /* readln_ */
/* $Procedure SPCT2B ( SPK and CK, text to binary ) */ /* Subroutine */ int spct2b_(integer *unit, char *binary, ftnlen binary_len) { /* System generated locals */ integer i__1; cilist ci__1; olist o__1; cllist cl__1; /* Builtin functions */ integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *), s_wsfe( cilist *), e_wsfe(void), f_clos(cllist *); /* Local variables */ char line[1000]; extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *, ftnlen, ftnlen), chkin_(char *, ftnlen); extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen); extern /* Subroutine */ int daft2b_(integer *, char *, integer *, ftnlen); integer handle; extern /* Subroutine */ int dafcls_(integer *), dafopw_(char *, integer *, ftnlen); integer scrtch; extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), getlun_(integer *), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); /* $ Abstract */ /* Reconstruct a binary SPK or CK file including comments */ /* from a text file opened by the calling program. */ /* $ 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 */ /* $ Keywords */ /* FILES */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* UNIT I Logical unit connected to the text format file. */ /* BINARY I Name of a binary SPK or CK file to be created. */ /* $ Detailed_Input */ /* UNIT is the logical unit connected to an existing text */ /* format SPK or CK file that may contain comments in */ /* the appropriate SPC format, as written by SPCB2A or */ /* SPCB2T. This file must be opened for read access */ /* using the routine TXTOPR. */ /* This file may contain text that precedes and */ /* follows the SPK or CK data and comments, however, */ /* when calling this routine, the file pointer must be */ /* in a position in the file such that the next line */ /* returned by a READ statement is */ /* ''NAIF/DAF'' */ /* which marks the beginning of the data. */ /* BINARY is the name of a binary SPK or CK file to be created. */ /* The binary file contains the same data and comments */ /* as the text file, but in the binary format required */ /* for use with the SPICELIB reader subroutines. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Files */ /* 1) See arguments UNIT and BINARY above. */ /* 2) This routine uses a Fortran scratch file to temporarily */ /* store the lines of comments if there are any. */ /* $ Exceptions */ /* 1) If there is a problem opening or writing to the binary */ /* file, a routine that SPCT2B calls diagnoses and signals */ /* an error. */ /* 2) If there is a problem reading from the text file, the */ /* error SPICE(FILEREADFAILED) is signalled. */ /* 3) If there is a problem opening a scratch file, the error */ /* SPICE(FILEOPENERROR) is signalled. */ /* 4) If there is a problem writing to the scratch file, the */ /* error SPICE(FILEWRITEFAILED) is signalled. */ /* $ Particulars */ /* The SPICELIB SPK and CK reader subroutines read binary files. */ /* However, because different computing environments have different */ /* binary representations of numbers, you must convert SPK and CK */ /* files to text format when porting from one system to another. */ /* After converting the file to text, you can transfer it using */ /* a transfer protocol program like Kermit or FTP. Then, convert */ /* the text file back to binary format. */ /* The following is a list of the SPICELIB routines that convert */ /* SPK and CK files between binary and text format: */ /* SPCA2B converts text to binary. It opens the text file, */ /* creates a new binary file, and closes both files. */ /* SPCB2A converts binary to text. It opens the binary file, */ /* creates a new text file, and closes both files. */ /* SPCT2B converts text to binary. It creates a new binary */ /* file and closes it. The text file is open on */ /* entrance and exit. */ /* SPCB2T converts binary to text. It opens the binary */ /* file and closes it. The text file is open on */ /* entrance and exit */ /* See the SPC required reading for more information */ /* about SPC routines and the SPK and CK file formats. */ /* $ Examples */ /* 1) The following code fragment creates a text file containing */ /* text format SPK data and comments preceded and followed */ /* by a standard label. */ /* The SPICELIB routine TXTOPN opens a new text file and TXTOPR */ /* opens an existing text file for read access. TEXT and */ /* BINARY are character strings that contain the names of the */ /* text and binary files. */ /* CALL TXTOPN ( TEXT, UNIT ) */ /* (Write header label to UNIT) */ /* CALL SPCB2T ( BINARY, UNIT ) */ /* (Write trailing label to UNIT) */ /* CLOSE ( UNIT ) */ /* The following code fragment reconverts the text format */ /* SPK data and comments back into binary format. */ /* CALL TXTOPR ( TEXT, UNIT ) */ /* (Read, or just read past, header label from UNIT) */ /* CALL SPCT2B ( UNIT, BINARY ) */ /* (Read trailing label from UNIT, if desired ) */ /* CLOSE ( UNIT ) */ /* 2) Suppose three text format SPK files have been appended */ /* together into one text file called THREE.TSP. The following */ /* code fragment converts each set of data and comments into */ /* its own binary file. */ /* CALL TXTOPR ( 'THREE.TSP', UNIT ) */ /* CALL SPCT2B ( UNIT, 'FIRST.BSP' ) */ /* CALL SPCT2B ( UNIT, 'SECOND.BSP' ) */ /* CALL SPCT2B ( UNIT, 'THIRD.BSP' ) */ /* CLOSE ( UNIT ) */ /* $ Restrictions */ /* 1) This routine assumes that the data and comments in the */ /* text format SPK or CK file come from a binary file */ /* and were written by one of the routines SPCB2A or SPCB2T. */ /* Data and/or comments written any other way may not be */ /* in the correct format and, therefore, may not be handled */ /* properly. */ /* 2) Older versions of SPK and CK files did not have a comment */ /* area. These files, in text format, may still be converted */ /* to binary using SPCT2B. However, upon exit, the file pointer */ /* will not be in position ready to read the first line of text */ /* after the data. Instead, the next READ statement after */ /* calling SPCT2B will return the second line of text after */ /* the data. Therefore, example 1 may not work as desired */ /* if the trailing label begins on the first line after the */ /* data. To solve this problem, use DAFT2B instead of SPCT2B. */ /* 3) UNIT must be obtained via TXTOPR. Use TXTOPR to open text */ /* files for read access and get the logical unit. System */ /* dependencies regarding opening text files have been isolated */ /* in the routines TXTOPN and TXTOPR. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* J.E. McLean (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */ /* -& */ /* $ Index_Entries */ /* text spk or ck to binary */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("SPCT2B", (ftnlen)6); } /* DAFT2B creates the new binary file and writes the data to */ /* it. If the 'NAIF/DAF' keyword is not the first line that */ /* it reads from the text file, it will signal an error. */ /* Initially, no records are reserved. */ daft2b_(unit, binary, &c__0, binary_len); /* The comments follow the data and are surrounded by markers. */ /* BMARK should be the next line that we read. If it isn't, */ /* then this is an old file, created before the comment area */ /* existed. In this case, we've read one line too far, but */ /* we can't backspace because the file was written using list- */ /* directed formatting (See the ANSI standard). All we can do */ /* is check out, leaving the file pointer where it is, but */ /* that's better than signalling an error. */ ci__1.cierr = 1; ci__1.ciend = 1; ci__1.ciunit = *unit; ci__1.cifmt = "(A)"; iostat = s_rsfe(&ci__1); if (iostat != 0) { goto L100001; } iostat = do_fio(&c__1, line, (ftnlen)1000); if (iostat != 0) { goto L100001; } iostat = e_rsfe(); L100001: if (iostat > 0) { setmsg_("Error reading the text file named FNM. Value of IOSTAT is " "#.", (ftnlen)61); errint_("#", &iostat, (ftnlen)1); errfnm_("FNM", unit, (ftnlen)3); sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); chkout_("SPCT2B", (ftnlen)6); return 0; } i__1 = ltrim_(line, (ftnlen)1000) - 1; if (s_cmp(line + i__1, "~NAIF/SPC BEGIN COMMENTS~", 1000 - i__1, (ftnlen) 25) != 0 || iostat < 0) { chkout_("SPCT2B", (ftnlen)6); return 0; } /* We're not at the end of the file, and the line we read */ /* is BMARK, so we write the comments to a scratch file. */ /* We do this because we have to use SPCAC to add the comments */ /* to the comment area of the binary file, and SPCAC rewinds */ /* the file. It's okay for SPCAC to rewind a scratch file, */ /* but it's not okay to rewind the file connected to UNIT -- */ /* we don't know the initial location of the file pointer. */ getlun_(&scrtch); o__1.oerr = 1; o__1.ounit = scrtch; o__1.ofnm = 0; o__1.orl = 0; o__1.osta = "SCRATCH"; o__1.oacc = "SEQUENTIAL"; o__1.ofm = "FORMATTED"; o__1.oblnk = 0; iostat = f_open(&o__1); if (iostat != 0) { setmsg_("Error opening a scratch file. File name was FNM. Value of" " IOSTAT is #.", (ftnlen)72); errint_("#", &iostat, (ftnlen)1); errfnm_("FNM", &scrtch, (ftnlen)3); sigerr_("SPICE(FILEOPENERROR)", (ftnlen)20); chkout_("SPCT2B", (ftnlen)6); return 0; } ci__1.cierr = 1; ci__1.ciunit = scrtch; ci__1.cifmt = "(A)"; iostat = s_wsfe(&ci__1); if (iostat != 0) { goto L100002; } iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)1000)); if (iostat != 0) { goto L100002; } iostat = e_wsfe(); L100002: if (iostat != 0) { setmsg_("Error writing to scratch file. File name is FNM. Value of " "IOSTAT is #.", (ftnlen)71); errint_("#", &iostat, (ftnlen)1); errfnm_("FNM", &scrtch, (ftnlen)3); sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); chkout_("SPCT2B", (ftnlen)6); return 0; } /* Continue reading lines from the text file and storing them */ /* in the scratch file until we get to the end marker. */ for(;;) { /* while(complicated condition) */ i__1 = ltrim_(line, (ftnlen)1000) - 1; if (!(s_cmp(line + i__1, "~NAIF/SPC END COMMENTS~", 1000 - i__1, ( ftnlen)23) != 0)) break; ci__1.cierr = 1; ci__1.ciend = 1; ci__1.ciunit = *unit; ci__1.cifmt = "(A)"; iostat = s_rsfe(&ci__1); if (iostat != 0) { goto L100003; } iostat = do_fio(&c__1, line, (ftnlen)1000); if (iostat != 0) { goto L100003; } iostat = e_rsfe(); L100003: if (iostat != 0) { setmsg_("Error reading the text file named FNM. Value of IOSTAT" " is #.", (ftnlen)61); errint_("#", &iostat, (ftnlen)1); errfnm_("FNM", unit, (ftnlen)3); sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); chkout_("SPCT2B", (ftnlen)6); return 0; } ci__1.cierr = 1; ci__1.ciunit = scrtch; ci__1.cifmt = "(A)"; iostat = s_wsfe(&ci__1); if (iostat != 0) { goto L100004; } iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)1000)); if (iostat != 0) { goto L100004; } iostat = e_wsfe(); L100004: if (iostat != 0) { setmsg_("Error writing to scratch file. File name is FNM. Valu" "e of IOSTAT is #.", (ftnlen)72); errint_("#", &iostat, (ftnlen)1); errfnm_("FNM", &scrtch, (ftnlen)3); sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); chkout_("SPCT2B", (ftnlen)6); return 0; } } /* Open the new binary file and add the comments that have been */ /* stored temporarily in a scratch file. */ dafopw_(binary, &handle, binary_len); spcac_(&handle, &scrtch, "~NAIF/SPC BEGIN COMMENTS~", "~NAIF/SPC END COM" "MENTS~", (ftnlen)25, (ftnlen)23); /* Close the files. The scratch file is automatically deleted. */ dafcls_(&handle); cl__1.cerr = 0; cl__1.cunit = scrtch; cl__1.csta = 0; f_clos(&cl__1); chkout_("SPCT2B", (ftnlen)6); return 0; } /* spct2b_ */
/* $Procedure ZZEKSCMP ( EK, scalar value comparison ) */ logical zzekscmp_(integer *op, integer *handle, integer *segdsc, integer * coldsc, integer *row, integer *eltidx, integer *dtype, char *cval, doublereal *dval, integer *ival, logical *null, ftnlen cval_len) { /* System generated locals */ integer i__1; logical ret_val; /* Builtin functions */ integer i_len(char *, ftnlen); logical l_lt(char *, char *, ftnlen, ftnlen), l_gt(char *, char *, ftnlen, ftnlen); /* Local variables */ char eltc[1024]; doublereal eltd; integer elti, unit; extern /* Subroutine */ int chkin_(char *, ftnlen); integer cvlen; logical found, enull; extern logical failed_(void), matchi_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); integer cmplen; doublereal numval; integer coltyp, strlen; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen); integer rel; extern /* Subroutine */ int zzekrsc_(integer *, integer *, integer *, integer *, integer *, integer *, char *, logical *, logical *, ftnlen), zzekrsd_(integer *, integer *, integer *, integer *, integer *, doublereal *, logical *, logical *), zzekrsi_(integer * , integer *, integer *, integer *, integer *, integer *, logical * , logical *); /* $ Abstract */ /* Compare a specified scalar EK column entry with a scalar value. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* PRIVATE */ /* EK */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Operator Codes */ /* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ /* Within the EK system, operators used in EK queries are */ /* represented by integer codes. The codes and their meanings are */ /* listed below. */ /* Relational expressions in EK queries have the form */ /* <column name> <operator> <value> */ /* For columns containing numeric values, the operators */ /* EQ, GE, GT, LE, LT, NE */ /* may be used; these operators have the same meanings as their */ /* Fortran counterparts. For columns containing character values, */ /* the list of allowed operators includes those in the above list, */ /* and in addition includes the operators */ /* LIKE, UNLIKE */ /* which are used to compare strings to a template. In the character */ /* case, the meanings of the parameters */ /* GE, GT, LE, LT */ /* match those of the Fortran lexical functions */ /* LGE, LGT, LLE, LLT */ /* The additional unary operators */ /* ISNULL, NOTNUL */ /* are used to test whether a value of any type is null. */ /* End Include Section: EK Operator Codes */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Query Limit Parameters */ /* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ /* Parameter MAXCON increased to 1000. */ /* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ /* Updated to support SELECT clause. */ /* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ /* These limits apply to character string queries input to the */ /* EK scanner. This limits are part of the EK system's user */ /* interface: the values should be advertised in the EK required */ /* reading document. */ /* Maximum length of an input query: MAXQRY. This value is */ /* currently set to twenty-five 80-character lines. */ /* Maximum number of columns that may be listed in the */ /* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ /* Maximum number of tables that may be listed in the `FROM */ /* clause' of a query: MAXTAB. */ /* Maximum number of relational expressions that may be listed */ /* in the `constraint clause' of a query: MAXCON. */ /* This limit applies to a query when it is represented in */ /* `normalized form': that is, the constraints have been */ /* expressed as a disjunction of conjunctions of relational */ /* expressions. The number of relational expressions in a query */ /* that has been expanded in this fashion may be greater than */ /* the number of relations in the query as orginally written. */ /* For example, the expression */ /* ( ( A LT 1 ) OR ( B GT 2 ) ) */ /* AND */ /* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ /* which contains 4 relational expressions, expands to the */ /* equivalent normalized constraint */ /* ( ( A LT 1 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ /* which contains eight relational expressions. */ /* MXJOIN is the maximum number of tables that can be joined. */ /* MXJCON is the maximum number of join constraints allowed. */ /* Maximum number of order-by columns that may be used in the */ /* `order-by clause' of a query: MAXORD. MAXORD = 10. */ /* Maximum number of tokens in a query: 500. Tokens are reserved */ /* words, column names, parentheses, and values. Literal strings */ /* and time values count as single tokens. */ /* Maximum number of numeric tokens in a query: */ /* Maximum total length of character tokens in a query: */ /* Maximum length of literal string values allowed in queries: */ /* MAXSTR. */ /* End Include Section: EK Query Limit Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Template Matching Wild Characters */ /* ekwild.inc Version 1 16-JAN-1995 (NJB) */ /* Within the EK system, templates used for pattern matching */ /* are those accepted by the SPICELIB routine MATCHW. MATCHW */ /* accepts two special characters: one representing wild */ /* strings and one representing wild characters. This include */ /* file defines those special characters for use within the EK */ /* system. */ /* Wild string symbol: this character matches any string. */ /* Wild character symbol: this character matches any character. */ /* End Include Section: EK Template Matching Wild Characters */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* OP I Relational operator code. */ /* HANDLE I EK file handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* ROW I ID of row containing column entry to compare. */ /* ELTIDX I Index of element in array-valued column entry. */ /* DTYPE I Data type of input value. */ /* CVAL I Character string to compare with column entry. */ /* DVAL I D.p. value to compare with column entry. */ /* IVAL I Integer value to compare with column entry. */ /* NULL I Flag indicating whether scalar is null. */ /* The function returns .TRUE. if and only if the specified column */ /* entry and input value of the corresponding data type satisfy the */ /* relation specified by the input argument OP. */ /* $ Detailed_Input */ /* OP is an integer code representing a binary relational */ /* operator. The possible values of OP are the */ /* parameters */ /* EQ */ /* GE */ /* GT */ /* LE */ /* LIKE */ /* LT */ /* NE */ /* ISNULL */ /* NOTNUL */ /* HANDLE is an EK file handle. The file may be open for */ /* reading or writing. */ /* SEGDSC is the EK segment descriptor of the column entry */ /* to be compared. */ /* COLDSC is an EK column descriptor for the column */ /* containing the entry to be compared. */ /* ROW is the identifier of the row containing the column */ /* entry to be compared. Note that these identifiers */ /* are polymorphic: their meaning is a function of */ /* the class of column that contains the entry of */ /* interest. */ /* ELTIDX is the index of the column entry element to be */ /* compared, if the column is array-valued. ELTIDX */ /* is ignored for scalar columns. */ /* DTYPE is the data type of the input scalar value. */ /* CVAL, */ /* DVAL, */ /* IVAL are, respectively, character, double precision, */ /* and integer scalar variables. The column entry */ /* is compared against whichever of these has the */ /* same data type as the entry; the other two */ /* variables are ignored. If the data type of the */ /* column entry is TIME, the entry is compared with */ /* the variable DVAL. */ /* NULL */ /* $ Detailed_Output */ /* The function returns .TRUE. if and only if the specified column */ /* entry and input value of the corresponding data type satisfy the */ /* relation specified by the input argument OP. */ /* If the specified column entry is null, it is considered to */ /* precede all non-null values, and the logical value of the */ /* expression */ /* <column element> OP <value> */ /* is determined accordingly. Null character values do not satisfy */ /* the relation */ /* <null column element> LIKE <character value> */ /* for any character value. */ /* $ Parameters */ /* Within the EK system, relational operators used in EK queries are */ /* represented by integer codes. The codes and their meanings are */ /* listed below. */ /* Relational expressions in EK queries have the form */ /* <column name> <operator> <value> */ /* For columns containing numeric values, the operators */ /* EQ, GE, GT, LE, LT, NE */ /* may be used; these operators have the same meanings as their */ /* Fortran counterparts. For columns containing character values, */ /* the list of allowed operators includes those in the above list, */ /* and in addition includes the operator */ /* LIKE */ /* which is used to compare strings to a template. In the character */ /* case, the meanings of the parameters */ /* GE, GT, LE, LT */ /* match those of the Fortran lexical functions */ /* LGE, LGT, LLE, LLT */ /* Null values are considered to precede all non-null values. */ /* $ Exceptions */ /* 1) If the input file handle is invalid, the error will be */ /* diagnosed by routines called by this routine. */ /* The function value is .FALSE. in this case. */ /* 2) If an I/O error occurs while attempting to find the address */ /* range of the specified column entry element, the error will */ /* be diagnosed by routines called by this routine. The */ /* function value is .FALSE. in this case. */ /* 3) If any of SEGDSC, COLDSC, or ROW are invalid, this routine */ /* may fail in unpredictable, but possibly spectacular, ways. */ /* Except as described in this header section, no attempt is */ /* made to handle these errors. */ /* 4) If the data type code in the input column descriptor is not */ /* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ /* The function value is .FALSE. in this case. */ /* 5) If the specified column entry cannot be found, the error */ /* SPICE(INVALIDINDEX) is signalled. The function value is */ /* .FALSE. in this case. */ /* 6) If the relational operator code OP is not recognized, the */ /* error SPICE(UNNATURALRELATION) is signalled. The function */ /* value is .FALSE. in this case. */ /* $ Files */ /* See the description of the argument HANDLE in $Detailed_Input. */ /* $ Particulars */ /* This routine is an EK utility intended to centralize a frequently */ /* performed comparison operation. */ /* $ Examples */ /* See ZZEKRMCH. */ /* $ Restrictions */ /* 1) This routine must execute quickly. Therefore, it checks in */ /* only if it detects an error. If an error is signalled by a */ /* routine called by this routine, this routine will not appear */ /* in the SPICELIB traceback display. Also, in the interest */ /* of speed, this routine does not test the value of the SPICELIB */ /* function RETURN upon entry. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.0, 31-MAY-2009 (NJB) */ /* Bug fix: routine failed to account for the possibility */ /* that scalar string column entries can have unlimited */ /* length. Now at most the first MAXSTR characters of such */ /* an entry are used in comparisons. */ /* - SPICELIB Version 1.1.0, 21-DEC-2001 (NJB) */ /* Bug fix: routine now indicates "no match" when operator */ /* is LIKE or UNLIKE and column entry is null. */ /* - SPICELIB Version 1.0.0, 17-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in for speed. */ /* The function value defaults to .FALSE. */ ret_val = FALSE_; /* Look up the specified column element. */ coltyp = coldsc[1]; if (coltyp == 1) { /* We'll use at most the first MAXSTR characters of the input */ /* string. */ /* Computing MIN */ i__1 = i_len(cval, cval_len); cvlen = min(i__1,1024); /* Fetch the column entry to be compared. Note that ROW */ /* is a polymorphic identifier. See ZZEKRSC for details */ /* on how ROW is used. */ zzekrsc_(handle, segdsc, coldsc, row, eltidx, &strlen, eltc, &enull, & found, (ftnlen)1024); if (failed_()) { /* Don't check out here because we haven't checked in. */ return ret_val; } /* Let CMPLEN be the string length to use in comparisons. */ if (found && ! enull) { cmplen = min(strlen,1024); } else { cmplen = 0; } } else if (coltyp == 2 || coltyp == 4) { zzekrsd_(handle, segdsc, coldsc, row, eltidx, &eltd, &enull, &found); } else if (coltyp == 3) { zzekrsi_(handle, segdsc, coldsc, row, eltidx, &elti, &enull, &found); } else { chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("Data type code # not recognized.", (ftnlen)32); errint_("#", &coltyp, (ftnlen)1); sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } if (! found) { dashlu_(handle, &unit); chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. Column entry eleme" "nt was not found.", (ftnlen)76); errfnm_("#", &unit, (ftnlen)1); errint_("#", &coldsc[8], (ftnlen)1); errint_("#", row, (ftnlen)1); errint_("#", eltidx, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } /* Handle the ISNULL and NOTNUL operators, if perchance we see them. */ if (*op == 9) { ret_val = enull; return ret_val; } else if (*op == 10) { ret_val = ! enull; return ret_val; } /* Find the order relation that applies to the input values. */ /* Null values precede all others. */ if (enull) { if (*null) { rel = 1; } else { rel = 5; } } else if (*null) { if (enull) { rel = 1; } else { rel = 3; } } else { /* Compare the value we looked up with the input scalar value. */ if (coltyp == 1) { if (*dtype != 1) { chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("Column type is #; value type is #.", (ftnlen)34); errint_("#", &coltyp, (ftnlen)1); errint_("#", dtype, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } if (l_lt(eltc, cval, cmplen, cvlen)) { rel = 5; } else if (l_gt(eltc, cval, cmplen, cvlen)) { rel = 3; } else { rel = 1; } } else if (coltyp == 4) { if (*dtype != 4 && *dtype != 2) { chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("Column type is #; value type is #.", (ftnlen)34); errint_("#", &coltyp, (ftnlen)1); errint_("#", dtype, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } if (eltd < *dval) { rel = 5; } else if (eltd > *dval) { rel = 3; } else { rel = 1; } } else if (coltyp == 2) { if (*dtype == 3) { numval = (doublereal) (*ival); } else if (*dtype == 2 || *dtype == 4) { numval = *dval; } else { chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("Column type is #; value type is #.", (ftnlen)34); errint_("#", &coltyp, (ftnlen)1); errint_("#", dtype, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } if (eltd < numval) { rel = 5; } else if (eltd > numval) { rel = 3; } else { rel = 1; } } else if (coltyp == 3) { if (*dtype == 3) { numval = (doublereal) (*ival); } else if (*dtype == 2) { numval = *dval; } else { chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("Column type is #; value type is #.", (ftnlen)34); errint_("#", &coltyp, (ftnlen)1); errint_("#", dtype, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } if ((doublereal) elti < numval) { rel = 5; } else if ((doublereal) elti > numval) { rel = 3; } else { rel = 1; } } else { /* Something untoward has happened in our column descriptor */ /* argument. */ chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("The data type code # was not recognized.", (ftnlen)40); errint_("#", &coltyp, (ftnlen)1); sigerr_("SPICE(INVALIDDATATYPE)", (ftnlen)22); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } } /* Determine the truth of the input relational expression. */ if (*op == 1) { ret_val = rel == 1; } else if (*op == 5) { ret_val = rel == 5; } else if (*op == 4) { ret_val = rel != 3; } else if (*op == 3) { ret_val = rel == 3; } else if (*op == 2) { ret_val = rel != 5; } else if (*op == 6) { ret_val = rel != 1; } else if (*op == 7 && *dtype == 1) { if (*null || enull) { ret_val = FALSE_; } else { ret_val = matchi_(eltc, cval, "*", "%", cmplen, cvlen, (ftnlen)1, (ftnlen)1); } } else if (*op == 8 && *dtype == 1) { if (*null || enull) { ret_val = FALSE_; } else { ret_val = ! matchi_(eltc, cval, "*", "%", cmplen, cvlen, (ftnlen) 1, (ftnlen)1); } } else { /* Sorry, we couldn't resist. */ chkin_("ZZEKSCMP", (ftnlen)8); setmsg_("The relational operator # was not recognized or was not app" "licable for data type #.", (ftnlen)83); errint_("#", op, (ftnlen)1); errint_("#", dtype, (ftnlen)1); sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24); chkout_("ZZEKSCMP", (ftnlen)8); return ret_val; } return ret_val; } /* zzekscmp_ */
/* $Procedure COUNTC ( Count characters in a text file ) */ integer countc_(integer *unit, integer *bline, integer *eline, char *line, ftnlen line_len) { /* System generated locals */ integer ret_val; cilist ci__1; alist al__1; /* Builtin functions */ integer f_rew(alist *), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ logical done; extern /* Subroutine */ int chkin_(char *, ftnlen); integer chars, linect; extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen), astrip_( char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); extern logical return_(void); /* $ Abstract */ /* Count the characters in a group of lines in a text 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 */ /* None. */ /* $ Keywords */ /* CHARACTERS */ /* FILES */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* UNIT I Logical unit connected to text file. */ /* BLINE I Beginning line number. */ /* ELINE I Ending line number. */ /* LINE I,O Workspace. */ /* COUNTC returns the number of characters. */ /* $ Detailed_Input */ /* UNIT is a logical unit that has been connected to a */ /* text file by the calling program. Use the routine */ /* TXTOPR to open the file for read access and get its */ /* logical unit. A text file is a formatted, */ /* sequential file that contains only printable */ /* characters: ASCII 32-126. */ /* BLINE, */ /* ELINE are line numbers in the text file. BLINE is */ /* the line where the count will begin, and ELINE */ /* is the line where the count will end. The */ /* number of characters in the beginning and ending */ /* lines are included in the total count. */ /* By convention, line 1 is the first line of the file. */ /* LINE on input, is an arbitrary character string whose */ /* contents are ignored. LINE is used to read lines */ /* from the file connected to UNIT; its function */ /* is to determine the maximum length of the lines */ /* that can be read from the file. Lines longer */ /* than the declared length of LINE are truncated */ /* as they are read. */ /* $ Detailed_Output */ /* LINE on output, is undefined. */ /* The function, COUNTC, returns the number of characters in the */ /* group of lines in the file beginning with BLINE and ending with */ /* ELINE. Trailing blanks on a line are not included in the count. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If an error occurs while reading from the input file, */ /* the error SPICE(FILEREADFAILED) is signalled. */ /* 2) If a non-printing ASCII character is encountered during */ /* the count, the error SPICE(INVALIDTEXT) is signalled. */ /* 3) If BLINE is greater than ELINE or if the file does not */ /* contain both of this lines, the error SPICE(CANNOTFINDGRP) */ /* is signalled. */ /* $ Files */ /* See argument UNIT. COUNTC rewinds the text file connected to */ /* UNIT and then steps through the file. The next read statement */ /* after calling COUNTC would return the line after ELINE. */ /* $ Particulars */ /* This routine counts characters in a group of lines in a text */ /* file. Using COUNTC, you can determine in advance how much space */ /* is required to store those characters. */ /* $ Examples */ /* The following code fragment opens an existing text file for */ /* read access and counts the characters that it contains in */ /* the first five lines. We'll assume that the longest line */ /* in the file is 80 characters. */ /* INTEGER COUNTC */ /* INTEGER UNIT */ /* INTEGER N */ /* CHARACTER*(80) LINE */ /* CALL TXTOPR ( 'DATA.TXT', UNIT ) */ /* N = COUNTC ( UNIT, 1, 5, LINE ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* J.E. McLean (JPL) */ /* H.A. Neilan (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 17-MAY-1994 (HAN) */ /* Set the default function value to either 0, 0.0D0, .FALSE., */ /* or blank depending on the type of the function. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */ /* -& */ /* $ Index_Entries */ /* count characters in a text file */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { ret_val = 0; return ret_val; } else { chkin_("COUNTC", (ftnlen)6); ret_val = 0; } /* First, see if the line numbers make sense. */ if (*bline > *eline || *bline <= 0) { setmsg_("The line numbers do not make sense: BLINE = # and ELINE =" " #.", (ftnlen)62); errint_("#", bline, (ftnlen)1); errint_("#", eline, (ftnlen)1); sigerr_("SPICE(CANNOTFINDGRP)", (ftnlen)20); chkout_("COUNTC", (ftnlen)6); return ret_val; } /* Read through the file, line by line, beginning with the first */ /* line in the file, checking for I/O errors, and counting */ /* characters in the lines between and including BLINE and ELINE. */ al__1.aerr = 0; al__1.aunit = *unit; f_rew(&al__1); linect = 0; chars = 0; done = FALSE_; while(! done) { ci__1.cierr = 1; ci__1.ciend = 1; ci__1.ciunit = *unit; ci__1.cifmt = "(A)"; iostat = s_rsfe(&ci__1); if (iostat != 0) { goto L100001; } iostat = do_fio(&c__1, line, line_len); if (iostat != 0) { goto L100001; } iostat = e_rsfe(); L100001: /* An end-of-file condition is indicated by a negative value */ /* for IOSTAT. Any other non-zero value indicates some other */ /* error. If IOSTAT is zero, the read was successful. */ if (iostat > 0) { setmsg_("Error reading text file named FILENAME.The value of IOS" "TAT is #.", (ftnlen)64); errint_("#", &iostat, (ftnlen)1); errfnm_("FILENAME", unit, (ftnlen)8); sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21); chkout_("COUNTC", (ftnlen)6); return ret_val; } else if (iostat < 0) { setmsg_("Reached end of file unexpectedly at line # in file FILE" ". BLINE = # and ELINE = #.", (ftnlen)82); errint_("#", &linect, (ftnlen)1); errint_("#", bline, (ftnlen)1); errint_("#", eline, (ftnlen)1); errfnm_("FILE", unit, (ftnlen)4); sigerr_("SPICE(CANNOTFINDGRP)", (ftnlen)20); chkout_("COUNTC", (ftnlen)6); return ret_val; } else { /* We've read a line successfully, so add it to the line count. */ /* If this line is in the group delimited by BLINE and ELINE, */ /* count the characters in it, and if this line is ELINE, we're */ /* done. */ ++linect; if (linect >= *bline && linect <= *eline) { /* Add the number of characters in this line to the count. */ /* If LINE is blank, LASTNB will return 0 which is just */ /* what we want. */ chars += lastnb_(line, line_len); /* Remove the printable characters from the line. If */ /* any characters remain, signal an error. */ astrip_(line, " ", "~", line, line_len, (ftnlen)1, (ftnlen)1, line_len); if (s_cmp(line, " ", line_len, (ftnlen)1) != 0) { setmsg_("Non-printing ASCII characters were found when c" "ounting characters on line number # in file FILE" "NAME.", (ftnlen)100); errint_("#", &linect, (ftnlen)1); errfnm_("FILENAME", unit, (ftnlen)8); sigerr_("SPICE(INVALIDTEXT)", (ftnlen)18); chkout_("COUNTC", (ftnlen)6); return ret_val; } } if (linect == *eline) { done = TRUE_; } } } /* Assign the final character count. */ ret_val = chars; chkout_("COUNTC", (ftnlen)6); return ret_val; } /* countc_ */
/* $Procedure WRITLN ( Write a text line to a logical unit ) */ /* Subroutine */ int writln_(char *line, integer *unit, ftnlen line_len) { /* System generated locals */ cilist ci__1; /* Builtin functions */ integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ extern /* Subroutine */ int chkin_(char *, ftnlen); extern integer rtrim_(char *, ftnlen); extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); /* $ Abstract */ /* Write a single line of text to the Fortran logical unit UNIT. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* ASCII */ /* TEXT */ /* FILES */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* LINE I The line which is to be written to UNIT. */ /* UNIT I The Fortran unit number to use for output. */ /* $ Detailed_Input */ /* LINE This contains the text line which is to be written */ /* to UNIT. */ /* The value of this variable is not modified. */ /* UNIT The Fortran unit number for the output. This may be */ /* either the unit number for the terminal, or the unit */ /* number of a previously opened text file. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If an error occurs while attempting to write to the text */ /* file attached to UNIT, the error SPICE(FILEWRITEFAILED) will */ /* be signalled. */ /* This routine only checks in with the error handler in the event */ /* that an error occurred. (Discovery check in) */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine will write a single text line to the device */ /* specified by UNIT. UNIT may be the terminal, or it may be */ /* a logical unit number obtained from a Fortran OPEN or INQUIRE */ /* statement. When written, the line will have trailing spaces */ /* removed. */ /* $ Examples */ /* CALL WRITLN( LINE, UNIT ) */ /* You have now written a line of text to unit UNIT. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* $ Version */ /* - SPICELIB Version 2.20.1, 18-MAY-2010 (BVS) */ /* Removed "C$" marker from text in the header. */ /* - SPICELIB Version 2.20.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL. */ /* - SPICELIB Version 2.19.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-CC_C. */ /* - SPICELIB Version 2.18.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ /* - SPICELIB Version 2.17.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ /* - SPICELIB Version 2.16.0, 13-MAY-2010 (BVS) */ /* Updated for PC-WINDOWS-64BIT-IFORT. */ /* - SPICELIB Version 2.15.0, 13-MAY-2010 (BVS) */ /* Updated for PC-LINUX-64BIT-GFORTRAN. */ /* - SPICELIB Version 2.14.0, 13-MAY-2010 (BVS) */ /* Updated for PC-64BIT-MS_C. */ /* - SPICELIB Version 2.13.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-INTEL_C. */ /* - SPICELIB Version 2.12.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-IFORT. */ /* - SPICELIB Version 2.11.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-GFORTRAN. */ /* - SPICELIB Version 2.10.0, 18-MAR-2009 (BVS) */ /* Updated for PC-LINUX-GFORTRAN. */ /* - SPICELIB Version 2.9.0, 18-MAR-2009 (BVS) */ /* Updated for MAC-OSX-GFORTRAN. */ /* - SPICELIB Version 2.8.0, 19-FEB-2008 (BVS) */ /* Updated for PC-LINUX-IFORT. */ /* - SPICELIB Version 2.7.0, 14-NOV-2006 (BVS) */ /* Updated for PC-LINUX-64BIT-GCC_C. */ /* - SPICELIB Version 2.6.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-INTEL_C. */ /* - SPICELIB Version 2.5.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-IFORT. */ /* - SPICELIB Version 2.4.0, 14-NOV-2006 (BVS) */ /* Updated for PC-WINDOWS-IFORT. */ /* - SPICELIB Version 2.3.0, 26-OCT-2005 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-GCC_C. */ /* - SPICELIB Version 2.2.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN_C. */ /* - SPICELIB Version 2.1.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN. */ /* - SPICELIB Version 2.0.5, 17-JUL-2002 (BVS) */ /* Added MAC-OSX environments. */ /* - SPICELIB Version 2.0.4, 08-OCT-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitely given. New */ /* environments are WIN-NT */ /* - SPICELIB Version 2.0.3, 16-SEP-1999 (NJB) */ /* CSPICE environments were added. Some typos were corrected. */ /* - SPICELIB Version 2.0.2, 28-JUL-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. New */ /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ /* - SPICELIB Version 2.0.1, 18-MAR-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. Previously, */ /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ /* by the environment label SUN. */ /* - SPICELIB Version 2.0.0, 08-APR-1998 (NJB) */ /* Module was updated for the PC-LINUX platform. */ /* - SPICELIB Version 1.1.1, 20-AUG-1996 (WLT) */ /* Corrected the heading for the Index_Entries section. */ /* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ /* For the Macintosh, we need to use real Fortran I/O, i.e., */ /* using the first column for carriage control. The change */ /* was to move the MAC environment indicator from one */ /* environment case to the other. */ /* Also, for UNIX environments, the parameter STDOUT is no */ /* longer defined. This only appears for platforms that */ /* need it to differentiate between writing to a file and */ /* the terminal screen (standard output), currently: VAX, */ /* PC-LAHEY, PC-MS, and MAC. */ /* - SPICELIB Version 1.0.0, 20-DEC-1995 (KRG) */ /* The routine graduated */ /* - Beta Version 3.1.0, 18-AUG-1995 (KRG) */ /* Moved the PC-LAHEY environment indicator from one environment */ /* case to the other. The Lahey compiler on the PC does treat text */ /* files and the standard output device differently. */ /* - Beta Version 3.0.1, 01-JAN-1995 (KRG) */ /* Moved the description of the input variable UNIT from the $ */ /* Detailed_Output section of the header to the correct location */ /* in the $ Detailed_Input section of the header. */ /* - Beta Version 3.0.0, 11-JUL-1994 (HAN) */ /* Edited master source file to correct the code for the */ /* PC/Microsoft FORTRAN PowerStation environment. It should use */ /* the same code as the VAX, not the PC/Lahey Fortran code. Also, */ /* code was included for the DEC Alpha OpenVMS/DEC Fortran and */ /* Sun Solaris/Sun Fortran environments. */ /* - Beta Version 2.0.0, 30-MAR-1994 (HAN) */ /* Edited master source file to include new environments: */ /* Silicon Graphics IRIX/Silicon Graphics Fortran, */ /* DEC Alpha-OSF/1, and NeXT/Absoft Fortran. */ /* - Beta Version 1.0.0, 17-DEC-1992 (KRG) */ /* -& */ /* $ Index_Entries */ /* write a text line to a logical unit */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 08-APR-1998 (NJB) */ /* Module was updated for the PC-LINUX platform. */ /* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */ /* For the Macintosh, we need to use real Fortran I/O, i.e., */ /* using the first column for carriage control. The change */ /* was to move the MAC environment indicator from one */ /* environment case to the other. */ /* Also, for UNIX environments, the parameter STDOUT is no */ /* longer defined. This only appears for platforms that */ /* need it to differentiate between writing to a file and */ /* the terminal screen (standard output), currently: VAX, */ /* PC-LAHEY, PC-MS, and MAC. */ /* - SPICELIB Version 1.0.0, 20-DEC-1995 (KRG) */ /* The routine graduated */ /* - Beta Version 3.1.0, 18-AUG-1995 (KRG) */ /* Moved the PC-LAHEY environment indicator from one environment */ /* case to the other. The Lahey compiler on the PC does treat text */ /* files and the standard output device differently. */ /* - Beta Version 3.0.1, 01-JAN-1995 (KRG) */ /* Moved the description of the input variable UNIT from the $ */ /* Detailed_Output section of the header to the correct location */ /* in the $ Detailed_Input section of the header. */ /* - Beta Version 3.0.0, 11-JUL-1994 (HAN) */ /* Edited master source file to correct the code for the */ /* PC/Microsoft FORTRAN PowerStation environment. It should use */ /* the same code as the VAX, not the PC/Lahey Fortran code. Also, */ /* code was included for the DEC Alpha OpenVMS/DEC Fortran and */ /* Sun Solaris/Sun Fortran environments. */ /* - Beta Version 2.0.0, 30-MAR-1994 (HAN) */ /* Edited master source file to include new environments: */ /* Silicon Graphics IRIX/Silicon Graphics Fortran, */ /* DEC Alpha-OSF/1, and NeXT/Absoft Fortran. */ /* - Beta Version 1.0.0, 17-DEC-1992 (KRG) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* UNIX based fortran implementations typically do not distinguish */ /* between a text file and the standard output unit, so no leading */ /* vertical spacing character is required. */ ci__1.cierr = 1; ci__1.ciunit = *unit; ci__1.cifmt = "(A)"; iostat = s_wsfe(&ci__1); if (iostat != 0) { goto L100001; } iostat = do_fio(&c__1, line, rtrim_(line, line_len)); if (iostat != 0) { goto L100001; } iostat = e_wsfe(); L100001: /* Check to see if we got a write error, and signal it if we did. */ /* Also check in and check out. */ if (iostat != 0) { chkin_("WRITLN", (ftnlen)6); setmsg_("Error Writing to file: #. IOSTAT = #.", (ftnlen)37); errfnm_("#", unit, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); chkout_("WRITLN", (ftnlen)6); return 0; } return 0; } /* writln_ */
/* $Procedure ZZEKFRX ( EK, find record in index ) */ /* Subroutine */ int zzekfrx_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *pos) { char cval[1024]; doublereal dval; integer ival; extern integer zzekrp2n_(integer *, integer *, integer *); integer unit; extern /* Subroutine */ int zzeklerc_(integer *, integer *, integer *, char *, integer *, logical *, integer *, integer *, ftnlen), zzeklerd_(integer *, integer *, integer *, doublereal *, integer * , logical *, integer *, integer *), zzekleri_(integer *, integer * , integer *, integer *, integer *, logical *, integer *, integer * ), chkin_(char *, ftnlen); integer recno, cvlen; logical found; integer dtype, cmplen; extern logical return_(void); logical isnull; extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errfnm_(char *, integer *, ftnlen); integer prvptr; extern /* Subroutine */ int errint_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), zzekrsc_(integer *, integer *, integer *, integer *, integer *, integer *, char *, logical *, logical *, ftnlen), zzekrsd_(integer *, integer *, integer *, integer *, integer *, doublereal *, logical *, logical *), zzekrsi_(integer *, integer *, integer *, integer *, integer * , integer *, logical *, logical *); /* $ Abstract */ /* Find the ordinal position of a specified record in a specified, */ /* indexed EK column. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Query Limit Parameters */ /* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ /* Parameter MAXCON increased to 1000. */ /* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ /* Updated to support SELECT clause. */ /* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ /* These limits apply to character string queries input to the */ /* EK scanner. This limits are part of the EK system's user */ /* interface: the values should be advertised in the EK required */ /* reading document. */ /* Maximum length of an input query: MAXQRY. This value is */ /* currently set to twenty-five 80-character lines. */ /* Maximum number of columns that may be listed in the */ /* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ /* Maximum number of tables that may be listed in the `FROM */ /* clause' of a query: MAXTAB. */ /* Maximum number of relational expressions that may be listed */ /* in the `constraint clause' of a query: MAXCON. */ /* This limit applies to a query when it is represented in */ /* `normalized form': that is, the constraints have been */ /* expressed as a disjunction of conjunctions of relational */ /* expressions. The number of relational expressions in a query */ /* that has been expanded in this fashion may be greater than */ /* the number of relations in the query as orginally written. */ /* For example, the expression */ /* ( ( A LT 1 ) OR ( B GT 2 ) ) */ /* AND */ /* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ /* which contains 4 relational expressions, expands to the */ /* equivalent normalized constraint */ /* ( ( A LT 1 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ /* which contains eight relational expressions. */ /* MXJOIN is the maximum number of tables that can be joined. */ /* MXJCON is the maximum number of join constraints allowed. */ /* Maximum number of order-by columns that may be used in the */ /* `order-by clause' of a query: MAXORD. MAXORD = 10. */ /* Maximum number of tokens in a query: 500. Tokens are reserved */ /* words, column names, parentheses, and values. Literal strings */ /* and time values count as single tokens. */ /* Maximum number of numeric tokens in a query: */ /* Maximum total length of character tokens in a query: */ /* Maximum length of literal string values allowed in queries: */ /* MAXSTR. */ /* End Include Section: EK Query Limit Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Pointer to record to locate. */ /* POS O Ordinal position of record. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. The file may be open for */ /* reading or writing. */ /* SEGDSC is the segment descriptor of the segment */ /* containing the column to be searched. */ /* COLDSC is the column descriptor of the column to be */ /* searched. */ /* RECPTR is a pointer to the record whose ordinal position */ /* is to be found. */ /* $ Detailed_Output */ /* POS is the ordinal position in the specified column */ /* of the input record, where the order relation is */ /* specified by the column's index. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If an I/O error occurs while reading the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* Various EK write operations require the capability of locating */ /* the index key that maps to a given record number. An example is */ /* updating a column's index to reflect deletion of a specified */ /* record: the key that maps to the record must be deleted. */ /* Locating this key is the inverse of the problem that the index */ /* is meant to solve. */ /* $ Examples */ /* See ZZEKIXDL. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 31-MAY-2010 (NJB) */ /* Bug fix: substring bound out-of-range violation */ /* in reference to local variable CVAL has been */ /* corrected. This error could occur if the a */ /* class 3 column entry had length exceeding MAXSTR. */ /* - Beta Version 1.0.0, 10-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZEKFRX", (ftnlen)7); } /* Determine the data type of the column, and look up the value */ /* associated with RECPTR. */ dtype = coldsc[1]; if (dtype == 1) { zzekrsc_(handle, segdsc, coldsc, recptr, &c__1, &cvlen, cval, &isnull, &found, (ftnlen)1024); if (found && ! isnull) { cmplen = min(cvlen,1024); } else { cmplen = 0; } } else if (dtype == 2 || dtype == 4) { zzekrsd_(handle, segdsc, coldsc, recptr, &c__1, &dval, &isnull, & found); } else if (dtype == 3) { zzekrsi_(handle, segdsc, coldsc, recptr, &c__1, &ival, &isnull, & found); } else { dashlu_(handle, &unit); setmsg_("File = #; COLIDX = #. Unrecognized data type code # found i" "n descriptor.", (ftnlen)72); errfnm_("#", &unit, (ftnlen)1); errint_("#", &coldsc[8], (ftnlen)1); errint_("#", &dtype, (ftnlen)1); sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); chkout_("ZZEKFRX", (ftnlen)7); return 0; } if (! found) { /* We have a most heinous situation. We should always be able */ /* to find the value associated with a record. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); setmsg_("File = #; RECNO = #; COLIDX = #. Column entry was not found" ". This probably indicates a corrupted file or a bug in the " "EK code.", (ftnlen)127); errfnm_("#", &unit, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errint_("#", &coldsc[8], (ftnlen)1); sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); chkout_("ZZEKFRX", (ftnlen)7); return 0; } /* Find the last column entry less than or equal to the one */ /* associated with the input record, where the order relation is */ /* dictionary ordering on (<column value>, <record number>) pairs. */ /* These ordered pairs are distinct, even if the column entries */ /* are not. Therefore, the ordinal position POS will actually be */ /* the ordinal position of our record. */ if (dtype == 1) { zzeklerc_(handle, segdsc, coldsc, cval, recptr, &isnull, pos, &prvptr, cmplen); } else if (dtype == 2 || dtype == 4) { zzeklerd_(handle, segdsc, coldsc, &dval, recptr, &isnull, pos, & prvptr); } else { /* The data type is INT. (We've already checked for invalid */ /* types.) */ zzekleri_(handle, segdsc, coldsc, &ival, recptr, &isnull, pos, & prvptr); } if (prvptr != *recptr) { /* Big problem. This should never happen. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); setmsg_("File = #; RECNO = #; COLIDX = #. Record that was last less" " than or equal to RECNO was not equal to RECNO. This probab" "ly indicates a corrupted file or a bug in the EK code.", ( ftnlen)174); errfnm_("#", &unit, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errint_("#", &coldsc[8], (ftnlen)1); sigerr_("SPICE(ITEMNOTFOUND)", (ftnlen)19); chkout_("ZZEKFRX", (ftnlen)7); return 0; } chkout_("ZZEKFRX", (ftnlen)7); return 0; } /* zzekfrx_ */
/* $Procedure ZZEKRD04 ( EK, read class 4 column entry elements ) */ /* Subroutine */ int zzekrd04_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *beg, integer *end, integer *ivals, logical *isnull, logical *found) { /* System generated locals */ integer i__1, i__2; /* Local variables */ integer base, nrec, nelt; extern integer zzekrp2n_(integer *, integer *, integer *); integer unit; extern /* Subroutine */ int zzekgfwd_(integer *, integer *, integer *, integer *), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( integer *, integer *, integer *, integer *); integer p, nread; extern /* Subroutine */ int chkin_(char *, ftnlen); integer recno, ncols, ptemp, start; extern logical failed_(void); extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, integer *); integer remain, colidx, datptr, maxidx, minidx, ptrloc; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen); /* $ Abstract */ /* Read a specified element range from a column entry in a specified */ /* record in a class 4 column. Class 4 columns have integer arrays */ /* as column entries. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* BEG I Start element index. */ /* END I End element index. */ /* IVALS O Integer values in column entry. */ /* ISNULL O Flag indicating whether column entry is null. */ /* FOUND O Flag indicating whether elements were found. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. */ /* SEGDSC is the descriptor of the segment from which data is */ /* to be read. */ /* COLDSC is the descriptor of the column from which data is */ /* to be read. */ /* RECPTR is a pointer to the record containing the column */ /* entry to be written. */ /* BEG, */ /* END are, respectively, the start and end indices of */ /* the contiguous range of elements to be read from */ /* the specified column entry. */ /* $ Detailed_Output */ /* IVALS are the values read from the specified column */ /* entry. The mapping of elements of the column entry */ /* to elements of IVALS is as shown below: */ /* Column entry element IVALS element */ /* -------------------- ------------- */ /* BEG 1 */ /* BEG+1 2 */ /* . . */ /* . . */ /* . . */ /* END END-BEG+1 */ /* IVALS is valid only if the output argument */ /* FOUND is returned .TRUE. */ /* ISNULL is a logical flag indicating whether the entry is */ /* null. ISNULL is set on output whether or not */ /* the range of elements designated by BEG and END */ /* exists. */ /* FOUND is a logical flag indicating whether the range */ /* of elements designated by BEG and END exists. */ /* If the number of elements in the specified column */ /* entry is not at least END, FOUND will be returned */ /* .FALSE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the specified column entry has not been initialized, the */ /* error SPICE(UNINITIALIZEDVALUE) is signalled. */ /* 3) If the ordinal position of the column specified by COLDSC */ /* is out of range, the error SPICE(INVALIDINDEX) is signalled. */ /* 4) If an I/O error occurs while reading the indicated file, */ /* the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine is a utility for reading data from class 4 columns. */ /* $ Examples */ /* See EKRCEI. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in ZZEKGFWD call. */ /* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 08-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in ZZEKGFWD call. */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ nrec = segdsc[5]; /* Make sure the column exists. */ ncols = segdsc[4]; colidx = coldsc[8]; if (colidx < 1 || colidx > ncols) { chkin_("ZZEKRD04", (ftnlen)8); setmsg_("Column index = #; valid range is 1:#.", (ftnlen)37); errint_("#", &colidx, (ftnlen)1); errint_("#", &nrec, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKRD04", (ftnlen)8); return 0; } /* Compute the data pointer location, and read the pointer. */ ptrloc = *recptr + 2 + colidx; dasrdi_(handle, &ptrloc, &ptrloc, &datptr); if (datptr > 0) { /* The entry is non-null. */ *isnull = FALSE_; /* Get the element count. Check for range specifications that */ /* can't be met. */ dasrdi_(handle, &datptr, &datptr, &nelt); if (*beg < 1 || *beg > nelt) { *found = FALSE_; return 0; } else if (*end < 1 || *end > nelt) { *found = FALSE_; return 0; } else if (*end < *beg) { *found = FALSE_; return 0; } /* The request is valid, so read the data. The first step is to */ /* locate the element at index BEG. */ zzekpgpg_(&c__3, &datptr, &p, &base); minidx = 1; maxidx = base + 254 - datptr; datptr += *beg; while(maxidx < *beg) { /* Locate the page on which the element is continued. */ i__1 = base + 255; i__2 = base + 255; dasrdi_(handle, &i__1, &i__2, &p); /* Determine the highest-indexed element of the column entry */ /* located on the current page. */ zzekpgbs_(&c__3, &p, &base); minidx = maxidx + 1; /* Computing MIN */ i__1 = maxidx + 254; maxidx = min(i__1,nelt); /* The following assignment will set DATPTR to the correct */ /* value on the last pass through this loop. */ datptr = base + 1 + (*beg - minidx); } /* At this point, P is the page on which the element having index */ /* BEG is located. BASE is the base address of this page. */ /* MAXIDX is the highest index of any element on the current page. */ remain = *end - *beg + 1; start = 1; /* Decide how many elements to read from the current page, and */ /* read them. */ /* Computing MIN */ i__1 = remain, i__2 = base + 254 - datptr + 1; nread = min(i__1,i__2); i__1 = datptr + nread - 1; dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]); remain -= nread; while(remain > 0 && ! failed_()) { /* Locate the page on which the element is continued. */ zzekgfwd_(handle, &c__3, &p, &ptemp); p = ptemp; zzekpgbs_(&c__3, &p, &base); datptr = base + 1; start += nread; nread = min(remain,254); i__1 = datptr + nread - 1; dasrdi_(handle, &datptr, &i__1, &ivals[start - 1]); remain -= nread; } *found = ! failed_(); } else if (datptr == -2) { /* The value is null. */ *isnull = TRUE_; *found = TRUE_; } else if (datptr == -1) { /* The data value is absent. This is an error. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); chkin_("ZZEKRD04", (ftnlen)8); setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" "OLIDX = #; RECNO = #; EK = #", (ftnlen)87); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &colidx, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(UNINITIALIZEDVALUE)", (ftnlen)25); chkout_("ZZEKRD04", (ftnlen)8); return 0; } else { /* The data pointer is corrupted. */ dashlu_(handle, &unit); chkin_("ZZEKRD04", (ftnlen)8); setmsg_("Data pointer is corrupted. SEGNO = #; COLIDX = #; RECNO = " "#; EK = #", (ftnlen)68); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &colidx, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKRD04", (ftnlen)8); return 0; } return 0; } /* zzekrd04_ */
/* $Procedure ZZEKGCDP ( EK, get column data pointer ) */ /* Subroutine */ int zzekgcdp_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *datptr) { extern integer zzekrp2n_(integer *, integer *, integer *); integer unit; extern /* Subroutine */ int chkin_(char *, ftnlen); integer recno, ncols; extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, integer *); integer colidx, ptrloc; extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); /* $ Abstract */ /* Return the data pointer for a specified EK column entry. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I File handle. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* DATPTR O Data pointer of column entry. */ /* $ Detailed_Input */ /* HANDLE is a file handle of an EK open for read or write */ /* access. */ /* SEGDSC is the descriptor of the segment containing */ /* the specified column entry. */ /* COLDSC is the descriptor of the column containing */ /* the specified column entry. */ /* RECPTR is a pointer to the record containing the column */ /* entry whose data pointer is desired. */ /* $ Detailed_Output */ /* DATPTR is the data pointer of the specified column entry. */ /* When DATPTR is positive, it represents a pointer */ /* to a data value. The interpretation of the */ /* pointer depends on the class of the column entry. */ /* DATPTR may also take on the distinguished values */ /* UNINIT (indicated uninitialized entry) */ /* NULL (indicated null entry) */ /* NOBACK (indicated uninitialized backup entry) */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If an I/O error occurs while reading the indicated file, the */ /* error will be diagnosed by routines called by this routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine hides details of column entry data pointer access. */ /* $ Examples */ /* See ZZEKRFIL. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 17-OCT-1995 (NJB) */ /* -& */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Make sure the column exists. */ ncols = segdsc[4]; colidx = coldsc[8]; if (colidx < 1 || colidx > ncols) { recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); chkin_("ZZEKGCDP", (ftnlen)8); setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " "EK = #", (ftnlen)65); errint_("#", &colidx, (ftnlen)1); errint_("#", &ncols, (ftnlen)1); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKGCDP", (ftnlen)8); return 0; } /* Compute the data pointer location, and read the pointer. */ ptrloc = *recptr + 2 + colidx; dasrdi_(handle, &ptrloc, &ptrloc, datptr); return 0; } /* zzekgcdp_ */
/* $Procedure DASA2L ( DAS, address to physical location ) */ /* Subroutine */ int dasa2l_(integer *handle, integer *type__, integer * addrss, integer *clbase, integer *clsize, integer *recno, integer * wordno) { /* Initialized data */ static integer next[3] = { 2,3,1 }; static integer prev[3] = { 3,1,2 }; static integer nw[3] = { 1024,128,256 }; static integer rngloc[3] = { 3,5,7 }; static logical first = TRUE_; static integer nfiles = 0; /* System generated locals */ integer i__1, i__2, i__3; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer free, nrec, fidx; static logical fast; static integer unit, i__, range[2], tbhan[20]; extern /* Subroutine */ int chkin_(char *, ftnlen); static integer ncomc, ncomr, ndirs; static logical known; static integer hiaddr; extern /* Subroutine */ int dasham_(integer *, char *, ftnlen); static integer tbbase[60] /* was [3][20] */; static char access[10]; static integer dscloc, dirrec[256]; extern /* Subroutine */ int dashfs_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *); static logical samfil; static integer mxaddr; extern integer isrchi_(integer *, integer *, integer *); static integer tbmxad[60] /* was [3][20] */; static logical tbfast[20]; static integer mxclrc; extern /* Subroutine */ int dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen); static integer lstrec[3]; extern /* Subroutine */ int sigerr_(char *, ftnlen); static integer prvhan; extern /* Subroutine */ int chkout_(char *, ftnlen); static integer nresvc, tbsize[60] /* was [3][20] */, nxtrec; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), dasrri_(integer *, integer *, integer *, integer *, integer *); static logical rdonly; static integer lstwrd[3], nresvr, ntypes, curtyp, prvtyp; /* $ Abstract */ /* Map a DAS address to a physical location in the DAS file */ /* it refers to. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAS */ /* $ Keywords */ /* DAS */ /* FILES */ /* TRANSFORMATION */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I DAS file handle. */ /* TYPE I Data type specifier. */ /* ADDRSS I DAS address of a word of data type TYPE. */ /* CLBASE, */ /* CLSIZE O Cluster base record number and size. */ /* RECNO, */ /* WORDNO O Record/word pair corresponding to ADDRSS. */ /* CHAR P Parameter indicating character data type. */ /* DP P Parameter indicating double precision data type. */ /* INT P Parameter indicating integer data type. */ /* $ Detailed_Input */ /* HANDLE is the file handle of an open DAS file. */ /* TYPE is a data type specifier. TYPE may be any of */ /* the parameters */ /* CHAR */ /* DP */ /* INT */ /* which indicate `character', `double precision', */ /* and `integer' respectively. */ /* ADDRSS is the address in a DAS of a word of data */ /* type TYPE. For each data type (double precision, */ /* integer, or character), addresses range */ /* from 1 to the maximum current value for that type, */ /* which is available from DAFRFR. */ /* $ Detailed_Output */ /* CLBASE, */ /* CLSIZE are, respectively, the base record number and */ /* size, in records, of the cluster containing the */ /* word corresponding to ADDRSS. The cluster spans */ /* records numbered CLBASE through CLBASE + */ /* CLSIZE - 1. */ /* RECNO, */ /* WORD are, respectively, the number of the physical */ /* record and the number of the word within the */ /* record that correspond to ADDRSS. Word numbers */ /* start at 1 and go up to NC, ND, or NI in */ /* character, double precision, or integer records */ /* respectively. */ /* $ Parameters */ /* CHAR, */ /* DP, */ /* INT are data type specifiers which indicate */ /* `character', `double precision', and `integer' */ /* respectively. These parameters are used in */ /* all DAS routines that require a data type */ /* specifier as input. */ /* $ Exceptions */ /* 1) If TYPE is not recognized, the error SPICE(DASINVALIDTYPE) */ /* will be signalled. */ /* 2) ADDRSS must be between 1 and LAST inclusive, where LAST */ /* is last address in the DAS for a word of the specified */ /* type. If ADDRSS is out of range, the error */ /* SPICE(DASNOSUCHADDRESS) will be signalled. */ /* 3) If this routine fails to find directory information for */ /* the input address, the error SPICE(NOSUCHRECORD) will be */ /* signalled. */ /* 4) If the input handle is invalid, the error will be diagnosed */ /* by routines called by this routine. */ /* If any of the above exceptions occur, the output arguments may */ /* contain bogus information. */ /* $ Files */ /* See the description of the argument HANDLE in $Detailed_Input. */ /* $ Particulars */ /* The DAS architecture allows a programmer to think of the data */ /* within a DAS file as three one-dimensional arrays: one of */ /* double precision numbers, one of integers, and one of characters. */ /* This model allows a programmer to ask the DAS system for the */ /* `nth double precision number (or integer, or character) in the */ /* file'. */ /* DAS files are Fortran direct access files, so to find the */ /* `nth double precision number', you must have the number of the */ /* record containing it and the `word number', or position, within */ /* the record of the double precision number. This routine finds */ /* the record/word number pair that specify the physical location */ /* in a DAS file corresponding to a DAS address. */ /* As opposed to DAFs, the mapping of addresses to physical locations */ /* for a DAS file depends on the organization of data in the file. */ /* Given a fixed set of DAS format parameters, the physical location */ /* of the nth double precision number can depend on how many integer */ /* and character records have been written prior to the record */ /* containing that double precision number. */ /* The cluster information output from this routine allows the */ /* caller to substantially reduce the number of directory reads */ /* required to read a from range of addresses that spans */ /* multiple physical records; the reading program only need call */ /* this routine once per cluster read, rather than once per */ /* physical record read. */ /* $ Examples */ /* 1) Use this routine to read integers from a range of */ /* addresses. This is done in the routine DASRDI. */ /* C */ /* C Decide how many integers to read. */ /* C */ /* NUMINT = LAST - FIRST + 1 */ /* NREAD = 0 */ /* C */ /* C Find out the physical location of the first */ /* C integer. If FIRST is invalid, DASA2L will take care */ /* C of the problem. */ /* C */ /* CALL DASA2L ( HANDLE, INT, FIRST, */ /* . CLBASE, CLSIZE, RECNO, WORDNO ) */ /* C */ /* C Read as much data from record RECNO as necessary. */ /* C */ /* N = MIN ( NUMINT, NWI - WORDNO + 1 ) */ /* CALL DASRRI ( HANDLE, RECNO, WORDNO, WORDNO + N-1, */ /* . DATA ) */ /* NREAD = N */ /* RECNO = RECNO + 1 */ /* C */ /* C Read from as many additional records as necessary. */ /* C */ /* DO WHILE ( NREAD .LT. NUMINT ) */ /* C */ /* C At this point, RECNO is the correct number of the */ /* C record to read from next. CLBASE is the number */ /* C of the first record of the cluster we're about */ /* C to read from. */ /* C */ /* IF ( RECNO .LT. ( CLBASE + CLSIZE ) ) THEN */ /* C */ /* C We can continue reading from the current */ /* C cluster. */ /* C */ /* N = MIN ( NUMINT - NREAD, NWI ) */ /* CALL DASRRI ( HANDLE, */ /* . RECNO, */ /* . 1, */ /* . N, */ /* . DATA ( NREAD + 1 ) ) */ /* NREAD = NREAD + N */ /* RECNO = RECNO + 1 */ /* ELSE */ /* C */ /* C We must find the next integer cluster to */ /* C read from. The first integer in this */ /* C cluster has address FIRST + NREAD. */ /* C */ /* CALL DASA2L ( HANDLE, */ /* . INT, */ /* . FIRST + NREAD, */ /* . CLBASE, */ /* . CLSIZE, */ /* . RECNO, */ /* . WORDNO ) */ /* END IF */ /* END DO */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.1 20-NOV-2001 (NJB) */ /* Comment fix: diagram showing directory record pointers */ /* incorrectly showed element 2 of the record as a backward */ /* pointer. The element is actually a forward pointer. */ /* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */ /* Bug fix: calculation to determine whether file is segregated */ /* has been fixed. */ /* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */ /* Corrected title of permuted index entry section. */ /* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ /* Re-written to optimize address calculations for segregated, */ /* read-only files. */ /* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ /* Fixed a typo in the $ Brief_I/O section of the header. */ /* Removed references to specific DAS file open routines in the */ /* $ Detailed_Input section of the header. This was done in order */ /* to minimize documentation changes if the DAS open routines ever */ /* change. */ /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* map DAS logical address to physical location */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */ /* Bug fix: calculation to determine whether file is segregated */ /* has been fixed. An incorrect variable name used in a bound */ /* calculation resulted in an incorrect determination of whether */ /* a file was segregated, and caused arithmetic overflow for */ /* files with large maximum addresses. */ /* In the previous version, the number of DAS words in a cluster */ /* was incorrectly calculated as the product of the maximum */ /* address of the cluster's data type and the number of words of */ /* that data type in a DAS record. The correct product involves */ /* the number of records in the cluster and the number of words of */ /* that data type in a DAS record. */ /* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */ /* Re-written to optimize address calculations for segregated, */ /* read-only files. */ /* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */ /* Fixed a typo in the $ Brief_I/O section of the header. */ /* Removed references to specific DAS file open routines in the */ /* $ Detailed_Input section of the header. This was done in order */ /* to minimize documentation changes if the DAS open routines ever */ /* change. */ /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Words per data record, for each data type: */ /* Directory pointer locations */ /* Directory address range locations */ /* Indices of lowest and highest addresses in a `range array': */ /* Location of first type descriptor */ /* Access word length */ /* File table size */ /* Local variables */ /* Saved variables */ /* Initial values */ /* NEXT and PREV map the DAS data type codes to their */ /* successors and predecessors, respectively. */ /* Discovery check-in is used in this routine. */ /* DAS files have the following general structure: */ /* +------------------------+ */ /* | file record | */ /* +------------------------+ */ /* | reserved records | */ /* | | */ /* +------------------------+ */ /* | comment records | */ /* | | */ /* | | */ /* | | */ /* +------------------------+ */ /* | first data directory | */ /* +------------------------+ */ /* | data records | */ /* | | */ /* | | */ /* | | */ /* | | */ /* +------------------------+ */ /* . */ /* . */ /* +------------------------+ */ /* | last data directory | */ /* +------------------------+ */ /* | data records | */ /* | | */ /* | | */ /* +------------------------+ */ /* Within each DAS data record, word numbers start at one and */ /* increase up to NWI, NWD, or NWC: the number of words in an */ /* integer, double precision, or character data record. */ /* +--------------------------------+ */ /* | | | ... | | */ /* +--------------------------------+ */ /* 1 2 NWD */ /* +--------------------------------+ */ /* | | | ... | | */ /* +--------------------------------+ */ /* 1 2 NWI */ /* +------------------------------------+ */ /* | | | ... | | */ /* +------------------------------------+ */ /* 1 2 NWC */ /* Directories are single records that describe the data */ /* types of data records that follow. The directories */ /* in a DAS file form a doubly linked list: each directory */ /* contains forward and backward pointers to the next and */ /* previous directories. */ /* Each directory also contains, for each data type, the lowest */ /* and highest logical address occurring in any of the records */ /* described by the directory. */ /* Following the pointers and address range information is */ /* a sequence of data type descriptors. These descriptors */ /* indicate the data type of data records following the */ /* directory record. Each descriptor gives the data type */ /* of a maximal set of contiguous data records, all having the */ /* same type. By `maximal set' we mean that no data records of */ /* the same type bound the set of records in question. */ /* Pictorially, the structure of a directory is as follows: */ /* +----------------------------------------------------+ */ /* | <pointers> | <address ranges> | <type descriptors> | */ /* +----------------------------------------------------+ */ /* where the <pointers> section looks like */ /* +-----------------------------------------+ */ /* | <backward pointer> | <forward pointer> | */ /* +-----------------------------------------+ */ /* the <address ranges> section looks like */ /* +-------------------------------------------+ */ /* | <char range> | <d.p. range> | <int range> | */ /* +-------------------------------------------+ */ /* and each range looks like one of: */ /* +------------------------------------------------+ */ /* | <lowest char address> | <highest char address> | */ /* +------------------------------------------------+ */ /* +------------------------------------------------+ */ /* | <lowest d.p. address> | <highest d.p. address> | */ /* +------------------------------------------------+ */ /* +------------------------------------------------+ */ /* | <lowest int address> | <highest int address> | */ /* +------------------------------------------------+ */ /* The type descriptors implement a run-length encoding */ /* scheme. The first element of the series of descriptors */ /* occupies two integers: it contains a type code and a count. */ /* The rest of the descriptors are just signed counts; the data */ /* types of the records they describe are deduced from the sign */ /* of the count and the data type of the previous descriptor. */ /* The method of finding the data type for a given descriptor */ /* in terms of its predecessor is as follows: if the sign of a */ /* descriptor is positive, the type of that descriptor is the */ /* successor of the type of the preceding descriptor in the */ /* sequence of types below. If the sign of a descriptor is */ /* negative, the type of the descriptor is the predecessor of the */ /* type of the preceding descriptor. */ /* C --> D --> I --> C */ /* For example, if the preceding type is `I', and a descriptor */ /* contains the number 16, the type of the descriptor is `C', */ /* whereas if the descriptor contained the number -800, the type */ /* of the descriptor would be `D'. */ /* Make sure the data type is valid. */ if (*type__ < 1 || *type__ > 3) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Invalid data type: #. File was #", (ftnlen)33); errint_("#", type__, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASINVALIDTYPE)", (ftnlen)21); chkout_("DASA2L", (ftnlen)6); return 0; } /* Decide whether we're looking at the same file as we did on */ /* the last call. */ if (first) { samfil = FALSE_; fast = FALSE_; prvhan = *handle; first = FALSE_; } else { samfil = *handle == prvhan; prvhan = *handle; } /* We have a special case if we're looking at a `fast' file */ /* that we saw on the last call. When we say a file is fast, */ /* we're implying that it's open for read access only and that it's */ /* segregated. In this case, we can do an address calculation */ /* without looking up any information from the file. */ if (samfil && fast) { *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)666)]; *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)667)]; mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)668)]; hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)669)]; /* Make sure that ADDRSS points to an existing location. */ if (*addrss < 1 || *addrss > mxaddr) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("ADDRSS was #; valid range for type # is # to #. File w" "as #", (ftnlen)59); errint_("#", addrss, (ftnlen)1); errint_("#", type__, (ftnlen)1); errint_("#", &c__1, (ftnlen)1); errint_("#", &mxaddr, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); chkout_("DASA2L", (ftnlen)6); return 0; } } else { /* If the current file is not the same one we looked at on the */ /* last call, find out whether the file is on record in our file */ /* table. Add the file to the table if necessary. Bump the */ /* oldest file in the table if there's no room. */ if (! samfil) { fidx = isrchi_(handle, &nfiles, tbhan); known = fidx > 0; if (known) { /* The file is in our list. */ fast = tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfast", i__1, "dasa2l_", (ftnlen)708)]; if (fast) { /* This is a segregated, read-only file. Look up the */ /* saved information we'll need to calculate addresses. */ *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2" "l_", (ftnlen)715)]; *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2" "l_", (ftnlen)716)]; mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)717)]; hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", ( ftnlen)718)]; /* Make sure that ADDRSS points to an existing location. */ if (*addrss < 1 || *addrss > mxaddr) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("ADDRSS was #; valid range for type # is # " "to #. File was #", (ftnlen)60); errint_("#", addrss, (ftnlen)1); errint_("#", type__, (ftnlen)1); errint_("#", &c__1, (ftnlen)1); errint_("#", &mxaddr, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); chkout_("DASA2L", (ftnlen)6); return 0; } } /* FAST is set. */ } /* KNOWN is set. */ } /* SAMFIL, FAST, and KNOWN are set. If the file is the same one */ /* we saw on the last call, the state variables FAST, and KNOWN */ /* retain their values from the previous call. */ /* FIDX is set at this point only if we're looking at a known */ /* file. */ /* Unless the file is recognized and known to be a fast file, we */ /* look up all metadata for the file. */ if (! (known && fast)) { if (! known) { /* This file is not in our list. If the list is not full, */ /* append the file to the list. If the list is full, */ /* replace the oldest (first) file with this one. */ if (nfiles < 20) { ++nfiles; fidx = nfiles; } else { fidx = 1; } tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tbhan", i__1, "dasa2l_", (ftnlen)781)] = *handle; /* Find out whether the file is open for read or write */ /* access. We consider the file to be `slow' until we find */ /* out otherwise. The contents of the arrays TBHIGH, */ /* TBBASE, TBSIZE, and TBMXAD are left undefined for slow */ /* files. */ dasham_(handle, access, (ftnlen)10); rdonly = s_cmp(access, "READ", (ftnlen)10, (ftnlen)4) == 0; fast = FALSE_; tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge( "tbfast", i__1, "dasa2l_", (ftnlen)794)] = fast; /* We'll set the flag KNOWN at the end of the outer IF */ /* block. */ } else { /* We set RDONLY to .FALSE. for any known file that is */ /* not fast. It's actually possible for a read-only file */ /* to be unsegregated, but this is expected to be a rare */ /* case, one that's not worth complicating this routine */ /* further for. */ rdonly = FALSE_; } /* RDONLY is set. */ /* FIDX is now set whether or not the current file is known. */ /* Get the number of reserved records, comment records, and */ /* the current last address of the data type TYPE from the */ /* file summary. */ dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, &tbmxad[( i__1 = fidx * 3 - 3) < 60 && 0 <= i__1 ? i__1 : s_rnge( "tbmxad", i__1, "dasa2l_", (ftnlen)821)], lstrec, lstwrd); mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)831)]; /* Make sure that ADDRSS points to an existing location. */ if (*addrss < 1 || *addrss > mxaddr) { chkin_("DASA2L", (ftnlen)6); dashlu_(handle, &unit); setmsg_("ADDRSS was #; valid range for type # is # to #. F" "ile was #", (ftnlen)60); errint_("#", addrss, (ftnlen)1); errint_("#", type__, (ftnlen)1); errint_("#", &c__1, (ftnlen)1); errint_("#", &mxaddr, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23); chkout_("DASA2L", (ftnlen)6); return 0; } /* Find out which directory describes the cluster containing */ /* this word. To do this, we must traverse the directory */ /* list. The first directory record comes right after the */ /* last comment record. (Don't forget the file record when */ /* counting the predecessors of the directory record.) */ /* Note that we don't need to worry about not finding a */ /* directory record that contains the address we're looking */ /* for, since we've already checked that the address is in */ /* range. */ /* Keep track of the number of directory records we see. We'll */ /* use this later to determine whether we've got a segregated */ /* file. */ nrec = nresvr + ncomr + 2; ndirs = 1; i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)872)] + 1; dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen) 872)], &i__3, range); while(range[1] < *addrss) { /* The record number of the next directory is the forward */ /* pointer in the current directory record. Update NREC */ /* with this pointer. Get the address range for the */ /* specified type covered by this next directory record. */ dasrri_(handle, &nrec, &c__2, &c__2, &nxtrec); nrec = nxtrec; ++ndirs; i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)891)] + 1; dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", ( ftnlen)891)], &i__3, range); } /* NREC is now the record number of the directory that contains */ /* the type descriptor for the address we're looking for. */ /* Our next task is to find the descriptor for the cluster */ /* containing the input address. To do this, we must examine */ /* the directory record in `left-to-right' order. As we do so, */ /* we'll keep track of the highest address of type TYPE */ /* occurring in the clusters whose descriptors we've seen. */ /* The variable HIADDR will contain this address. */ dasrri_(handle, &nrec, &c__1, &c__256, dirrec); /* In the process of finding the physical location */ /* corresponding to ADDRSS, we'll find the record number of the */ /* base of the cluster containing ADDRSS. We'll start out by */ /* initializing this value with the number of the first data */ /* record of the next cluster. */ *clbase = nrec + 1; /* We'll initialize HIADDR with the value preceding the lowest */ /* address of type TYPE described by the current directory. */ hiaddr = dirrec[(i__2 = rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen) 925)] - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", (ftnlen)925)] - 1; /* Initialize the number of records described by the last seen */ /* type descriptor. This number, when added to CLBASE, should */ /* yield the number of the first record of the current cluster; */ /* that's why it's initialized to 0. */ *clsize = 0; /* Now find the descriptor for the cluster containing ADDRSS. */ /* Read descriptors until we get to the one that describes the */ /* record containing ADDRSS. Keep track of descriptor data */ /* types as we go. Also count the descriptors. */ /* At this point, HIADDR is less than ADDRSS, so the loop will */ /* always be executed at least once. */ prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen)944)]; dscloc = 10; while(hiaddr < *addrss) { /* Update CLBASE so that it is the record number of the */ /* first record of the current cluster. */ *clbase += *clsize; /* Find the type of the current descriptor. */ if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", (ftnlen)957)] > 0) { curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("next", i__1, "dasa2l_", (ftnlen)958)]; } else { curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen)960)]; } /* Forgetting to update PRVTYP is a Very Bad Thing (VBT). */ prvtyp = curtyp; /* If the current descriptor is of the type we're interested */ /* in, update the highest address count. */ if (curtyp == *type__) { hiaddr += nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)973)] * ( i__3 = dirrec[(i__2 = dscloc - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", ( ftnlen)973)], abs(i__3)); } /* Compute the number of records described by the current */ /* descriptor. Update the descriptor location. */ *clsize = (i__2 = dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", ( ftnlen)980)], abs(i__2)); ++dscloc; } /* If we have an unknown read-only file, see whether the file */ /* is segregated. If it is, we'll be able to compute */ /* addresses much faster for subsequent reads to this file. */ if (rdonly && ! known) { if (ndirs == 1) { /* If this file is segregated, there are at most three */ /* cluster descriptors, and each one points to a cluster */ /* containing all records of the corresponding data type. */ /* For each data type having a non-zero maximum address, */ /* the size of the corresponding cluster must be large */ /* enough to hold all addresses of that type. */ ntypes = 0; for (i__ = 1; i__ <= 3; ++i__) { if (tbmxad[(i__1 = i__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_" , (ftnlen)1005)] > 0) { ++ntypes; } } /* Now look at the first NTYPES cluster descriptors, */ /* collecting cluster bases and sizes as we go. */ mxclrc = nrec + 1; prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa2l_", (ftnlen) 1016)]; dscloc = 10; fast = TRUE_; while(dscloc <= ntypes + 9 && fast) { /* Find the type of the current descriptor. */ if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasa2l_", ( ftnlen)1025)] > 0) { curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("next", i__1, "dasa" "2l_", (ftnlen)1026)]; } else { curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("prev", i__1, "dasa" "2l_", (ftnlen)1028)]; } prvtyp = curtyp; tbbase[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbbase", i__1, "dasa2l_" , (ftnlen)1032)] = mxclrc; tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_" , (ftnlen)1033)] = (i__3 = dirrec[(i__2 = dscloc - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_", (ftnlen) 1033)], abs(i__3)); mxclrc += tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)1034)]; fast = tbmxad[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)1037)] <= tbsize[(i__2 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__2 ? i__2 : s_rnge("tbsize", i__2, "dasa2l_", ( ftnlen)1037)] * nw[(i__3 = curtyp - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("nw", i__3, "dasa2" "l_", (ftnlen)1037)]; ++dscloc; } /* FAST is set. */ } else { /* The file has more than one directory record. */ fast = FALSE_; } /* If the file was unknown, readonly, and had one directory */ /* record, we determined whether it was a fast file. */ } else { /* The file was already known and wasn't fast, or is not */ /* readonly. */ fast = FALSE_; } /* FAST is set. */ } /* This is the end of the `.NOT. ( KNOWN .AND. FAST )' case. */ /* At this point, we've set or looked up CLBASE, CLSIZE, MXADDR, */ /* and HIADDR. */ /* If the file was unknown, we set TBHAN, TBRDON, and TBFAST. */ /* If the file was unknown and turned out to be fast, we set */ /* TBBASE, TBSIZE, TBHIGH, and TBMXAD as well. */ /* At this point, it's safe to indicate that the file is known. */ known = TRUE_; } /* At this point, */ /* -- CLBASE is properly set: it is the record number of the */ /* first record of the cluster containing ADDRSS. */ /* -- CLSIZE is properly set: it is the size of the cluster */ /* containing ADDRSS. */ /* -- HIADDR is the last logical address in the cluster */ /* containing ADDRSS. */ /* Now we must find the physical record and word corresponding */ /* to ADDRSS. The structure of the cluster containing ADDRSS and */ /* HIADDR is shown below: */ /* +--------------------------------------+ */ /* | | Record # CLBASE */ /* +--------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------+ */ /* | |ADDRSS| | Record # RECNO */ /* +--------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------+ Record # */ /* | |HIADDR| */ /* +--------------------------------------+ CLBASE + CLSIZE - 1 */ *recno = *clbase + *clsize - 1 - (hiaddr - *addrss) / nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", ( ftnlen)1122)]; *wordno = *addrss - (*addrss - 1) / nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)1125)] * nw[( i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("nw", i__2, "dasa2l_", (ftnlen)1125)]; return 0; } /* dasa2l_ */
/* $Procedure EKUCEI ( EK, update integer column entry ) */ /* Subroutine */ int ekucei_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, integer *ivals, logical *isnull, ftnlen column_len) { integer unit; extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, integer *, ftnlen), zzekrbck_(char *, integer *, integer *, integer *, integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), zzektrdp_(integer *, integer *, integer *, integer *), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer class__, dtype; extern logical failed_(void); integer coldsc[11], segdsc[24]; logical isshad; extern /* Subroutine */ int dashlu_(integer *, integer *); integer recptr; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), ekshdw_(integer *, logical *), zzekue01_(integer *, integer *, integer *, integer *, integer *, logical *), zzekue04_(integer *, integer *, integer *, integer *, integer *, integer *, logical *); /* $ Abstract */ /* Update an integer column entry in a specified EK record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGNO I Index of segment containing record. */ /* RECNO I Record in which entry is to be updated. */ /* COLUMN I Column name. */ /* NVALS I Number of values in in new column entry. */ /* IVALS I Integer values to add to column. */ /* ISNULL I Flag indicating whether column entry is null. */ /* $ Detailed_Input */ /* HANDLE is a file handle attached to an EK open for */ /* write access. */ /* SEGNO is the index of the segment containing the column */ /* entry to be updated. */ /* RECNO is the index of the record containing the column */ /* entry to be updated. This record number is */ /* relative to the start of the segment indicated by */ /* SEGNO; the first record in the segment has index 1. */ /* COLUMN is the name of the column containing the entry to */ /* be updated. */ /* NVALS, */ /* IVALS are, respectively, the number of values to add to */ /* the specified column and the set of values */ /* themselves. The data values are written in to the */ /* specifed column and record. */ /* If the column has fixed-size entries, then NVALS */ /* must equal the entry size for the specified column. */ /* For columns with variable-sized entries, the size */ /* of the new entry need not match the size of the */ /* entry it replaces. In particular, the new entry */ /* may be larger. */ /* ISNULL is a logical flag indicating whether the entry is */ /* null. If ISNULL is .FALSE., the column entry */ /* defined by NVALS and IVALS is added to the */ /* specified kernel file. */ /* If ISNULL is .TRUE., NVALS and IVALS are ignored. */ /* The contents of the column entry are undefined. */ /* If the column has fixed-length, variable-size */ /* entries, the number of entries is considered to */ /* be 1. */ /* The new entry may be null even though it replaces */ /* a non-null value, and vice versa. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If SEGNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 3) If COLUMN is not the name of a declared column, the error */ /* will be diagnosed by routines called by this routine. */ /* 4) If COLUMN specifies a column of whose data type is not */ /* integer, the error SPICE(WRONGDATATYPE) will be */ /* signalled. */ /* 5) If RECNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 6) If the specified column has fixed-size entries and NVALS */ /* does not match this size, the error will diagnosed by routines */ /* called by this routine. */ /* 7) If the specified column has variable-size entries and NVALS */ /* is non-positive, the error will diagnosed by routines */ /* called by this routine. */ /* 8) If an attempt is made to add a null value to a column that */ /* doesn't take null values, the error will diagnosed by routines */ /* called by this routine. */ /* 9) If COLUMN specifies a column of whose class is not */ /* an integer class known to this routine, the error */ /* SPICE(NOCLASS) will be signalled. */ /* 10) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine operates by side effects: it modifies the named */ /* EK file by adding data to the specified record in the specified */ /* column. Data may be added to a segment in random order; it is not */ /* necessary to fill in columns or rows sequentially. Data may only */ /* be added one logical element at a time. Partial assignments of */ /* logical elements are not supported. */ /* $ Examples */ /* 1) Replace the value in the third record of the column ICOL in */ /* the fifth segment of an EK file designated by HANDLE. Set */ /* the new value to 999. */ /* CALL EKUCEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .FALSE. ) */ /* 2) Same as (1), but this time add a null value. The argument */ /* 999 is ignored because the null flag is set to .TRUE. */ /* CALL EKUCEI ( HANDLE, 5, 3, 'ICOL', 1, 999, .TRUE. ) */ /* 3) Replace the entry in the third record of the column IARRAY in */ /* the fifth segment of an EK file designated by HANDLE. Set */ /* the new value using an array IBUFF of 10 values. */ /* CALL EKUCEI ( HANDLE, 5, 3, 'IARRAY', 10, IBUFF, .FALSE. ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 20-JUN-1999 (WLT) */ /* Removed unbalanced call to CHKOUT. */ /* - Beta Version 1.0.0, 26-SEP-1995 (NJB) */ /* -& */ /* $ Index_Entries */ /* replace integer entry in an EK column */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* First step: find the descriptor for the named segment. Using */ /* this descriptor, get the column descriptor. */ zzeksdsc_(handle, segno, segdsc); zzekcdsc_(handle, segdsc, column, coldsc, column_len); if (failed_()) { return 0; } /* This column had better be of integer type. */ dtype = coldsc[1]; if (dtype != 3) { chkin_("EKUCEI", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Column # is of type #; EKUCEI only works with integer colum" "ns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)93); errch_("#", column, (ftnlen)1, column_len); errint_("#", &dtype, (ftnlen)1); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); chkout_("EKUCEI", (ftnlen)6); return 0; } /* Look up the record pointer for the target record. */ zzektrdp_(handle, &segdsc[6], recno, &recptr); /* Determine whether the EK is shadowed. */ ekshdw_(handle, &isshad); /* If the EK is shadowed, we must back up the current column entry */ /* if the entry has not already been backed up. ZZEKRBCK will */ /* handle this task. */ if (isshad) { zzekrbck_("UPDATE", handle, segdsc, coldsc, recno, (ftnlen)6); } /* Now it's time to carry out the replacement. */ class__ = coldsc[0]; if (class__ == 1) { /* Class 1 columns contain scalar integer data. */ zzekue01_(handle, segdsc, coldsc, &recptr, ivals, isnull); } else if (class__ == 4) { /* Class 4 columns contain array-valued integer data. */ zzekue04_(handle, segdsc, coldsc, &recptr, nvals, ivals, isnull); } else { /* This is an unsupported integer column class. */ *segno = segdsc[1]; chkin_("EKUCEI", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Class # from input column descriptor is not a supported int" "eger class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( ftnlen)113); errint_("#", &class__, (ftnlen)1); errch_("#", column, (ftnlen)1, column_len); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(NOCLASS)", (ftnlen)14); chkout_("EKUCEI", (ftnlen)6); return 0; } return 0; } /* ekucei_ */
/* $Procedure EKRCEC ( EK, read column entry element, character ) */ /* Subroutine */ int ekrcec_(integer *handle, integer *segno, integer *recno, char *column, integer *nvals, char *cvals, logical *isnull, ftnlen column_len, ftnlen cvals_len) { integer unit; extern /* Subroutine */ int zzekcdsc_(integer *, integer *, char *, integer *, ftnlen), zzeksdsc_(integer *, integer *, integer *), zzektrdp_(integer *, integer *, integer *, integer *); extern integer zzekesiz_(integer *, integer *, integer *, integer *); extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer class__, cvlen; logical found; integer dtype; extern logical failed_(void); integer coldsc[11], segdsc[24]; extern /* Subroutine */ int dashlu_(integer *, integer *); integer recptr; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), zzekrd03_(integer *, integer *, integer *, integer *, integer *, char *, logical *, ftnlen), zzekrd06_(integer *, integer *, integer *, integer *, integer *, integer *, char *, logical *, logical *, ftnlen), zzekrd09_(integer *, integer *, integer *, integer *, integer *, char *, logical *, ftnlen); /* $ Abstract */ /* Read data from a character column in a specified EK record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGNO I Index of segment containing record. */ /* RECNO I Record from which data is to be read. */ /* COLUMN I Column name. */ /* NVALS O Number of values in column entry. */ /* CVALS O Character values in column entry. */ /* ISNULL O Flag indicating whether column entry is null. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. The file may be open for */ /* read or write access. */ /* SEGNO is the index of the segment from which data is to */ /* be read. */ /* RECNO is the index of the record from which data is to be */ /* read. This record number is relative to the start */ /* of the segment indicated by SEGNO; the first */ /* record in the segment has index 1. */ /* COLUMN is the name of the column from which data is to be */ /* read. */ /* $ Detailed_Output */ /* NVALS, */ /* CVALS are, respectively, the number of values found in */ /* the specified column entry and the set of values */ /* themselves. The array CVALS must have sufficient */ /* string length to accommodate the longest string */ /* in the returned column entry. */ /* For columns having fixed-size entries, when a */ /* a column entry is null, NVALS is still set to the */ /* column entry size. For columns having variable- */ /* size entries, NVALS is set to 1 for null entries. */ /* ISNULL is a logical flag indicating whether the returned */ /* column entry is null. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If SEGNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 3) If RECNO is out of range, the error will diagnosed by routines */ /* called by this routine. */ /* 4) If COLUMN is not the name of a declared column, the error */ /* will be diagnosed by routines called by this routine. */ /* 5) If COLUMN specifies a column of whose data type is not */ /* character, the error SPICE(WRONGDATATYPE) will be */ /* signalled. */ /* 6) If COLUMN specifies a column of whose class is not */ /* a character class known to this routine, the error */ /* SPICE(NOCLASS) will be signalled. */ /* 7) If an attempt is made to read an uninitialized column entry, */ /* the error will be diagnosed by routines called by this */ /* routine. A null entry is considered to be initialized, but */ /* entries do not contain null values by default. */ /* 8) If an I/O error occurs while reading or writing the indicated */ /* file, the error will be diagnosed by routines called by this */ /* routine. */ /* 9) If any element of the column entry would be truncated when */ /* assigned to an element of CVALS, the error will be diagnosed */ /* by routines called by this routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine is a utility that allows an EK file to be read */ /* directly without using the high-level query interface. */ /* $ Examples */ /* 1) Read the value in the third record of the column CCOL in */ /* the fifth segment of an EK file designated by HANDLE. */ /* CALL EKRCEC ( HANDLE, 5, 3, 'CCOL', N, CVAL, ISNULL ) */ /* $ Restrictions */ /* 1) EK files open for write access are not necessarily readable. */ /* In particular, a column entry can be read only if it has been */ /* initialized. The caller is responsible for determining */ /* when it is safe to read from files open for write access. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.2.0, 20-JUN-1999 (WLT) */ /* Removed unbalanced call to CHKOUT. */ /* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ /* Bug fix: Record number, not record pointer, is now supplied */ /* to look up data in the class 9 case. Miscellaneous header */ /* changes were made as well. Check for string truncation on */ /* output has been added. */ /* - SPICELIB Version 1.0.0, 26-SEP-1995 (NJB) */ /* -& */ /* $ Index_Entries */ /* read character data from EK column */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ /* Bug fix: Record number, not record pointer, is now supplied */ /* to look up data in the class 9 case. For class 9 columns, */ /* column entry locations are calculated directly from record */ /* numbers, no indirection is used. */ /* Miscellaneous header changes were made as well. */ /* The routines */ /* ZZEKRD03 */ /* ZZEKRD06 */ /* ZZEKRD09 */ /* now check for string truncation on output and signal errors */ /* if truncation occurs. */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* First step: find the descriptor for the named segment. Using */ /* this descriptor, get the column descriptor. */ zzeksdsc_(handle, segno, segdsc); zzekcdsc_(handle, segdsc, column, coldsc, column_len); if (failed_()) { return 0; } /* This column had better be of character type. */ dtype = coldsc[1]; if (dtype != 1) { chkin_("EKRCEC", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Column # is of type #; EKRCEC only works with character col" "umns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)95); errch_("#", column, (ftnlen)1, column_len); errint_("#", &dtype, (ftnlen)1); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); chkout_("EKRCEC", (ftnlen)6); return 0; } /* Now it's time to read data from the file. Call the low-level */ /* reader appropriate to the column's class. */ class__ = coldsc[0]; if (class__ == 3) { /* Look up the record pointer for the target record. */ zzektrdp_(handle, &segdsc[6], recno, &recptr); zzekrd03_(handle, segdsc, coldsc, &recptr, &cvlen, cvals, isnull, cvals_len); *nvals = 1; } else if (class__ == 6) { zzektrdp_(handle, &segdsc[6], recno, &recptr); *nvals = zzekesiz_(handle, segdsc, coldsc, &recptr); zzekrd06_(handle, segdsc, coldsc, &recptr, &c__1, nvals, cvals, isnull, &found, cvals_len); } else if (class__ == 9) { /* Records in class 9 columns are identified by a record number */ /* rather than a pointer. */ zzekrd09_(handle, segdsc, coldsc, recno, &cvlen, cvals, isnull, cvals_len); *nvals = 1; } else { /* This is an unsupported character column class. */ *segno = segdsc[1]; chkin_("EKRCEC", (ftnlen)6); dashlu_(handle, &unit); setmsg_("Class # from input column descriptor is not a supported cha" "racter class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", ( ftnlen)115); errint_("#", &class__, (ftnlen)1); errch_("#", column, (ftnlen)1, column_len); errint_("#", recno, (ftnlen)1); errint_("#", segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(NOCLASS)", (ftnlen)14); chkout_("EKRCEC", (ftnlen)6); return 0; } return 0; } /* ekrcec_ */
/* $Procedure ZZEKRSD ( EK, read scalar, double precision ) */ /* Subroutine */ int zzekrsd_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *eltidx, doublereal *dval, logical * isnull, logical *found) { extern integer zzekrp2n_(integer *, integer *, integer *); integer unit; extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, ftnlen), chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer class__, recno, segno, dtype; extern /* Subroutine */ int dashlu_(integer *, integer *); char column[32]; extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), zzekrd02_(integer *, integer *, integer *, integer *, doublereal *, logical *), zzekrd05_(integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, logical *, logical *), zzekrd08_(integer *, integer *, integer *, integer *, doublereal *, logical *); /* $ Abstract */ /* Read scalar data from a double precision column in a specified EK */ /* record. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Name Size */ /* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ /* Size of column name, in characters. */ /* End Include Section: EK Column Name Size */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Pointer to record from which data is to be read. */ /* ELTIDX I Index of column entry element to be read. */ /* DVAL O D.p. value in column entry. */ /* ISNULL O Flag indicating whether column entry is null. */ /* FOUND O Flag indicting whether entry element was found. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. */ /* SEGDSC is the descriptor of the segment from which data is */ /* to be read. */ /* COLDSC is the column descriptor corresponding to the */ /* column from which data is to be read. */ /* RECPTR is a pointer to the record from which data is to be */ /* read. */ /* ELTIDX is the index of the column entry element to read. */ /* If the column entry is scalar, this argument is */ /* ignored. */ /* $ Detailed_Output */ /* DVAL is the specified column entry. DVAL is valid only */ /* when FOUND is set to .TRUE. */ /* ISNULL is a logical flag indicating whether the entry is */ /* null. ISNULL is valid only when FOUND is set to */ /* .TRUE. */ /* FOUND is a logical flag indicating whether the specified */ /* column entry element was found. For vector-valued */ /* columns, if ELTIDX refers to a non-existent */ /* column entry element, FOUND is set to .FALSE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If COLDSC is not the name of a declared column, the error */ /* will be diagnosed by routines called by this routine. */ /* 3) If COLDSC specifies a column of whose data type is not */ /* double precision, the error SPICE(WRONGDATATYPE) will be */ /* signalled. */ /* 4) If COLDSC specifies a column of whose class is not */ /* an double precision class known to this routine, the error */ /* SPICE(NOCLASS) will be signalled. */ /* 5) If the indicated column is array-valued, and if ELTIDX is */ /* non-positive, the error will be diagnosed by routines called */ /* by this routine. However, if ELTIDX is greater than the */ /* number of elements in the specified column entry, FOUND is */ /* set to .FALSE. and no error is signalled. */ /* 6) If an I/O error occurs while reading the indicated file, */ /* the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* The ZZEKRSx routines are low-level readers that expect column */ /* entries to be defined by descriptors. Since these routines do not */ /* look up descriptors, in cases where many successive accesses to */ /* the same segment and column are required, these routines are */ /* considerably more efficient than the high-level readers. */ /* These routines do not participate in tracing. */ /* $ Examples */ /* See ZZEKECMP. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 06-NOV-1995 (NJB) */ /* -& */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Nothing found to begin with. */ *found = FALSE_; /* This column had better be of d.p. or TIME type. */ dtype = coldsc[1]; if (dtype != 2 && dtype != 4) { zzekcnam_(handle, coldsc, column, (ftnlen)32); dashlu_(handle, &unit); segno = segdsc[1]; recno = zzekrp2n_(handle, &segdsc[1], recptr); chkin_("ZZEKRSD", (ftnlen)7); dashlu_(handle, &unit); setmsg_("Column # is of type #; ZZEKRSD only works with DP or TIME c" "olumns. RECNO = #; SEGNO = #; EK = #.", (ftnlen)97); errch_("#", column, (ftnlen)1, (ftnlen)32); errint_("#", &dtype, (ftnlen)1); errint_("#", &recno, (ftnlen)1); errint_("#", &segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20); chkout_("ZZEKRSD", (ftnlen)7); return 0; } /* Now it's time to read data from the file. Call the low-level */ /* reader appropriate to the column's class. */ class__ = coldsc[0]; if (class__ == 2) { zzekrd02_(handle, segdsc, coldsc, recptr, dval, isnull); *found = TRUE_; } else if (class__ == 5) { /* Class 5 columns contain d.p. array entries. */ zzekrd05_(handle, segdsc, coldsc, recptr, eltidx, eltidx, dval, isnull, found); } else if (class__ == 8) { zzekrd08_(handle, segdsc, coldsc, recptr, dval, isnull); *found = TRUE_; } else { /* This is an unsupported d.p. column class. */ zzekcnam_(handle, coldsc, column, (ftnlen)32); dashlu_(handle, &unit); segno = segdsc[1]; recno = zzekrp2n_(handle, &segdsc[1], recptr); chkin_("ZZEKRSD", (ftnlen)7); dashlu_(handle, &unit); setmsg_("Class # from input column descriptor is not a supported d.p" ". class. COLUMN = #; RECNO = #; SEGNO = #; EK = #.", (ftnlen) 110); errint_("#", &class__, (ftnlen)1); errch_("#", column, (ftnlen)1, (ftnlen)32); errint_("#", &recno, (ftnlen)1); errint_("#", &segno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(NOCLASS)", (ftnlen)14); chkout_("ZZEKRSD", (ftnlen)7); return 0; } return 0; } /* zzekrsd_ */
/* $Procedure DAFT2B ( DAF, text to binary ) */ /* Subroutine */ int daft2b_(integer *text, char *binary, integer *resv, ftnlen binary_len) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_rsle(void), s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char * , integer, char *, integer); /* Local variables */ char name__[1000*2]; integer more, i__; extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *, integer *, doublereal *, integer *, doublereal *); char tarch[8]; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); integer chunk, isize, lsize; char ttype[8]; extern /* Subroutine */ int idw2at_(char *, char *, char *, ftnlen, ftnlen, ftnlen), dafada_(doublereal *, integer *); doublereal dc[125]; extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *, ftnlen); integer ic[250]; extern /* Subroutine */ int dafena_(void); integer nd; extern logical failed_(void); integer ni, handle; extern /* Subroutine */ int dafcls_(integer *); char ifname[60*2]; extern /* Subroutine */ int dafopn_(char *, integer *, integer *, char *, integer *, integer *, ftnlen, ftnlen); doublereal buffer[1024]; char idword[8]; extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_( char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); doublereal sum[125]; /* Fortran I/O blocks */ static cilist io___5 = { 1, 0, 1, 0, 0 }; static cilist io___6 = { 1, 0, 1, 0, 0 }; static cilist io___13 = { 1, 0, 1, 0, 0 }; static cilist io___15 = { 1, 0, 1, 0, 0 }; static cilist io___17 = { 1, 0, 1, 0, 0 }; static cilist io___20 = { 1, 0, 1, 0, 0 }; static cilist io___23 = { 1, 0, 1, 0, 0 }; static cilist io___25 = { 1, 0, 1, 0, 0 }; static cilist io___27 = { 1, 0, 1, 0, 0 }; static cilist io___28 = { 1, 0, 1, 0, 0 }; static cilist io___29 = { 1, 0, 1, 0, 0 }; static cilist io___30 = { 1, 0, 1, 0, 0 }; /* $ Abstract */ /* Deprecated. The routine DAFTB supersedes this routine. */ /* NAIF supports this routine only to provide backward */ /* compatibility. */ /* Reconstruct a binary DAF from a text file opened by */ /* the calling program. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* DAF */ /* $ Keywords */ /* FILES */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* TEXT I Logical unit connected to text file. */ /* BINARY I Name of a binary DAF to be created. */ /* RESV I Number of records to reserve. */ /* BSIZE P Buffer size. */ /* $ Detailed_Input */ /* TEXT is a logical unit number, to which a text file has */ /* been connected by the calling program, and into */ /* which the contents of binary DAF have been */ /* written. The file pointer should be placed just */ /* before the file ID word. */ /* BINARY is the name of a binary DAF to be created. */ /* The binary DAF contains the same data as the */ /* text file, but in a form more suitable for use */ /* by application programs. */ /* RESV is the number of records to be reserved in the */ /* binary DAF. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* BSIZE is the size of the buffer used to read array elements */ /* from the text file. No single group of elements should */ /* contains more than BSIZE elements. */ /* $ Exceptions */ /* 1) If for some reason the text file cannot be read, */ /* the error SPICE(DAFREADFAIL) is signalled. */ /* 2) If the architecture of the file is not DAF, as specified by */ /* the ID word, the error SPICE(NOTADAFFILE) will be signalled. */ /* 3) If the text file does not contain matching internal file */ /* names, the error SPICE(DAFNOIFNMATCH) is signalled. */ /* 4) If the text file does not contain matching array names, */ /* the error SPICE(DAFNONAMEMATCH) is signalled. */ /* 5) If the buffer size is not sufficient, the error */ /* SPICE(DAFOVERFLOW) is signalled. */ /* $ Files */ /* See arguments TEXT, BINARY. */ /* $ Particulars */ /* This routine has been made obsolete by the new DAF text to binary */ /* conversion routine DAFTB. This routine remains available for */ /* reasons of backward compatibility. We strongly recommend that you */ /* use the new conversion routines for any new software development. */ /* Please see the header of the routine DAFTB for details. */ /* This routine is necessary for converting older DAF text files into */ /* their equivalent binary formats, as DAFTB uses a different text */ /* file format that is incompatible with the text file format */ /* expected by this routine. */ /* Any binary DAF may be transferred between heterogeneous */ /* Fortran environments by converting it to an equivalent file */ /* containing only ASCII characters. Such a file can be transferred */ /* almost universally, using any number of established protocols */ /* (Kermit, FTP, and so on). Once transferred, the ASCII file can */ /* be reconverted to a binary DAF, using the representations */ /* native to the new host environment. */ /* There are two pairs of routines that can be used to convert */ /* DAFs between binary and ASCII. The first pair, DAFB2A */ /* and DAFA2B, works with complete files. That is, DAFB2A creates */ /* a complete ASCII file containing all of the information in */ /* a particular binary DAF, and nothing else; this file can */ /* be fed directly into DAFA2B to produce a complete binary DAF. */ /* In each case, the names of the files are specified. */ /* A related pair of routines, DAFB2T and DAFT2B, assume that */ /* the ASCII data are to be stored in the midst of a text file. */ /* This allows the calling program to surround the data with */ /* standardized labels, to append several binary DAFs into a */ /* single text file, and so on. */ /* Note that you must select the number of records to be reserved */ /* in the binary DAF. The contents of reserved records are ignored */ /* by the normal transfer process. */ /* $ Examples */ /* DAFB2A and DAFA2B are typically used for simple transfers. */ /* If A.DAF is a binary DAF in environment 1, it can be transferred */ /* to environment 2 in three steps. */ /* 1) Convert it to ASCII: */ /* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */ /* 2) Transfer the ASCII file, using FTP, Kermit, or some other */ /* file transfer utility: */ /* ftp> put a.ascii */ /* 3) Convert it to binary on the new machine, */ /* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */ /* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */ /* environment. */ /* If the file needs to contain other information---a standard */ /* label, for instance---the first and third steps must be modified */ /* to use DAFB2T and DAFT2B. The first step becomes */ /* (Open a text file) */ /* (Write the label) */ /* CALL DAFB2T ( BINARY, UNIT ) */ /* (Close the text file) */ /* The third step becomes */ /* (Open the text file) */ /* (Read the label) */ /* CALL DAFT2B ( UNIT, BINARY, RESV ) */ /* (Close the text file) */ /* $ Restrictions */ /* DAFT2B cannot be executed while any other DAF is open */ /* for writing. */ /* $ Literature_References */ /* NAIF Document 167.0, "Double Precision Array Files (DAF) */ /* Specification and User's Guide" */ /* $ Author_and_Institution */ /* K. R. Gehringer (JPL) */ /* J.E. McLean (JPL) */ /* I.M. Underwood (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.1, 26-JUL-2012 (EDW) */ /* Edited Abstract section to use "Deprecated" keyword */ /* and state replacement routine. */ /* Eliminated unneeded Revisions section. */ /* - SPICELIB Version 3.0.0, 04-OCT-1993 (KRG) */ /* Removed the error SPICE(DAFNOIDWORD) as it was no longer */ /* relevant. */ /* Added the error SPICE(NOTADAFFILE) if this routine is called */ /* with a file that does not contain an ID word identifying the */ /* file as a DAF file. */ /* There were no checks of the IOSTAT variable after attempting to */ /* read from the text file, a single test of the IOSTAT variable */ /* was made at the end of the routine. This was not adequate to */ /* detect errors when writing to the text file. So after all of */ /* these read statements, an IF ... END IF block was added to */ /* signal an error if IOSTAT .NE. 0. */ /* IF ( IOSTAT .NE. 0 ) THEN */ /* CALL SETMSG ( 'The attempt to read from file ''#''' // */ /* . ' failed. IOSTAT = #.' ) */ /* CALL ERRFNM ( '#', UNIT ) */ /* CALL SIGERR ( 'SPICE(DAFREADFAIL)' ) */ /* CALL CHKOUT ( 'DAFT2B' ) */ /* RETURN */ /* END IF */ /* Removed the code from the end of the routine that purported to */ /* check for read errors: */ /* C */ /* C If any read screws up, they should all screw up. Why */ /* C make a billion separate checks? */ /* C */ /* IF ( IOSTAT .NE. 0 ) THEN */ /* CALL SETMSG ( 'Value of IOSTAT was: #. ' ) */ /* CALL ERRINT ( '#', IOSTAT ) */ /* CALL SIGERR ( 'SPICE(DAFREADFAIL)' ) */ /* END IF */ /* The answer to the question is: */ /* You have to do a billion separate checks because the IOSTAT */ /* value is only valid for the most recently executed read. */ /* Added a statment to the $ Particulars section to the effect */ /* that this routine has been made obsolete by the introduction of */ /* the routine DAFTB, and that we strongly recommend the use of */ /* the new routine. This routine must, however, be used when */ /* converting older text files to binary, as the old and new */ /* formats are not compatible. */ /* Modified the $ Abstract section to reflect the fact that this */ /* routine is obsolete and maintained for purposes of backward */ /* compatibility only. */ /* - SPICELIB Version 2.0.2, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 2.0.1, 6-AUG-1990 (HAN) */ /* Header documentation was corrected. This routine will */ /* convert a file containing either ID word, 'NAIF/DAF' or */ /* 'NAIF/NIP'. (Previous versions of SPICELIB software used */ /* the ID word 'NAIF/NIP'.) */ /* - SPICELIB Version 2.0.0, 2-AUG-1990 (JEM) */ /* The previous version of this routine always failed and */ /* signalled the error SPICE(DAFNOIDWORD) because of a faulty */ /* logical expression in an error-checking IF statement. */ /* The error SPICE(DAFNOIDWORD) should be signalled if the */ /* next non-blank line in the text file does not begin with the */ /* word 'NAIF/DAF' AND does not begin with the word 'NAIF/NIP'. */ /* Previously the logic was incorrect causing the error to be */ /* signalled every time no matter what the word was. The */ /* correction consisted of replacing '.OR.' with '.AND.' */ /* in the logical expression. */ /* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */ /* Literature references added to the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */ /* -& */ /* $ Index_Entries */ /* text daf to binary */ /* -& */ /* SPICELIB functions */ /* Local Parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("DAFT2B", (ftnlen)6); } s_copy(idword, " ", (ftnlen)8, (ftnlen)1); s_copy(tarch, " ", (ftnlen)8, (ftnlen)1); s_copy(ttype, " ", (ftnlen)8, (ftnlen)1); /* We should be positioned and ready to read the file ID word from */ /* the text file, so let's try it. */ io___5.ciunit = *text; iostat = s_rsle(&io___5); if (iostat != 0) { goto L100001; } iostat = do_lio(&c__9, &c__1, idword, (ftnlen)8); if (iostat != 0) { goto L100001; } iostat = e_rsle(); L100001: if (iostat != 0) { setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } /* Split the ID word into an architecture and type, and verify that */ /* the architecture is 'DAF'. If it is not, this is the wrong */ /* routine, and an error will be signalled. */ idw2at_(idword, tarch, ttype, (ftnlen)8, (ftnlen)8, (ftnlen)8); if (s_cmp(tarch, "DAF", (ftnlen)8, (ftnlen)3) != 0) { setmsg_("File architecture is not 'DAF' for file '#'", (ftnlen)43); errfnm_("#", text, (ftnlen)1); sigerr_("SPICE(NOTADAFFILE)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } io___6.ciunit = *text; iostat = s_rsle(&io___6); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__3, &c__1, (char *)&nd, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__3, &c__1, (char *)&ni, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__9, &c__1, ifname, (ftnlen)60); if (iostat != 0) { goto L100002; } iostat = e_rsle(); L100002: if (iostat != 0) { setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } /* Open the new binary file. */ dafopn_(binary, &nd, &ni, ifname, resv, &handle, binary_len, (ftnlen)60); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } /* Each array is preceded by a '1', which indicates that more */ /* arrays are to come. The array itself begins with the name */ /* and the summary components, and ends with the name again. */ /* The contents are written in arbitrary chunks. The final */ /* chunk is followed by a '0', which indicates that no chunks */ /* remain. The names must match, or the array should not */ /* be terminated normally. */ /* If the chunks in the file are bigger than the local buffer */ /* size, we are in trouble. */ lsize = nd + (ni - 1) / 2 + 1; isize = lsize << 3; io___13.ciunit = *text; iostat = s_rsle(&io___13); if (iostat != 0) { goto L100003; } iostat = do_lio(&c__3, &c__1, (char *)&more, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100003; } iostat = e_rsle(); L100003: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } while(more > 0) { io___15.ciunit = *text; iostat = s_rsle(&io___15); if (iostat != 0) { goto L100004; } iostat = do_lio(&c__9, &c__1, name__, isize); if (iostat != 0) { goto L100004; } iostat = e_rsle(); L100004: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } io___17.ciunit = *text; iostat = s_rsle(&io___17); if (iostat != 0) { goto L100005; } i__1 = nd; for (i__ = 1; i__ <= i__1; ++i__) { iostat = do_lio(&c__5, &c__1, (char *)&dc[(i__2 = i__ - 1) < 125 && 0 <= i__2 ? i__2 : s_rnge("dc", i__2, "daft2b_", ( ftnlen)465)], (ftnlen)sizeof(doublereal)); if (iostat != 0) { goto L100005; } } iostat = e_rsle(); L100005: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } io___20.ciunit = *text; iostat = s_rsle(&io___20); if (iostat != 0) { goto L100006; } i__2 = ni - 2; for (i__ = 1; i__ <= i__2; ++i__) { iostat = do_lio(&c__3, &c__1, (char *)&ic[(i__1 = i__ - 1) < 250 && 0 <= i__1 ? i__1 : s_rnge("ic", i__1, "daft2b_", ( ftnlen)480)], (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100006; } } iostat = e_rsle(); L100006: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } dafps_(&nd, &ni, dc, ic, sum); dafbna_(&handle, sum, name__, isize); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } io___23.ciunit = *text; iostat = s_rsle(&io___23); if (iostat != 0) { goto L100007; } iostat = do_lio(&c__3, &c__1, (char *)&chunk, (ftnlen)sizeof(integer)) ; if (iostat != 0) { goto L100007; } iostat = e_rsle(); L100007: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } while(chunk > 0) { if (chunk > 1024) { dafcls_(&handle); setmsg_("Buffer size exceeded. Increase to #.", (ftnlen)36); errint_("#", &chunk, (ftnlen)1); sigerr_("SPICE(DAFOVERFLOW)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } else { io___25.ciunit = *text; iostat = s_rsle(&io___25); if (iostat != 0) { goto L100008; } i__1 = chunk; for (i__ = 1; i__ <= i__1; ++i__) { iostat = do_lio(&c__5, &c__1, (char *)&buffer[(i__2 = i__ - 1) < 1024 && 0 <= i__2 ? i__2 : s_rnge("buffer", i__2, "daft2b_", (ftnlen)533)], (ftnlen)sizeof( doublereal)); if (iostat != 0) { goto L100008; } } iostat = e_rsle(); L100008: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTA" "T = #.", (ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } dafada_(buffer, &chunk); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } } io___27.ciunit = *text; iostat = s_rsle(&io___27); if (iostat != 0) { goto L100009; } iostat = do_lio(&c__3, &c__1, (char *)&chunk, (ftnlen)sizeof( integer)); if (iostat != 0) { goto L100009; } iostat = e_rsle(); L100009: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = " "#.", (ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } } io___28.ciunit = *text; iostat = s_rsle(&io___28); if (iostat != 0) { goto L100010; } iostat = do_lio(&c__9, &c__1, name__ + 1000, isize); if (iostat != 0) { goto L100010; } iostat = e_rsle(); L100010: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } if (s_cmp(name__, name__ + 1000, isize, isize) != 0) { dafcls_(&handle); setmsg_("Array name mismatch: # and #.", (ftnlen)29); errch_("#", name__, (ftnlen)1, isize); errch_("#", name__ + 1000, (ftnlen)1, isize); sigerr_("SPICE(DAFNONAMEMATCH)", (ftnlen)21); chkout_("DAFT2B", (ftnlen)6); return 0; } else { dafena_(); if (failed_()) { chkout_("DAFT2B", (ftnlen)6); return 0; } } io___29.ciunit = *text; iostat = s_rsle(&io___29); if (iostat != 0) { goto L100011; } iostat = do_lio(&c__3, &c__1, (char *)&more, (ftnlen)sizeof(integer)); if (iostat != 0) { goto L100011; } iostat = e_rsle(); L100011: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } } /* The final '0' indicates that no arrays remain. The first shall */ /* be last: the internal file name brings up the rear. If it doesn't */ /* match the one at the front, complain. */ io___30.ciunit = *text; iostat = s_rsle(&io___30); if (iostat != 0) { goto L100012; } iostat = do_lio(&c__9, &c__1, ifname + 60, (ftnlen)60); if (iostat != 0) { goto L100012; } iostat = e_rsle(); L100012: if (iostat != 0) { dafcls_(&handle); setmsg_("The attempt to read from file '#' failed. IOSTAT = #.", ( ftnlen)53); errfnm_("#", text, (ftnlen)1); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(DAFREADFAIL)", (ftnlen)18); chkout_("DAFT2B", (ftnlen)6); return 0; } if (s_cmp(ifname, ifname + 60, (ftnlen)60, (ftnlen)60) != 0) { dafcls_(&handle); setmsg_("Internal file name mismatch: # and #", (ftnlen)36); errch_("#", ifname, (ftnlen)1, (ftnlen)60); errch_("#", ifname + 60, (ftnlen)1, (ftnlen)60); sigerr_("SPICE(DAFNOIFNMATCH)", (ftnlen)20); chkout_("DAFT2B", (ftnlen)6); return 0; } /* Close the DAF file we just created. */ dafcls_(&handle); chkout_("DAFT2B", (ftnlen)6); return 0; } /* daft2b_ */
/* $Procedure ZZEKRD03 ( EK, read class 3 column entry elements ) */ /* Subroutine */ int zzekrd03_(integer *handle, integer *segdsc, integer * coldsc, integer *recptr, integer *cvlen, char *cval, logical *isnull, ftnlen cval_len) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ integer i_len(char *, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ integer nrec, bpos; extern integer zzekrp2n_(integer *, integer *, integer *); integer epos, unit; extern /* Subroutine */ int zzekcnam_(integer *, integer *, char *, ftnlen), zzekpgbs_(integer *, integer *, integer *), zzekpgpg_( integer *, integer *, integer *, integer *); integer b, e, l, n, p, pbase, avail; extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); integer recno, ncols; extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, integer *, integer *, char *, ftnlen), dasrdi_(integer *, integer *, integer *, integer *); char column[32]; integer colidx, datptr, relptr, ptrloc; extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), zzekgei_(integer *, integer *, integer *); /* $ Abstract */ /* Read a column entry from a specified record in a class 3 column. */ /* Class 3 columns contain scalar character values. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Name Size */ /* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ /* Size of column name, in characters. */ /* End Include Section: EK Column Name Size */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Page Parameters */ /* ekfilpar.inc Version 1 03-APR-1995 (NJB) */ /* These parameters apply to EK files using architecture 4. */ /* These files use a paged DAS file as their underlying file */ /* structure. */ /* In paged DAS EK files, data pages are structured: they contain */ /* metadata as well as data. The metadata is located in the last */ /* few addresses of each page, so as to interfere as little as */ /* possible with calculation of data addresses. */ /* Each data page belongs to exactly one segment. Some bookkeeping */ /* information, such as record pointers, is also stored in data */ /* pages. */ /* Each page contains a forward pointer that allows rapid lookup */ /* of data items that span multiple pages. Each page also keeps */ /* track of the current number of links from its parent segment */ /* to the page. Link counts enable pages to `know' when they */ /* are no longer in use by a segment; unused pages are deallocated */ /* and returned to the free list. */ /* The parameters in this include file depend on the parameters */ /* declared in the include file ekpage.inc. If those parameters */ /* change, this file must be updated. The specified parameter */ /* declarations we need from that file are: */ /* INTEGER PGSIZC */ /* PARAMETER ( PGSIZC = 1024 ) */ /* INTEGER PGSIZD */ /* PARAMETER ( PGSIZD = 128 ) */ /* INTEGER PGSIZI */ /* PARAMETER ( PGSIZI = 256 ) */ /* Character pages use an encoding mechanism to represent integer */ /* metadata. Each integer is encoded in five consecutive */ /* characters. */ /* Character data page parameters: */ /* Size of encoded integer: */ /* Usable page size: */ /* Location of character forward pointer: */ /* Location of character link count: */ /* Double precision data page parameters: */ /* Usable page size: */ /* Location of d.p. forward pointer: */ /* Location of d.p. link count: */ /* Integer data page parameters: */ /* Usable page size: */ /* Location of integer forward pointer: */ /* Location of integer link count: */ /* End Include Section: EK Data Page Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Record Pointer Parameters */ /* ekrecptr.inc Version 2 18-JUL-1995 (NJB) */ /* This file declares parameters used in EK record pointers. */ /* Each segment references data in a given record via two levels */ /* of indirection: a record number points to a record pointer, */ /* which is a structured array of metadata and data pointers. */ /* Record pointers always occupy contiguous ranges of integer */ /* addresses. */ /* The parameter declarations in this file depend on the assumption */ /* that integer pages contain 256 DAS integer words and that the */ /* maximum number of columns in a segment is 100. Record pointers */ /* are stored in integer data pages, so they must fit within the */ /* usable data area afforded by these pages. The size of the usable */ /* data area is given by the parameter IPSIZE which is declared in */ /* ekdatpag.inc. The assumed value of IPSIZE is 254. */ /* The first element of each record pointer is a status indicator. */ /* The meanings of status indicators depend on whether the parent EK */ /* is shadowed or not. For shadowed EKs, allowed status values and */ /* their meanings are: */ /* OLD The record has not been modified since */ /* the EK containing the record was opened. */ /* UPDATE The record is an update of a previously existing */ /* record. The original record is now on the */ /* modified record list. */ /* NEW The record has been added since the EK containing the */ /* record was opened. The record is not an update */ /* of a previously existing record. */ /* DELOLD This status applies only to a backup record. */ /* DELOLD status indicates that the record corresponds */ /* to a deleted OLD record in the source segment. */ /* DELNEW This status applies only to a backup record. */ /* DELNEW status indicates that the record corresponds */ /* to a deleted NEW record in the source segment. */ /* DELUPD This status applies only to a backup record. */ /* DELUPD status indicates that the record corresponds */ /* to a deleted UPDATEd record in the source segment. */ /* In EKs that are not shadowed, all records have status OLD. */ /* The following parameters refer to indices within the record */ /* pointer structure: */ /* Index of status indicator: */ /* Each record pointer contains a pointer to its companion: for a */ /* record belonging to a shadowed EK, this is the backup counterpart, */ /* or if the parent EK is itself a backup EK, a pointer to the */ /* record's source record. The pointer is UNINIT (see below) if the */ /* record is unmodified. */ /* Record companion pointers contain record numbers, not record */ /* base addresses. */ /* Index of record's companion pointer: */ /* Each data item is referenced by an integer. The meaning of */ /* this integer depends on the representation of data in the */ /* column to which the data item belongs. Actual lookup of a */ /* data item must be done by subroutines appropriate to the class of */ /* the column to which the item belongs. Note that data items don't */ /* necessarily occupy contiguous ranges of DAS addresses. */ /* Base address of data pointers: */ /* Maximum record pointer size: */ /* Data pointers are given the value UNINIT to start with; this */ /* indicates that the data item is uninitialized. UNINIT is */ /* distinct from the value NULL. NOBACK indicates an uninitialized */ /* backup column entry. */ /* End Include Section: EK Record Pointer Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* SEGDSC I Segment descriptor. */ /* COLDSC I Column descriptor. */ /* RECPTR I Record pointer. */ /* CVLEN O Length of returned character value. */ /* CVAL O Character value in column entry. */ /* ISNULL O Flag indicating whether column entry is null. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. */ /* SEGDSC is the descriptor of the segment from which data is */ /* to be read. */ /* COLDSC is the descriptor of the column from which data is */ /* to be read. */ /* RECPTR is a pointer to the record containing the column */ /* entry to be written. */ /* $ Detailed_Output */ /* CVLEN is the length of the returned string value. This */ /* is the index of the last non-blank character of */ /* the string. This definition applies to both fixed- */ /* and variable-length strings. */ /* CVLEN is set to 1 if the column entry is null. */ /* CVAL is the value read from the specified column entry. */ /* If CVAL has insufficient length to hold the */ /* returned string value, the output value is */ /* truncated on the right. Entries that are shorter */ /* than the string length of CVAL are padded with */ /* trailing blanks. */ /* ISNULL is a logical flag indicating whether the entry is */ /* null. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the specified column entry has not been initialized, the */ /* error SPICE(UNINITIALIZED) is signaled. */ /* 3) If the ordinal position of the column specified by COLDSC */ /* is out of range, the error SPICE(INVALIDINDEX) is signaled. */ /* 4) If the output string CVAL is too short to accommodate the */ /* returned string value, the output value is truncated on the */ /* right. No error is signaled. */ /* 5) If an I/O error occurs while reading the indicated file, */ /* the error will be diagnosed by routines called by this */ /* routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine is a utility for reading data from class 3 columns. */ /* $ Examples */ /* See EKRCEC. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.3.0, 31-MAY-2010 (NJB) */ /* Bug fix: call to DASRDI was overwriting local memory. This */ /* problem did not affect operation of the routine except on */ /* the Mac/Intel/OSX/ifort/32-bit platform, on which it caused */ /* a segmentation fault when this routine was compiled with */ /* default optimization. */ /* - SPICELIB Version 1.2.0, 23-JUL-1999 (NJB) */ /* Error check for string truncation on output was removed. */ /* This error check interfered with the use of this routine */ /* (via a call to ZZEKRSC) within ZZEKJSRT, which relies on */ /* being able to read into a buffer initial substrings of scalar */ /* data. */ /* - SPICELIB Version 1.1.0, 28-JUL-1997 (NJB) */ /* Error check for string truncation on output was added. */ /* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ /* to SPICE(UNINITIALIZED). Error messages were enhanced so */ /* as to use column names rather than indices. Miscellaneous */ /* header fixes were made. */ /* - SPICELIB Version 1.0.0, 18-OCT-1995 (NJB) */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.2.0, 23-JUL-1999 (NJB) */ /* Error check for string truncation on output was removed. */ /* This error check interfered with the use of this routine */ /* (via a call to ZZEKRSC) within ZZEKJSRT, which relies on */ /* being able to read into a buffer initial substrings of scalar */ /* data. */ /* - SPICELIB Version 1.1.0, 25-JUL-1997 (NJB) */ /* Error check for string truncation on output was added. */ /* SHORT error message SPICE(UNINITIALIZEDVALUE) was shortened */ /* to SPICE(UNINITIALIZED), since the previous string exceeded */ /* the maximum allowed length for the short error message. */ /* Error messages were enhanced so as to use column names rather */ /* than indices. */ /* -& */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Make sure the column exists. */ ncols = segdsc[4]; colidx = coldsc[8]; if (colidx < 1 || colidx > ncols) { recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); chkin_("ZZEKRD03", (ftnlen)8); setmsg_("Column index = #; valid range is 1:#.SEGNO = #; RECNO = #; " "EK = #", (ftnlen)65); errint_("#", &colidx, (ftnlen)1); errint_("#", &nrec, (ftnlen)1); errint_("#", &segdsc[1], (ftnlen)1); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKRD03", (ftnlen)8); return 0; } /* Compute the data pointer location, and read both the pointer */ /* and the stored string size. */ ptrloc = *recptr + 2 + colidx; dasrdi_(handle, &ptrloc, &ptrloc, &datptr); if (datptr > 0) { /* Read the value. This is slightly more complicated than */ /* the numeric cases, because the value may be spread across */ /* multiple pages. Also, we must not write past the end of the */ /* output string. */ /* We'll need the number of the page at which the first character */ /* of the string is stored. This page contains at least one */ /* character of the data value. */ zzekgei_(handle, &datptr, cvlen); /* Set the data pointer to the start of the string data, skipping */ /* over the encoded string length. */ datptr += 5; /* Computing MIN */ i__1 = *cvlen, i__2 = i_len(cval, cval_len); n = min(i__1,i__2); /* Read the available data from the page under consideration. */ zzekpgpg_(&c__1, &datptr, &p, &pbase); relptr = datptr - pbase; /* Computing MIN */ i__1 = n, i__2 = 1014 - relptr + 1; avail = min(i__1,i__2); b = datptr; e = datptr + avail - 1; bpos = 1; epos = avail; l = epos - bpos + 1; dasrdc_(handle, &b, &e, &bpos, &epos, cval, cval_len); n -= l; while(n > 0) { /* Read the forward page pointer from the current page; find */ /* the base address of the referenced page. */ i__1 = pbase + 1015; zzekgei_(handle, &i__1, &p); zzekpgbs_(&c__1, &p, &pbase); avail = min(n,1014); b = pbase + 1; e = pbase + avail; bpos = epos + 1; epos += avail; dasrdc_(handle, &b, &e, &bpos, &epos, cval, cval_len); n -= avail; bpos = epos + 1; } /* Blank-pad CVAL if required. */ if (i_len(cval, cval_len) > epos) { i__1 = epos; s_copy(cval + i__1, " ", cval_len - i__1, (ftnlen)1); } *isnull = FALSE_; } else if (datptr == -2) { /* The value is null. */ *isnull = TRUE_; *cvlen = 1; } else if (datptr == -1 || datptr == -3) { /* The data value is absent. This is an error. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); zzekcnam_(handle, coldsc, column, (ftnlen)32); chkin_("ZZEKRD03", (ftnlen)8); setmsg_("Attempted to read uninitialized column entry. SEGNO = #; C" "OLUMN = #; RECNO = #; EK = #", (ftnlen)87); errint_("#", &segdsc[1], (ftnlen)1); errch_("#", column, (ftnlen)1, (ftnlen)32); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(UNINITIALIZED)", (ftnlen)20); chkout_("ZZEKRD03", (ftnlen)8); return 0; } else { /* The data pointer is corrupted. */ recno = zzekrp2n_(handle, &segdsc[1], recptr); dashlu_(handle, &unit); zzekcnam_(handle, coldsc, column, (ftnlen)32); chkin_("ZZEKRD03", (ftnlen)8); setmsg_("Data pointer is corrupted. SEGNO = #; COLUMN = #; RECNO = " "#; EK = #", (ftnlen)68); errint_("#", &segdsc[1], (ftnlen)1); errch_("#", column, (ftnlen)1, (ftnlen)32); errint_("#", &recno, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKRD03", (ftnlen)8); return 0; } return 0; } /* zzekrd03_ */
/* $Procedure 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 ZZEKCDSC ( Private: EK, return column descriptor ) */ /* Subroutine */ int zzekcdsc_(integer *handle, integer *segdsc, char *column, integer *coldsc, ftnlen column_len) { /* System generated locals */ integer i__1, i__2; /* Local variables */ integer unit, i__; char cname[32]; integer mbase; extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); logical found; integer ncols; extern logical eqstr_(char *, char *, ftnlen, ftnlen); integer dscbas; extern /* Subroutine */ int dasrdc_(integer *, integer *, integer *, integer *, integer *, char *, ftnlen); integer nambas; extern /* Subroutine */ int dasrdi_(integer *, integer *, integer *, integer *), dashlu_(integer *, integer *), setmsg_(char *, ftnlen) , errint_(char *, integer *, ftnlen), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); /* $ Abstract */ /* SPICE Private routine intended solely for the support of SPICE */ /* routines. Users should not call this routine directly due */ /* to the volatile nature of this routine. */ /* Look up the column descriptor for a column of a given name */ /* in a specified segment. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Name Size */ /* ekcnamsz.inc Version 1 17-JAN-1995 (NJB) */ /* Size of column name, in characters. */ /* End Include Section: EK Column Name Size */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to an EK file. */ /* SEGDSC I Segment descriptor. */ /* COLUMN I Name of column. */ /* COLDSC O Descriptor for specified column. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle for the file containing the */ /* column of interest. The EK may be open for read */ /* or write access. */ /* SEGDSC is the descriptor of the segment containing the */ /* column for which a descriptor is desired. */ /* COLUMN is the name of the column whose descriptor is */ /* desired. Case and white space are not significant. */ /* $ Detailed_Output */ /* COLDSC is the descriptor of the column belonging to the */ /* specified file and segment and having name COLUMN. */ /* See the include file ekcoldsc.inc for details */ /* regarding the structure of EK column descriptors. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the input column name does not match any column in the */ /* designated segment, the error SPICE(BUG) is signalled. It */ /* is the caller's responsibility to call this routine with */ /* valid input arguments. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine exists for the sole purpose of centralizing code */ /* used to perform column descriptor look-ups. */ /* $ Examples */ /* See the EKACEx routines. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 27-SEP-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Use discovery check-in. */ /* Get the segment's integer metadata's base address. */ mbase = segdsc[2]; /* Get the number of columns. */ ncols = segdsc[4]; /* Search linearly through the column descriptors, looking for */ /* a column name match. It's an error if we don't find the input */ /* name. */ found = FALSE_; i__ = 1; while(i__ <= ncols && ! found) { dscbas = mbase + 24 + (i__ - 1) * 11; /* Get the character base address of the column name from the */ /* current descriptor. */ i__1 = dscbas + 1; i__2 = dscbas + 11; dasrdi_(handle, &i__1, &i__2, coldsc); nambas = coldsc[4]; /* Look up the name and compare. */ i__1 = nambas + 1; i__2 = nambas + 32; dasrdc_(handle, &i__1, &i__2, &c__1, &c__32, cname, (ftnlen)32); if (eqstr_(cname, column, (ftnlen)32, column_len)) { found = TRUE_; } else { ++i__; } } if (! found) { dashlu_(handle, &unit); chkin_("ZZEKCDSC", (ftnlen)8); setmsg_("Descriptor for column # was not found. Segment base = #; fi" "le = #.", (ftnlen)66); errch_("#", column, (ftnlen)1, column_len); errint_("#", &mbase, (ftnlen)1); errfnm_("#", &unit, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZEKCDSC", (ftnlen)8); return 0; } return 0; } /* zzekcdsc_ */
/* $Procedure ZZEKVMCH ( EK, vector match ) */ logical zzekvmch_(integer *ncnstr, logical *active, integer *lhans, integer * lsdscs, integer *lcdscs, integer *lrows, integer *lelts, integer *ops, integer *rhans, integer *rsdscs, integer *rcdscs, integer *rrows, integer *relts) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; logical ret_val; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Local variables */ char cval[1024*2]; integer hans[2], elts[2]; logical null[2]; integer unit, rows[2]; extern integer zzekecmp_(integer *, integer *, integer *, integer *, integer *); integer i__, n; extern /* Subroutine */ int chkin_(char *, ftnlen); integer cvlen[2]; logical found; extern /* Subroutine */ int movei_(integer *, integer *, integer *); extern logical matchi_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); integer cldscs[22] /* was [11][2] */, cmplen[2], sgdscs[48] /* was [24][2] */; extern /* Subroutine */ int dashlu_(integer *, integer *), setmsg_(char *, ftnlen), errfnm_(char *, integer *, ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); integer rel; extern /* Subroutine */ int zzekrsc_(integer *, integer *, integer *, integer *, integer *, integer *, char *, logical *, logical *, ftnlen); /* $ Abstract */ /* Determine whether a vector of constraints involving comparisons of */ /* specified EK column elements is satisfied. */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* $ Required_Reading */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Boolean Enumerated Type */ /* ekbool.inc Version 1 21-DEC-1994 (NJB) */ /* Within the EK system, boolean values sometimes must be */ /* represented by integer or character codes. The codes and their */ /* meanings are listed below. */ /* Integer code indicating `true': */ /* Integer code indicating `false': */ /* Character code indicating `true': */ /* Character code indicating `false': */ /* End Include Section: EK Boolean Enumerated Type */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Operator Codes */ /* ekopcd.inc Version 1 30-DEC-1994 (NJB) */ /* Within the EK system, operators used in EK queries are */ /* represented by integer codes. The codes and their meanings are */ /* listed below. */ /* Relational expressions in EK queries have the form */ /* <column name> <operator> <value> */ /* For columns containing numeric values, the operators */ /* EQ, GE, GT, LE, LT, NE */ /* may be used; these operators have the same meanings as their */ /* Fortran counterparts. For columns containing character values, */ /* the list of allowed operators includes those in the above list, */ /* and in addition includes the operators */ /* LIKE, UNLIKE */ /* which are used to compare strings to a template. In the character */ /* case, the meanings of the parameters */ /* GE, GT, LE, LT */ /* match those of the Fortran lexical functions */ /* LGE, LGT, LLE, LLT */ /* The additional unary operators */ /* ISNULL, NOTNUL */ /* are used to test whether a value of any type is null. */ /* End Include Section: EK Operator Codes */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Column Descriptor Parameters */ /* ekcoldsc.inc Version 6 23-AUG-1995 (NJB) */ /* Note: The column descriptor size parameter CDSCSZ is */ /* declared separately in the include section CDSIZE$INC.FOR. */ /* Offset of column descriptors, relative to start of segment */ /* integer address range. This number, when added to the last */ /* integer address preceding the segment, yields the DAS integer */ /* base address of the first column descriptor. Currently, this */ /* offset is exactly the size of a segment descriptor. The */ /* parameter SDSCSZ, which defines the size of a segment descriptor, */ /* is declared in the include file eksegdsc.inc. */ /* Size of column descriptor */ /* Indices of various pieces of column descriptors: */ /* CLSIDX is the index of the column's class code. (We use the */ /* word `class' to distinguish this item from the column's data */ /* type.) */ /* TYPIDX is the index of the column's data type code (CHR, INT, DP, */ /* or TIME). The type is actually implied by the class, but it */ /* will frequently be convenient to look up the type directly. */ /* LENIDX is the index of the column's string length value, if the */ /* column has character type. A value of IFALSE in this element of */ /* the descriptor indicates that the strings have variable length. */ /* SIZIDX is the index of the column's element size value. This */ /* descriptor element is meaningful for columns with fixed-size */ /* entries. For variable-sized columns, this value is IFALSE. */ /* NAMIDX is the index of the base address of the column's name. */ /* IXTIDX is the data type of the column's index. IXTIDX */ /* contains a type value only if the column is indexed. For columns */ /* that are not indexed, the location IXTIDX contains the boolean */ /* value IFALSE. */ /* IXPIDX is a pointer to the column's index. IXTPDX contains a */ /* meaningful value only if the column is indexed. The */ /* interpretation of the pointer depends on the data type of the */ /* index. */ /* NFLIDX is the index of a flag indicating whether nulls are */ /* permitted in the column. The value at location NFLIDX is */ /* ITRUE if nulls are permitted and IFALSE otherwise. */ /* ORDIDX is the index of the column's ordinal position in the */ /* list of columns belonging to the column's parent segment. */ /* METIDX is the index of the column's integer metadata pointer. */ /* This pointer is a DAS integer address. */ /* The last position in the column descriptor is reserved. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Column Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Segment Descriptor Parameters */ /* eksegdsc.inc Version 8 06-NOV-1995 (NJB) */ /* All `base addresses' referred to below are the addresses */ /* *preceding* the item the base applies to. This convention */ /* enables simplied address calculations in many cases. */ /* Size of segment descriptor. Note: the include file ekcoldsc.inc */ /* must be updated if this parameter is changed. The parameter */ /* CDOFF in that file should be kept equal to SDSCSZ. */ /* Index of the segment type code: */ /* Index of the segment's number. This number is the segment's */ /* index in the list of segments contained in the EK to which */ /* the segment belongs. */ /* Index of the DAS integer base address of the segment's integer */ /* meta-data: */ /* Index of the DAS character base address of the table name: */ /* Index of the segment's column count: */ /* Index of the segment's record count: */ /* Index of the root page number of the record tree: */ /* Index of the root page number of the character data page tree: */ /* Index of the root page number of the double precision data page */ /* tree: */ /* Index of the root page number of the integer data page tree: */ /* Index of the `modified' flag: */ /* Index of the `initialized' flag: */ /* Index of the shadowing flag: */ /* Index of the companion file handle: */ /* Index of the companion segment number: */ /* The next three items are, respectively, the page numbers of the */ /* last character, d.p., and integer data pages allocated by the */ /* segment: */ /* The next three items are, respectively, the page-relative */ /* indices of the last DAS word in use in the segment's */ /* last character, d.p., and integer data pages: */ /* Index of the DAS character base address of the column name list: */ /* The last descriptor element is reserved for future use. No */ /* parameter is defined to point to this location. */ /* End Include Section: EK Segment Descriptor Parameters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Template Matching Wild Characters */ /* ekwild.inc Version 1 16-JAN-1995 (NJB) */ /* Within the EK system, templates used for pattern matching */ /* are those accepted by the SPICELIB routine MATCHW. MATCHW */ /* accepts two special characters: one representing wild */ /* strings and one representing wild characters. This include */ /* file defines those special characters for use within the EK */ /* system. */ /* Wild string symbol: this character matches any string. */ /* Wild character symbol: this character matches any character. */ /* End Include Section: EK Template Matching Wild Characters */ /* $ Disclaimer */ /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */ /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */ /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */ /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */ /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */ /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */ /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */ /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */ /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */ /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */ /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */ /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */ /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */ /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */ /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */ /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */ /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */ /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */ /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */ /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */ /* Include Section: EK Query Limit Parameters */ /* ekqlimit.inc Version 3 16-NOV-1995 (NJB) */ /* Parameter MAXCON increased to 1000. */ /* ekqlimit.inc Version 2 01-AUG-1995 (NJB) */ /* Updated to support SELECT clause. */ /* ekqlimit.inc Version 1 07-FEB-1995 (NJB) */ /* These limits apply to character string queries input to the */ /* EK scanner. This limits are part of the EK system's user */ /* interface: the values should be advertised in the EK required */ /* reading document. */ /* Maximum length of an input query: MAXQRY. This value is */ /* currently set to twenty-five 80-character lines. */ /* Maximum number of columns that may be listed in the */ /* `order-by clause' of a query: MAXSEL. MAXSEL = 50. */ /* Maximum number of tables that may be listed in the `FROM */ /* clause' of a query: MAXTAB. */ /* Maximum number of relational expressions that may be listed */ /* in the `constraint clause' of a query: MAXCON. */ /* This limit applies to a query when it is represented in */ /* `normalized form': that is, the constraints have been */ /* expressed as a disjunction of conjunctions of relational */ /* expressions. The number of relational expressions in a query */ /* that has been expanded in this fashion may be greater than */ /* the number of relations in the query as orginally written. */ /* For example, the expression */ /* ( ( A LT 1 ) OR ( B GT 2 ) ) */ /* AND */ /* ( ( C NE 3 ) OR ( D EQ 4 ) ) */ /* which contains 4 relational expressions, expands to the */ /* equivalent normalized constraint */ /* ( ( A LT 1 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( A LT 1 ) AND ( D EQ 4 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( C NE 3 ) ) */ /* OR */ /* ( ( B GT 2 ) AND ( D EQ 4 ) ) */ /* which contains eight relational expressions. */ /* MXJOIN is the maximum number of tables that can be joined. */ /* MXJCON is the maximum number of join constraints allowed. */ /* Maximum number of order-by columns that may be used in the */ /* `order-by clause' of a query: MAXORD. MAXORD = 10. */ /* Maximum number of tokens in a query: 500. Tokens are reserved */ /* words, column names, parentheses, and values. Literal strings */ /* and time values count as single tokens. */ /* Maximum number of numeric tokens in a query: */ /* Maximum total length of character tokens in a query: */ /* Maximum length of literal string values allowed in queries: */ /* MAXSTR. */ /* End Include Section: EK Query Limit Parameters */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* NCNSTR I Number of join constraints. */ /* ACTIVE I Array of flags indicating applicable constraints. */ /* LHANS I Handles of EKs for columns on LHS's of constraints. */ /* LSDSCS I Descriptors of segments on LHS's of constraints. */ /* LCDSCS I Column descriptors for LHS's of constraints. */ /* LROWS I Row numbers for LHS's of constraints. */ /* LCOLS I Column names for LHS's of constraints. */ /* LELTS I Column element indices for LHS's of constraints. */ /* OPS I Code for relational operator in constraints. */ /* RHAN I Handles of EKs for columns on RHS's of constraints. */ /* RSDSCS I Descriptors of segments on RHS's of constraints. */ /* RCDSCS I Column descriptors for RHS's of constraints. */ /* RROWS I Row numbers for RHS's of constraints. */ /* RCOLS I Column names for RHS's of constraints. */ /* RELTS I Column element indices for RHS's of constraints. */ /* The function returns .TRUE. if and only if all of the relational */ /* constraints specified by the input arguments are satisfied. */ /* $ Detailed_Input */ /* NCNSTR is the number of input join constraints. Each */ /* input constraint relates two EK column entries; */ /* abstractly, the form of the constraints is: */ /* <col entry 1> <relational op> <col entry 2> */ /* The compared entries are defined by handles, */ /* segment base addresses, column descriptors, and row */ /* numbers. */ /* ACTIVE is an array of logical flags indicating which */ /* constraints are currently applicable. The Nth */ /* element of ACTIVE indicates whether or not to apply */ /* the Nth constraint: if ACTIVE(N) is .TRUE., the */ /* constraint is applicable, otherwise it isn't. */ /* The elements of the other input arguments that */ /* define constraints are defined when the */ /* corresponding element of ACTIVE is .TRUE. For */ /* example, when the second constraint is not active, */ /* the second column descriptor in LDSCRS may not be */ /* defined. */ /* LHANS is an array of EK file handles for the left-hand- */ /* sides of the constraints. */ /* LSDSCS is an array of segment descriptors for the */ /* left-hand-sides of the constraints. */ /* LDSCRS is an array of column descriptors for the */ /* left-hand-sides of the constraints. */ /* LROWS is an array of row numbers for the left-hand-sides */ /* of the constraints. */ /* LELTS is an array of column entry element indices for the */ /* left-hand-sides of the constraints. These */ /* indices are ignored unless the columns they apply */ /* to are array-valued. */ /* OPS is an array of relational operators used in the */ /* input constraints. The elements of OPS are any of */ /* the integer parameters */ /* EQ, GE, GT, LE, LT, NE, LIKE, ISNULL, NOTNUL */ /* The Ith element of OPS corresponds to the Ith */ /* constraint. */ /* RHANS is an array of EK file handles for the right-hand- */ /* sides of the constraints. */ /* RSDSCS is an array of segment descriptors for the */ /* right-hand-sides of the constraints. */ /* RDSCRS is an array of column descriptors for the */ /* right-hand-sides of the constraints. */ /* RROWS is an array of row numbers for the right-hand-sides */ /* of the constraints. */ /* RELTS is an array of column entry element indices for the */ /* right-hand-sides of the constraints. These */ /* indices are ignored unless the columns they apply */ /* to are array-valued. */ /* $ Detailed_Output */ /* The function returns .TRUE. if and only if all of the relational */ /* constraints specified by the input arguments are satisfied. */ /* $ Parameters */ /* Within the EK system, operators used in EK queries are */ /* represented by integer codes. The codes and their meanings are */ /* listed below. */ /* Relational expressions in EK queries have the form */ /* <column name> <operator> <value> */ /* For columns containing numeric values, the operators */ /* EQ, GE, GT, LE, LT, NE */ /* may be used; these operators have the same meanings as their */ /* Fortran counterparts. For columns containing character values, */ /* the list of allowed operators includes those in the above list, */ /* and in addition includes the operator */ /* LIKE */ /* which is used to compare strings to a template. In the character */ /* case, the meanings of the parameters */ /* GE, GT, LE, LT */ /* match those of the Fortran lexical functions */ /* LGE, LGT, LLE, LLT */ /* The additional unary operators */ /* ISNULL, NOTNUL */ /* are used to test whether a value of any type is null. */ /* $ Exceptions */ /* 1) If any of the input file handles is invalid, the error */ /* will be diagnosed by routines called by this routine. */ /* The function value is .FALSE. in this case. */ /* 2) If an I/O error occurs while attempting to find the address */ /* range of a column entry element, the error will */ /* be diagnosed by routines called by this routine. The */ /* function value is .FALSE. in this case. */ /* 3) If any of the input segment descriptors, column descriptors, */ /* or row numbers are invalid, this routine may fail in */ /* unpredictable, but possibly spectacular, ways. Except */ /* as described in this header section, no attempt is made to */ /* handle these errors. */ /* 4) If the data type code in an input column descriptor is not */ /* recognized, the error SPICE(INVALIDDATATYPE) is signalled. */ /* The function value is .FALSE. in this case. */ /* 5) If a relational operator code is not recognized, the */ /* error SPICE(UNNATURALRELATION) is signalled. */ /* The function value is .FALSE. in this case. */ /* $ Files */ /* See the descriptions of the arguments LHAN and RHAN in */ /* $Detailed_Input. */ /* $ Particulars */ /* This routine is an EK utility intended to centralize a frequently */ /* performed comparison operation. */ /* $ Examples */ /* See EKSRCH. */ /* $ Restrictions */ /* 1) This routine must execute quickly. Therefore, it checks in */ /* only if it detects an error. If an error is signalled by a */ /* routine called by this routine, this routine will not appear */ /* in the SPICELIB traceback display. Also, in the interest */ /* of speed, this routine does not test the value of the SPICELIB */ /* function RETURN upon entry. */ /* 2) This routine depends on the requested comparison to have */ /* been semantically checked. Semantically invalid comparisons */ /* are treated as bugs. */ /* 3) Only the first MAXSTR characters of character strings are */ /* used in comparisons. */ /* C */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.0, 01-JUN-2010 (NJB) */ /* Bug fix: subscript out of range error caused by */ /* column entry strings longer than MAXLEN has been */ /* corrected. Also updated Restrictions header section. */ /* - Beta Version 1.0.0, 11-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Non-SPICELIB functions */ /* Local variables */ /* Use discovery check-in for speed. Don't check RETURN. */ /* The function value defaults to .TRUE. As we test the constraints, */ /* we may find one that the input row vector doesn't satisfy, at */ /* which point we can terminate the comparison. */ ret_val = TRUE_; n = 1; while(n <= *ncnstr && ret_val) { if (active[n - 1]) { /* Apply the Nth join constraint to the input row vector. */ /* Compare the entries in the two rows in the columns indicated */ /* by the Nth column descriptor pair. To do this, find the */ /* address ranges for each column entry. We don't check the */ /* found flag because every column entry has at least one */ /* element. */ /* We'll start out setting REL to EQ. If we find out */ /* otherwise, we'll change it. */ hans[0] = lhans[n - 1]; hans[1] = rhans[n - 1]; movei_(&lsdscs[n * 24 - 24], &c__24, sgdscs); movei_(&rsdscs[n * 24 - 24], &c__24, &sgdscs[24]); rows[0] = lrows[n - 1]; rows[1] = rrows[n - 1]; elts[0] = lelts[n - 1]; elts[1] = relts[n - 1]; movei_(&lcdscs[n * 11 - 11], &c__11, cldscs); movei_(&rcdscs[n * 11 - 11], &c__11, &cldscs[11]); rel = zzekecmp_(hans, sgdscs, cldscs, rows, elts); /* Determine the truth of the Nth input relational expression, */ /* and set ZZEKVMCH accordingly. */ if (ops[n - 1] == 1) { ret_val = rel == 1; } else if (ops[n - 1] == 5) { ret_val = rel == 5; } else if (ops[n - 1] == 4) { ret_val = rel != 3; } else if (ops[n - 1] == 3) { ret_val = rel == 3; } else if (ops[n - 1] == 2) { ret_val = rel != 5; } else if (ops[n - 1] == 6) { ret_val = rel != 1; } else if (ops[n - 1] == 7 && cldscs[1] == 1) { for (i__ = 1; i__ <= 2; ++i__) { zzekrsc_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("hans", i__1, "zzekvmch_", (ftnlen)399)], & sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= i__2 ? i__2 : s_rnge("sgdscs", i__2, "zzekvmch_", ( ftnlen)399)], &cldscs[(i__3 = i__ * 11 - 11) < 22 && 0 <= i__3 ? i__3 : s_rnge("cldscs", i__3, "zzekvmch_", (ftnlen)399)], &rows[(i__4 = i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("rows", i__4, "zzekvmch_", (ftnlen)399)], &elts[(i__5 = i__ - 1) < 2 && 0 <= i__5 ? i__5 : s_rnge("elts", i__5, "zzekvmch_", (ftnlen)399)], &cvlen[(i__6 = i__ - 1) < 2 && 0 <= i__6 ? i__6 : s_rnge("cvlen", i__6, "zzekvmch_", (ftnlen)399)], cval + (((i__7 = i__ - 1) < 2 && 0 <= i__7 ? i__7 : s_rnge("cval", i__7, "zzekvmch_", (ftnlen)399)) << 10), &null[( i__8 = i__ - 1) < 2 && 0 <= i__8 ? i__8 : s_rnge( "null", i__8, "zzekvmch_", (ftnlen)399)], &found, (ftnlen)1024); if (! found) { dashlu_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("hans", i__1, "zzekvmch_", ( ftnlen)412)], &unit); chkin_("ZZEKVMCH", (ftnlen)8); setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. " "Column entry element was not found.", ( ftnlen)79); errfnm_("#", &unit, (ftnlen)1); errint_("#", &cldscs[(i__1 = i__ * 11 - 3) < 22 && 0 <= i__1 ? i__1 : s_rnge("cldscs", i__1, "zze" "kvmch_", (ftnlen)419)], (ftnlen)1); errint_("#", &rows[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("rows", i__1, "zzekvmch_", ( ftnlen)420)], (ftnlen)1); errint_("#", &elts[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("elts", i__1, "zzekvmch_", ( ftnlen)421)], (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKVMCH", (ftnlen)8); return ret_val; } if (found && ! null[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("null", i__1, "zzekvmch_", (ftnlen) 428)]) { /* Computing MIN */ i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("cvlen", i__2, "zzekvmch_", (ftnlen) 430)]; cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) 430)] = min(i__3,1024); } else { cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) 432)] = 0; } } ret_val = matchi_(cval, cval + 1024, "*", "%", cmplen[0], cmplen[1], (ftnlen)1, (ftnlen)1); } else if (ops[n - 1] == 8 && cldscs[1] == 1) { for (i__ = 1; i__ <= 2; ++i__) { zzekrsc_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("hans", i__1, "zzekvmch_", (ftnlen)450)], & sgdscs[(i__2 = i__ * 24 - 24) < 48 && 0 <= i__2 ? i__2 : s_rnge("sgdscs", i__2, "zzekvmch_", ( ftnlen)450)], &cldscs[(i__3 = i__ * 11 - 11) < 22 && 0 <= i__3 ? i__3 : s_rnge("cldscs", i__3, "zzekvmch_", (ftnlen)450)], &rows[(i__4 = i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("rows", i__4, "zzekvmch_", (ftnlen)450)], &elts[(i__5 = i__ - 1) < 2 && 0 <= i__5 ? i__5 : s_rnge("elts", i__5, "zzekvmch_", (ftnlen)450)], &cvlen[(i__6 = i__ - 1) < 2 && 0 <= i__6 ? i__6 : s_rnge("cvlen", i__6, "zzekvmch_", (ftnlen)450)], cval + (((i__7 = i__ - 1) < 2 && 0 <= i__7 ? i__7 : s_rnge("cval", i__7, "zzekvmch_", (ftnlen)450)) << 10), &null[( i__8 = i__ - 1) < 2 && 0 <= i__8 ? i__8 : s_rnge( "null", i__8, "zzekvmch_", (ftnlen)450)], &found, (ftnlen)1024); if (! found) { dashlu_(&hans[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("hans", i__1, "zzekvmch_", ( ftnlen)463)], &unit); chkin_("ZZEKVMCH", (ftnlen)8); setmsg_("EK = #; COLIDX = #; ROW = #; ELTIDX = #. " "Column entry element was not found.", ( ftnlen)79); errfnm_("#", &unit, (ftnlen)1); errint_("#", &cldscs[(i__1 = i__ * 11 - 3) < 22 && 0 <= i__1 ? i__1 : s_rnge("cldscs", i__1, "zze" "kvmch_", (ftnlen)470)], (ftnlen)1); errint_("#", &rows[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("rows", i__1, "zzekvmch_", ( ftnlen)471)], (ftnlen)1); errint_("#", &elts[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("elts", i__1, "zzekvmch_", ( ftnlen)472)], (ftnlen)1); sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19); chkout_("ZZEKVMCH", (ftnlen)8); return ret_val; } if (found && ! null[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("null", i__1, "zzekvmch_", (ftnlen) 480)]) { /* Computing MIN */ i__3 = cvlen[(i__2 = i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("cvlen", i__2, "zzekvmch_", (ftnlen) 482)]; cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) 482)] = min(i__3,1024); } else { cmplen[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : s_rnge("cmplen", i__1, "zzekvmch_", (ftnlen) 484)] = 0; } } ret_val = ! matchi_(cval, cval + 1024, "*", "%", cmplen[0], cmplen[1], (ftnlen)1, (ftnlen)1); } else { /* Sorry, we couldn't resist. */ ret_val = FALSE_; chkin_("ZZEKVMCH", (ftnlen)8); setmsg_("The relational operator # was not recognized.", ( ftnlen)45); errint_("#", &ops[n - 1], (ftnlen)1); sigerr_("SPICE(UNNATURALRELATION)", (ftnlen)24); chkout_("ZZEKVMCH", (ftnlen)8); return ret_val; } } /* We've completed the test for the Nth constraint, if that */ /* constraint was active. */ ++n; } return ret_val; } /* zzekvmch_ */