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
ckbsr

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

     CKBSR ( C-kernel, buffer segments for readers )

     SUBROUTINE CKBSR ( FNAME,
    .                   HANDLE,
    .                   INST,
    .                   SCLKDP,
    .                   TOL,
    .                   NEEDAV,
    .                   DESCR,
    .                   SEGID,
    .                   FOUND   )

Abstract

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

Required_Reading

     CK
     DAF

Keywords

     POINTING

Declarations

     IMPLICIT NONE

     CHARACTER*(*)         FNAME
     INTEGER               HANDLE
     INTEGER               INST
     DOUBLE PRECISION      SCLKDP
     DOUBLE PRECISION      TOL
     LOGICAL               NEEDAV
     DOUBLE PRECISION      DESCR    ( * )
     CHARACTER*(*)         SEGID
     LOGICAL               FOUND

     INTEGER               FTSIZE
     PARAMETER           ( FTSIZE =  5000 )

     INTEGER               ITSIZE
     PARAMETER           ( ITSIZE =  5000 )

     INTEGER               LBPOOL
     PARAMETER           ( LBPOOL =   -5 )

     INTEGER               STSIZE
     PARAMETER           ( STSIZE = 100000 )

Brief_I/O

     VARIABLE  I/O  ENTRY POINTS
     --------  ---  --------------------------------------------------
     FNAME      I   CKLPF
     HANDLE    I-O  CKLPF, CKUPF, CKSNS
     INST       I   CKBSS
     SCLKDP     I   CKBSS
     TOL        I   CKBSS
     NEEDAV     I   CKBSS
     DESCR      O   CKSNS
     SEGID      O   CKSNS
     FOUND      O   CKSNS, CKHAVE

Detailed_Input

     FNAME    is the name of a binary C-kernel file to be loaded.

     HANDLE   on input, is the handle of a binary C-kernel file to be
              unloaded.

     INST     is the NAIF ID of an instrument.

     SCLKDP   is an encoded spacecraft clock time.

     TOL      is a time tolerance, measured in the same units as
              encoded spacecraft clock.

     NEEDAV   indicates whether or not angular velocity data are
              required.

              If .TRUE., only segments containing pointing and angular
              velocity data will be checked. If .FALSE., segments
              containing just pointing data will also be considered.

Detailed_Output

     HANDLE   on output, is the handle of the C-kernel file
              containing a located segment.

     DESCR    is the packed descriptor of a located segment.

     SEGID    is the identifier of a located segment.

     FOUND    indicates whether a requested segment was found or not.

Parameters

     FTSIZE   is the maximum number of pointing files that can
              be loaded by CKLPF at any given time for use by the
              readers.

     ITSIZE   is the maximum number of instruments whose segments
              are buffered by CKSNS.

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

Exceptions

     1)  If CKBSR is called directly, the error SPICE(CKBOGUSENTRY)
         is signaled.

     2)  See entry points CKLPF, CKUPF, CKBSS, and CKSNS for
         exceptions specific to them.

Files

     C-kernel pointing files are indicated by filename before loading
     (see CKLPF) and handle after loading (all other places).

Particulars

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

        CKLPF       Load pointing file.
        CKUPF       Unload pointing file.
        CKBSS       Begin search for segment.
        CKSNS       Select next segment.
        CKHAVE      Determine whether or not any CKs are loaded.

     Before a file can be read by the C-kernel readers, it must be
     loaded by CKLPF, which among other things load the file into
     the DAF subsystem.

     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 a C-kernel 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 CK routines.

     A file may be removed from the list of files for potential
     searching by unloading it via a call to CKUPF.

     The purpose of entry points CKBSS and CKSNS is to search for
     segments in CK files matching certain criteria, which is
     established based on CKBSS input arguments INST, SCLKDP, TOL and
     NEEDAV. These two routines are used together to search through
     all loaded CK files for segments.

     CKBSS sets up a search for segments by CKSNS. It records the
     instrument and time to be searched for, and whether to require
     segments containing angular velocity data. If angular velocity
     data are required, only segments containing angular velocity
     data will be returned by CKSNS. If angular velocity data are
     not required, segments returned by CKSNS may or may not contain
     angular velocity data.

     CKBSS determines the first task that CKSNS will have to perform
     if it is called to get an applicable segment.

     CKSNS finds segments matching the search criteria set up by
     CKBSS. Last-loaded files get searched first, and individual files
     are searched backwards.

     A segment matches the CKBSS/CKSNS search criteria when the
     following statements are true.

        1) INST matches the instrument number for the segment.

        2) The time interval [SCLKDP - TOL, SCLKDP + TOL] intersects
           the time interval of the segment.

        3) If angular velocity data are required, as indicated by
           NEEDAV, the segment contains angular velocity data.

     When an applicable segment is found, CKSNS returns that segment's
     descriptor and identifier, along with the handle of the file
     containing the segment.

     Subsequent calls to CKSNS continue the search, picking up where
     the previous call to this routine left off.

     CKSNS uses information on loaded files to manage a buffer
     of saved segment descriptors and identifiers. The buffer is used
     to speed up access time by minimizing file reads.

