Index of Functions: A  B  C  D  E  F  G  H  I  J  K  L  M  N  O  P  Q  R  S  T  U  V  W  X 
Index Page
spkbsr

Table of contents
Procedure
Abstract
Required_Reading
Keywords
Declarations
Brief_I/O
Detailed_Input
Detailed_Output
Parameters
Exceptions
Files
Particulars
Examples
Restrictions
Literature_References
Author_and_Institution
Version

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