| spkbsr |
|
Table of contents
Procedure
SPKBSR ( S/P Kernel, Buffer segments for readers )
SUBROUTINE SPKBSR ( FNAME,
. HANDLE,
. BODY,
. ET,
. DESCR,
. IDENT,
. FOUND )
Abstract
Load and unload files for use by the readers. Buffer segments
for readers.
Required_Reading
SPK
Keywords
EPHEMERIS
FILES
Declarations
IMPLICIT NONE
CHARACTER*(*) FNAME
INTEGER HANDLE
INTEGER BODY
DOUBLE PRECISION ET
DOUBLE PRECISION DESCR ( * )
CHARACTER*(*) IDENT
LOGICAL FOUND
INTEGER FTSIZE
PARAMETER ( FTSIZE = 5000 )
INTEGER BTSIZE
PARAMETER ( BTSIZE = 10000 )
INTEGER LBPOOL
PARAMETER ( LBPOOL = -5 )
INTEGER STSIZE
PARAMETER ( STSIZE = 100000 )
Brief_I/O
VARIABLE I/O ENTRY POINTS
-------- --- --------------------------------------------------
FNAME I SPKLEF
HANDLE I-O SPKLEF, SPKUEF, SPKSFS
BODY I SPKSFS
ET I SPKSFS
DESCR O SPKSFS
IDENT O SPKSFS
Detailed_Input
FNAME is the name of an SPK file to be loaded.
HANDLE on input is the handle of an SPK file to be
unloaded.
BODY is the NAIF integer code of an ephemeris object,
typically a solar system body.
ET is a time, in seconds past the epoch J2000 TDB.
Detailed_Output
HANDLE on output is the handle of the S/P-kernel file
containing a located segment.
DESCR is the descriptor of a located segment.
IDENT is the identifier of a located segment.
FOUND indicates whether a requested segment was found or not.
Parameters
FTSIZE is the maximum number of ephemeris files that can be
loaded by SPKLEF at any given time for use by the
readers.
BTSIZE is the maximum number of bodies whose segments can be
buffered by SPKSFS.
STSIZE is the maximum number of segments that can be buffered at
any given time by SPKSFS.
Exceptions
1) If SPKBSR is called directly, the error SPICE(BOGUSENTRY)
is signaled.
2) See entry points SPKLEF, SPKUEF, and SPKSFS for exceptions
specific to them.
Files
S/P-kernel ephemeris files are indicated by filename before
loading (see SPKLEF) and handle after loading (all other places).
Particulars
SPKBSR serves as an umbrella, allowing data to be shared by its
entry points:
SPKLEF Load ephemeris file.
SPKUEF Unload ephemeris file.
SPKSFS Select file and segment.
Before a file can be read by the S/P-kernel readers, it must be
loaded by SPKLEF, which among other things, loads the file into
the DAF system.
Up to FTSIZE files may be loaded for use simultaneously, and a
file only has to be loaded once to become a potential search
target for any number of subsequent reads.
Once an SPK file has been loaded, it is assigned a file
handle, which is used to keep track of the file internally,
and which is used by the calling program to refer to the file
in all subsequent calls to SPK routines.
A file may be removed from the list of files for potential
searching by unloading it via a call to SPKUEF.
SPKSFS performs the search for segments within a file for the
S/P-kernel readers. It searches through last-loaded files first.
Within a single file, it searches through last-inserted segments
first, thus assuming that "newest data is best".
Information on loaded files is used by SPKSFS to manage a buffer
of saved segment descriptors and identifiers to speed up access
time without having to necessarily perform file reads.
Examples
Suppose that ephemeris data for the Mars Global Surveyor
spacecraft relative to Mars are contained in three separate files:
PREDICT.SPK contains complete predict ephemeris data for several
successive orbits, and UPDATE_1.SPK and UPDATE_2.SPK contain two
separate updates to selected intervals within those orbits, based
on altimeter fits.
In the following example, states of the spacecraft are computed
in two different ways:
First, the predict file and one of the update files are both
loaded and states are requested for regular intervals within
the orbits. The update file is searched through first, and if no
data for the requested time is available, the predict file is
used.
Then, the first update file is unloaded, the second update file
is loaded, and the same requests are made as above.
Throughout the two searches, a table is written which contains
the state (position and velocity) of the spacecraft, and the
file from which the data came, if such data was found, and an
error message otherwise.
It is assumed that the beginning and ending ephemeris times
(BEG_ET, END_ET) for the entire span have already been
initialized, along with the step-size for each measurement
(DELTA). The two routines WRITE_TABLE and WRITE_ERROR do not
exist in SPICELIB.
INTEGER PRED_HNDL
INTEGER UPD1_HNDL
INTEGER UPD2_HNDL
INTEGER HANDLE
INTEGER BODY
INTEGER CENTER
DOUBLE PRECISION BEG_ET
DOUBLE PRECISION END_ET
DOUBLE PRECISION DELTA
DOUBLE PRECISION ET
DOUBLE PRECISION DESCR ( 5 )
DOUBLE PRECISION STATE ( 6 )
CHARACTER*40 IDENT
CHARACTER*25 FNAME
LOGICAL FOUND
C
C Load the predict file and the first update file. Since
C last-loaded files get searched first, we want to load the
C update file second.
C
CALL SPKLEF ( 'PREDICT.SPK', PRED_HNDL )
CALL SPKLEF ( 'UPDATE_1.SPK', UPD1_HNDL )
C
C NAIF code for the Mars Global Surveyor spacecraft is -94.
C
BODY = -94
C
C Compute states for regular intervals between BEG_ET and
C END_ET.
C
ET = BEG_ET
DO WHILE ( ET .LE. END_ET )
C
C Locate the applicable segment (handle and descriptor).
C
CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND )
IF ( FOUND ) THEN
C
C Evaluate the state, get the name of the file from
C whence the data came, and write the results to the
C table.
C
CALL SPKPV ( HANDLE, DESCR, ET, 'J2000', STATE,
. CENTER )
CALL DAFHFN ( HANDLE, FNAME )
CALL WRITE_TABLE ( ET, STATE, FNAME )
ELSE
CALL WRITE_ERROR ( ET )
END IF
C
C The next time.
C
ET = ET + DELTA
END DO
C
C Unload the first update file, load the second, and do
C everything over again. Since the original file stays
C loaded, the update file once again gets searched first.
C
CALL SPKUEF ( UPD1_HNDL )
CALL SPKLEF ( 'UPDATE_2.SPK', UPD2_HNDL )
ET = BEG_ET
DO WHILE ( ET .LE. END_ET )
C
C Locate the applicable segment.
C
CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND )
IF ( FOUND ) THEN
C
C Evaluate the state, get the name of the file from
C whence the data came, and write the results to the
C table.
C
CALL SPKPV ( HANDLE, DESCR, ET, 'J2000', STATE,
. CENTER )
CALL DAFHFN ( HANDLE, FNAME )
CALL WRITE_TABLE ( ET, STATE, FNAME )
ELSE
CALL WRITE_ERROR ( ET )
END IF
C
C The next time.
C
ET = ET + DELTA
END DO
Restrictions
1) If Fortran I/O errors occur while searching a loaded SPK
file, the internal state of this suite of routines may
be corrupted. It may be possible to correct the state
by unloading the pertinent SPK files and then re-loading
them.
Literature_References
None.
Author_and_Institution
N.J. Bachman (JPL)
J. Diaz del Rio (ODC Space)
J.M. Lynch (JPL)
H.A. Neilan (JPL)
B.V. Semenov (JPL)
W.L. Taber (JPL)
R.E. Thurman (JPL)
Version
SPICELIB Version 6.1.0, 13-OCT-2021 (JDR) (BVS) (NJB)
Increased BTSIZE (from 200 to 10000).
Updated entry point SPKSFS to always initialize FOUND.
Edited the header of SPKBSR umbrella routine and its entry
points SPKLEF, SPKUEF and SPKSFS.
Changed SAVE statements to save each variable individually.
SPICELIB Version 6.0.1, 15-MAR-2017 (NJB)
Corrected various spelling errors within comments.
SPICELIB Version 6.0.0, 17-MAR-2014 (NJB)
Updated segment pool initialization condition in entry
point SPKLEF so that the pool is initialized only if the file
table is empty.
SPICELIB Version 5.4.0, 13-JUN-2013 (BVS)
Increased FTSIZE (from 1000 to 5000).
Increased STSIZE (from 50000 to 100000).
SPICELIB Version 5.3.0, 01-MAR-2011 (NJB)
Bug fix:
In the SPKSFS 'MAKE ROOM' state, when the suspended activity
is 'ADD TO FRONT' and no segment table room is available,
the body table's pointer to the current segment list
is now set to null. Previously the pointer was allowed to go
stale.
SPICELIB Version 5.2.0, 07-APR-2010 (NJB)
Increased segment table buffer size to 50000 entries.
SPICELIB Version 5.1.0, 08-SEP-2005 (NJB)
Updated to remove non-standard use of duplicate arguments
in MOVED calls in entry points SPKUEF and SPKSFS.
Increased segment table buffer size to 30000 entries.
SPICELIB Version 5.0.0, 21-FEB-2003 (NJB)
Increased segment table buffer size to 10000 entries.
SPICELIB Version 4.0.0, 28-DEC-2001 (NJB)
Bug fixes:
1) When a segment list is freed because the entire list
is contributed by a single SPK file, and the list is
too large to be buffered, the corresponding body table
pointer is now set to null.
2) An algorithm change has eliminated a bug caused by not
updating the current body index when body table entries
having empty segment lists were compressed out of the
body table. Previously the body table pointer BINDEX
could go stale after the compression.
3) When a already loaded kernel is re-opened with DAFOPR,
it now has its link count reset to 1 via a call to
DAFCLS.
4) The load routine SPKLEF now resets all file numbers when
the next file number reaches INTMAX()-1, thereby
avoiding arithmetic overflow.
5) The unload routine SPKUEF now calls RETURN() on entry and
returns if so directed.
6) In SPKSFS, DAF calls are followed by tests of FAILED()
in order to ensure that the main state loop terminates.
7) In SPKSFS, a subscript bound violation in a loop
termination test was corrected.
The "re-use interval" feature was introduced to improve speed
in the case where repeated, consecutive requests are satisfied
by the same segment.
The segment list cost algorithm was modified slightly:
the contribution of a file search to the cost of a list
is included only when the file search is completed. The
cost of finding the re-use interval is accounted for when
unbuffered searches are required.
The file table size has been increased to 1000, in order
to take advantage of the DAF system's new ability to load
1000 files.
The body table size has been increased to 200 in order to
decrease the chance of thrashing due to swapping segment
lists for different bodies.
Various small updates and corrections were made to the
comments throughout the file.
SPICELIB Version 3.0.0, 14-AUG-1995 (WLT)
An interim fix to a bug in SPKBSR was made. The parameters
STSIZE and BTSIZE were increased to be much larger than before
(from 100 and 20 to 2000 and 40 respectively). This should
keep the boundary errors experienced by Cassini users from
occurring again. Version 4.0.0 with a real fix to the
boundary problem should be installed in SPICELIB by
October 1995
SPICELIB Version 2.0.0, 25-NOV-1992 (JML)
1) When loading a file, SPKLEF now checks if the file table is
full only after determining that the file is not currently
loaded. Previously, if the file table was full and an
attempt was made to reload a file, an error was signaled. A
new exception was added as a result of this change.
2) A bug in the way that SPKLEF and SPKUEF clean up the body
tables after a file is unloaded was fixed.
3) Variable declarations were added to the example program
so that it can now be compiled.
4) A cut and paste error in the description of the segment
table was corrected.
SPICELIB Version 1.0.3, 10-MAR-1992 (WLT)
Comment section for permuted index source lines was added
following the header.
SPICELIB Version 1.0.2, 09-SEP-1991 (HAN)
The declaration of the variable STATE in the $Examples section
was changed from a 3 dimensional vector to a 6 dimensional
vector, and the term state was specified to be the position
and velocity of a body relative to another body.
SPICELIB Version 1.0.1, 22-MAR-1990 (HAN)
Literature references added to the header.
SPICELIB Version 1.0.0, 31-JAN-1990 (RET)
|
Fri Dec 31 18:36:50 2021