Example #1
0
File: sgfrvi.c Project: Dbelsa/coft
/* $Procedure      SGFRVI ( Generic Segments: Fetch ref. value and index ) */
/* Subroutine */ int sgfrvi_(integer *handle, doublereal *descr, doublereal *
	x, doublereal *value, integer *indx, logical *found)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    logical done;
    integer i__, begin;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    logical myfnd;
    extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafgda_(
	    integer *, integer *, integer *, doublereal *);
    extern logical failed_(void);
    doublereal endref;
    integer nfetch;
    doublereal buffer[101];
    integer bfindx, remain;
    extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, 
	    integer *);
    doublereal dpimax;
    integer myrefb;
    extern integer lstled_(doublereal *, integer *, doublereal *);
    doublereal dptemp;
    integer fullrd, rdridx, myrdrb;
    extern integer intmax_(void);
    integer mynref;
    logical isdirv;
    integer myindx;
    extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, 
	    ftnlen);
    integer mynrdr;
    extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
    doublereal myvalu;
    extern logical return_(void);
    extern /* Subroutine */ int sigerr_(char *, ftnlen);
    integer myrdrt, mynpkt, end;

/* $ Abstract */

/*     Given the handle of a DAF and the descriptor associated with */
/*     a generic DAF segment in the file, find the reference value */
/*     associated with the value X and it's index. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     DAF Required Reading. */

/* $ Keywords */

/*     GENERIC SEGMENTS */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     HANDLE     I   The handle of a DAF open for reading. */
/*     DESCR      I   The descriptor for a DAF generic segment. */
/*     X          I   The key value used to find a reference and index. */
/*     VALUE      O   The reference value associated with X. */
/*     INDX       O   The index of VALUE within the reference values. */
/*     FOUND      O   A flag indicating whether values for X were found. */

/* $ Detailed_Input */

/*     HANDLE     is the handle of a DAF open for reading */

/*     DESCR      is the descriptor of the generic segment that we are */
/*                going to search for a reference value to associate with */
/*                X. */

/*     X          a value for which the associated reference value */
/*                and reference index is requested. */

/* $ Detailed_Output */

/*     VALUE      is the reference value associated with the input value */
/*                X. */

/*     INDX       is the index of VALUE within the set of reference */
/*                values for the generic segment. This value may be used */
/*                to obtain a particular packet of data from the generic */
/*                segment. */

/*     FOUND      is a logical flag indicating whether a reference value */
/*                associated with X was found. If a reference value was */
/*                found, FOUND will have a value of TRUE; otherwise it */
/*                will have a value of FALSE. */

/* $ Parameters */

/*     This subroutine makes use of parameters defined in the file */
/*     'sgparam.inc'. */

/* $ Files */

/*      See the description of HANDLE above. */

/* $ Exceptions */

/*     1) The error SPICE(UNKNOWNREFDIR) will be signalled if */
/*        the reference directory structure is unrecognized.  The most */
/*        likely cause of this error is that an upgrade to your */
/*        version of the SPICE toolkit is needed. */

/*     2) If a value computed for the index of an implicitly indexed */
/*        generic segment is too large to be represented as an integer, */
/*        the error SPICE(INDEXTOOLARGE) will be signalled. */

/* $ Particulars */

/*     This routine allows you to easily find the index and value */
/*     of the reference item that should be associated with a */
/*     value X.  Given this information you can then easily retrieve */
/*     the packet that should be associated with X. */

/* $ Examples */

/*     Suppose that you have a generic segment that contains the */
/*     following items. */

/*         1)  Packets that model the motion of a body as a function */
/*             of time over some interval of time. */

/*         2)  Reference values that are the epochs corresponding */
/*             to the beginning of the intervals for the packets. */

/*     To retrieve the correct packet to use to compute the position */
/*     and velocity of the body at a particular epoch,  ET, you could */
/*     use the following code. (Note this block of code assumes that */
/*     you aren't going to run into any exceptional cases such as ET */
/*     falling outside the range of times for which the packets can */
/*     provide ephemeris data.) */

/*        Find out the index of the time that should be associated */
/*        with the ET we've been given */

/*        CALL SGFRVI ( HANDLE, DESCR, ET,  ETFND, INDX, FOUND ) */

/*        Fetch the INDX'th ephemeris packet from the segment. */

/*        CALL SGFPKT ( HANDLE, DESCR, INDX, EPHEM ) */


/* $ Restrictions */

/*     The segment described by DESCR MUST be a generic segment, */
/*     otherwise the results of this routine are not predictable. */

/* $ Author_and_Institution */

/*      K.R. Gehringer  (JPL) */
/*      W.L. Taber      (JPL) */

/* $ Literature_References */

/*      None. */

/* $ Version */

/* -    SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */

/*        Replaced DAFRDA call with DAFGDA. */

/* -    SPICELIB Version 1.1.0, 08-MAY-1996 (WLT) */

/*        A bug was found in the EXPCLS index case when the */
/*        trying to retrieve the last value in a generic segment. */
/*        This bug was discovered by the HP compiler complaining */
/*        that an index used was not initialized. */

/*        The offending line was */

/*                 MYVALU = BUFFER(I) */

/*        The corrected line is: */

/*                 MYVALU = BUFFER(BFINDX) */

/* -    SPICELIB Version 1.0.0, 28-Mar-1994 (KRG) (WLT) */

/* -& */
/* $ Index_Entries */

/*     find the index of a reference value in a generic segment */

/* -& */

/*     Spicelib Functions */


/*     Local Parameters */

/*     Include the mnemonic values for the generic segment declarations. */


/* $ Abstract */

/*     Parameter declarations for the generic segments subroutines. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*      DAF Required Reading */

/* $ Keywords */

/*       GENERIC SEGMENTS */

/* $ Particulars */

/*     This include file contains the parameters used by the generic */
/*     segments subroutines, SGxxxx. A generic segment is a */
/*     generalization of a DAF array which places a particular structure */
/*     on the data contained in the array, as described below. */

/*     This file defines the mnemonics that are used for the index types */
/*     allowed in generic segments as well as mnemonics for the meta data */
/*     items which are used to describe 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. */

/* $ Restrictions */

/*     1) If new reference index types are added, the new type(s) should */
/*        be defined to be the consecutive integer(s) after the last */
/*        defined reference index type used. In this way a value for */
/*        the maximum allowed index type may be maintained. This value */
/*        must also be updated if new reference index types are added. */

/*     2) If new meta data items are needed, mnemonics for them must be */
/*        added to the end of the current list of mnemonics and before */
/*        the NMETA mnemonic. In this way compatibility with files having */
/*        a different, but smaller, number of meta data items may be */
/*        maintained. See the description and example below. */

/* $ Author_and_Institution */

/*     N.J. Bachman      (JPL) */
/*     K.R. Gehringer    (JPL) */
/*     W.L. Taber        (JPL) */
/*     F.S. Turner       (JPL) */

/* $ Literature_References */

/*     Generic Segments Required Reading. */
/*     DAF Required Reading. */

/* $ Version */

/* -    SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */

/*        Header update: equations for comptutations of packet indices */
/*        for the cases of index types 0 and 1 were corrected. */

/* -    SPICELIB Version 1.1.0, 25-09-98 (FST) */

/*        Added parameter MNMETA, the minimum number of meta data items */
/*        that must be present in a generic DAF segment. */

/* -    SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */

/* -& */

/*     Mnemonics for the type of reference value index. */

/*     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. */


/*     Reference Index Type 0 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /    VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | -------------------- | */
/*                          \        REF(2)        / */

/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */


/*     Reference Index Type 1 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /          VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | 0.5 + -------------------- | */
/*                          \              REF(2)        / */


/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */

/*     We get the larger index in the event that VALUE is halfway between */
/*     X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */


/*     Reference Index Type 2 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is strictly less than VALUE. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 3 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is less than or equal to VALUE. The reference values must be */
/*     in ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 4 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the reference item */
/*     that is closest to the value of VALUE. In the event of a "tie" */
/*     the larger index is selected. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     These parameters define the valid range for the index types. An */
/*     index type code, MYTYPE, for a generic segment must satisfy the */
/*     relation MNIDXT <= MYTYPE <= MXIDXT. */


/*     The following meta data items will appear in all generic segments. */
/*     Other meta data items may be added if a need arises. */

/*       1)  CONBAS  Base Address of the constants in a generic segment. */

/*       2)  NCON    Number of constants in a generic segment. */

/*       3)  RDRBAS  Base Address of the reference directory for a */
/*                   generic segment. */

/*       4)  NRDR    Number of items in the reference directory of a */
/*                   generic segment. */

/*       5)  RDRTYP  Type of the reference directory 0, 1, 2 ... for a */
/*                   generic segment. */

/*       6)  REFBAS  Base Address of the reference items for a generic */
/*                   segment. */

/*       7)  NREF    Number of reference items in a generic segment. */

/*       8)  PDRBAS  Base Address of the Packet Directory for a generic */
/*                   segment. */

/*       9)  NPDR    Number of items in the Packet Directory of a generic */
/*                   segment. */

/*      10)  PDRTYP  Type of the packet directory 0, 1, ... for a generic */
/*                   segment. */

/*      11)  PKTBAS  Base Address of the Packets for a generic segment. */

/*      12)  NPKT    Number of Packets in a generic segment. */

/*      13)  RSVBAS  Base Address of the Reserved Area in a generic */
/*                   segment. */

/*      14)  NRSV    Number of items in the reserved area of a generic */
/*                   segment. */

/*      15)  PKTSZ   Size of the packets for a segment with fixed width */
/*                   data packets or the size of the largest packet for a */
/*                   segment with variable width data packets. */

/*      16)  PKTOFF  Offset of the packet data from the start of a packet */
/*                   record. Each data packet is placed into a packet */
/*                   record which may have some bookkeeping information */
/*                   prepended to the data for use by the generic */
/*                   segments software. */

/*      17)  NMETA   Number of meta data items in a generic segment. */

/*     Meta Data Item  1 */
/*     ----------------- */


/*     Meta Data Item  2 */
/*     ----------------- */


/*     Meta Data Item  3 */
/*     ----------------- */


/*     Meta Data Item  4 */
/*     ----------------- */


/*     Meta Data Item  5 */
/*     ----------------- */


/*     Meta Data Item  6 */
/*     ----------------- */


/*     Meta Data Item  7 */
/*     ----------------- */


/*     Meta Data Item  8 */
/*     ----------------- */


/*     Meta Data Item  9 */
/*     ----------------- */


/*     Meta Data Item 10 */
/*     ----------------- */


/*     Meta Data Item 11 */
/*     ----------------- */


/*     Meta Data Item 12 */
/*     ----------------- */


/*     Meta Data Item 13 */
/*     ----------------- */


/*     Meta Data Item 14 */
/*     ----------------- */


/*     Meta Data Item 15 */
/*     ----------------- */


/*     Meta Data Item 16 */
/*     ----------------- */


