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
pckbsr

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

     PCKBSR ( PCK, buffer segments for readers )

     SUBROUTINE PCKBSR ( FNAME,
    .                    HANDLE,
    .                    BODY,
    .                    ET,
    .                    DESCR,
    .                    IDENT,
    .                    FOUND   )

Abstract

     Load and unload PCK binary files for use by the readers.
     Buffer segments for readers.

Required_Reading

     DAF
     PCK

Keywords

     FILES
     PCK

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 =     20 )

     INTEGER               LBPOOL
     PARAMETER           ( LBPOOL =     -5 )

     INTEGER               STSIZE
     PARAMETER           ( STSIZE =   5000 )

Brief_I/O

     VARIABLE  I/O  ENTRY POINTS
     --------  ---  --------------------------------------------------
     FNAME      I   PCKLOF
     HANDLE    I-O  PCKLOF, PCKUOF, PCKSFS
     BODY       I   PCKSFS
     ET         I   PCKSFS
     DESCR      O   PCKSFS
     IDENT      O   PCKSFS

Detailed_Input

     FNAME    is the name of an PCK file to be loaded.

     HANDLE   on input, is the handle of an PCK 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 binary PCK file
              containing a located segment.

     DESCR    is the descriptor of a located segment.

     IDENT    is the identifier of a located segment.

     FOUND    is a logical flag indicating whether a segment meeting
              the search criteria was found. FOUND will have the
              value .TRUE. if an appropriate segment was found during
              the search; it will have the value of .FALSE.
              otherwise. If FOUND has the value .FALSE., then either
              an appropriate segment could not be found in any of the
              loaded files or there were no PCK kernel files loaded
              when the request for a segment was made.

Parameters

     FTSIZE   is the maximum number of files that may be loaded
              by PCKLOF at any given time for use by the PCK readers.

     BTSIZE   is the maximum number of bodies whose segments can be
              buffered by PCKSFS.

     STSIZE   is the maximum number of segments that can be buffered at
              any given time by PCKSFS.

Exceptions

     1)  If PCKBSR is called directly, the error SPICE(BOGUSENTRY)
         is signaled.

     2)  See entry points PCKLOF, PCKUOF, and PCKSFS for exceptions
         specific to them.

Files

     PCK kernel files are indicated by filename before loading
     (see PCKLOF) and handle after loading (all other places).

Particulars

     PCKBSR serves as an umbrella, allowing data to be shared by its
     entry points:

        PCKLOF       Load PCK binary file.
        PCKUOF       Unload PCK binary file.
        PCKSFS       Select file and segment.

     Before a file can be read by the PCK kernel readers, it must be
     loaded by PCKLOF, which among other things, calls routines to
     open the specified file.

     Multiple files may be loaded for use simultaneously, and a file
     need only be loaded once to become a potential search target
     for any number of subsequent reads.

     Once a PCK kernel file is loaded and opened, it is assigned a file
     handle, which is used by the calling program to refer to the file
     in all subsequent calls to PCK routines.

     A file may be removed from the list of files searched by using
     PCKUOF to unload it.

     PCKSFS performs the search for segments within a file for the
     PCK kernel readers. It searches through the most recently loaded
     files first. Within a single file, PCKSFS searches through
     the segments in reverse order, beginning with the last segment in
     the file. The search stops when the first appropriate segment is
     found or all files and segments have been searched without a
     match.

     PCKSFS buffers information from loaded PCK files to improve access
     time by preventing unnecessary file reads during segment searches.

