| daffa |
|
Table of contents
Procedure
DAFFA ( DAF, find array )
SUBROUTINE DAFFA ( HANDLE, SUM, NAME, FOUND )
Abstract
Find arrays in a DAF.
Required_Reading
DAF
Keywords
FILES
Declarations
IMPLICIT NONE
INCLUDE 'zzddhman.inc'
INTEGER TBSIZE
PARAMETER ( TBSIZE = FTSIZE )
INTEGER HANDLE
DOUBLE PRECISION SUM ( * )
CHARACTER*(*) NAME
LOGICAL FOUND
Brief_I/O
VARIABLE I/O ENTRY
-------- --- --------------------------------------------------
HANDLE I-O DAFBFS, DAFBBS, DAFGH, DAFCS
SUM I-O DAFGS, DAFRS, DAFWS
NAME I-O DAFGN, DAFRN
FOUND O DAFFNA, DAFFPA
Detailed_Input
HANDLE on input is the handle of the DAF to be searched.
SUM on input is an array summary that replaces the
summary of the current array in the DAF currently
being searched.
NAME on input is an array name that replaces the name
of the current array in the DAF currently being
searched.
Detailed_Output
HANDLE on output is the handle of the DAF currently being
searched.
SUM on output is the summary for the array found most
recently.
NAME on output is the name for the array found
most recently.
FOUND is .TRUE. whenever the search for the next or the
previous array is successful, and is .FALSE. otherwise.
Parameters
TBSIZE is the maximum number of files (DAS and DAF) that may be
simultaneously open. TBSIZE is set to FTSIZE which is
assigned and defined in zzdhman.inc.
Exceptions
1) If DAFFA is called directly, the error SPICE(BOGUSENTRY)
is signaled.
2) See entry points DAFBFS, DAFFNA, DAFBBS, DAFFPA, DAFGS, DAFGN,
DAFGH, DAFRS, DAFWS, DAFRN, and DAFCS for exceptions specific
to those entry points.
Files
DAFs read by DAFFA and its entry points are opened
elsewhere, and referred to only by their handles.
Particulars
DAFFA serves as an umbrella, allowing data to be shared by its
entry points:
DAFBFS Begin forward search.
DAFFNA Find next array.
DAFBBS Begin backward search.
DAFFPA Find previous array.
DAFGS Get summary.
DAFGN Get name.
DAFGH Get handle.
DAFRS Replace summary.
DAFWS Write summary.
DAFRN Replace name.
DAFCS Continue search.
The main function of these entry points is to allow the
contents of any DAF to be examined on an array-by-array
basis.
Conceptually, the arrays in a DAF form a doubly linked list,
which can be searched in either of two directions: forward or
backward. It is possible to search multiple DAFs simultaneously.
DAFBFS (begin forward search) and DAFFNA are used to search the
arrays in a DAF in forward order. In applications that search a
single DAF at a time, the normal usage is
CALL DAFBFS ( HANDLE )
CALL DAFFNA ( FOUND )
DO WHILE ( FOUND )
CALL DAFGS ( SUM )
CALL DAFGN ( NAME )
.
.
CALL DAFFNA ( FOUND )
END DO
DAFBBS (begin backward search) and DAFFPA are used to search the
arrays in a DAF in backward order. In applications that search
a single DAF at a time, the normal usage is
CALL DAFBBS ( HANDLE )
CALL DAFFPA ( FOUND )
DO WHILE ( FOUND )
CALL DAFGS ( SUM )
CALL DAFGN ( NAME )
.
.
CALL DAFFPA ( FOUND )
END DO
In applications that conduct multiple searches simultaneously,
the above usage must be modified to specify the handle of the
file to operate on, in any case where the file may not be the
last one specified by DAFBFS or DAFBBS. The routine DAFCS
(DAF, continue search) is used for this purpose. Below, we
give an example of an interleaved search of two files specified
by the handles HANDL1 and HANDL2. The directions of searches
in different DAFs are independent; here we conduct a forward
search on one file and a backward search on the other.
Throughout, we use DAFCS to specify which file to operate on,
before calling DAFFNA, DAFFPA, DAFGS, DAFRS, DAFWS, DAFGN, or
DAFRN.
CALL DAFBFS ( HANDL1 )
CALL DAFBBS ( HANDL2 )
CALL DAFCS ( HANDL1 )
CALL DAFFNA ( FOUND1 )
CALL DAFCS ( HANDL2 )
CALL DAFFPA ( FOUND2 )
DO WHILE ( FOUND1 .OR. FOUND2 )
IF ( FOUND1 ) THEN
CALL DAFCS ( HANDL1 )
CALL DAFGS ( SUM )
CALL DAFGN ( NAME )
.
.
CALL DAFCS ( HANDL1 )
CALL DAFFNA ( FOUND1 )
END IF
IF ( FOUND2 ) THEN
CALL DAFCS ( HANDL2 )
CALL DAFGS ( SUM )
CALL DAFGN ( NAME )
.
.
CALL DAFCS ( HANDL2 )
CALL DAFFPA ( FOUND2 )
END IF
END DO
At any time, the latest array found (whether by DAFFNA or DAFFPA)
is regarded as the `current' array for the file in which the
array was found. The last DAF in which a search was started,
executed, or continued by any of DAFBFS, DAFBBS, DAFFNA, DAFFPA
or DAFCS is regarded as the `current' DAF. The summary and name
for the current array in the current DAF can be returned
separately, as shown above, by calls to DAFGS (get summary) and
DAFGN (get name). The handle of the current DAF can also be
returned by calling DAFGH (get handle).
The summary and name of the current array in the current DAF can
be updated (again, separately) by providing new ones through DAFRS
(replace summary) and DAFRN (replace name). This feature
should not be used except to correct errors that occurred during
the creation of a file. Note that changes can only be made to
files opened for write access. Also, the addresses of an array
cannot be changed using these routines. (Another routine,
DAFWS, is provided for this purpose, but should be used only
to reorder the arrays in a file.)
Once a search has been begun, it may be continued in either
direction. That is, DAFFPA may be used to back up during a
forward search, and DAFFNA may be used to advance during a
backward search.
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) The following program illustrates the way summaries and
names for the arrays contained in a DAF can be modified.
This example is provided for educational purpose only.
Replace the body ID code 301 (Moon) with a test body ID,
e.g. -999, in every descriptor of an SPK file; update the
segment identifier to indicate that such change has been
implemented.
Example code begins here.
PROGRAM DAFFA_EX1
IMPLICIT NONE
C
C SPICELIB functions
C
INTEGER CARDI
INTEGER RTRIM
C
C Local parameters.
C
INTEGER DSCSIZ
PARAMETER ( DSCSIZ = 5 )
INTEGER FILSIZ
PARAMETER ( FILSIZ = 255 )
INTEGER LBCELL
PARAMETER ( LBCELL = -5 )
INTEGER MAXOBJ
PARAMETER ( MAXOBJ = 1000 )
INTEGER ND
PARAMETER ( ND = 2 )
INTEGER NI
PARAMETER ( NI = 6 )
INTEGER NEWCODE
PARAMETER ( NEWCODE = -999 )
INTEGER OLDCODE
PARAMETER ( OLDCODE = 301 )
INTEGER SGIDLN
PARAMETER ( SGIDLN = 1000 )
C
C Local variables.
C
CHARACTER*(FILSIZ) FNAME
CHARACTER*(SGIDLN) SEGID
CHARACTER*(SGIDLN) UPDSID
DOUBLE PRECISION DC ( ND )
DOUBLE PRECISION SUM ( DSCSIZ )
INTEGER HANDLE
INTEGER I
INTEGER IC ( NI )
INTEGER IDS ( LBCELL : MAXOBJ )
INTEGER OBJ
LOGICAL FOUND
LOGICAL UPDATE
C
C Get the SPK file name.
C
CALL PROMPT ( 'Enter name of the SPK file > ', FNAME )
C
C Initialize the set IDS.
C
CALL SSIZEI ( MAXOBJ, IDS )
C
C Find the set of objects in the SPK file.
C
CALL SPKOBJ ( FNAME, IDS )
WRITE(*,'(A)') 'Objects in the original DAF file:'
WRITE(*,'(20I4)') ( IDS(I), I= 1, CARDI ( IDS ) )
C
C Open for writing the SPK file.
C
CALL DAFOPW ( FNAME, HANDLE )
C
C Search the file in forward order.
C
CALL DAFBFS ( HANDLE )
CALL DAFFNA ( FOUND )
WRITE(*,'(A)') 'Original Segment IDs (forward order):'
DO WHILE ( FOUND )
C
C Fetch and unpack the descriptor (aka summary)
C of the current segment, and get its name.
C
CALL DAFGN ( SEGID )
CALL DAFGS ( SUM )
CALL DAFUS ( SUM, ND, NI, DC, IC )
C
C Print the current segment name
C
WRITE(*,'(2I6,2X,A)') IC(1), IC(2),
. SEGID(:RTRIM(SEGID))
C
C Replace ID codes if necessary.
C
UPDATE = .FALSE.
IF ( IC(1) .EQ. OLDCODE ) THEN
IC(1) = NEWCODE
UPDATE = .TRUE.
END IF
IF ( IC(2) .EQ. OLDCODE ) THEN
IC(2) = NEWCODE
UPDATE = .TRUE.
END IF
C
C Update segment ID if necessary.
C
IF ( UPDATE ) THEN
UPDSID = '# - Updated. Do not use.'
CALL REPMC ( UPDSID, '#', SEGID(:RTRIM(SEGID)),
. UPDSID )
CALL DAFRN ( UPDSID )
END IF
C
C Re-pack the descriptor; replace the descriptor
C in the file.
C
CALL DAFPS ( ND, NI, DC, IC, SUM )
CALL DAFRS ( SUM )
C
C Find the next segment.
C
CALL DAFFNA ( FOUND )
END DO
C
C Close the file.
C
CALL DAFCLS ( HANDLE )
C
C Reset the set IDS.
C
CALL SCARDI ( 0, IDS )
C
C Find the set of objects in the updated SPK file.
C
CALL SPKOBJ ( FNAME, IDS )
WRITE(*,*) ' '
WRITE(*,'(A)') 'Objects in the updated DAF file:'
WRITE(*,'(20I4)') ( IDS(I), I= 1, CARDI ( IDS ) )
C
C Search the file in backwards order and output the
C segment IDs.
C
CALL DAFOPR ( FNAME, HANDLE )
CALL DAFBBS ( HANDLE )
CALL DAFFPA ( FOUND )
WRITE(*,'(A)') 'Updated Segment IDs (backwards order):'
DO WHILE ( FOUND )
C
C Fetch and unpack the descriptor (aka summary)
C of the current segment, and get its name.
C
CALL DAFGN ( SEGID )
CALL DAFGS ( SUM )
CALL DAFUS ( SUM, ND, NI, DC, IC )
WRITE(*,'(2I6,2X,A)') IC(1), IC(2),
. SEGID(:RTRIM(SEGID))
C
C Find the previous segment.
C
CALL DAFFPA ( FOUND )
END DO
C
C Close the file.
C
CALL DAFCLS ( HANDLE )
END
When this program was executed on a Mac/Intel/gfortran/64-bit
platform, using the SPK file named de430.bsp, the output was:
Enter name of the SPK file > de430.bsp
Objects in the original DAF file:
1 2 3 4 5 6 7 8 9 10 199 299 301 399
Original Segment IDs (forward order):
1 0 DE-0430LE-0430
2 0 DE-0430LE-0430
3 0 DE-0430LE-0430
4 0 DE-0430LE-0430
5 0 DE-0430LE-0430
6 0 DE-0430LE-0430
7 0 DE-0430LE-0430
8 0 DE-0430LE-0430
9 0 DE-0430LE-0430
10 0 DE-0430LE-0430
301 3 DE-0430LE-0430
399 3 DE-0430LE-0430
199 1 DE-0430LE-0430
299 2 DE-0430LE-0430
Objects in the updated DAF file:
-999 1 2 3 4 5 6 7 8 9 10 199 299 399
Updated Segment IDs (backwards order):
299 2 DE-0430LE-0430
199 1 DE-0430LE-0430
399 3 DE-0430LE-0430
-999 3 DE-0430LE-0430 - Updated. Do not use.
10 0 DE-0430LE-0430
9 0 DE-0430LE-0430
8 0 DE-0430LE-0430
7 0 DE-0430LE-0430
6 0 DE-0430LE-0430
5 0 DE-0430LE-0430
4 0 DE-0430LE-0430
3 0 DE-0430LE-0430
2 0 DE-0430LE-0430
1 0 DE-0430LE-0430
2) The following program compares data in two DAFs. The DAFs are
expected to have the same number of arrays, the same number
of elements in each corresponding array, and the same summary
format.
Each difference whose magnitude exceeds a specified tolerance
is flagged. The difference information is written to the
screen.
Example code begins here.
PROGRAM DAFFA_EX2
IMPLICIT NONE
C
C Local parameters
C
INTEGER RTRIM
C
C Local parameters
C
INTEGER ARRYSZ
PARAMETER ( ARRYSZ = 10000000 )
INTEGER ERRLEN
PARAMETER ( ERRLEN = 240 )
INTEGER FILEN
PARAMETER ( FILEN = 128 )
INTEGER LINLEN
PARAMETER ( LINLEN = 80 )
INTEGER MAXND
PARAMETER ( MAXND = 125 )
INTEGER MAXNI
PARAMETER ( MAXNI = 250 )
INTEGER MAXSUM
PARAMETER ( MAXSUM = 128 )
INTEGER RLEN
PARAMETER ( RLEN = 1000 )
C
C Local variables
C
CHARACTER*(RLEN) ANAME1
CHARACTER*(RLEN) ANAME2
CHARACTER*(FILEN) DAF1
CHARACTER*(FILEN) DAF2
CHARACTER*(FILEN) LOG
CHARACTER*(ERRLEN) PRSERR
CHARACTER*(LINLEN) STR
CHARACTER*(LINLEN) TOLCH
DOUBLE PRECISION ARRAY1 ( ARRYSZ )
DOUBLE PRECISION ARRAY2 ( ARRYSZ )
DOUBLE PRECISION DC1 ( MAXND )
DOUBLE PRECISION DC2 ( MAXND )
DOUBLE PRECISION TOL
DOUBLE PRECISION DIFF
DOUBLE PRECISION SUM1 ( MAXSUM )
DOUBLE PRECISION SUM2 ( MAXSUM )
INTEGER FA1
INTEGER FA2
INTEGER I
INTEGER IA1
INTEGER IA2
INTEGER IC1 ( MAXNI )
INTEGER IC2 ( MAXNI )
INTEGER HANDL1
INTEGER HANDL2
INTEGER LEN1
INTEGER LEN2
INTEGER ND1
INTEGER ND2
INTEGER NI1
INTEGER NI2
INTEGER PTR
LOGICAL FOUND
C
C Start out by obtaining the names of the DAFs to be
C compared.
C
CALL PROMPT ( 'Enter name of first DAF > ', DAF1 )
CALL PROMPT ( 'Enter name of second DAF > ', DAF2 )
CALL PROMPT ( 'Enter tolerance for data comparison > ',
. TOLCH )
CALL NPARSD ( TOLCH, TOL, PRSERR, PTR )
C
C Open both DAFs for reading.
C
CALL DAFOPR ( DAF1, HANDL1 )
CALL DAFOPR ( DAF2, HANDL2 )
C
C Start forward searches in both DAFS.
C
CALL DAFBFS ( HANDL1 )
CALL DAFBFS ( HANDL2 )
C
C Obtain the summary formats for each DAF. Stop now
C if the summary formats don't match.
C
CALL DAFHSF ( HANDL1, ND1, NI1 )
CALL DAFHSF ( HANDL2, ND2, NI2 )
IF ( ( ND1 .NE. ND2 ) .OR. ( NI1 .NE. NI2 ) ) THEN
STR = 'Summary formats do not match. NI1 = #, '//
. 'NI2 = #, ND1 = #, ND2 = #.'
CALL REPMI ( STR, '#', NI1, STR )
CALL REPMI ( STR, '#', NI2, STR )
CALL REPMI ( STR, '#', ND1, STR )
CALL REPMI ( STR, '#', ND2, STR )
WRITE(*,*) STR
CALL SIGERR ( 'Incompatible DAFs' )
END IF
C
C Find the first array in each DAF. Use DAFCS
C (DAF, continue search) to set the handle of the DAF
C to search in before calling DAFFNA.
C
CALL DAFCS ( HANDL1 )
CALL DAFFNA ( FOUND )
IF ( FOUND ) THEN
CALL DAFCS ( HANDL2 )
CALL DAFFNA ( FOUND )
END IF
DO WHILE ( FOUND )
C
C Get the summary and name of each array, using
C DAFCS to select the DAF to get the information
C from. Unpack the summaries and find the beginning
C and ending addresses of the arrays. Read the
C arrays into the variables ARRAY1 and ARRAY2.
C
CALL DAFCS ( HANDL1 )
CALL DAFGN ( ANAME1 )
CALL DAFGS ( SUM1 )
CALL DAFUS ( SUM1, ND1, NI1, DC1, IC1 )
IA1 = IC1 ( NI1 - 1 )
FA1 = IC1 ( NI1 )
LEN1 = FA1 - IA1 + 1
IF ( LEN1 .GT. ARRYSZ ) THEN
CALL SETMSG ( 'Buffer too small; need # elts.')
CALL ERRINT ( '#', LEN1 )
CALL SIGERR ( 'ARRAYTOOSMALL' )
ELSE
CALL DAFGDA ( HANDL1, IA1, FA1, ARRAY1 )
END IF
CALL DAFCS ( HANDL2 )
CALL DAFGN ( ANAME2 )
CALL DAFGS ( SUM2 )
CALL DAFUS ( SUM2, ND2, NI2, DC2, IC2 )
IA2 = IC2 ( NI2 - 1 )
FA2 = IC2 ( NI2 )
LEN2 = FA2 - IA2 + 1
IF ( LEN2 .GT. ARRYSZ ) THEN
CALL SETMSG ( 'Buffer too small; need # elts.')
CALL ERRINT ( '#', LEN2 )
CALL SIGERR ( 'ARRAYTOOSMALL' )
ELSE IF ( LEN1 .NE. LEN2 ) THEN
CALL SETMSG ( 'DAF structures do not match. '//
. 'LEN1 = #, LEN2 = #. ' )
CALL ERRINT ( '#', LEN1 )
CALL ERRINT ( '#', LEN2 )
CALL SIGERR ( 'Incompatible DAFs' )
ELSE
CALL DAFGDA ( HANDL2, IA2, FA2, ARRAY2 )
END IF
C
C
C Compare the data in the two arrays. Log a message
C for every instance of data that differs by more
C than the allowed tolerance. Use the array names
C to label the data sources.
C
DO I = 1, LEN1
DIFF = ABS( ARRAY1(I) - ARRAY2(I) )
IF ( DIFF .GT. TOL ) THEN
C
C Get the array names.
C
CALL DAFCS ( HANDL1 )
CALL DAFGN ( ANAME1 )
CALL DAFCS ( HANDL2 )
CALL DAFGN ( ANAME2 )
C
C Construct the report strings. The number 14
C below is the number of significant digits to
C show in the strings representing d.p.
C numbers.
C
WRITE(*,*) ' '
WRITE(*,*) 'Difference of array ' //
. 'elements exceeded ' //
. 'tolerance.'
WRITE(*,*) 'First array : ',
. ANAME1(:RTRIM(ANAME1))
WRITE(*,*) 'Second array: ',
. ANAME2(:RTRIM(ANAME2))
STR = 'First value : #'
CALL REPMD ( STR, '#', ARRAY1(I), 14, STR )
WRITE(*,*) STR
STR = 'Second value: #'
CALL REPMD ( STR, '#', ARRAY2(I), 14, STR )
WRITE(*,*) STR
STR = 'Difference : #'
CALL REPMD ( STR, '#', DIFF, 14, STR )
WRITE(*,*) STR
END IF
END DO
C
C Find the next pair of arrays.
C
CALL DAFCS ( HANDL1 )
CALL DAFFNA ( FOUND )
IF ( FOUND ) THEN
CALL DAFCS ( HANDL2 )
CALL DAFFNA ( FOUND )
END IF
END DO
C
C Close the DAFs.
C
CALL DAFCLS ( HANDL1 )
CALL DAFCLS ( HANDL2 )
END
When this program was executed on a Mac/Intel/gfortran/64-bit
platform, using the PCK (DAF) files named
earth_720101_031229.bpc and earth_720101_070527.bpc, and a
tolerance of '1.D0', the output was:
Enter name of first DAF > earth_720101_031229.bpc
Enter name of second DAF > earth_720101_070527.bpc
Enter tolerance for data comparison > 1.D0
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8352636890345E+08
Second value: -8.8352636783584E+08
Difference : 1.0676109790802E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8343997629503E+08
Second value: -8.8343997451568E+08
Difference : 1.7793515920639E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8335358368661E+08
Second value: -8.8335358119552E+08
Difference : 2.4910920858383E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8326719107819E+08
Second value: -8.8326718787536E+08
Difference : 3.2028328180313E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8318079846977E+08
Second value: -8.8318079455519E+08
Difference : 3.9145733118057E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8309440586135E+08
Second value: -8.8309440123503E+08
Difference : 4.6263140439987E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8300801325293E+08
Second value: -8.8300800791487E+08
Difference : 5.3380546569824E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8292162064451E+08
Second value: -8.8292161459471E+08
Difference : 6.0497951507568E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8283522803609E+08
Second value: -8.8283522127455E+08
Difference : 6.7615358829498E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8274883542767E+08
Second value: -8.8274882795439E+08
Difference : 7.4732763767242E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8266244281925E+08
Second value: -8.8266243463423E+08
Difference : 8.1850171089172E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8257605021083E+08
Second value: -8.8257604131407E+08
Difference : 8.8967577219009E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8248965760241E+08
Second value: -8.8248964799391E+08
Difference : 9.6084982156754E+00
Difference of array elements exceeded tolerance.
First array : Earth PCK, ITRF93 Frame
Second array: Earth PCK, ITRF93 Frame
First value : -8.8240326499398E+08
Second value: -8.8240325467375E+08
[...]
Warning: incomplete output. Only 100 out of 80582 lines have
been provided.
Restrictions
1) Calls that do or may change DAF addresses of DAF summaries,
names, or data of a given DAF file should not be made during
a search of that file initiated by either DAFBFS or DAFBBS.
No such changes should be made between the start of a search
and calls to any entry point that reads or writes to the
summary of the "current array" found by that search, or
that returns a "found" flag indicating whether the current
array exists.
Changing the size of the comment area while a search is in
progress can invalidate record numbers stored in local data
structures of this routine. This can cause corrupted array
summaries and names to be returned upon read access and file
corruption to occur upon write access.
Adding arrays (aka "segments") while either a forward or
backward search is in progress can cause the search to miss
the new segments.
Literature_References
None.
Author_and_Institution
N.J. Bachman (JPL)
J. Diaz del Rio (ODC Space)
H.A. Neilan (JPL)
B.V. Semenov (JPL)
W.L. Taber (JPL)
F.S. Turner (JPL)
I.M. Underwood (JPL)
E.D. Wright (JPL)
Version
SPICELIB Version 3.2.0, 27-OCT-2021 (JDR) (NJB)
Added IMPLICIT NONE statement.
Edited the header of DAFFA umbrella routine and all its entry
to comply with NAIF standard.
Updated $Restrictions sections of this routine and its entry
points.
SPICELIB Version 3.1.1, 14-MAR-2017 (NJB)
Updated second header code example in this routine: fixed
error check for array overflow, corrected indentation of
continuation characters, added IMPLICIT NONE, deleted unused
declaration, increased buffer size, and changed DAFRDA call to
DAFGDA call.
Updated header example in entry point DAFGH: changed DAFRDA
call to DAFGDA call.
SPICELIB Version 3.1.0, 10-FEB-2014 (EDW) (BVS)
Added a functional code example to the $Examples section
in DAFBFS, DAFFNA, DAFGS.
Added check on value of "found" boolean returned from
DAFGSR calls. Failure to check this value can cause an
infinite loop during segment searches on damaged SPKs.
Eliminated unneeded $Revisions section.
Removed the obsolete Reference citation to "NAIF
Document 167.0."
Added full declaration of HANDLE to the $Declarations section
of the DAFCS header.
SPICELIB Version 3.0.0, 16-NOV-2001 (FST)
This umbrella and its entry points were updated to
work properly with the changes in the DAF system as
a result of its utilization of the new handle manager.
Calls to DAFRDR were replaced with the translation-aware
interface DAFGSR for retrieving summary records from
DAFs.
Updated the entry points of DAFFA to enable its
internal state table size, TBSIZE, to be smaller
than the file table maintained by DAFAH: FTSIZE.
Since DAFAH now tracks FTSIZE files as defined in
the include file 'zzddhman.inc', it was decided that
in the interest of releasing the toolkit this module
would undergo simple changes. As such most previous
references to FTSIZE in this umbrella have been replaced
with TBSIZE where appropriate. DAFBFS and DAFBBS now signal
errors if there is not enough room to add a new DAF's
dossier to the state table. Also, after attempting to
clean up all files listed in the state table that are
not currently open, DAFBFS and DAFBBS attempt to locate
the first dossier with STADDG set to .FALSE. This is then
freed to make room for the new DAF. If DAFBNA fails
to locate such a dossier in the state table, it
signals the error SPICE(STFULL).
The parameter FILEN was removed, as it is defined
on an environmental basis in the include file
'zzddhman.inc'.
SPICELIB Version 2.0.1, 10-MAR-1992 (WLT)
Comment section for permuted index source lines was added
following the header.
SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) (WLT)
Updated to support simultaneous searches of multiple DAFs.
In previous versions of DAFFA, only one search could be
conducted at a time. Therefore, there was no question about
which DAF was being operated on by any of the DAFFA entry
points that don't accept file handles as input arguments.
In the current version of DAFFA, the entry points that don't
accept file handles as inputs operate on the `current DAF'.
The current DAF is the last one in which a search was
started by DAFBFS or DAFBBS, or continued by the new entry
point DAFCS. DAFCS was added to allow users to set the
current DAF, so that searches of multiple DAFs can be
interleaved.
Note that the notion of `current DAF' as discussed here applies
only to DAFs acted upon by entry points of DAFFA. In DAFANA,
there is a DAF that is treated as the `current DAF' for
adding data; there is no connection between the DAFs regarded
as current by DAFFA and DAFANA.
The two principal changes to DAFFA are the addition of the
new entry point DAFCS, and the addition of a data structure
called the `state table'. The state table is a collection of
parallel arrays that maintain information about the state
of each search that is currently in progress. The arrays are
indexed by a singly linked list pool; this mechanism allows
addition and deletion of information about searches without
requiring movement of data already in the state table. The
linked list pool contains an `active' list and a `free' list.
Nodes in the active list are used to index elements of the
state table where data about searches in progress is stored.
The head node of the active list is of particular significance:
the state information pointed to by this node is that of the
current DAF. Nodes in the free list index elements of the
state table that are available for use.
When a search is started on a DAF that is not already `known'
to DAFFA, information about the DAF is added to the state
table. If there are no free elements in the state table,
the routine starting the search (DAFBFS or DAFBBS) will
perform garbage collection: the routine will test the handles
of each file about which information in stored in the state
table to see whether that file is still open. Nodes containing
information about DAFs that are no longer open will be moved
to the free list.
Whenever a DAF becomes the current DAF, the linked list
that indexes the state table is adjusted so that the
information about the current DAF is at the head of the list.
This way, a slight efficiency is gained when repeated search
accesses are made to the same DAF, since the linear search
through the state table for information on that DAF will
be shortened.
Since the algorithms for maintenance of linked lists are well
known, they are not documented here. However, see the
internals of the SPICELIB routine SPKBSR for a nice diagram
describing a similar data structure.
The state table contains two arrays that are quite large:
there are buffers that contain the last character record
and summary record read from each DAF. A parallel situation
exists in DAFANA, where the name and array summary for each
array under construction are buffered. The total storage
required for these arrays (in DAFANA and DAFFA together) is
4000 * TBSIZE bytes. For this reason, it may be a good idea
to reduce the value of TBSIZE in SPICELIB versions for
machines where memory is scarce.
SPICELIB Version 1.0.1, 22-MAR-1990 (HAN)
Literature references added to the header.
SPICELIB Version 1.0.0, 31-JAN-1990 (IMU)
|
Fri Dec 31 18:36:07 2021