/*     If new meta data items are to be added to this list, they should */
/*     be added above this comment block as described below. */

/*        INTEGER               NEW1 */
/*        PARAMETER           ( NEW1   = PKTOFF + 1 ) */

/*        INTEGER               NEW2 */
/*        PARAMETER           ( NEW2   = NEW1   + 1 ) */

/*        INTEGER               NEWEST */
/*        PARAMETER           ( NEWEST = NEW2   + 1 ) */

/*     and then the value of NMETA must be changed as well to be: */

/*        INTEGER               NMETA */
/*        PARAMETER           ( NMETA  = NEWEST + 1 ) */

/*     Meta Data Item 17 */
/*     ----------------- */


/*     Maximum number of meta data items. This is always set equal to */
/*     NMETA. */


/*     Minimum number of meta data items that must be present in a DAF */
/*     generic segment.  This number is to remain fixed even if more */
/*     meta data items are added for compatibility with old DAF files. */


/*     Local Variables */


/*     Saved Variables */


/*     Initial Values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    }
    chkin_("SGFRVI", (ftnlen)6);

/*     Set the value for the maximum index as a double precision number, */
/*     but only do it the first time into the subroutine. */

    if (first) {
	first = FALSE_;
	dpimax = (doublereal) intmax_();
    }

/*     Collect the necessary meta data values common to all cases. */

    sgmeta_(handle, descr, &c__12, &mynpkt);
    sgmeta_(handle, descr, &c__7, &mynref);
    sgmeta_(handle, descr, &c__5, &myrdrt);
    sgmeta_(handle, descr, &c__6, &myrefb);
    if (failed_()) {
	chkout_("SGFRVI", (ftnlen)6);
	return 0;
    }

/*     Check to be sure that we know how to deal with the type of index */
/*     in the segment. The index type should be between the minimum */
/*     allowed index type, MNIDXT, and the maximum allowed index type, */
/*     MXIDXT, as specified in the file 'sgparam.inc'. */

    if (myrdrt < 0 || myrdrt > 4) {
	setmsg_("The generic DAF segment you attempted to read has an unsupp"
		"orted reference directory structure. The integer code given "
		"for this structure is #, and allowed codes are within the ra"
		"nge # to #. The likely cause of this anamoly is your version"
		" of SPICELIB needs updating. Contact your system administrat"
		"or or NAIF for a toolkit update.", (ftnlen)331);
	errint_("#", &myrdrt, (ftnlen)1);
	errint_("#", &c__0, (ftnlen)1);
	errint_("#", &c__4, (ftnlen)1);
	sigerr_("SPICE(UNKNOWNREFDIR)", (ftnlen)20);
	chkout_("SGFRVI", (ftnlen)6);
	return 0;
    }

/*     We don't have an index yet and we initialize things to zero. */

    myfnd = FALSE_;
    myindx = 0;
    myvalu = 0.;

/*     We pass the idiot checks, so lets proceed. We have a IF block for */
/*     each allowed reference directory type code. */

/*        For implicitly indexed data packets, the interval */

/*           [ BUFFER(1), BUFFER(1) + (N - 1) * BUFFER(2) ) */

/*        is divided into subintervals as follows: */

/*           (-infinity, r1), [r_1,r_2) [r_2, r_3), ..., [r_i, r_(i+1)), */
/*            ..., [r_N, +infinity), */

/*        where N = the number of packets in the segment, MYNPKT, and */
/*        r_i = BUFFER(1) + (i-1) * BUFFER(2). */

/*        If X is in [r_i, r_(i+1)), i = 1, N-1, then we found a value */
/*        and the index returned will be i with the reference value */
/*        returned will be r_i. */

/*        If X is in [r_N, +infinity), then we found a value and the */
/*        index returned will be N and the reference value returned will */
/*        be r_N. */

/*        If X is in (-infinity, r1), we have two possibilities: */

/*           1) If the index type is implicit closest, we found a value, */
/*              the index returned will be 1 and the reference value */
/*              returned will be r_1. */

/*           2) If the index type is implicit less than or equal, we do */
/*              not find a value. */

/*        For explicitly indexed packets we simply search the reference */
/*        directory for an appropriate reference value. */

    if (myrdrt != 0 && myrdrt != 1) {

/*        In addition to the meta data items we already have, we also */
/*        need these. */

	sgmeta_(handle, descr, &c__4, &mynrdr);
	sgmeta_(handle, descr, &c__3, &myrdrb);
	if (failed_()) {
	    chkout_("SGFRVI", (ftnlen)6);
	    return 0;
	}

/*        We need to scan the reference directory (if there is one) to */
/*        determine the appropriate block of reference values to read */
/*        from the generic segment. Then we compute the number of */
/*        reference values to fetch and examine. Finally, based on the */
/*        index type we figure out whether we have found a reference */
/*        value or not. It will take a little while to get there, so */
/*        let's get going. */

/*        We have not started yet, so we're not done and we cannot have a */
/*        reference directory value yet. */

	done = FALSE_;
	isdirv = FALSE_;

/*        We have not read any full buffers of reference directory values */
/*        yet, all of the reference directory values remain to be read, */
/*        and we have no index for a reference directory value. */

	fullrd = 0;
	remain = mynrdr;
	rdridx = 0;

/*        Search the reference directory values to select the appropriate */
/*        block of reference values to read. */

	while(! done && remain > 0) {

/*           Read a buffer of reference directory items. */

	    nfetch = min(100,remain);
	    begin = myrdrb + fullrd * 100 + 1;
	    end = begin + nfetch - 1;
	    dafgda_(handle, &begin, &end, buffer);
	    if (failed_()) {
		chkout_("SGFRVI", (ftnlen)6);
		return 0;
	    }

/*           See if X is in the current buffer. */

	    rdridx = lstled_(x, &nfetch, buffer);
	    if (rdridx == 0) {

/*              If not, then X < BUFFER(1) and we're done. This indicates */
/*              that the desired reference value is before, or in, the */
/*              previous block of reference values. */

		done = TRUE_;
	    } else if (rdridx == nfetch) {

/*              If we get the last value of the buffer, then either we */
/*              are done, X = BUFFER(NFETCH), or X > BUFFER(NFETCH). */

		if (*x == buffer[(i__1 = nfetch - 1) < 101 && 0 <= i__1 ? 
			i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)417)]
			) {

/*                 If X = BUFFER(NFETCH) we are done, we have a directory */
/*                 value, and it might be a value we want to return. */

		    done = TRUE_;
		    isdirv = TRUE_;
		} else {

/*                 Otherwise, we might have more stuff to read, so update */
/*                 the remainder and the current number of full buffer */
/*                 reads and try the loop again. */

		    remain -= nfetch;
		    if (remain > 0) {

/*                    We don't want to increment FULLRD for a partial */
/*                    buffer read. The arithmetic for the index */
/*                    calculations below will use RDRIDX to deal with */
/*                    this. */

			++fullrd;
		    }
		}
	    } else {

/*              BUFFER(1) <= X < BUFFER(NFETCH), i.e., we have something */
/*              in the buffer. Check to see if X = BUFFER(RDRIDX). If so, */
/*              we are done, we have a directory value, and it might be a */
/*              value we want to return. Otherwise, we are just done. */

		done = TRUE_;
		if (*x == buffer[(i__1 = rdridx - 1) < 101 && 0 <= i__1 ? 
			i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)455)]
			) {
		    isdirv = TRUE_;
		}
	    }
	}
	rdridx = fullrd * 100 + rdridx;

/*        There are three cases that we need to consider when X is not a */
/*        reference directory value: */

/*           Case 1: 0 < RDRIDX < MYNRDR (most common first) */
/*           Case 2: RDRIDX = 0 */
/*           Case 3: RDRIDX = MYNRDR */

	if (! isdirv) {
	    if (rdridx > 0 && rdridx < mynrdr) {

/*              If we were able to bracket X before reaching the end of */
/*              the reference directory, then we KNOW that we have a */
/*              candidate for a reference value in the reference data. */
/*              All we need to do is read the reference data and find it */
/*              in the buffer. We also read the reference directory */
/*              values that bracket the desired reference value into */
/*              BUFFER, so that they are there if we need them. */

/* Computing MIN */
		i__1 = 101, i__2 = mynref - rdridx * 100 + 1;
		nfetch = min(i__1,i__2);
		begin = myrefb + rdridx * 100;
		end = begin + nfetch - 1;
		dafgda_(handle, &begin, &end, buffer);
		if (failed_()) {
		    chkout_("SGFRVI", (ftnlen)6);
		    return 0;
		}
		bfindx = lstled_(x, &nfetch, buffer);
		myindx = rdridx * 100 + bfindx - 1;
	    } else if (rdridx == 0) {

/*              The reference value may be one of the reference values */
/*              less than the first reference directory item. So we */
/*              compute the beginning and ending addresses for the data, */
/*              read it in, and try to find a reference value. */

		nfetch = min(101,mynref);
		begin = myrefb + 1;
		end = begin + nfetch - 1;
		dafgda_(handle, &begin, &end, buffer);
		if (failed_()) {
		    chkout_("SGFRVI", (ftnlen)6);
		    return 0;
		}
		bfindx = lstled_(x, &nfetch, buffer);
		myindx = bfindx;
	    } else if (rdridx == mynrdr) {

/*              If we were not able to bracket X before reaching the end */
/*              of the reference directory, then we might have a */
/*              candidate for a reference value in the reference data */
/*              after the last reference directory value. All we need to */
/*              do is read the reference data and look. */

/*              NOTE: NFETCH can never be zero or negative, so we can */
/*              glibly use it. The reason for this is the NFETCH can only */
/*              be zero if the desired reference value is a reference */
/*              directory value, and we already know that the reference */
/*              value we want is not a reference directory value, because */
/*              we are here. For similar reasons, NFETCH can never be */
/*              negative. */

		begin = myrefb + rdridx * 100;
		end = myrefb + mynref;
		nfetch = end - begin + 1;
		dafgda_(handle, &begin, &end, buffer);
		if (failed_()) {
		    chkout_("SGFRVI", (ftnlen)6);
		    return 0;
		}
		bfindx = lstled_(x, &nfetch, buffer);
		myindx = rdridx * 100 + bfindx - 1;
	    }
	} else {

/*           We have a reference directory value, whose index is easy to */
/*           compute. */

	    myindx = rdridx * 100;
	}