Examples

     The numerical results shown for these examples may differ across
     platforms. The results depend on the SPICE kernels used as
     input, the compiler and supporting libraries, and the machine
     specific arithmetic implementation.

     1) Suppose that the data of interest are contained in a PCK file,
        and that we want to generate a table containing the
        descriptors of the PCK segments, or a message indicating that
        no segment was found, for various request times. We are
        interested in the data coverage of the segments in the file.

        The code example below loads PCK files and performs searches
        for various epochs, generating a table containing the segment
        descriptors, if found, or a message indicating that a segment
        descriptor was not found.

        Use the PCK kernel below as input file for the code example.

           earth_latest_high_prec.bpc


        Example code begins here.


              PROGRAM PCKBSR_EX1
              IMPLICIT NONE


        C
        C     Local parameters
        C
              DOUBLE PRECISION      DELTA
              PARAMETER           ( DELTA  = 50000000.D0 )

              INTEGER               BODY
              PARAMETER           ( BODY   = 3000        )

              INTEGER               DESCSZ
              PARAMETER           ( DESCSZ = 5           )

              INTEGER               IDSIZE
              PARAMETER           ( IDSIZE = 40          )

              INTEGER               NEPOCH
              PARAMETER           ( NEPOCH = 10          )


        C
        C     Local variables
        C
              CHARACTER*(IDSIZE)    SEGID

              DOUBLE PRECISION      BEGET
              DOUBLE PRECISION      DESCR ( DESCSZ )
              DOUBLE PRECISION      ENDET
              DOUBLE PRECISION      ET

              INTEGER               BADDR
              INTEGER               BODYID
              INTEGER               EADDR
              INTEGER               FRAMID
              INTEGER               HANDLE
              INTEGER               I
              INTEGER               PCKHDL
              INTEGER               PCKTYP

              LOGICAL               FOUND

        C
        C     Load the PCK file.
        C
              CALL PCKLOF ( 'earth_latest_high_prec.bpc', PCKHDL )

        C
        C     Search for segments using evenly spaced epochs.
        C
              ET = -86400.D0

              DO I = 1, NEPOCH

                 WRITE(*,*) 'Epoch = ', ET

        C
        C        Locate the applicable segment (handle and
        C        descriptor).
        C
                 CALL PCKSFS ( BODY, ET, HANDLE, DESCR, SEGID, FOUND )

                 IF ( FOUND ) THEN

        C
        C           Unpack the segment.
        C
                    CALL PCKUDS ( DESCR, BODYID, FRAMID, PCKTYP,
             .                    BEGET, ENDET,  BADDR,  EADDR  )

                    WRITE(*,*) '   Segment ID: ', SEGID
                    WRITE(*,*) '   Body ID   : ', BODYID
                    WRITE(*,*) '   Frame ID  : ', FRAMID
                    WRITE(*,*) '   PCK Type  : ', PCKTYP
                    WRITE(*,*) '   Start ET  : ', BEGET
                    WRITE(*,*) '   End ET    : ', ENDET

                 ELSE

                    WRITE(*,*) '   ***** SEGMENT NOT FOUND *****'

                 END IF

                 WRITE(*,*) ' '

        C
        C        Increment the epoch.
        C
                 ET = ET + DELTA

              END DO

        C
        C     Unload the PCK file.
        C
              CALL PCKUOF ( PCKHDL )

              END


        When this program was executed on a Mac/Intel/gfortran/64-bit
        platform, the output was:


         Epoch =   -86400.000000000000
            ***** SEGMENT NOT FOUND *****

         Epoch =    49913600.000000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :   -43135.816087188054
            End ET    :    86343752.179112613

         Epoch =    99913600.000000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    86343752.179112613
            End ET    :    172730640.17431438

         Epoch =    149913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    86343752.179112613
            End ET    :    172730640.17431438

         Epoch =    199913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    172730640.17431438
            End ET    :    259117528.16951615

         Epoch =    249913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    172730640.17431438
            End ET    :    259117528.16951615

         Epoch =    299913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    259117528.16951615
            End ET    :    345504416.16470283

         Epoch =    349913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    345504416.16470283
            End ET    :    431891304.15988630

         Epoch =    399913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    345504416.16470283
            End ET    :    431891304.15988630

         Epoch =    449913600.00000000
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    431891304.15988630
            End ET    :    518278192.15506977


     2) In this example multiple PCK files are loaded and searched for
        segments.

        Use the PCK kernel below as the first input file for the code
        example.

           earth_latest_high_prec.bpc


        Use the PCK kernel below as the second input file for the code
        example.

           earth_720101_070426.bpc

        Example code begins here.


              PROGRAM PCKBSR_EX2
              IMPLICIT NONE


        C
        C     Local parameters
        C
              DOUBLE PRECISION      DELTA
              PARAMETER           ( DELTA  = 50000000.D0 )

              INTEGER               BODY
              PARAMETER           ( BODY   = 3000        )

              INTEGER               DESCSZ
              PARAMETER           ( DESCSZ = 5           )

              INTEGER               IDSIZE
              PARAMETER           ( IDSIZE = 40          )

              INTEGER               NEPOCH
              PARAMETER           ( NEPOCH = 10          )


        C
        C     Local variables
        C
              CHARACTER*(IDSIZE)    SEGID

              DOUBLE PRECISION      BEGET
              DOUBLE PRECISION      DESCR ( DESCSZ )
              DOUBLE PRECISION      ENDET
              DOUBLE PRECISION      ET

              INTEGER               BADDR
              INTEGER               BODYID
              INTEGER               EADDR
              INTEGER               FRAMID
              INTEGER               HANDLE
              INTEGER               I
              INTEGER               PCKHD1
              INTEGER               PCKHD2
              INTEGER               PCKTYP

              LOGICAL               FOUND

        C
        C     Load the PCK files.
        C
              CALL PCKLOF ( 'earth_latest_high_prec.bpc', PCKHD1 )
              CALL PCKLOF ( 'earth_720101_070426.bpc',    PCKHD2 )

        C
        C     Search for segments using evenly spaced epochs.
        C
              ET = -86400.D0

              DO I = 1, NEPOCH

                 WRITE(*,*) 'Epoch = ', ET

        C
        C        Locate the applicable segment (handle and
        C        descriptor).
        C
                 CALL PCKSFS ( BODY, ET, HANDLE, DESCR, SEGID, FOUND )

                 IF ( FOUND ) THEN

        C
        C           Unpack the segment.
        C
                    CALL PCKUDS ( DESCR, BODYID, FRAMID, PCKTYP,
             .                    BEGET, ENDET,  BADDR,  EADDR  )

                    WRITE(*,*) '   Handle    : ', HANDLE
                    WRITE(*,*) '   Segment ID: ', SEGID
                    WRITE(*,*) '   Body ID   : ', BODYID
                    WRITE(*,*) '   Frame ID  : ', FRAMID
                    WRITE(*,*) '   PCK Type  : ', PCKTYP
                    WRITE(*,*) '   Start ET  : ', BEGET
                    WRITE(*,*) '   End ET    : ', ENDET

                 ELSE

                    WRITE(*,*) '   ***** SEGMENT NOT FOUND *****'

                 END IF

                 WRITE(*,*) ' '

        C
        C        Increment the epoch.
        C
                 ET = ET + DELTA

              END DO

        C
        C     Unload the PCK files.
        C
              CALL PCKUOF ( PCKHD1 )
              CALL PCKUOF ( PCKHD2 )

              END


        When this program was executed on a Mac/Intel/gfortran/64-bit
        platform, the output was:


         Epoch =   -86400.000000000000
            Handle    :            2
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :   -74415076.797098771
            End ET    :    11979698.742793124

         Epoch =    49913600.000000000
            Handle    :            2
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    11979698.742793124
            End ET    :    98374474.282683983

         Epoch =    99913600.000000000
            Handle    :            2
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    98374474.282683983
            End ET    :    184769249.82257757

         Epoch =    149913600.00000000
            Handle    :            2
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    98374474.282683983
            End ET    :    184769249.82257757

         Epoch =    199913600.00000000
            Handle    :            2
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    184769249.82257757
            End ET    :    230817665.18534085

         Epoch =    249913600.00000000
            Handle    :            1
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    172730640.17431438
            End ET    :    259117528.16951615

         Epoch =    299913600.00000000
            Handle    :            1
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    259117528.16951615
            End ET    :    345504416.16470283

         Epoch =    349913600.00000000
            Handle    :            1
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    345504416.16470283
            End ET    :    431891304.15988630

         Epoch =    399913600.00000000
            Handle    :            1
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    345504416.16470283
            End ET    :    431891304.15988630

         Epoch =    449913600.00000000
            Handle    :            1
            Segment ID: Earth PCK, ITRF93 Frame
            Body ID   :         3000
            Frame ID  :           17
            PCK Type  :            2
            Start ET  :    431891304.15988630
            End ET    :    518278192.15506977

