| sgseqw |
|
Table of contents
Procedure
SGSEQW ( Generic segments: Sequential writer. )
SUBROUTINE SGSEQW ( HANDLE, DESCR, SEGID, NCONST, CONST,
. NPKTS, PKTSIZ, PKTDAT, NREFS, REFDAT,
. IDXTYP )
Abstract
This is the umbrella routine for managing the sequential writing
of generic segments to DAF files. It should never be called
directly, it provides the mechanism whereby data are shared by
its entry points.
Required_Reading
DAF
Keywords
GENERIC SEGMENTS
Declarations
IMPLICIT NONE
INTEGER HANDLE
DOUBLE PRECISION DESCR ( * )
CHARACTER*(*) SEGID
INTEGER NCONST
DOUBLE PRECISION CONST ( * )
INTEGER NPKTS
INTEGER PKTSIZ ( * )
DOUBLE PRECISION PKTDAT ( * )
INTEGER NREFS
DOUBLE PRECISION REFDAT ( * )
INTEGER IDXTYP
Brief_I/O
VARIABLE I/O DESCRIPTION
-------- --- --------------------------------------------------
HANDLE I Handle of a DAF file opened with write access.
DESCR I Descriptor for a generic segment.
SEGID I Identifier for a generic segment.
NCONST I Number of constant values in a generic segment.
CONST I Array of constant values for a generic segment.
NPKTS I Number of data packets to write to a segment.
PKTSIZ I Size of fixed size packets or sizes of variable
size packets.
PKTDAT I Array of packet data.
NREFS I Number of reference values.
REFDAT I Reference data.
IDXTYP I Index type for the reference values.
Detailed_Input
HANDLE is the handle of a DAF file opened with write access.
This is the handle of the file in which a generic segment
will be started, or the handle of a file in which a
generic segment is currently being written.
DESCR is the descriptor for the generic segment that is being
written. This is the packed form of the DAF double
precision and integer summaries which contains ND double
precision numbers and NI integers, respectively.
SEGID is an identifier for the generic segment that is being
written. This is a character string containing at most
NC printing ASCII characters where
/ ND + ( NI + 1 ) \
NC = 8 * | ----------------- |
\ 2 /
SEGID may be blank.
NCONST is the number of constant values to be placed in the
generic segment.
CONST is an array of NCONST constant values for the generic
segment.
NPKTS is the number of data packets to write to a generic
segment.
PKTSIZ is the size of fixed size packets or sizes of variable
size packets.
The size of a packet is the number of double precision
numbers it contains.
When writing a segment with fixed size packets, only
the first element of the array, PKTSIZ(1), is used, and
it should contain the size of the fixed size packets. In
this instance, the calling program need not declare this
variable as an array of one integer; it may be declared
as an integer variable.
When writing a segment with variable size packets,
there must be an element in the array PKTSIZ for each of
the data packets.
PKTDAT is a singly dimensioned array containing the double
precision data for the fixed or variable size data
packets to be added to the generic segment associated
with HANDLE.
For fixed size data packets, PKTDAT will have the
following structure:
Packet # Range of locations for the packet data.
-------- ------------------------------------------
1 PKTDAT(1) to PKTDAT(PS)
2 PKTDAT(PS+1) to PKTDAT(2*PS)
3 PKTDAT(2*PS+1) to PKTDAT(3*PS)
4 PKTDAT(3*PS+1) to PKTDAT(4*PS)
.
.
.
NPKTS PKTDAT((NPKTS-1)*PS+1) to PKTDAT(NPKTS*PS)
where PS = PKTSIZ(1).
For variable size data packets, PKTDAT will have the
following structure:
Packet # Range of locations for the packet data.
-------- ------------------------------------------
1 PKTDAT(1) to PKTDAT(P(1))
2 PKTDAT(P(1)+1) to PKTDAT(P(2))
3 PKTDAT(P(2)+1) to PKTDAT(P(3))
4 PKTDAT(P(3)+1) to PKTDAT(P(4))
.
.
.
NPKTS PKTDAT(P(NPKTS-1)+1) to PKTDAT(P(NPKTS))
I
---
where P(I) = > PKTSIZ(K).
---
K = 1
NREFS is the number of reference values.
For implicitly indexed packets, NREFS must have a value
of two (2).
When writing packets to a generic segment which uses an
implicit index type, the value specified by NREFS is
used only on the first call to SGWFPK or SGWVPK. On all
subsequent calls to these subroutines for a particular
implicitly indexed generic segment, the value of NREFS
is ignored.
For explicitly indexed packets, NREFS must be equal to
NPKTS; there should be a reference value for each data
packet being written to the generic segment.
When writing packets to a segment which uses an explicit
index type, the value specified by NREFS is used on
every call to SGWFPK or SGWVPK and it must always be
equal to NPKTS.
REFDAT is the reference data values.
For implicitly indexed packets, there must be two (2)
values. The values represent a starting value, which
will have an index of 1, and a step size between
reference values, which are used to compute an index and
a reference value associated with a specified key value.
In order to avoid, or at least minimize, numerical
difficulties associated with computing index values for
generic segments with implicit index types, the value of
the step size must be an integer, i.e., DINT(REFDAT(2))
must equal REFDAT(2). In this case, we also recommend
that REFDAT(1) be an integer, although this is not
enforced.
When writing packets to a generic segment which uses an
implicit index type, the values specified by REFDAT are
used only on the first call to SGWFPK or SGWVPK. On all
subsequent calls to these subroutines for a particular
implicitly indexed generic segment REFDAT is ignored.
For explicitly indexed packets, there must be NPKTS
reference values and the values must be in increasing
order:
REFDAT(I) < REFDAT(I+1), I = 1, NPKTS-1
When writing packets to a segment which uses an explicit
index type, the values specified by REFDAT are used on
every call to SGWFPK or SGWVPK. On all calls to these
subroutines after the first, the value of REFDAT(1) must
be strictly greater than than the value of REFDAT(NPKTS)
from the previous call. This preserves the ordering of
the reference values for the entire segment.
IDXTYP is the index type to use for the reference values.
Two forms of indexing are provided:
1) An implicit form of indexing based on using two
values, a starting value, which will have an index
of 1, and a step size between reference values,
which are used to compute an index and a reference
value associated with a specified key value. See
the descriptions of the implicit types below for
the particular formula used in each case.
2) An explicit form of indexing based on a reference
value for each data packet.
See the chapter on Generic segments in the DAF required
or the include file 'sgparam.inc' for more details
about the index types that are available.
Detailed_Output
None.
The data passed to the various entry points of this subroutine are
used to construct a generic segment in one or more DAF files, with
the current file specified by the input argument HANDLE.
Parameters
The entry points in this subroutine make use of parameters defined
in the file 'sgparam.inc'.
Exceptions
1) If this subroutine is called directly rather than through one
of its entry points, the error SPICE(BOGUSENTRY) is signaled.
2) See the individual entry points for descriptions of their
exceptions.
Files
See HANDLE in the $Detailed_Input section above.
Particulars
This is the umbrella routine for managing the sequential writing
of generic segments to DAF files. It should never be called
directly, but provides the mechanism whereby data are shared by
its entry points. The entry points included in this subroutine
are:
SGBWFS ( HANDLE, DESCR, SEGID, NCONST, CONST, PKTSIZ, IDXTYP )
Begin writing a generic segment with fixed size packets.
SGBWVS ( HANDLE, DESCR, SEGID, NCONST, CONST, IDXTYP )
Begin writing a generic segment with variable size packets.
SGWFPK ( HANDLE, NPKTS, PKTDAT, NREFS, REFDAT )
Write fixed size packets to a generic segment started by
calling SGBWFS.
SGWVPK ( HANDLE, NPKTS, PKTSIZ, PKTDAT, NREFS, REFDAT )
Write variable size packets to a generic segment started by
calling SGBWVS.
SGWES ( HANDLE )
End a generic segment.
A DAF generic segment contains several logical data partitions:
1) A partition for constant values to be associated with each
data packet in the segment.
2) A partition for the data packets.
3) A partition for reference values.
4) A partition for a packet directory, if the segment contains
variable sized packets.
5) A partition for a reference value directory.
6) A reserved partition that is not currently used. This
partition is only for the use of the NAIF group at the Jet
Propulsion Laboratory (JPL).
7) A partition for the meta data which describes the locations
and sizes of other partitions as well as providing some
additional descriptive information about the generic
segment.
+============================+
| Constants |
+============================+
| Packet 1 |
|----------------------------|
| Packet 2 |
|----------------------------|
| . |
| . |
| . |
|----------------------------|
| Packet N |
+============================+
| Reference Values |
+============================+
| Packet Directory |
+============================+
| Reference Directory |
+============================+
| Reserved Area |
+============================+
| Segment Meta Data |
+----------------------------+
Only the placement of the meta data at the end of a generic
segment is required. The other data partitions may occur in any
order in the generic segment because the meta data will contain
pointers to their appropriate locations within the generic
segment.
The meta data for a generic segment should only be obtained
through use of the subroutine SGMETA. The meta data should not be
written through any mechanism other than the ending of a generic
segment begun by SGBWFS or SGBWVS using SGWES.
The entry points of this subroutine when used together provide the
following capabilities:
1) The ability to write a generic segment with fixed size data
packets to a DAF.
2) the ability to write a generic segment with variable size
data packets to a DAF.
3) The ability to write generic segments to multiple files.
Only a single generic segment may be written to a particular
file at any time, but several files may each have a generic
segment being written to them at the same time.
Packets may be placed into a generic segment one at a time or N at
at time, depending upon the whim of the programmer, limitations
of the computing equipment (memory), or requirements placed upon
the software that will write a generic segment.
Packets are retrieved from a generic segment by an index which may
be obtained by using the subroutine SGFRVI (generic segments fetch
reference value and index).
Examples
In examples 1 and 3, we make use of the fictitious subroutines
GET_FIX_PKT ( PACKET, REF, DONE )
and
GET_VAR_PKT ( PACKET, SIZE, REF, DONE )
where
DONE is a logical flag indicating whether there is more data
available. DONE = .TRUE. implies there is no more data.
DONE = .FALSE. implies there is more data available.
PACKET is a double precision array of an appropriate size to
hold all of the data returned.
REF is a double precision reference value that will be used
to create an index for the data packets in the segment.
The values of this variable are always increasing, e.g.,
the value of REF on the second call to GET_FIX_PKT or
GET_VAR_PKT will be greater than the value on the first
call to the subroutine.
SIZE is an integer for the size of the variable size data
packet that is returned.
These subroutines return a fixed size data packet and a variable
size data packet, respectively. We make use of these fictitious
subroutines in the examples to avoid adding unnecessary or
distracting complications.
You may think of these subroutines as methods for acquiring data
from a "black-box" process. In the first case, the data is always
returned in fixed size blocks from a black-box that fills a local
buffer with data and always returned the entire buffer when data
is requested, e.g., an instrument that measures the concentrations
of carbon dioxide, sulfur dioxide, ozone, and other constituents
of the air. In the second case, the data is returned in variably
sized blocks from a black-box, e.g., an algorithm which integrates
a function using polynomials of varying degree; different numbers
of coefficients are required for polynomials of differing degrees.
In examples 2 and 4, we make use of the fictitious subroutines
GET_FIX_PKTS ( NPKTS, PKTS, REFS, DONE )
and
GET_VAR_PKTS ( NPKTS, PKTS, SIZES, REFS, DONE )
where
DONE is a logical flag indicating whether there is more data
available. DONE = .TRUE. implies there is no more data.
DONE = .FALSE. implies there is more data available;
NPKTS is the number of data packets returned in the array
PKTS.
PKTS is a double precision array containing NPKTS data
packets, either fixed size or variable size, and is of
an appropriate size to hold all of the data returned.
See the description of PKTDAT above for the exact manner
in which fixed size packets and variable size packets
are stored in an array.
REFS is a double precision array which contains NPKTS
reference values that will be used to create an index
for the data packets in the segment. The values of this
variable are always increasing, e.g., the first value of
REFS on the second call to GET_FIX_PKTS or GET_VAR_PKTS
will be greater than the last value of REFS on the first
call to the subroutine.
SIZES is an array of integers containing the sizes of each of
the variable size data packets that is returned in PKTS.
These subroutines return arrays containing one or more fixed size
data packets and one or more variable size data packets,
respectively. We make use of these fictitious subroutines in the
examples to avoid adding unnecessary or distracting complications.
For each example, we provide a simple code fragment that
demonstrates the use of the entry points to create generic
segments. We assume that all of the relevant variables are defined
at the time that the entry points are invoked. These code
fragments are for illustrative purposes; they do not necessarily
conform to what would be considered good programming practice.
Example 1-A: Adding fixed size packets one at a time.
For this example, we make no assumptions about the reference
values returned by GET_VAR_PKT other than they are increasing.
Having no other information about the reference values, we must
use an explicit indexing method to store the packets.
.
.
.
C
C First we begin a fixed size segment. To do this, we
C need:
C
C HANDLE -- The handle of a DAF opened with write
C access.
C DESCR -- The packed descriptor for the segment that
C we want to create.
C SEGID -- A short character string that provides an
C identifier for the segment.
C NCONST -- The number of constant values to be
C associated with all of the packets in the
C segment.
C CONST -- An array of constant values to be associated
C with all of the packets in a segment.
C PKTSIZ -- The size of the packets that will be stored
C in this segment, i.e., the number of double
C precision numbers necessary to store a
C complete data packet.
C EXPCLS -- The type of indexing scheme that we will use
C for searching the segment to obtain a data
C packet. In this case, we are going to use an
C explicit index, which requires a reference
C value for each data packet, and when
C searching for a data packet we will choose
C the packet with a reference value closest to
C the requested value. See the include file
C 'sgparam.inc' for the value of EXPCLS.
C
CALL SGBWFS ( HANDLE, DESCR, SEGID, NCONST,
. CONST, PKTSIZ, EXPCLS )
C
C We loop until done, obtaining a fixed size packet
C and writing it to the generic segment in the file.
C
DONE = .FALSE.
DO WHILE ( .NOT. DONE )
C
C Get a fixed size packet and a reference value.
C
CALL GET_FIX_PKT ( PACKET, REF, DONE )
C
C Write the packet to the segment, unless we're done.
C
IF ( .NOT. DONE ) THEN
CALL SGWFPK ( HANDLE, 1, PACKET, 1, REF )
END IF
END DO
C
C End the segment and move on to other things.
C
CALL SGWES ( HANDLE )
.
.
.
Example 1-B: Adding fixed size packets with uniformly spaced
reference values.
In the previous example, we made no assumptions about the
reference values other than that they were increasing. We now
will assume that the reference values are also equally spaced
and that we have a priori values for a beginning reference
value, BEGIN_REF, and a step size, STEP_SIZE, that is the
difference between two consecutive reference values. We have
BEGIN_REF <= REF <= BEGIN_REF + (N-1) * STEP_SIZE
where BEGIN_REF equals the first reference value returned by
GET_FIX_PKT and BEGIN_REF + (N-1) * STEP_SIZE equals the last
reference value returned. Under these assumptions we can use an
implicit index for the data packets which will provide a more
space efficient method for putting the data packets into a
generic segment. We repeat the example under these assumptions
using an implicit indexing method. Nothing else has changed.
The index for a data packet in the implicitly indexed generic
segment we create is computed from the formula:
/ VALUE - REFDAT(1) \
INDEX = IDINT | 1.5 + ----------------------- |
\ REFDAT(2) /
where the index for the data packet associated with VALUE is
desired.
The reference value associated with this index is:
REF = REFDAT(1) + REFDAT*(INDEX - 1)
.
.
.
C
C First we begin a fixed size segment. To do this, we
C need:
C
C HANDLE -- The handle of a DAF opened with write
C access.
C DESCR -- The packed descriptor for the segment that
C we want to create.
C SEGID -- A short character string that provides an
C identifier for the segment.
C NCONST -- The number of constant values to be
C associated with all of the packets in the
C segment.
C CONST -- An array of constant values to be associated
C with all of the packets in a segment.
C PKTSIZ -- The size of the packets that will be stored
C in this segment, i.e., the number of double
C precision numbers necessary to store a
C complete data packet.
C IMPCLS -- The type of indexing scheme that we will use
C for searching the segment to obtain a data
C packet. In this case, we are going to use
C an implicit index, which requires beginning
C and ending times which bound all reference
C values, and when searching for a data packet
C we will choose the packet whose index is
C computed by the formula above. See the
C include file 'sgparam.inc' for the value
C of IMPCLS
C
CALL SGBWFS ( HANDLE, DESCR, SEGID, NCONST,
. CONST, PKTSIZ, IMPCLS )
C
C Set the beginning and ending reference values for the
C implicit indexing method.
C
REFS(1) = BEGIN_REF
REFS(2) = STEP_SIZE
C
C Get the first data packet and put it in the generic
C segment. At the same time, we write the bounds used for
C the implicit indexing. We ignore the value of REF since
C the reference values are equally spaced and we are using
C an implicit indexing method. We do not check DONE here
C because we assume that there is at least one data packet.
C
CALL GET_FIX_PKT ( PACKET, REF, DONE )
CALL SGWFPK ( HANDLE, 1, PACKET, 2, REFS )
C
C We loop until done, obtaining a fixed size packet
C and writing it to the generic segment in the file.
C
DO WHILE ( .NOT. DONE )
C
C Get a fixed size packet and a reference value.
C
CALL GET_FIX_PKT ( PACKET, REF, DONE )
C
C Write the packet to the segment, unless we're done.
C Because this segment is implicitly indexed, the last
C two calling arguments are only used in the first call
C to SGWFPK above. they are ignored in all subsequent
C calls, so we may pass "dummy" arguments.
C
IF ( .NOT. DONE ) THEN
CALL SGWFPK ( HANDLE, 1, PACKET, DUM1, DUM2 )
END IF
END DO
C
C End the segment and move on to other things.
C
CALL SGWES ( HANDLE )
.
.
.
Example 2: Adding fixed size packets more efficiently.
It is possible to add more than one fixed size data packet to a
generic segment at one time. Doing this will usually prove to
be a more efficient way of adding the data packets, provided
there is sufficient storage to hold more than one data packet
available. This example demonstrates this capability.
For this example, we make no assumptions about the reference
values returned by GET_FIX_PKTS other than they are increasing.
Having no other information about the reference values, we must
use an explicit indexing method to store the packets.
.
.
.
C
C First we begin a fixed size segment. To do this, we
C need:
C
C HANDLE -- The handle of a DAF opened with write
C access.
C DESCR -- The packed descriptor for the segment that
C we want to create.
C SEGID -- A short character string that provides an
C identifier for the segment.
C NCONST -- The number of constant values to be
C associated with all of the packets in the
C segment.
C CONST -- An array of constant values to be associated
C with all of the packets in a segment.
C PKTSIZ -- The size of the packets that will be stored
C in this segment, i.e., the number of double
C precision numbers necessary to store a
C complete data packet.
C EXPCLS -- The type of indexing scheme that we will use
C for searching the segment to obtain a data
C packet. In this case, we are going to use an
C explicit index, which requires a reference
C value for each data packet, and when
C searching for a data packet we will choose
C the packet with a reference value closest to
C the requested value. See the include file
C 'sgparam.inc' for the value of EXPCLS
C
CALL SGBWFS ( HANDLE, DESCR, SEGID, NCONST,
. CONST, PKTSIZ, EXPCLS )
C
C We loop until done, obtaining a fixed size packet
C and writing it to the generic segment in the file.
C
DONE = .FALSE.
DO WHILE ( .NOT. DONE )
C
C Get a collection of fixed size packet and associated
C array of increasing reference values.
C
CALL GET_FIX_PKTS ( NPKTS, PKTS, REFS, DONE )
C
C Write the packets to the segment if we have any. Since
C we are using an explicit index, the number of
C reference values is the same as the number of data
C packets.
C
IF ( .NOT. DONE ) THEN
CALL SGWFPK ( HANDLE, NPKTS, PKTS, NPKTS, REFS )
END IF
END DO
C
C End the segment and move on to other things.
C
CALL SGWES ( HANDLE )
.
.
.
If we are using an implicit indexing method, multiple data
packets may be added with one call to SGWFPK as in the above
example for an explicit index, with the exception that there
are only two reference values, and they are specified on the
first call to SGWFPK, as in Example 1-B.
Example 3-A: Adding variable size packets one at a time.
For this example, we make no assumptions about the reference
values returned by GET_VAR_PKT other than they are increasing.
Having no other information about the reference values, we must
use an explicit indexing method to store the packets.
.
.
.
C
C First we begin a variable size segment. To do this, we
C need:
C
C HANDLE -- The handle of a DAF opened with write
C access.
C DESCR -- The packed descriptor for the segment that
C we want to create.
C SEGID -- A short character string that provides an
C identifier for the segment.
C NCONST -- The number of constant values to be
C associated with all of the packets in the
C segment.
C CONST -- An array of constant values to be associated
C with all of the packets in a segment.
C EXPCLS -- The type of indexing scheme that we will use
C for searching the segment to obtain a data
C packet. In this case, we are going to use an
C explicit index, which requires a reference
C value for each data packet, and when
C searching for a data packet we will choose
C the packet with a reference value closest to
C the requested value. See the include file
C 'sgparam.inc' for the value of EXPCLS.
C
CALL SGBVFS ( HANDLE, DESCR, SEGID,
. NCONST, CONST, EXPCLS )
C
C We loop until done, obtaining a variable size packet
C and writing it to the generic segment in the file.
C
DONE = .FALSE.
DO WHILE ( .NOT. DONE )
C
C Get a variable size packet and a reference value.
C
CALL GET_VAR_PKT ( PACKET, SIZE, REF, DONE )
C
C Write the packet to the segment, unless we're done.
C
IF ( .NOT. DONE ) THEN
CALL SGWVPK ( HANDLE, 1, SIZE, PACKET, 1, REF )
END IF
END DO
C
C End the segment and move on to other things.
C
CALL SGWES ( HANDLE )
.
.
.
Example 3-B: Adding variable size packets one at a time with
uniformly spaced reference values.
In the previous example, we made no assumptions about the
reference values other than that they were increasing. We now
will assume that the reference values are also equally spaced
and that we have a priori values for a beginning reference
value, BEGIN_REF, and a step size, STEP_SIZE, that is the
difference between two consecutive reference values. We have
BEGIN_REF <= REF <= BEGIN_REF + (N-1) * STEP_SIZE
where BEGIN_REF equals the first reference value returned by
GET_VAR_PKT and BEGIN_REF + (N-1) * STEP_SIZE equals the last
reference value returned. Putting all of this together means
that we can use an implicit index for the data packets which
will provide a more space efficient method for putting the data
packets into a generic segment. We repeat the example under
these assumptions using an implicit indexing method. Nothing
else has changed.
The index for a data packet in the implicitly indexed generic
segment we create is computed from the formula:
/ VALUE - REFDAT(1) \
INDEX = IDINT | 1.5 + ----------------------- |
\ REFDAT(2) /
where the index for the data packet associated with VALUE is
desired.
The reference value associated with this index is:
REF = REFDAT(1) + REFDAT*(INDEX - 1)
.
.
.
C
C First we begin a variable size segment. To do this, we
C need:
C
C HANDLE -- The handle of a DAF opened with write
C access.
C DESCR -- The packed descriptor for the segment that
C we want to create.
C SEGID -- A short character string that provides an
C identifier for the segment.
C NCONST -- The number of constant values to be
C associated with all of the packets in the
C segment.
C CONST -- An array of constant values to be associated
C with all of the packets in a segment.
C IMPCLS -- The type of indexing scheme that we will use
C for searching the segment to obtain a data
C packet. In this case, we are going to use
C an implicit index, which requires beginning
C and ending times which bound all reference
C values, and when searching for a data packet
C we will choose the packet whose index is
C computed by the formula above. See the
C include file 'sgparam.inc' for the value of
C IMPCLS.
C
CALL SGBWVS ( HANDLE, DESCR, SEGID, NCONST,
. CONST, IMPCLS )
C
C Set the beginning and ending reference values for the
C implicit indexing method.
C
REFS(1) = BEGIN_REF
REFS(2) = STEP_SIZE
C
C Get the first data packet and put it in the generic
C segment. At the same time, we write the bounds used for
C the implicit indexing. We ignore the value of REF since
C the reference values are equally spaced and we are using
C an implicit indexing method. We do not check DONE here
C because we assume that there is at least one data packet.
C
CALL GET_VAR_PKT ( PACKET, SIZE, REF, DONE )
CALL SGWVPK ( HANDLE, 1, SIZE, PACKET, 2, REFS )
C
C We loop until done, obtaining a fixed size packet
C and writing it to the generic segment in the file.
C
DO WHILE ( .NOT. DONE )
C
C Get a variable size packet and a unique reference
C value.
C
CALL GET_VAR_PKT ( PACKET, SIZE, REF, DONE )
C
C Write the packet to the segment, unless we're done.
C Because this segment is implicitly indexed, the last
C two calling arguments are only used in the first call
C to SGWFPK above. they are ignored in all subsequent
C calls, so we may pass "dummy" arguments.
C
IF ( .NOT. DONE ) THEN
CALL SGVFPK ( HANDLE, 1, SIZE, PACKET, DUM1, DUM2 )
END IF
END DO
C
C End the segment and move on to other things.
C
CALL SGWES ( HANDLE )
.
.
.
Example 4: Adding variable size packets more efficiently.
It is possible to add more than one variable size data packet
to a generic segment at one time. Doing this will usually prove
to be a more efficient way of adding the data packets, provided
there is sufficient storage to hold more than one data packet
available. This example demonstrates this capability.
For this example, we make no assumptions about the reference
values returned by GET_VAR_PKTS other than they are increasing.
Having no other information about the reference values, we must
use an explicit indexing method to store the packets.
.
.
.
C
C First we begin a variable size segment. To do this, we
C need:
C
C HANDLE -- The handle of a DAF opened with write
C access.
C DESCR -- The packed descriptor for the segment that
C we want to create.
C SEGID -- A short character string that provides an
C identifier for the segment.
C NCONST -- The number of constant values to be
C associated with all of the packets in the
C segment.
C CONST -- An array of constant values to be associated
C with all of the packets in a segment.
C EXPCLS -- The type of indexing scheme that we will use
C for searching the segment to obtain a data
C packet. In this case, we are going to use an
C explicit index, which requires a reference
C value for each data packet, and when
C searching for a data packet we will choose
C the packet with a reference value closest to
C the requested value. See the include file
C sgparam.inc for the value of EXPCLS.
C
CALL SGBWVS ( HANDLE, DESCR, SEGID,
C . NCONST, CONST, EXPCLS )
C
C We loop until done, obtaining a fixed size packet
C and writing it to the generic segment in the file.
C
DONE = .FALSE.
DO WHILE ( .NOT. DONE )
C
C Get a collection of variable size packets and an
C array of increasing reference values.
C
GET_VAR_PKTS ( NPKTS, PKTS, SIZES, REFS, DONE )
C
C Write the packets to the segment if we have any. Since
C we are using an explicit index, the number of
C reference values is the same as the number of data
C packets.
C
IF ( NPKTS .GT. 0 ) THEN
CALL SGWVPK ( HANDLE, NPKTS, SIZES,
. PKTS, NPKTS, REFS )
END IF
END DO
C
C End the segment and move on to other things.
C
CALL SGWES ( HANDLE )
.
.
.
If we are using an implicit indexing method, multiple data
packets may be added with one call to SGWVPK as in the above
example for an explicit index, with the exception that there
are only two reference values, and they are specified on the
first call to SGWVPK, as in Example 3-B.
Example 5: Adding packets to multiple files.
It is possible to write multiple generic segments to different
DAFs at the same time. Only one generic segment may be written
to a particular DAF at any given time, however.
For this example we assume that we have previously opened four
DAF files, having the handles HANDL1, HANDL2, HANDL3, HANDL4.
We will be writing fixed size data packets to the DAFs
associated with handles HANDL2 and HANDL3, with packet sizes of
21 and 53, respectively. We will be writing variable size data
packets to the DAFs associated with handles HANDL1 and HANDL4.
We will be writing individual data packets to the files
associated with handles HANDL2 and HANDL4, and one or more data
packets to the files associated with handles HANDL1 and HANDL3.
On each trip through the loop in the example below, we will add
data to any of the segments whose status flags are not set. We
are done with the loop below when we have finished each of the
segments, as indicated by its status flag.
For this example, we make no assumptions about the reference
values returned by the GET_*_* subroutines other than they are
increasing. Having no other information about the reference
values, we must use an explicit indexing method to store the
packets.
.
.
.
C
C First we begin a generic segment of the appropriate type
C in each of the files. segment. To do this, we need:
C
C HANDL1, HANDL2, HANDL3, HANDL4 --
C
C The handles of a DAFs opened with write access to
C which we wish to add a new generic segment.
C
C DESCR1, DESCR2, DESCR3, DESCR4 --
C
C The packed descriptors for the segments that
C we want to create.
C
C SEGID1, SEGID2, SEGID3, SEGID4 --
C
C A short character string that provides an
C identifier for each of the segments we will be
C creating.
C
C NCON1, NCON2, NCON3, NCON4 --
C
C The number of constant values to be associated with
C all of the packets in each the segments we will be
C creating.
C
C
C CONST1, CONST2, CONST3, CONST4 --
C
C An array of constant values to be associated with
C all of the packets in each of the segments that we
C are creating.
C
C IDXT1, IDXT2, IDXT3, IDXT4 --
C
C The type of indexing scheme that we will use for
C searching each of the segments to obtain a data
C packet. In this example, each of the generic
C segments will use an explicit index, which requires
C a reference value for each data packet. When
C searching for a data packet we will choose the
C packet with a reference value closest to the
C requested value.
C
C IDXT1 = EXPCLS
C IDXT2 = EXPCLS
C IDXT3 = EXPCLS
C IDXT4 = EXPCLS
C
CALL SGBWVS ( HANDL1, DESCR1, SEGID1,
. NCON1, CONST1, IDXT1 )
CALL SGBWFS ( HANDL2, DESCR2, SEGID2, 21,
. NCON2, CONST2, IDXT2 )
CALL SGBWFS ( HANDL3, DESCR3, SEGID3, 53,
. NCON3, CONST3, IDXT3 )
CALL SGBWVS ( HANDL4, DESCR4, SEGID4,
. NCON4, CONST4, IDXT4 )
C
C We loop until done, obtaining data packets and writing
C them to the generic segments in the appropriate DAFs.
C
C We keep track of a status flag, DONE1, DONE2, DONE3,
C DONE4, for each of the segments we are writing. When we
C have finished writing all of the segments, we exit the
C loop.
C
DONE = .FALSE.
DONE1 = .FALSE.
DONE2 = .FALSE.
DONE3 = .FALSE.
DONE4 = .FALSE.
DO WHILE ( .NOT. DONE )
C
C Get data packets and reference values for HANDL1 and
C write them to the generic segment in that file.
C
IF ( .NOT. DONE1 ) THEN
GET_VAR_PKTS ( NPKTS, PKTS, SIZES, REFS, DONE1 )
IF ( NPKTS .GT. 0 ) THEN
CALL SGWVPK ( HANDL1, NPKTS, SIZES,
. PKTS, NPKTS, REFS )
END IF
END IF
C
C Get a data packet and reference value for HANDL2 and
C write it to the generic segment in that file.
C
IF ( .NOT. DONE2 ) THEN
CALL GET_FIX_PKT ( PACKET, REF, DONE2 )
IF ( .NOT. DONE2 ) THEN
CALL SGWFPK ( HANDL2, 1, PACKET, 1, REF )
END IF
END IF
C
C Get data packets and reference values for HANDL3 and
C write them to the generic segment in that file.
C
IF ( .NOT. DONE3 ) THEN
CALL GET_FIX_PKTS ( NPKTS, PKTS, REFS, DONE3 )
IF ( NPKTS .GT. 0 ) THEN
CALL SGWFPK ( HANDL3, NPKTS, PKTS, NPKTS, REFS )
END IF
END IF
C
C Get a data packet and reference value for HANDL4 and
C write it to the generic segment in that file.
C
IF ( .NOT. DONE4 ) THEN
GET_VAR_PKT ( PACKET, SIZE, REF, DONE4 )
IF ( .NOT. DONE4 ) THEN
CALL SGWVPK ( HANDL4, 1, SIZES, PKTS, 1, REFS )
END IF
END IF
C
C Set the DONE flag.
C
DONE = DONE1 .AND. DONE2 .AND. DONE3 .AND. DONE4
END DO
C
C End the segments and move on to other things.
C
CALL SGWES ( HANDL1 )
CALL SGWES ( HANDL2 )
CALL SGWES ( HANDL3 )
CALL SGWES ( HANDL4 )
.
.
.
Restrictions
1) See the individual entry points for any restrictions they may
have.
Literature_References
None.
Author_and_Institution
N.J. Bachman (JPL)
J. Diaz del Rio (ODC Space)
K.R. Gehringer (JPL)
W.L. Taber (JPL)
E.D. Wright (JPL)
Version
SPICELIB Version 1.2.1, 27-OCT-2021 (JDR)
Edited the header to comply with NAIF standard.
SPICELIB Version 1.2.0, 07-SEP-2001 (EDW)
Replaced DAFRDA calls with DAFGDA.
Removed DAFHLU calls; replaced ERRFN calls with ERRHAN.
SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB)
Fixed an annoying little bug in the variable segments code
when ending a segment. Rather than storing an appropriate
offset from the beginning of the segment as the packet
address in the packet directory, the absolute address, the
DAF address, was stored. This bug has been fixed.
See SGWES for the details of the changes.
SPICELIB Version 1.0.0, 03-APR-1995 (KRG) (WLT)
|
Fri Dec 31 18:36:48 2021