/*        Now, if we have a candidate for a reference value, lets make */
/*        sure, based onthe type of index we have. */

	if (myrdrt == 2) {

/*           We have a reference value only if X > some reference */
/*           value. */

	    if (! isdirv) {

/*              If the value is not a reference directory value, then */
/*              we have two cases: */

/*                 Case 1: 0 < MYINDX <= MYNREF */
/*                 Case 2: MYINDX = 0 */

		if (myindx > 0 && myindx <= mynref) {

/*                 We found a reference value. The reference value we */
/*                 want is either the value indicated by MYINDX or */
/*                 the reference value immediately preceding MYINDX, */
/*                 if there is such a value. To deal with this we */
/*                 split the test up into two cases. */

		    if (myindx > 1) {

/*                    If X > BUFFER(BFINDX) then we are done, so set the */
/*                    value. If not, then we want the reference value */
/*                    that is immediately before the current one. */

			if (*x > buffer[(i__1 = bfindx - 1) < 101 && 0 <= 
				i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
				, (ftnlen)595)]) {
			    myfnd = TRUE_;
			    myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= 
				    i__1 ? i__1 : s_rnge("buffer", i__1, 
				    "sgfrvi_", (ftnlen)598)];
			} else {
			    myfnd = TRUE_;
			    myvalu = buffer[(i__1 = bfindx - 2) < 101 && 0 <= 
				    i__1 ? i__1 : s_rnge("buffer", i__1, 
				    "sgfrvi_", (ftnlen)603)];
			    --myindx;
			}
		    } else {

/*                    Remember, MYINDX is 1 here. If we are greater */
/*                    than the first reference value in the segment, */
/*                    we are done. Otherwise there is no reference */
/*                    value to be associated with X. */

			if (*x > buffer[(i__1 = myindx - 1) < 101 && 0 <= 
				i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
				, (ftnlen)615)]) {
			    myfnd = TRUE_;
			    myvalu = buffer[(i__1 = myindx - 1) < 101 && 0 <= 
				    i__1 ? i__1 : s_rnge("buffer", i__1, 
				    "sgfrvi_", (ftnlen)618)];
			} else {

/*                       We did not find a reference value. X was */
/*                       equal to the first reference value of the */
/*                       generic segment. */

			    myfnd = FALSE_;
			}
		    }
		} else if (myindx == 0) {

/*                 We did not find a reference value. X was < the */
/*                 first reference value for the generic segment. */

		    myfnd = FALSE_;
		}
	    } else {

/*              We have a reference directory value, and we are done. */
/*              Either the reference directory value is the one we */
/*              want or the reference value immediately preceeding it */
/*              is the one we want. */

		myfnd = TRUE_;
		--myindx;
		begin = myrefb + myindx;
		end = begin;
		dafgda_(handle, &begin, &end, &myvalu);
		if (failed_()) {
		    chkout_("SGFRVI", (ftnlen)6);
		    return 0;
		}
	    }
	} else if (myrdrt == 3) {

/*           We have a reference value only if X >= some reference */
/*           value. At this point, either we have the value and index */
/*           we want or X is before the first reference value of the */
/*           generic segment. We consider two cases, the first when X */
/*           is not a referecne directory value, and the second when */
/*           it is. */

	    if (! isdirv) {

/*              If X is not a directory value, then MYINDX is either */
/*              equal to zero, implying that X is before the first */
/*              reference value in the generic segment, or MYINDX > 0, */
/*              implying that we have found a reference value. */

		if (myindx > 0 && myindx <= mynref) {
		    myfnd = TRUE_;
		    myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ? 
			    i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
			    684)];
		} else if (myindx == 0) {

/*                 We did not find a reference value. X was < the */
/*                 first reference value for the generic segment. */

		    myfnd = FALSE_;
		}
	    } else {

/*              We have a reference directory value, and it is the one */
/*              we want. */

		myfnd = TRUE_;
		myvalu = *x;
	    }
	} else if (myrdrt == 4) {

/*           We have a reference value for every value of X. If X < */
/*           the first reference value of the generic segment, the */
/*           closest value is the first reference value. If X > the */
/*           last reference value of the generic segment, the closest */
/*           value is the last reference value. For X between the */
/*           first and last reference values we simple take the */
/*           closest reference value to X, resolving a tie by */
/*           accepting the larger reference value. */

	    if (! isdirv) {

/*              If X is not a directory value, then MYINDX is either */
/*              equal to zero, implying that X is before the first */
/*              reference value in the generic segment, */
/*              0 < MYINDX < MYNPKT, implying X is between the first */
/*              and last reference values in the generic segment, or */
/*              MYINDX = MYNPKT implying that X is greater than or */
/*              equal to the last reference value. */

		if (myindx > 0 && myindx < mynref) {
		    i__ = bfindx;

/*                 Find the closest value to X, choosing the larger in */
/*                 the event of a tie. */

		    if (buffer[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : 
			    s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)734)] - 
			    *x <= *x - buffer[(i__2 = i__ - 1) < 101 && 0 <= 
			    i__2 ? i__2 : s_rnge("buffer", i__2, "sgfrvi_", (
			    ftnlen)734)]) {
			++i__;
			++myindx;
		    }
		    myfnd = TRUE_;
		    myvalu = buffer[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? 
			    i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
			    742)];
		} else if (myindx == 0) {

/*                 X is before the first reference value for the */
/*                 generic segment, so the closest reference value is */
/*                 the first one. */

		    myfnd = TRUE_;
		    myindx = 1;
		    myvalu = buffer[0];
		} else if (myindx == mynref) {

/*                 X is at of after the last reference value for the */
/*                 generic segment, so the closest reference value is */
/*                 the last reference value, which will be in BUFFER. */

		    myfnd = TRUE_;
		    myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ? 
			    i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
			    762)];
		}
	    } else {

/*              We have a reference directory value, and it is the one */
/*              we want. */

		myfnd = TRUE_;
		myvalu = *x;
	    }
	}
    } else if (myrdrt == 0) {

/*        Get the begin and end addresses from which to read the */
/*        reference values and get the reference values. */

	begin = myrefb + 1;
	end = myrefb + 2;
	dafgda_(handle, &begin, &end, buffer);
	if (failed_()) {
	    chkout_("SGFRVI", (ftnlen)6);
	    return 0;
	}
	endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];

/*        Compute the index if we can. */

	if (*x < buffer[0]) {

/*           If X is less than BUFFER(1), we do not have a reference */
/*           value. */

	    myfnd = FALSE_;
	} else if (*x > endref) {

/*           If X is greater than ENDREF, then we have a reference */
/*           value, ENDREF. */

	    myfnd = TRUE_;
	    myindx = mynpkt;
	    myvalu = endref;
	} else {

/*           r_1 < X < r_N, i.e., we found a value. Compute the index */
/*           and the reference value. */

	    if (mynpkt > 1) {
		myfnd = TRUE_;

/*              Compute the index. */

		dptemp = (*x - buffer[0]) / buffer[1] + 1.;

/*              Test to see if we can safely convert the index to an */
/*              integer. */

		if (dptemp > dpimax) {
		    setmsg_("The computed index is too large to be represent"
			    "ed as an integer. The most likely problem is tha"
			    "t an incorrect value was stored for the step siz"
			    "e. The value found for the step was: #", (ftnlen)
			    181);
		    errdp_("#", &buffer[1], (ftnlen)1);
		    sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
		    chkout_("SGFRVI", (ftnlen)6);
		    return 0;
		}
		myindx = (integer) dptemp;
		myindx = min(myindx,mynpkt);
	    } else {

/*              There is only one packet. */

		myindx = 1;
	    }

/*           Compute the reference value. */

	    myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
	}
    } else if (myrdrt == 1) {

/*        Get the begin and end addresses from which to read the */
/*        reference values and get the reference values. */

	begin = myrefb + 1;
	end = myrefb + 2;
	dafgda_(handle, &begin, &end, buffer);
	if (failed_()) {
	    chkout_("SGFRVI", (ftnlen)6);
	    return 0;
	}
	endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];

/*        Compute the index if we can. */

	if (*x < buffer[0]) {

/*           If X < BUFFER(1), then we found a value, the index */
/*           returned will be 1 and the reference value returned will */
/*           be BUFFER(1). */

	    myfnd = TRUE_;
	    myindx = 1;
	    myvalu = buffer[0];
	} else if (*x > endref) {

/*           If X > ENDREF, then we found a value, the index returned */
/*           will be MYNPKT and the reference value returned will be */
/*           ENDREF. */

	    myfnd = TRUE_;
	    myindx = mynpkt;
	    myvalu = endref;
	} else {

/*           r_1 < X < r_N, i.e., we found a value. Compute the index */
/*           and the reference value. If X is closer to r_I, the index */
/*           returned will be I with a reference value of r_I. If X is */
/*           closer to r_(I+1), the index returned will be I+1 with a */
/*           reference value of r_(I+1). */

	    if (mynpkt > 1) {
		myfnd = TRUE_;

/*              Compute the index. */

		dptemp = (*x - buffer[0]) / buffer[1] + 1.5;
		if (dptemp > dpimax + .5) {
		    setmsg_("The computed index is too large to be represent"
			    "ed as an integer. The most likely problem is tha"
			    "t an incorrect value was stored for the step siz"
			    "e. The value found for the step was: #", (ftnlen)
			    181);
		    errdp_("#", &buffer[1], (ftnlen)1);
		    sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
		    chkout_("SGFRVI", (ftnlen)6);
		    return 0;
		}
		myindx = (integer) dptemp;
	    } else {

/*              There is only one packet. */

		myindx = 1;
	    }

/*           Compute the reference value. */

	    myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
	}
    }

/*     At this point, we have either found a value or not. If so, then we */
/*     need to set the index, value, and found flag for output. */
/*     Otherwise, we simply set the found flag. */

    if (myfnd) {
	*indx = myindx;
	*value = myvalu;
    }
    *found = myfnd;
    chkout_("SGFRVI", (ftnlen)6);
    return 0;
} /* sgfrvi_ */
Example #2
0
/* $Procedure      SPKS10 ( S/P Kernel, subset, type 10 ) */
/* Subroutine */ int spks10_(integer *srchan, doublereal *srcdsc, integer *
	dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    char time[40];
    integer i__;
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
	    char *, ftnlen), dafus_(doublereal *, integer *, integer *, 
	    doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
    doublereal dtemp[2];
    logical found;
    integer itemp[6];
    doublereal myref;
    extern /* Subroutine */ int sgwes_(integer *);
    integer dummy;
    extern logical failed_(void);
    integer begidx;
    doublereal begtim, packet[14];
    integer endidx, nepoch;
    doublereal endtim;
    extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, 
	    integer *, doublereal *), sgbwfs_(integer *, doublereal *, char *,
	     integer *, doublereal *, integer *, integer *, ftnlen), chkout_(
	    char *, ftnlen), sigerr_(char *, ftnlen), sgfrvi_(integer *, 
	    doublereal *, doublereal *, doublereal *, integer *, logical *), 
	    setmsg_(char *, ftnlen), sgmeta_(integer *, doublereal *, integer 
	    *, integer *), sgfpkt_(integer *, doublereal *, integer *, 
	    integer *, doublereal *, integer *), sgfref_(integer *, 
	    doublereal *, integer *, integer *, doublereal *);
    doublereal consts[8];
    extern /* Subroutine */ int sgwfpk_(integer *, integer *, doublereal *, 
	    integer *, doublereal *);
    extern logical return_(void);

/* $ Abstract */