Restrictions

     1)  If Fortran I/O errors occur while searching a loaded PCK
         file, the internal state of this suite of routines may
         be corrupted. It may be possible to correct the state
         by unloading the pertinent PCK files and then re-loading
         them.

Literature_References

     None.

Author_and_Institution

     N.J. Bachman       (JPL)
     J. Diaz del Rio    (ODC Space)
     B.V. Semenov       (JPL)
     E.D. Wright        (JPL)
     K.S. Zukor         (JPL)

Version

    SPICELIB Version 2.1.0, 26-OCT-2021 (JDR) (BVS) (NJB)

        Updated entry point PCKSFS to always initialize FOUND.

        Edited the header of the PCKBSR umbrella and all its entry
        points to comply with NAIF standard. Added complete code
        examples from existing fragments.

        Changed SAVE statements to save each variable individually.

    SPICELIB Version 2.0.1, 30-JAN-2017 (NJB)

        Corrected various spelling errors within comments.

    SPICELIB Version 2.0.0, 17-MAR-2014 (NJB)

        Updated segment pool initialization condition in entry
        point PCKLOF so that the pool is initialized only if the file
        table is empty.

    SPICELIB Version 1.4.0, 03-JAN-2014 (BVS) (EDW)

        Minor edits to $Procedure; clean trailing whitespace.

        Increased FTSIZE (from 1000 to 5000).

        Increased STSIZE (from 100 to 5000).

    SPICELIB Version 1.3.0, 01-MAR-2011 (NJB)

        Bug fix:

           In the PCKSFS '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 1.2.0, 08-SEP-2005 (NJB)

        Updated to remove non-standard use of duplicate arguments
        in MOVED calls in entry points PCKUOF and PCKSFS.

    SPICELIB Version 1.1.0, 08-NOV-2001 (NJB)

        Bug fixes:

           1) When a segment list is freed because the entire list
              is contributed by a single PCK 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 PCKLOF now resets all file numbers when
              the next file number reaches INTMAX()-1, thereby
              avoiding arithmetic overflow.

           5) The unload routine PCKUOF now calls RETURN() on entry and
              returns if so directed.

           6) In PCKSFS, DAF calls are followed by tests of FAILED()
              in order to ensure that the main state loop terminates.

           7) In PCKSFS, 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. For each body, the associated re-use
        interval marks the time interval containing the previous
        request time for which the previously returned segment provides
        the  highest-priority data available.

        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.

        Various small updates and corrections were made to the
        comments throughout the file.

        In order to simplify the source code, the in-line singly
        linked list implementation of the segment table has been
        replaced by an implementation relying on the SPICELIB
        doubly linked list routines.

    SPICELIB Version 1.0.0, 16-MAR-1994 (KSZ)

        This differs only slightly from the SPKXXX code.
        The main difference is that the SFS subroutine returns
        FOUND = .FALSE. if no files are found, rather than returning
        an error.
Fri Dec 31 18:36:37 2021