Examples

     The numerical results shown for this example 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 pointing data for the Viking Orbiter 2 scan
        platform orientation for a certain interval of time are
        contained in three separate files, one containing data for the
        original SEDR (Supplemental Experiment Data Record) files,
        contains the complete set of pointing data and another two
        which contain two separate pointing updates based on
        reconstruction, one of them containing discrete data, and the
        other continuous pointing data.

        In the following example, pointing from the C-kernel is
        extracted in two different ways for the purpose of comparing
        the two updates:

        First, the original pointing file and one of the update files
        are both loaded and pointing is retrieved for all of the
        pictures. The update file is searched through first, and if
        no data for the desired picture is located, then the original
        file provides the requested pointing.

        Then, the first update file is unloaded, the second update
        file is loaded, and the same search is performed, as above.


        Use the CK kernel below to load the Viking Orbiter 2 scan
        platform orientation containing a combination of data from
        SEDR files.

           vo2_sedr_ck2.bc


        Use the CK kernel below to load the Viking Orbiter 2 scan
        platform orientation discrete data reconstructed during
        cartographic image registration by S. Wu, USGS.

           vo2_swu.bc


        Use the CK kernel below to load the Viking Orbiter 2 scan
        platform orientation discrete data reconstructed during
        cartographic image registration by S. Wu, USGS, where each
        discrete pointing instance was "expanded" into a 2 second
        window.

           vo2_swu_ck2.bc


        Use the meta-kernel shown below to load the required SPICE
        kernels.


           KPL/MK

           File name: ckbsr_ex1.tm

           This meta-kernel is intended to support operation of SPICE
           example programs. The kernels shown here should not be
           assumed to contain adequate or correct versions of data
           required by SPICE-based user applications.

           In order for an application to use this meta-kernel, the
           kernels referenced here must be present in the user's
           current working directory.

           The names and contents of the kernels referenced
           by this meta-kernel are as follows:

              File name                     Contents
              ---------                     --------
              vo2_fict.tsc                  Viking 2 SCLK
              naif0012.tls                  Leapseconds


           \begindata

              KERNELS_TO_LOAD = ( 'vo2_fict.tsc',
                                  'naif0012.tls'  )

           \begintext

           End of meta-kernel


        Example code begins here.


              PROGRAM CKBSR_EX1
              IMPLICIT NONE

        C
        C     Local parameters.
        C
              INTEGER               NPICS
              PARAMETER           ( NPICS  = 5  )

              INTEGER               TIMLEN
              PARAMETER           ( TIMLEN = 24 )


        C
        C     Local variables.
        C
              INTEGER               HANDLE
              INTEGER               HNORIG
              INTEGER               HUPDT
              INTEGER               UPDATE
              INTEGER               INST
              INTEGER               SC
              INTEGER               I

              DOUBLE PRECISION      ET
              DOUBLE PRECISION      DESCR    (    5 )
              DOUBLE PRECISION      SCLKDP
              DOUBLE PRECISION      TOL
              DOUBLE PRECISION      CLKOUT
              DOUBLE PRECISION      CMAT     ( 3, 3 )
              DOUBLE PRECISION      AV       (    3 )

              CHARACTER*(TIMLEN)    FDS      ( NPICS )
              CHARACTER*(25)        FNAME
              CHARACTER*(40)        SEGID
              CHARACTER*(16)        OUTFDS
              CHARACTER*(14)        TOLSTR
              CHARACTER*(25)        UDFILE   (    2 )

              LOGICAL               PFOUND
              LOGICAL               SFOUND
              LOGICAL               NEEDAV

        C
        C     Set the times for the pictures.
        C
              DATA                  FDS /
             .                 '1976 OCT 31 22:07:21.000',
             .                 '1977-JAN-09 18:33:13.707',
             .                 '1977 APR 24 11:48:05.000',
             .                 '1977 JUN 07 00:13:15.000',
             .                 '1977-AUG-07 14:55:12.019' /


              UDFILE ( 1 ) = 'vo2_swu.bc'
              UDFILE ( 2 ) = 'vo2_swu_ck2.bc'

        C
        C     The NAIF integer ID codes for the Viking Orbiter 2
        C     spacecraft and scan platform on Viking Orbiter 2 are
        C     -30 and -30000, respectively.
        C
              SC           = -30
              INST         = -30000

        C
        C     Load the LSK and Viking 2 SCLK files.
        C
              CALL FURNSH ( 'ckbsr_ex1.tm' )

        C
        C     Allow a time tolerance of 500 milliseconds.  Convert
        C     the tolerance to 'ticks', the units of encoded
        C     spacecraft clock time.
        C
              TOLSTR  = '0.500'
              CALL SCTIKS ( SC, TOLSTR, TOL )

        C
        C     Don't care about angular velocity data.
        C
              NEEDAV = .FALSE.

        C
        C     Load the original CK file first.
        C
              CALL CKLPF ( 'vo2_sedr_ck2.bc', HNORIG )

        C
        C     Write banner.
        C
              WRITE(*,'(A)') '     Input UTC time       '
             .            // 'Pointing found in      SCLK time'
              WRITE(*,'(A)') '------------------------  '
             .            // '-----------------  ----------------'

              DO UPDATE = 1, 2
        C
        C        Load the update file.  Last-loaded files get searched
        C        first, so the update file will be searched before
        C        the original file.
        C
                 CALL CKLPF ( UDFILE ( UPDATE ), HUPDT )

                 DO I = 1, NPICS

        C
        C           Encode the character string representation of
        C           spacecraft clock time in FDS.
        C
                    CALL STR2ET ( FDS( I ) , ET  )
                    CALL SCE2C  ( SC, ET, SCLKDP )

        C
        C           Begin a search for this instrument and time, and
        C           get the first applicable segment.
        C
                    CALL CKBSS ( INST,   SCLKDP, TOL,   NEEDAV  )
                    CALL CKSNS ( HANDLE, DESCR,  SEGID, SFOUND  )

        C
        C           Keep trying candidate segments until a segment can
        C           produce a pointing instance within the specified
        C           time tolerance of SCLKDP, the encoded spacecraft
        C           clock time.
        C
                    PFOUND = .FALSE.
                    DO WHILE (  SFOUND .AND. ( .NOT. PFOUND )  )

                       CALL CKPFS ( HANDLE, DESCR,  SCLKDP,
             .                      TOL,    NEEDAV, CMAT,
             .                      AV,     CLKOUT, PFOUND )

                       IF ( PFOUND ) THEN

        C
        C                 Get the name of the file from whence the
        C                 pointing instance came, decode the
        C                 spacecraft clock time associated with the
        C                 instance, and write the results to the
        C                 table.
        C
                          CALL DAFHFN ( HANDLE, FNAME          )
                          CALL SCDECD ( SC,     CLKOUT, OUTFDS )

                          WRITE(*,'(A,2X,A17,2X,A)') FDS( I ), FNAME,
             .                                       OUTFDS

                       ELSE

        C
        C                 Look for another candidate segment.
        C
                          CALL CKSNS ( HANDLE, DESCR, SEGID, SFOUND )

                       END IF

                    END DO

                    IF ( .NOT. PFOUND ) THEN

                       WRITE(*,'(A)') FDS( I ) // '  pointing not '
             .                     // 'found in any file.'

                    END IF

                 END DO

                 WRITE(*,*) ' '

        C
        C        Unload the update file. The original file stays
        C        loaded.
        C
                 CALL CKUPF  ( HUPDT )

              END DO

              END


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


             Input UTC time       Pointing found in      SCLK time
        ------------------------  -----------------  ----------------
        1976 OCT 31 22:07:21.000  vo2_sedr_ck2.bc    1/0026345241.000
        1977-JAN-09 18:33:13.707  vo2_swu.bc         1/0032380394.707
        1977 APR 24 11:48:05.000  vo2_sedr_ck2.bc    1/0041428086.000
        1977 JUN 07 00:13:15.000  pointing not found in any file.
        1977-AUG-07 14:55:12.019  vo2_sedr_ck2.bc    1/0050511313.019

        1976 OCT 31 22:07:21.000  vo2_sedr_ck2.bc    1/0026345241.000
        1977-JAN-09 18:33:13.707  vo2_swu_ck2.bc     1/0032380394.707
        1977 APR 24 11:48:05.000  vo2_sedr_ck2.bc    1/0041428086.000
        1977 JUN 07 00:13:15.000  pointing not found in any file.
        1977-AUG-07 14:55:12.019  vo2_swu_ck2.bc     1/0050511313.019