/*     Extract a subset of the data in a type 10 SPK segment into a new */
/*     type 10 segment. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */

/* $ Abstract */

/*     Parameter declarations for the generic segments subroutines. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*      DAF Required Reading */

/* $ Keywords */

/*       GENERIC SEGMENTS */

/* $ Particulars */

/*     This include file contains the parameters used by the generic */
/*     segments subroutines, SGxxxx. A generic segment is a */
/*     generalization of a DAF array which places a particular structure */
/*     on the data contained in the array, as described below. */

/*     This file defines the mnemonics that are used for the index types */
/*     allowed in generic segments as well as mnemonics for the meta data */
/*     items which are used to describe 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. */

/* $ Restrictions */

/*     1) If new reference index types are added, the new type(s) should */
/*        be defined to be the consecutive integer(s) after the last */
/*        defined reference index type used. In this way a value for */
/*        the maximum allowed index type may be maintained. This value */
/*        must also be updated if new reference index types are added. */

/*     2) If new meta data items are needed, mnemonics for them must be */
/*        added to the end of the current list of mnemonics and before */
/*        the NMETA mnemonic. In this way compatibility with files having */
/*        a different, but smaller, number of meta data items may be */
/*        maintained. See the description and example below. */

/* $ Author_and_Institution */

/*     N.J. Bachman      (JPL) */
/*     K.R. Gehringer    (JPL) */
/*     W.L. Taber        (JPL) */
/*     F.S. Turner       (JPL) */

/* $ Literature_References */

/*     Generic Segments Required Reading. */
/*     DAF Required Reading. */

/* $ Version */

/* -    SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */

/*        Header update: equations for comptutations of packet indices */
/*        for the cases of index types 0 and 1 were corrected. */

/* -    SPICELIB Version 1.1.0, 25-09-98 (FST) */

/*        Added parameter MNMETA, the minimum number of meta data items */
/*        that must be present in a generic DAF segment. */

/* -    SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */

/* -& */

/*     Mnemonics for the type of reference value index. */

/*     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. */


/*     Reference Index Type 0 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /    VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | -------------------- | */
/*                          \        REF(2)        / */

/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */


/*     Reference Index Type 1 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /          VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | 0.5 + -------------------- | */
/*                          \              REF(2)        / */


/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */

/*     We get the larger index in the event that VALUE is halfway between */
/*     X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */


/*     Reference Index Type 2 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is strictly less than VALUE. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 3 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is less than or equal to VALUE. The reference values must be */
/*     in ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 4 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the reference item */
/*     that is closest to the value of VALUE. In the event of a "tie" */
/*     the larger index is selected. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     These parameters define the valid range for the index types. An */
/*     index type code, MYTYPE, for a generic segment must satisfy the */
/*     relation MNIDXT <= MYTYPE <= MXIDXT. */


/*     The following meta data items will appear in all generic segments. */
/*     Other meta data items may be added if a need arises. */

/*       1)  CONBAS  Base Address of the constants in a generic segment. */

/*       2)  NCON    Number of constants in a generic segment. */

/*       3)  RDRBAS  Base Address of the reference directory for a */
/*                   generic segment. */

/*       4)  NRDR    Number of items in the reference directory of a */
/*                   generic segment. */

/*       5)  RDRTYP  Type of the reference directory 0, 1, 2 ... for a */
/*                   generic segment. */

/*       6)  REFBAS  Base Address of the reference items for a generic */
/*                   segment. */

/*       7)  NREF    Number of reference items in a generic segment. */

/*       8)  PDRBAS  Base Address of the Packet Directory for a generic */
/*                   segment. */

/*       9)  NPDR    Number of items in the Packet Directory of a generic */
/*                   segment. */

/*      10)  PDRTYP  Type of the packet directory 0, 1, ... for a generic */
/*                   segment. */

/*      11)  PKTBAS  Base Address of the Packets for a generic segment. */

/*      12)  NPKT    Number of Packets in a generic segment. */

/*      13)  RSVBAS  Base Address of the Reserved Area in a generic */
/*                   segment. */

/*      14)  NRSV    Number of items in the reserved area of a generic */
/*                   segment. */

/*      15)  PKTSZ   Size of the packets for a segment with fixed width */
/*                   data packets or the size of the largest packet for a */
/*                   segment with variable width data packets. */

/*      16)  PKTOFF  Offset of the packet data from the start of a packet */
/*                   record. Each data packet is placed into a packet */
/*                   record which may have some bookkeeping information */
/*                   prepended to the data for use by the generic */
/*                   segments software. */

/*      17)  NMETA   Number of meta data items in a generic segment. */

/*     Meta Data Item  1 */
/*     ----------------- */


/*     Meta Data Item  2 */
/*     ----------------- */


/*     Meta Data Item  3 */
/*     ----------------- */


/*     Meta Data Item  4 */
/*     ----------------- */


/*     Meta Data Item  5 */
/*     ----------------- */


/*     Meta Data Item  6 */
/*     ----------------- */


/*     Meta Data Item  7 */
/*     ----------------- */


/*     Meta Data Item  8 */
/*     ----------------- */


/*     Meta Data Item  9 */
/*     ----------------- */


/*     Meta Data Item 10 */
/*     ----------------- */


/*     Meta Data Item 11 */
/*     ----------------- */


/*     Meta Data Item 12 */
/*     ----------------- */


/*     Meta Data Item 13 */
/*     ----------------- */


/*     Meta Data Item 14 */
/*     ----------------- */


/*     Meta Data Item 15 */
/*     ----------------- */


/*     Meta Data Item 16 */
/*     ----------------- */


/*     If new meta data items are to be added to this list, they should */
/*     be added above this comment block as described below. */

/*        INTEGER               NEW1 */
/*        PARAMETER           ( NEW1   = PKTOFF + 1 ) */

/*        INTEGER               NEW2 */
/*        PARAMETER           ( NEW2   = NEW1   + 1 ) */

/*        INTEGER               NEWEST */
/*        PARAMETER           ( NEWEST = NEW2   + 1 ) */

/*     and then the value of NMETA must be changed as well to be: */

/*        INTEGER               NMETA */
/*        PARAMETER           ( NMETA  = NEWEST + 1 ) */

/*     Meta Data Item 17 */
/*     ----------------- */


/*     Maximum number of meta data items. This is always set equal to */
/*     NMETA. */


/*     Minimum number of meta data items that must be present in a DAF */
/*     generic segment.  This number is to remain fixed even if more */
/*     meta data items are added for compatibility with old DAF files. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     SRCHAN     I   Handle of the SPK file with the source segment. */
/*     SRCDSC     I   Descriptor for the source segment. */
/*     DSTHAN     I   Handle of the SPK file for the destination segment. */
/*     DSTDSC     I   Descriptor for the destination segment. */
/*     DSTSID     I   Segment identifier for the new segment. */

/* $ Detailed_Input */

/*     SRCHAN   The handle of the SPK file containing the source segment. */

/*     SRCDSC   The SPK descriptor for the source segment. */

/*     DSTHAN   The handle of the SPK file containing the new segment. */

/*     DSTDSC   The SPK descriptor for the destination segment. It */
/*              contains the desired start and stop times for the */
/*              requested subset. */

/*     DSTSID   The segment identifier for the destination segment. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     None. */

/* $ Files */

/*     See arguments SRCHAN, DSTHAN. */

/* $ Particulars */

/*     This subroutine copies a subset of the data form one SPK segment */
/*     to another. */

/*     The exact structure of a segment of SPK type 10 is detailed in */
/*     the SPK Required Reading. Please see this document for details. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) We assume that the source descriptor actually describes a */
/*        segment in the source SPK file containing the time coverage */
/*        that is desired for the subsetting operation. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     W.L. Taber    (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 30-JUN-1997 (KRG) */

/* -& */
/* $ Index_Entries */

/*     subset type_10 spk segment */

/* -& */

/*     SPICELIB functions */


/*     Local Parameters */


/*     DAF ND and NI values for SPK files. */


/*     The number of geophysical constants: */


/*     The number of elements per two-line set: */


/*     Local Variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("SPKS10", (ftnlen)6);
    }

/*     First, unpack the destination segment descriptor and set some */
/*     local variables. */

    dafus_(dstdsc, &c__2, &c__6, dtemp, itemp);
    begtim = dtemp[0];
    endtim = dtemp[1];

/*     Get the constants for the input segment and send them to the */
/*     output segment by beginning a fixed packet size segment. */

    sgfcon_(srchan, srcdsc, &c__1, &c__8, consts);
    sgbwfs_(dsthan, dstdsc, dstsid, &c__8, consts, &c__14, &c__4, dstsid_len);
    if (failed_()) {
	chkout_("SPKS10", (ftnlen)6);
	return 0;
    }

/*     Get the beginning and ending indices for the packets we need for */
/*     the destination segment.  Note we need to get the preceding */
/*     and succeeding packets (if there are any) corresponding to the */
/*     start and end times of the output segments */

    sgfrvi_(srchan, srcdsc, &begtim, &myref, &begidx, &found);
    if (! found) {
	etcal_(&begtim, time, (ftnlen)40);
	setmsg_("An error has occurred while attempting to subset the a type"
		" 10 SPK segment. The error occurred while attempting to loca"
		"te a packet for the epoch #.  There does not appear to be su"
		"ch a packet. ", (ftnlen)192);
	errch_("#", time, (ftnlen)1, (ftnlen)40);
	sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22);
	chkout_("SPKS10", (ftnlen)6);
	return 0;
    }
    if (myref > begtim) {
/* Computing MAX */
	i__1 = 1, i__2 = begidx - 1;
	begidx = max(i__1,i__2);
    }
    sgfrvi_(srchan, srcdsc, &endtim, &myref, &endidx, &found);
    if (! found) {
	etcal_(&endtim, time, (ftnlen)40);
	setmsg_("An error has occurred while attempting to subset the a type"
		" 10 SPK segment. The error occurred while attempting to loca"
		"te a packet for the epoch #.  There does not appear to be su"
		"ch a packet. ", (ftnlen)192);
	errch_("#", time, (ftnlen)1, (ftnlen)40);
	sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22);
	chkout_("SPKS10", (ftnlen)6);
	return 0;
    }

/*     Get the total number of epochs. */

    sgmeta_(srchan, srcdsc, &c__7, &nepoch);
    if (myref < endtim) {
/* Computing MIN */
	i__1 = nepoch, i__2 = endidx + 1;
	endidx = min(i__1,i__2);
    }

/*     Now we get the data one record at a time from the source segment */
/*     and write it out to the destination segment. */

    i__1 = endidx;
    for (i__ = begidx; i__ <= i__1; ++i__) {
	sgfpkt_(srchan, srcdsc, &i__, &i__, packet, &dummy);
	sgfref_(srchan, srcdsc, &i__, &i__, &myref);
	sgwfpk_(dsthan, &c__1, packet, &c__1, &myref);
    }

/*     Now all we need to do is end the segment. */

    sgwes_(dsthan);
    chkout_("SPKS10", (ftnlen)6);
    return 0;
} /* spks10_ */
Example #3
0
File: spkr10.c Project: Dbelsa/coft
/* $Procedure SPKR10 ( SPK, read record from SPK type 10 segment ) */
/* Subroutine */ int spkr10_(integer *handle, doublereal *descr, doublereal *
	et, doublereal *record)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer ends[2], indx, from, i__;
    extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *, 
	    integer *, doublereal *);
    static logical found;
    static doublereal value;
    static integer to, nepoch, getelm;
    extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *, 
	    integer *, doublereal *), sgmeta_(integer *, doublereal *, 
	    integer *, integer *), chkout_(char *, ftnlen), sgfpkt_(integer *,
	     doublereal *, integer *, integer *, doublereal *, integer *), 
	    sgfrvi_(integer *, doublereal *, doublereal *, doublereal *, 
	    integer *, logical *);
    static integer putelm;
    extern logical return_(void);
    static integer set1, set2;

/* $ Abstract */

/*     Read a single SPK data record from a segment of type 10 */
/*     (NORAD two line element sets). */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */

/* $ Abstract */

/*     Parameter declarations for the generic segments subroutines. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*      DAF Required Reading */

/* $ Keywords */

/*       GENERIC SEGMENTS */

/* $ Particulars */

/*     This include file contains the parameters used by the generic */
/*     segments subroutines, SGxxxx. A generic segment is a */
/*     generalization of a DAF array which places a particular structure */
/*     on the data contained in the array, as described below. */

/*     This file defines the mnemonics that are used for the index types */
/*     allowed in generic segments as well as mnemonics for the meta data */
/*     items which are used to describe 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. */

/* $ Restrictions */

/*     1) If new reference index types are added, the new type(s) should */
/*        be defined to be the consecutive integer(s) after the last */
/*        defined reference index type used. In this way a value for */
/*        the maximum allowed index type may be maintained. This value */
/*        must also be updated if new reference index types are added. */

/*     2) If new meta data items are needed, mnemonics for them must be */
/*        added to the end of the current list of mnemonics and before */
/*        the NMETA mnemonic. In this way compatibility with files having */
/*        a different, but smaller, number of meta data items may be */
/*        maintained. See the description and example below. */

/* $ Author_and_Institution */

/*     N.J. Bachman      (JPL) */
/*     K.R. Gehringer    (JPL) */
/*     W.L. Taber        (JPL) */
/*     F.S. Turner       (JPL) */

/* $ Literature_References */

/*     Generic Segments Required Reading. */
/*     DAF Required Reading. */

/* $ Version */

/* -    SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */

/*        Header update: equations for comptutations of packet indices */
/*        for the cases of index types 0 and 1 were corrected. */

/* -    SPICELIB Version 1.1.0, 25-09-98 (FST) */

/*        Added parameter MNMETA, the minimum number of meta data items */
/*        that must be present in a generic DAF segment. */

/* -    SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */

/* -& */

/*     Mnemonics for the type of reference value index. */

/*     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. */


/*     Reference Index Type 0 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /    VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | -------------------- | */
/*                          \        REF(2)        / */

/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */


/*     Reference Index Type 1 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /          VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | 0.5 + -------------------- | */
/*                          \              REF(2)        / */


/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */

/*     We get the larger index in the event that VALUE is halfway between */
/*     X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */


/*     Reference Index Type 2 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is strictly less than VALUE. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 3 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is less than or equal to VALUE. The reference values must be */
/*     in ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 4 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the reference item */
/*     that is closest to the value of VALUE. In the event of a "tie" */
/*     the larger index is selected. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     These parameters define the valid range for the index types. An */
/*     index type code, MYTYPE, for a generic segment must satisfy the */
/*     relation MNIDXT <= MYTYPE <= MXIDXT. */


/*     The following meta data items will appear in all generic segments. */
/*     Other meta data items may be added if a need arises. */

/*       1)  CONBAS  Base Address of the constants in a generic segment. */

/*       2)  NCON    Number of constants in a generic segment. */

/*       3)  RDRBAS  Base Address of the reference directory for a */
/*                   generic segment. */

/*       4)  NRDR    Number of items in the reference directory of a */
/*                   generic segment. */

/*       5)  RDRTYP  Type of the reference directory 0, 1, 2 ... for a */
/*                   generic segment. */

/*       6)  REFBAS  Base Address of the reference items for a generic */
/*                   segment. */

/*       7)  NREF    Number of reference items in a generic segment. */

/*       8)  PDRBAS  Base Address of the Packet Directory for a generic */
/*                   segment. */

/*       9)  NPDR    Number of items in the Packet Directory of a generic */
/*                   segment. */

/*      10)  PDRTYP  Type of the packet directory 0, 1, ... for a generic */
/*                   segment. */

/*      11)  PKTBAS  Base Address of the Packets for a generic segment. */

/*      12)  NPKT    Number of Packets in a generic segment. */

/*      13)  RSVBAS  Base Address of the Reserved Area in a generic */
/*                   segment. */

/*      14)  NRSV    Number of items in the reserved area of a generic */
/*                   segment. */

/*      15)  PKTSZ   Size of the packets for a segment with fixed width */
/*                   data packets or the size of the largest packet for a */
/*                   segment with variable width data packets. */

/*      16)  PKTOFF  Offset of the packet data from the start of a packet */
/*                   record. Each data packet is placed into a packet */
/*                   record which may have some bookkeeping information */
/*                   prepended to the data for use by the generic */
/*                   segments software. */

/*      17)  NMETA   Number of meta data items in a generic segment. */

/*     Meta Data Item  1 */
/*     ----------------- */


/*     Meta Data Item  2 */
/*     ----------------- */


/*     Meta Data Item  3 */
/*     ----------------- */


/*     Meta Data Item  4 */
/*     ----------------- */


/*     Meta Data Item  5 */
/*     ----------------- */


/*     Meta Data Item  6 */
/*     ----------------- */


/*     Meta Data Item  7 */
/*     ----------------- */


/*     Meta Data Item  8 */
/*     ----------------- */


/*     Meta Data Item  9 */
/*     ----------------- */


/*     Meta Data Item 10 */
/*     ----------------- */


/*     Meta Data Item 11 */
/*     ----------------- */


/*     Meta Data Item 12 */
/*     ----------------- */


/*     Meta Data Item 13 */
/*     ----------------- */


/*     Meta Data Item 14 */
/*     ----------------- */


/*     Meta Data Item 15 */
/*     ----------------- */


/*     Meta Data Item 16 */
/*     ----------------- */


/*     If new meta data items are to be added to this list, they should */
/*     be added above this comment block as described below. */

/*        INTEGER               NEW1 */
/*        PARAMETER           ( NEW1   = PKTOFF + 1 ) */

/*        INTEGER               NEW2 */
/*        PARAMETER           ( NEW2   = NEW1   + 1 ) */

/*        INTEGER               NEWEST */
/*        PARAMETER           ( NEWEST = NEW2   + 1 ) */

/*     and then the value of NMETA must be changed as well to be: */

/*        INTEGER               NMETA */
/*        PARAMETER           ( NMETA  = NEWEST + 1 ) */

/*     Meta Data Item 17 */
/*     ----------------- */


/*     Maximum number of meta data items. This is always set equal to */
/*     NMETA. */


/*     Minimum number of meta data items that must be present in a DAF */
/*     generic segment.  This number is to remain fixed even if more */
/*     meta data items are added for compatibility with old DAF files. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     HANDLE     I   File handle. */
/*     DESCR      I   Segment descriptor. */
/*     ET         I   Target epoch. */
/*     RECORD     O   Data record. */

/* $ Detailed_Input */

/*     HANDLE, */
/*     DESCR       are the file handle and segment descriptor for */
/*                 a SPK segment of type 10. */

/*     ET          is a target epoch, for which a data record from */
/*                 a specific segment is required. */

/* $ Detailed_Output */

/*     RECORD      is the record from the specified segment which, */
/*                 when evaluated at epoch ET, will give the state */
/*                 (position and velocity) of some body, relative */
/*                 to some center, in some inertial reference frame. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) It is assumed that the descriptor and handle supplied are */
/*        for a properly constructed type 10 segment.  No checks are */
/*        performed to ensure this. */

/*     2) All errors are diagnosed by routines in the call tree */
/*        of this routine. */

/* $ Files */

/*     See argument HANDLE. */

/* $ Particulars */

/*     See the SPK Required Reading file for a description of the */
/*     structure of a data type 10 segment. */

/* $ Examples */

/*     The data returned by the SPKRnn routine is in its rawest form, */
/*     taken directly from the segment.  As such, it will be meaningless */
/*     to a user unless he/she understands the structure of the data type */
/*     completely.  Given that understanding, however, the SPKRxx */
/*     routines might be used to "dump" and check segment data for a */
/*     particular epoch. */


/*     C */
/*     C     Get a segment applicable to a specified body and epoch. */
/*     C */
/*           CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */

/*     C */
/*     C     Look at parts of the descriptor. */
/*     C */
/*           CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/*           CENTER = ICD( 2 ) */
/*           REF    = ICD( 3 ) */
/*           TYPE   = ICD( 4 ) */

/*           IF ( TYPE .EQ. 1 ) THEN */
/*              CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */
/*                  . */
/*                  .  Look at the RECORD data. */
/*                  . */
/*           END IF */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/*     User's Guide" */

/* $ Author_and_Institution */

/*     W.L. Taber  (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.1.0, 09-MAR-2009 (EDW) */

/*        Remove declaration of unused varaible DOINT. */

/* -    SPICELIB Version 1.0.0, 05-JAN-1994 (WLT) */

/* -& */
/* $ Index_Entries */

/*     read record from type_10 spk segment */

/* -& */

/*     SPICELIB functions */


/*     Local variables */


/*     We have 2 nutation/obliquity terms and their rates giving us */
/*     four angle components for each packet. */


/*     BEGEL1 is the location in the record where the first */
/*     two-line element set will begin. */


/*     BEGEL2 is the location in the record where the second */
/*     two-line element set will begin. */


/*     ENSET1 and ENSET2 are the locations in the record where the */
/*     last element of set 1 and set 2 will be located. */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    }
    chkin_("SPKR10", (ftnlen)6);

/*     Fetch the constants and store them in the first part of */
/*     the output RECORD. */

    sgfcon_(handle, descr, &c__1, &c__8, record);

/*     Locate the time in the file closest to the input ET. */

    sgfrvi_(handle, descr, et, &value, &indx, &found);

/*     Determine which pair of element sets to choose so that */
/*     they will bracket ET. */

    if (*et <= value) {
/* Computing MAX */
	i__1 = indx - 1;
	from = max(i__1,1);
	to = indx;
    } else {
	sgmeta_(handle, descr, &c__7, &nepoch);
	from = indx;
/* Computing MIN */
	i__1 = indx + 1;
	to = min(i__1,nepoch);
    }