Restrictions

     1)  If Fortran I/O errors occur while searching a loaded CK
         file, the internal state of this suite of routines may
         be corrupted. It may be possible to correct the state
         by unloading the pertinent CK 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)
     B.V. Semenov       (JPL)
     W.L. Taber         (JPL)
     R.E. Thurman       (JPL)
     I.M. Underwood     (JPL)

Version

    SPICELIB Version 5.1.0, 25-OCT-2021 (JDR) (BVS) (NJB)

        Increased ITSIZE (from 100 to 5000).

        Updated entry point CKSNS to always initialize FOUND.

        Edited the header of umbrella routine CKBSR, and all entry
        points to comply with NAIF standard. Created complete code
        example from existing fragments in CKBSR $Examples section.

        Added references to CKHAVE entry point in CKBSR header.

        Moved details related to search criteria and conditions to meet
        it from the $Detailed_Input to $Particulars.

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

        Corrected various spelling errors within comments.

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

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

    SPICELIB Version 4.6.0, 13-JUN-2013 (BVS)

        Increased FTSIZE (from 1000 to 5000).

        Increased STSIZE (from 50000 to 100000).

    SPICELIB Version 4.5.0, 24-FEB-2011 (NJB)

        Bug fixes:

          1) In the CKSNS 'MAKE ROOM' state, when the
             suspended activity is 'ADD TO FRONT' and no segment table
             room is available, the instrument table's pointer to the
             current segment list is now set to null. Previously the
             pointer was allowed to go stale.

          2) In CKUPF, the null pointer test used to determine
             eligibility for segment list deletion now uses the .LE.
             operator instead of the .EQ. operator.


    SPICELIB Version 4.4.0, 07-APR-2010 (NJB)

        Increased STSIZE to 50000.

    SPICELIB Version 4.3.1, 28-FEB-2008 (BVS)

        Corrected the contents of the $Required_Reading section
        of the CKHAVE entry point header.

    SPICELIB Version 4.3.0, 23-OCT-2005 (NJB)

        Updated to remove non-standard use of duplicate arguments in
        MOVED calls in entry points CKUPF and CKSNS. Replaced header
        reference to LDPOOL with reference to FURNSH.

    SPICELIB Version 4.2.0, 30-DEC-2004 (NJB)

        Increased STSIZE to 20000.

    SPICELIB Version 4.1.0, 20-NOV-2001 (NJB)

        Bug fixes:

           1) When a segment list is freed because the entire list
              is contributed by a single CK file, and the list is
              too large to be buffered, the corresponding instrument
              table pointer is now set to null.

           2) An algorithm change has eliminated a bug caused by not
              updating the current instrument index when instrument
              table entries having empty segment lists were compressed
              out of the instrument table. Previously the instrument
              table pointer IINDEX 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 CKLPF now resets all file numbers when
              the next file number reaches INTMAX()-1, thereby
              avoiding arithmetic overflow.

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

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

        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 instrument table size has been increased to 100 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 4.0.0, 17-FEB-2000 (WLT)

        Added the Entry point CKHAVE

    SPICELIB Version 3.0.0, 03-MAR-1999 (WLT)

        The parameter STSIZE was increased from 1000 to 4000 to
        avoid the buffering error that exists in the CKBSR.

    SPICELIB Version 2.0.0, 25-NOV-1992 (JML)

     1) When loading a file, CKLPF 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 CKLPF and CKUPF clean up the instrument
        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) The length of the elements in the array of segment
        identifiers ( STIDNT ) was changed from 56 to 40.

    SPICELIB Version 1.1.1, 10-MAR-1992 (WLT)

        Comment section for permuted index source lines was added
        following the header.

    SPICELIB Version 1.1.0, 01-NOV-1990 (JML)

        An initial value was assigned to the variable STATUS so
        that an error will be signaled if CKSNS is called
        without CKBSS ever having been called to initiate the
        search.

    SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU)
Fri Dec 31 18:36:01 2021