/*     Fetch the element sets */

    sgfpkt_(handle, descr, &from, &to, &record[8], ends);

/*     If the size of the packets is not 14, this is an old style */
/*     two-line element set without nutation information.  We simply */
/*     set all of the angles to zero. */

    if (ends[0] == 10) {

/*        First shift the elements to their proper locations in RECORD */
/*        so there will be room to fill in the zeros. */

	putelm = 32;
	getelm = 28;
	while(getelm > 18) {
	    record[putelm - 1] = record[getelm - 1];
	    --putelm;
	    --getelm;
	}
	set1 = 19;
	set2 = 33;
	for (i__ = 1; i__ <= 4; ++i__) {
	    record[set1 - 1] = 0.;
	    record[set2 - 1] = 0.;
	    ++set1;
	    ++set2;
	}
    }

/*     If we only got one element set, ET  was either before the */
/*     first one in the segment or after the last one in the */
/*     segment.  We simply copy the one fetched a second time so */
/*     that the record is properly constructed. */

    if (from == to) {
	moved_(&record[8], &c__14, &record[22]);
    }
    chkout_("SPKR10", (ftnlen)6);
    return 0;
} /* spkr10_ */
Example #4
0
/* $Procedure      SGFPKT ( Generic Segment: Fetch data packets ) */
/* Subroutine */ int sgfpkt_(integer *handle, doublereal *descr, integer *
	first, integer *last, doublereal *values, integer *ends)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer size, b, e, i__;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal dtemp[2];
    integer begin1, begin2;
    extern /* Subroutine */ int dafgda_(integer *, integer *, integer *, 
	    doublereal *);
    extern logical failed_(void);
    extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *, 
	    integer *), sigerr_(char *, ftnlen);
    integer mypdrb;
    extern /* Subroutine */ int chkout_(char *, ftnlen);
    integer soffst;
    extern /* Subroutine */ int setmsg_(char *, ftnlen);
    integer mypktb, voffst;
    extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
    integer mynpdr;
    extern logical return_(void);
    integer mypdrt, mynpkt, mypkto, mypksz;

/* $ Abstract */

/*     Given the descriptor for a generic segment in a DAF file */
/*     associated with HANDLE, fetch the data packets indexed from FIRST */
/*     to LAST from the packet partition of the generic segment. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*      DAF Required Reading */

/* $ Keywords */

/*      GENERIC SEGMENTS */

/* $ Declarations */
/* $ Brief_I/O */

/*      VARIABLE  I/O  DESCRIPTION */
/*      --------  ---  -------------------------------------------------- */
/*      HANDLE     I   The file handle attached to an open DAF. */
/*      DESCR      I   The descriptor associated with a generic segment. */
/*      FIRST      I   The index of the first data packet to fetch. */
/*      LAST       I   The index of the last data packet to fetch. */
/*      VALUES     O   The data packets that have been fetched. */
/*      ENDS       O   An array of pointers to the ends of the packets. */

/* $ Detailed_Input */

/*      HANDLE     is the handle of a DAF opened for reading that */
/*                 contains the segment described by DESCR. */

/*      DESCR      is the descriptor of the segment with the desired */
/*                 constant values. This must be the descriptor for a */
/*                 generic segment in the DAF associated with HANDLE. */

/*      FIRST      is the index of the first value to fetch from the */
/*                 constants section of the DAF segment described */
/*                 by DESCR. */

/*      LAST       is the index of the last value to fetch from the */
/*                 constants section of the DAF segment described */
/*                 by DESCR */

/* $ Detailed_Output */

/*     VALUES      is the array of values constructed by concatenating */
/*                 requested packets one after the other into */
/*                 an array.  Pictorially we can represent VALUES */
/*                 as: */

/*                    +--------------------------+ */
/*                    | first requested packet   | */
/*                    +--------------------------+ */
/*                    | second requested packet  | */
/*                    +--------------------------+ */
/*                               . */
/*                               . */
/*                               . */
/*                    +--------------------------+ */
/*                    | first requested packet   | */
/*                    +--------------------------+ */

/*     ENDS        is an array of pointers to the ends of the */
/*                 fetched packets.  ENDS(1) gives the index */
/*                 of the last item of the first packet fetched. */
/*                 ENDS(2) gives the index of the last item of */
/*                 the second packet fetched, etc. */

/* $ Parameters */

/*     This subroutine makes use of parameters defined in the file */
/*     'sgparam.inc'. */

/* $ Files */

/*      See the description of HANDLE above. */

/* $ Exceptions */

/*     1) The error SPICE(REQUESTOUTOFBOUNDS) will be signalled */
/*        if FIRST is less than 1 or LAST is greater than the */
/*        number of packets. */

/*     2) The error SPICE(REQUESTOUTOFORDER) will be signalled */
/*        if LAST is less than FIRST. */

/*     3) The error SPICE(UNKNOWNPACKETDIR) will be signalled if */
/*        the packet directory structure is unrecognized.  The most */
/*        likely cause of this error is that an upgrade to your */
/*        version of the SPICE toolkit is needed. */

/* $ Particulars */

/*     This routine fetches requested packets from a generic */
/*     DAF segment.  The two arrays returned have the following */
/*     relationship to one another.  The first packet returned */
/*     resides in VALUES between indexes 1 and ENDS(1).  If a */
/*     second packet is returned it resides in VALUES between */
/*     indices ENDS(1)+1 and ENDS(2).  This relations ship is */
/*     repeated so that if I is greater than 1 and at least I */
/*     packets were returned then the I'th packet resides in */
/*     VALUES between index ENDS(I-1) + 1 and ENDS(I). */

/* $ Examples */

/*     Suppose that you have located a generic DAF segment (as */
/*     identified by the contents of a segment descriptor).  The */
/*     fragment of code below shows how you could fetch packets */
/*     3 through 7 (assuming that many packets are present). */
/*     from the segment. */

/*        Declarations: */

/*        DOUBLE PRECISION   MYPKSZ (<enough room to hold all packets>) */

/*        INTEGER               ENDS  ( 5 ) */
/*        INTEGER               MYNPKT */

/*        get the number of packets */

/*        CALL SGMETA ( HANDLE, DESCR, NPKT, MYNPKT ) */

/*        finally, fetch the packets from the segment. */

/*        IF ( 7 .LE. MYNPKT ) THEN */
/*           CALL SGFPKT ( HANDLE, DESCR, 3, 7,  MYPKSZ, ENDS ) */
/*        END IF */

/* $ Restrictions */

/*      The segment described by DESCR must be a generic segment, */
/*      otherwise the results of this routine are not predictable. */

/* $ Author_and_Institution */

/*     K.R. Gehringer  (JPL) */
/*     W.L. Taber      (JPL) */

/* $ Literature_References */

/*      None. */

/* $ Version */

/* -    SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */

/*        Replaced DAFRDA calls with DAFGDA. */

/* -    SPICELIB Version 1.1.0, 30-JUL-1996 (KRG) (NJB) */

/*        Found and fixed a bug in the calculation of the beginning */
/*        address for variable length packet fetching. The base address */
/*        for the packet directory was not added into the value. This */
/*        bug went unnoticed because of a bug in SGSEQW, entry SGWES, */
/*        that put absolute addresses into the packet directory rather */
/*        than addresses that were relative to the start of the DAF */
/*        array. The bug in SGSEQW has also been fixed. */

/* -    SPICELIB Version 1.0.0, 06-JAN-1994 (KRG) (WLT) */

/* -& */
/* $ Index_Entries */

/*     fetch packets from a generic segment */

/* -& */

/*     Spicelib Functions */


/*     Local Parameters */

/*     Include the mnemonic values. */


/*     Local Variables */


/* $ Abstract */

/*     Parameter declarations for the generic segments subroutines. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*      DAF Required Reading */

/* $ Keywords */

/*       GENERIC SEGMENTS */

/* $ Particulars */

/*     This include file contains the parameters used by the generic */
/*     segments subroutines, SGxxxx. A generic segment is a */
/*     generalization of a DAF array which places a particular structure */
/*     on the data contained in the array, as described below. */

/*     This file defines the mnemonics that are used for the index types */
/*     allowed in generic segments as well as mnemonics for the meta data */
/*     items which are used to describe 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. */

/* $ Restrictions */

/*     1) If new reference index types are added, the new type(s) should */
/*        be defined to be the consecutive integer(s) after the last */
/*        defined reference index type used. In this way a value for */
/*        the maximum allowed index type may be maintained. This value */
/*        must also be updated if new reference index types are added. */

/*     2) If new meta data items are needed, mnemonics for them must be */
/*        added to the end of the current list of mnemonics and before */
/*        the NMETA mnemonic. In this way compatibility with files having */
/*        a different, but smaller, number of meta data items may be */
/*        maintained. See the description and example below. */

/* $ Author_and_Institution */

/*     N.J. Bachman      (JPL) */
/*     K.R. Gehringer    (JPL) */
/*     W.L. Taber        (JPL) */
/*     F.S. Turner       (JPL) */

/* $ Literature_References */

/*     Generic Segments Required Reading. */
/*     DAF Required Reading. */

/* $ Version */

/* -    SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */

/*        Header update: equations for comptutations of packet indices */
/*        for the cases of index types 0 and 1 were corrected. */

/* -    SPICELIB Version 1.1.0, 25-09-98 (FST) */

/*        Added parameter MNMETA, the minimum number of meta data items */
/*        that must be present in a generic DAF segment. */

/* -    SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */

/* -& */

/*     Mnemonics for the type of reference value index. */

/*     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. */


/*     Reference Index Type 0 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /    VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | -------------------- | */
/*                          \        REF(2)        / */

/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */


/*     Reference Index Type 1 */
/*     ---------------------- */

/*     Implied index. The index and reference value of a data packet */
/*     associated with a specified key value are computed from the two */
/*     generic segment reference values using the formula below. The two */
/*     generic segment reference values, REF(1) and REF(2), represent, */
/*     respectively, a starting value and a step size between reference */
/*     values. The index of the data packet associated with a key value */
/*     of VALUE is given by: */

/*                          /          VALUE - REF(1)    \ */
/*        INDEX = 1  +  INT | 0.5 + -------------------- | */
/*                          \              REF(2)        / */


/*     and the reference value associated with VALUE is given by: */

/*        REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */

/*     We get the larger index in the event that VALUE is halfway between */
/*     X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */


/*     Reference Index Type 2 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is strictly less than VALUE. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 3 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the last reference item */
/*     that is less than or equal to VALUE. The reference values must be */
/*     in ascending order, REF(I) < REF(I+1). */


/*     Reference Index Type 4 */
/*     ---------------------- */

/*     Explicit index. In this case the number of packets must equal the */
/*     number of reference values. The index of the packet associated */
/*     with a key value of VALUE is the index of the reference item */
/*     that is closest to the value of VALUE. In the event of a "tie" */
/*     the larger index is selected. The reference values must be in */
/*     ascending order, REF(I) < REF(I+1). */


/*     These parameters define the valid range for the index types. An */
/*     index type code, MYTYPE, for a generic segment must satisfy the */
/*     relation MNIDXT <= MYTYPE <= MXIDXT. */


/*     The following meta data items will appear in all generic segments. */
/*     Other meta data items may be added if a need arises. */

/*       1)  CONBAS  Base Address of the constants in a generic segment. */

/*       2)  NCON    Number of constants in a generic segment. */

/*       3)  RDRBAS  Base Address of the reference directory for a */
/*                   generic segment. */

/*       4)  NRDR    Number of items in the reference directory of a */
/*                   generic segment. */

/*       5)  RDRTYP  Type of the reference directory 0, 1, 2 ... for a */
/*                   generic segment. */

/*       6)  REFBAS  Base Address of the reference items for a generic */
/*                   segment. */

/*       7)  NREF    Number of reference items in a generic segment. */

/*       8)  PDRBAS  Base Address of the Packet Directory for a generic */
/*                   segment. */

/*       9)  NPDR    Number of items in the Packet Directory of a generic */
/*                   segment. */

/*      10)  PDRTYP  Type of the packet directory 0, 1, ... for a generic */
/*                   segment. */

/*      11)  PKTBAS  Base Address of the Packets for a generic segment. */

/*      12)  NPKT    Number of Packets in a generic segment. */

/*      13)  RSVBAS  Base Address of the Reserved Area in a generic */
/*                   segment. */

/*      14)  NRSV    Number of items in the reserved area of a generic */
/*                   segment. */

/*      15)  PKTSZ   Size of the packets for a segment with fixed width */
/*                   data packets or the size of the largest packet for a */
/*                   segment with variable width data packets. */

/*      16)  PKTOFF  Offset of the packet data from the start of a packet */
/*                   record. Each data packet is placed into a packet */
/*                   record which may have some bookkeeping information */
/*                   prepended to the data for use by the generic */
/*                   segments software. */

/*      17)  NMETA   Number of meta data items in a generic segment. */

/*     Meta Data Item  1 */
/*     ----------------- */


/*     Meta Data Item  2 */
/*     ----------------- */


/*     Meta Data Item  3 */
/*     ----------------- */


/*     Meta Data Item  4 */
/*     ----------------- */


/*     Meta Data Item  5 */
/*     ----------------- */


/*     Meta Data Item  6 */
/*     ----------------- */


/*     Meta Data Item  7 */
/*     ----------------- */


/*     Meta Data Item  8 */
/*     ----------------- */


/*     Meta Data Item  9 */
/*     ----------------- */


/*     Meta Data Item 10 */
/*     ----------------- */


/*     Meta Data Item 11 */
/*     ----------------- */


/*     Meta Data Item 12 */
/*     ----------------- */


/*     Meta Data Item 13 */
/*     ----------------- */


/*     Meta Data Item 14 */
/*     ----------------- */


/*     Meta Data Item 15 */
/*     ----------------- */


/*     Meta Data Item 16 */
/*     ----------------- */


/*     If new meta data items are to be added to this list, they should */
/*     be added above this comment block as described below. */

/*        INTEGER               NEW1 */
/*        PARAMETER           ( NEW1   = PKTOFF + 1 ) */

/*        INTEGER               NEW2 */
/*        PARAMETER           ( NEW2   = NEW1   + 1 ) */

/*        INTEGER               NEWEST */
/*        PARAMETER           ( NEWEST = NEW2   + 1 ) */

/*     and then the value of NMETA must be changed as well to be: */

/*        INTEGER               NMETA */
/*        PARAMETER           ( NMETA  = NEWEST + 1 ) */

/*     Meta Data Item 17 */
/*     ----------------- */


/*     Maximum number of meta data items. This is always set equal to */
/*     NMETA. */


/*     Minimum number of meta data items that must be present in a DAF */
/*     generic segment.  This number is to remain fixed even if more */
/*     meta data items are added for compatibility with old DAF files. */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    }
    chkin_("SGFPKT", (ftnlen)6);

/*     Perform the needed initialization */

    sgmeta_(handle, descr, &c__12, &mynpkt);
    sgmeta_(handle, descr, &c__10, &mypdrt);
    sgmeta_(handle, descr, &c__16, &mypkto);
    sgmeta_(handle, descr, &c__15, &mypksz);
    sgmeta_(handle, descr, &c__11, &mypktb);
    if (failed_()) {
	chkout_("SGFPKT", (ftnlen)6);
	return 0;
    }

/*     Perform checks on the inputs for reasonableness. */

    if (*first < 1 || *last > mynpkt) {
	setmsg_("The range of packets requested extends beyond the available"
		" packet data.  The packet data is available for indexes 1 to"
		" #.  You've requested data from # to #. ", (ftnlen)159);
	errint_("#", &mynpkt, (ftnlen)1);
	errint_("#", first, (ftnlen)1);
	errint_("#", last, (ftnlen)1);
	sigerr_("SPICE(REQUESTOUTOFBOUNDS)", (ftnlen)25);
	chkout_("SGFPKT", (ftnlen)6);
	return 0;
    }
    if (*last < *first) {
	setmsg_("The last packet requested, #, is before the first packet re"
		"quested, #. ", (ftnlen)71);
	errint_("#", last, (ftnlen)1);
	errint_("#", first, (ftnlen)1);
	sigerr_("SPICE(REQUESTOUTOFORDER)", (ftnlen)24);
	chkout_("SGFPKT", (ftnlen)6);
	return 0;
    }

/*     We've passed the sanity tests, if the packet directory structure */
/*     is recognized fetch the values and ends. We assume that we are */
/*     reading data from a correctly constructed generic segment, so we */
/*     do not need to worry about the type of reference index, as this is */
/*     not needed to fetch a data packet. */
/*     Currently, only two packet directory types are supported, and this */
/*     subroutine is the only place that this is documented. The types */
/*     have values zero (0) and one (1) for, respectively, fixed size */
/*     packets and variable size packets. */

    if (mypdrt == 0) {

/*        All packets have the same size MYPKSZ so the address of the */
/*        start of the first packet and end of the last packet are easily */
/*        computed. */

	if (mypkto == 0) {

/*           Compute tha addresses for the packet data in the generic */
/*           segment. */

	    b = mypktb + (*first - 1) * mypksz + 1;
	    e = mypktb + *last * mypksz;

/*           Get the packet data all in one shot since we know it's */
/*           contiguous. */

	    dafgda_(handle, &b, &e, values);
	} else {

/*           Compute the addresses for the packet data in the generic */
/*           segment. Remember that we need to account for an offset */
/*           here to get to the start of the actual data packet. */

	    size = mypksz + mypkto;

/*           Get the packet data. Because there is an offset from the */
/*           address to the start of the packet data, we need to get */
/*           the data one packet at a time rather than all at once. */

	    i__1 = *last;
	    for (i__ = *first; i__ <= i__1; ++i__) {
		soffst = (i__ - 1) * size + 1;
		voffst = (i__ - *first) * mypksz + 1;
		b = mypktb + soffst + mypkto;
		e = mypktb + soffst + mypksz;
		dafgda_(handle, &b, &e, &values[voffst - 1]);
		if (failed_()) {
		    chkout_("SGFPKT", (ftnlen)6);
		    return 0;
		}
	    }
	}

/*        Compute the ends for each of the data packets. This is the */
/*        same for both of the cases above because we have fixed size */
/*        data packets. */

	i__1 = *last - *first + 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    ends[i__ - 1] = i__ * mypksz;
	}
    } else {

/*        In addition to the other meta data items already retrieved, we */
/*        will also need a few others. */

	sgmeta_(handle, descr, &c__8, &mypdrb);
	sgmeta_(handle, descr, &c__9, &mynpdr);
	if (failed_()) {
	    chkout_("SGFPKT", (ftnlen)6);
	    return 0;
	}

/*        Each packet has a different size, so we need to fetch each one */
/*        individually, keeping track of the ends and things. We assume */
/*        that there is enough room in the array of values to hold all of */
/*        the packets. For the variable packet case, however, we do not */
/*        need to treat the implicit indexing and explicit indexing cases */
/*        separately. */

	voffst = 1;
	i__1 = *last - *first + 1;
	for (i__ = 1; i__ <= i__1; ++i__) {

/*           Compute the addresses in the generic segment for the */
/*           beginning of data packets I and I+1. We need these to */
/*           compute the size of the packet. */

	    b = mypdrb + *first + i__ - 1;
	    e = b + 1;

/*           Get the beginning addresses for the two data packets and */
/*           convert them into integers. */

	    dafgda_(handle, &b, &e, dtemp);
	    if (failed_()) {
		chkout_("SGFPKT", (ftnlen)6);
		return 0;
	    }
	    begin1 = (integer) dtemp[0];
	    begin2 = (integer) dtemp[1];

/*           Compute the size of data packet I, remembering to deal with */
/*           the packet offset that might be present, and the beginning */
/*           and ending addresses for the packet data. */

	    size = begin2 - begin1 - mypkto;
	    b = mypktb + begin1;
	    e = b + size - 1;

/*           Get the data for packet I. */

	    dafgda_(handle, &b, &e, &values[voffst - 1]);
	    if (failed_()) {
		chkout_("SGFPKT", (ftnlen)6);
		return 0;
	    }

/*           Compute the end for packet I and store it. */

	    voffst += size;
	    ends[i__ - 1] = voffst - 1;
	}
    }
    chkout_("SGFPKT", (ftnlen)6);
    return 0;
} /* sgfpkt_ */
Example #5
0
/* $Procedure      CKNR04 ( C-kernel, number of records, data type 4 ) */
/* Subroutine */ int cknr04_(integer *handle, doublereal *descr, integer *
	nrec)
{
    extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *, 
	    integer *, integer *, doublereal *, integer *), sgmeta_(integer *,
	     doublereal *, integer *, integer *), sigerr_(char *, ftnlen), 
	    chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, 
	    integer *, ftnlen);
    extern logical return_(void);
    doublereal dcd[2];
    integer icd[6];

/* $ Abstract */

/*     Given the handle of a CK file and the descriptor of a type 4 */
/*     segment in that file, return the number of pointing instances */
/*     in that segment. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     CK */
/*     DAF */

/* $ Keywords */

/*     POINTING */

/* $ Declarations */
/* $ Abstract */

/*     Declarations of the CK data type specific and general CK low */
/*     level routine parameters. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     CK.REQ */

/* $ Keywords */

/*     CK */

/* $ Restrictions */

/*     1) If new CK types are added, the size of the record passed */
/*        between CKRxx and CKExx must be registered as separate */
/*        parameter. If this size will be greater than current value */
/*        of the CKMRSZ parameter (which specifies the maximum record */
/*        size for the record buffer used inside CKPFS) then it should */
/*        be assigned to CKMRSZ as a new value. */

/* $ Author_and_Institution */

/*     N.J. Bachman      (JPL) */
/*     B.V. Semenov      (JPL) */

/* $ Literature_References */

/*     CK Required Reading. */

/* $ Version */

/* -    SPICELIB Version 3.0.0, 27-JAN-2014 (NJB) */

/*        Updated to support CK type 6. Maximum degree for */
/*        type 5 was updated to be consistent with the */
/*        maximum degree for type 6. */

/* -    SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */

/*        Updated to support CK type 5. */

/* -    SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */

/* -& */

/*     Number of quaternion components and number of quaternion and */
/*     angular rate components together. */


/*     CK Type 1 parameters: */

/*     CK1DTP   CK data type 1 ID; */

/*     CK1RSZ   maximum size of a record passed between CKR01 */
/*              and CKE01. */


/*     CK Type 2 parameters: */

/*     CK2DTP   CK data type 2 ID; */

/*     CK2RSZ   maximum size of a record passed between CKR02 */
/*              and CKE02. */


/*     CK Type 3 parameters: */

/*     CK3DTP   CK data type 3 ID; */

/*     CK3RSZ   maximum size of a record passed between CKR03 */
/*              and CKE03. */


/*     CK Type 4 parameters: */

/*     CK4DTP   CK data type 4 ID; */

/*     CK4PCD   parameter defining integer to DP packing schema that */
/*              is applied when seven number integer array containing */
/*              polynomial degrees for quaternion and angular rate */
/*              components packed into a single DP number stored in */
/*              actual CK records in a file; the value of must not be */
/*              changed or compatibility with existing type 4 CK files */
/*              will be lost. */

/*     CK4MXD   maximum Chebychev polynomial degree allowed in type 4 */
/*              records; the value of this parameter must never exceed */
/*              value of the CK4PCD; */

/*     CK4SFT   number of additional DPs, which are not polynomial */
/*              coefficients, located at the beginning of a type 4 */
/*              CK record that passed between routines CKR04 and CKE04; */

/*     CK4RSZ   maximum size of type 4 CK record passed between CKR04 */
/*              and CKE04; CK4RSZ is computed as follows: */

/*                 CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */


/*     CK Type 5 parameters: */


/*     CK5DTP   CK data type 5 ID; */

/*     CK5MXD   maximum polynomial degree allowed in type 5 */
/*              records. */

/*     CK5MET   number of additional DPs, which are not polynomial */
/*              coefficients, located at the beginning of a type 5 */
/*              CK record that passed between routines CKR05 and CKE05; */

/*     CK5MXP   maximum packet size for any subtype.  Subtype 2 */
/*              has the greatest packet size, since these packets */
/*              contain a quaternion, its derivative, an angular */
/*              velocity vector, and its derivative.  See ck05.inc */
/*              for a description of the subtypes. */

/*     CK5RSZ   maximum size of type 5 CK record passed between CKR05 */
/*              and CKE05; CK5RSZ is computed as follows: */

/*                 CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */


/*     CK Type 6 parameters: */


/*     CK6DTP   CK data type 6 ID; */

/*     CK6MXD   maximum polynomial degree allowed in type 6 */
/*              records. */

/*     CK6MET   number of additional DPs, which are not polynomial */
/*              coefficients, located at the beginning of a type 6 */
/*              CK record that passed between routines CKR06 and CKE06; */

/*     CK6MXP   maximum packet size for any subtype.  Subtype 2 */
/*              has the greatest packet size, since these packets */
/*              contain a quaternion, its derivative, an angular */
/*              velocity vector, and its derivative.  See ck06.inc */
/*              for a description of the subtypes. */

/*     CK6RSZ   maximum size of type 6 CK record passed between CKR06 */
/*              and CKE06; CK6RSZ is computed as follows: */

/*                 CK6RSZ = CK6MET + ( CK6MXD + 1 ) * ( CK6PS3 + 1 ) */

/*              where CK6PS3 is equal to the parameter CK06PS3 defined */
/*              in ck06.inc. Note that the subtype having the largest */
/*              packet size (subtype 2) does not give rise to the */
/*              largest record size, because that type is Hermite and */
/*              requires half the window size used by subtype 3 for a */
/*              given polynomial degree. */


/*     The parameter CK6PS3 must be in sync with C06PS3 defined in */
/*     ck06.inc. */



/*     Maximum record size that can be handled by CKPFS. This value */
/*     must be set to the maximum of all CKxRSZ parameters (currently */
/*     CK5RSZ.) */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     HANDLE     I   The handle of the file containing the segment. */
/*     DESCR      I   The descriptor of the type 4 segment. */
/*     NREC       O   The number of pointing records in the segment. */

/* $ Detailed_Input */

/*     HANDLE     is the handle of the binary CK file containing the */
/*                segment. The file should have been opened for read */
/*                or write access, either by CKLPF, DAFOPR, or DAFOPW. */

/*     DESCR      The packed descriptor of a data type 4 segment. */

/* $ Detailed_Output */

/*     NREC       The number of pointing records in the type 4 */
/*                segment. */

/* $ Parameters */

/*     See 'ckparam.inc'. */

/* $ Exceptions */

/*     1)  If the segment indicated by DESCR is not a type 4 segment, */
/*         the error 'SPICE(CKWRONGDATATYPE)' is signalled. */

/*     2)  If the specified handle does not belong to any DAF file that */
/*         is currently known to be open, an error is diagnosed by a */
/*         routine that this routine calls. */

/*     3)  If DESCR is not a valid descriptor of a segment in the CK */
/*         file specified by HANDLE, the results of this routine are */
/*         unpredictable. */

/* $ Files */

/*     The file specified by HANDLE should be open for read or */
/*     write access. */

/* $ Particulars */

/*     For a complete description of the internal structure of a type 4 */
/*     segment, see the CK required reading. */

/*     This routine returns the number of pointing records contained */
/*     in the specified segment. It is normally used in conjunction */
/*     with CKGR04 which returns the Ith pointing record in the */
/*     segment. */

/* $ Examples */

/*     Suppose that DATA.BC is a CK file that contains segments of */
/*     data type 4. Then the following code fragment extracts the */
/*     data packets contained in the segment. */

/*     C */
/*     C     CK parameters include file. */
/*     C */
/*           INCLUDE               'ckparam.inc' */
/*     C */
/*     C     Declarations. */
/*     C */
/*           DOUBLE PRECISION      DCD    ( 2 ) */
/*           DOUBLE PRECISION      DESCR  ( 5 ) */
/*           DOUBLE PRECISION      PKTDAT ( CK4RSZ ) */

/*           INTEGER               AVFLAG */
/*           INTEGER               HANDLE */
/*           INTEGER               I */
/*           INTEGER               ICD    ( 6 ) */
/*           INTEGER               K */
/*           INTEGER               LASTAD */
/*           INTEGER               NCOEF  ( QAVSIZ ) */
/*           INTEGER               NREC */

/*           LOGICAL               FOUND */
/*     C */
/*     C     First load the file. (The file may also be opened by using */
/*     C     CKLPF.) */
/*     C */
/*           CALL DAFOPR ( 'DATA.BC', HANDLE ) */
/*     C */
/*     C     Begin forward search. Find the first array. */
/*     C */
/*           CALL DAFBFS ( HANDLE ) */
/*           CALL DAFFNA ( FOUND  ) */
/*     C */
/*     C     Get segment descriptor. */
/*     C */
/*           CALL DAFGS ( DESCR ) */
/*     C */
/*     C     Unpack the segment descriptor into its double precision */
/*     C     and integer components. */
/*     C */
/*           CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */

/*           IF ( ICD( 3 ) .EQ. 4 ) THEN */
/*     C */
/*     C        How many records does this segment contain? */
/*     C */
/*              CALL CKNR04 ( HANDLE, DESCR, NREC ) */

/*              DO I = 1, NREC */
/*     C */
/*     C           Get the data records stored in the segment. */
/*     C */
/*                 CALL CKGR04 ( HANDLE, DESCR, I, PKTDAT ) */
/*     C */
/*     C           Print data packet contents. Print coverage interval */
/*     C           midpoint & radii first. */
/*     C */
/*                 WRITE (2,*) PKTDAT (1) */
/*                 WRITE (2,*) PKTDAT (2) */
/*     C */
/*     C           Decode numbers of coefficients. */
/*     C */
/*                 CALL ZZCK4D2I ( PKTDAT(3), QAVSIZ, CK4PCD, NCOEF ) */
/*     C */
/*     C           Print number of coefficients for Q0, Q1, Q2 and Q3. */
/*     C */
/*                 WRITE (2,FMT='(I2,6X,I2)') NCOEF( 1 ), NCOEF( 2 ) */
/*                 WRITE (2,FMT='(I2,6X,I2)') NCOEF( 3 ), NCOEF( 4 ) */
/*     C */
/*     C           Print number coefficients for AV1, AV2 and AV3. */
/*     C */
/*                 WRITE (2,FMT='(I2,6X,I2)') NCOEF( 5 ), NCOEF( 6 ) */
/*                 WRITE (2,FMT='(I2,6X,I2)') NCOEF( 7 ) */
/*     C */
/*     C           Print Cheby coefficients. */
/*     C */
/*                 LASTAD = 0 */

/*                 DO K = 1, QAVSIZ */
/*                    LASTAD = LASTAD + NCOEF( K ) */
/*                 END DO */

/*                 DO K = 4, LASTAD + 4 */
/*                    WRITE (2,*) PKTDAT (K) */
/*                 END DO */

/*              END DO */

/*           END IF */

/* $ Restrictions */

/*     1) The binary CK file containing the segment whose descriptor */
/*        was passed to this routine must be opened for read or write */
/*        access by either CKLPF, DAFOPR, or DAFOPW. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     Y.K. Zaiko     (JPL) */
/*     B.V. Semenov   (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.1, 18-APR-2014 (BVS) */

/*        Minor header edits. */

/* -    SPICELIB Version 1.0.0, 05-MAY-1999 (YKZ) (BVS) */

/* -& */
/* $ Index_Entries */

/*     number of CK type_4 records */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("CKNR04", (ftnlen)6);
    }

/*     Check whether our segment is of the type 4 by unpacking */
/*     descriptor and checking value of its third integer component. */

    dafus_(descr, &c__2, &c__6, dcd, icd);
    if (icd[2] != 4) {
	setmsg_("Data type of the segment should be 4: Passed descriptor sho"
		"ws type = #.", (ftnlen)71);
	errint_("#", &icd[2], (ftnlen)1);
	sigerr_("SPICE(CKWRONGDATATYPE)", (ftnlen)22);
	chkout_("CKNR04", (ftnlen)6);
	return 0;
    }

/*     The number of records (packets) can be obtained by a call to */
/*     SGMETA. This number is a meta item 12 (see sgparam.inc for */
/*     details.) */

    sgmeta_(handle, descr, &c__12, nrec);

/*     All done. */

    chkout_("CKNR04", (ftnlen)6);
    return 0;
} /* cknr04_ */