/* $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_ */
/* $Procedure CKE03 ( C-kernel, evaluate pointing record, data type 3 ) */
/* Subroutine */ int cke03_(logical *needav, doublereal *record, doublereal *
cmat, doublereal *av, doublereal *clkout)
{
/* System generated locals */
doublereal d__1;
/* Local variables */
doublereal frac, axis[3];
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mtxm_(
doublereal *, doublereal *, doublereal *), mxmt_(doublereal *,
doublereal *, doublereal *);
doublereal cmat1[9] /* was [3][3] */, cmat2[9] /* was [3][3] */, t,
angle, delta[9] /* was [3][3] */;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *), vlcom_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
doublereal q1[4], q2[4], t1, t2;
extern logical failed_(void);
extern /* Subroutine */ int raxisa_(doublereal *, doublereal *,
doublereal *), axisar_(doublereal *, doublereal *, doublereal *),
chkout_(char *, ftnlen);
doublereal av1[3], av2[3];
extern logical return_(void);
extern /* Subroutine */ int q2m_(doublereal *, doublereal *);
doublereal rot[9] /* was [3][3] */;
/* $ Abstract */
/* Evaluate a pointing record returned by CKR03 from a CK type 3 */
/* segment. Return the C-matrix and angular velocity vector associated */
/* with the time CLKOUT. */
/* $ 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 */
/* ROTATION */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* NEEDAV I True if angular velocity is requested. */
/* RECORD I Data type 3 pointing record. */
/* CMAT O C-matrix. */
/* AV O Angular velocity vector. */
/* CLKOUT O SCLK associated with C-matrix. */
/* $ Detailed_Input */
/* NEEDAV is true if angular velocity is requested. */
/* RECORD is a set of double precision numbers returned by CKR03 */
/* that contain sufficient information from a type 3 CK */
/* segment to evaluate the C-matrix and the angular */
/* velocity vector at a particular time. Depending on */
/* the contents of RECORD, this routine will either */
/* interpolate between two pointing instances that */
/* bracket a request time, or it will simply return the */
/* pointing given by a single pointing instance. */
/* When pointing at the request time can be determined */
/* by linearly interpolating between the two pointing */
/* instances that bracket that time, the bracketing */
/* pointing instances are returned in RECORD as follows: */
/* RECORD( 1 ) = Left bracketing SCLK time. */
/* RECORD( 2 ) = lq0 \ */
/* RECORD( 3 ) = lq1 \ Left bracketing */
/* RECORD( 4 ) = lq2 / quaternion. */
/* RECORD( 5 ) = lq3 / */
/* RECORD( 6 ) = lav1 \ Left bracketing */
/* RECORD( 7 ) = lav2 | angular velocity */
/* RECORD( 8 ) = lav3 / ( optional ) */
/* RECORD( 9 ) = Right bracketing SCLK time. */
/* RECORD( 10 ) = rq0 \ */
/* RECORD( 11 ) = rq1 \ Right bracketing */
/* RECORD( 12 ) = rq2 / quaternion. */
/* RECORD( 13 ) = rq3 / */
/* RECORD( 14 ) = rav1 \ Right bracketing */
/* RECORD( 15 ) = rav2 | angular velocity */
/* RECORD( 16 ) = rav3 / ( optional ) */
/* RECORD( 17 ) = pointing request time */
/* The quantities lq0 - lq3 and rq0 - rq3 are the */
/* components of the quaternions that represent the */
/* C-matrices associated with the times that bracket */
/* the requested time. */
/* The quantities lav1, lav2, lav3 and rav1, rav2, rav3 */
/* are the components of the angular velocity vectors at */
/* the respective bracketing times. The components of the */
/* angular velocity vectors are specified relative to the */
/* inertial reference frame of the segment. */
/* When the routine is to simply return the pointing */
/* given by a particular pointing instance, then the */
/* values of that pointing instance are returned in both */
/* parts of RECORD ( i.e. RECORD(1-9) and RECORD(10-16) ). */
/* $ Detailed_Output */
/* CMAT is a rotation matrix that transforms the components */
/* of a vector expressed in the inertial frame given in */
/* the segment to components expressed in the instrument */
/* fixed frame at the returned time. */
/* Thus, if a vector v has components x, y, z in the */
/* inertial frame, then v has components x', y', z' in the */
/* instrument fixed frame where: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* If the x', y', z' components are known, use the */
/* transpose of the C-matrix to determine x, y, z as */
/* follows. */
/* [ x ] [ ]T [ x' ] */
/* | y | = | CMAT | | y' | */
/* [ z ] [ ] [ z' ] */
/* (Transpose of CMAT) */
/* AV is the angular velocity vector of the instrument fixed */
/* frame defined by CMAT. The angular velocity is */
/* returned only if NEEDAV is true. */
/* The direction of the angular velocity vector gives */
/* the right-handed axis about which the instrument fixed */
/* reference frame is rotating. The magnitude of AV is */
/* the magnitude of the instantaneous velocity of the */
/* rotation, in radians per second. */
/* The angular velocity vector is returned in component */
/* form */
/* AV = [ AV1 , AV2 , AV3 ] */
/* which is in terms of the inertial coordinate frame */
/* specified in the segment descriptor. */
/* CLKOUT is the encoded SCLK associated with the returned */
/* C-matrix and angular velocity vector. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) No explicit checking is done to determine whether RECORD is */
/* valid. However, routines in the call tree of this routine */
/* may signal errors if inputs are invalid or otherwise */
/* in appropriate. */
/* $ Files */
/* None. */
/* $ Particulars */
/* If the array RECORD contains pointing instances that bracket the */
/* request time then CKE03 will linearly interpolate between those */
/* two values to obtain pointing at the request time. If the */
/* pointing instances in RECORD are for the same time, then this */
/* routine will simply unpack the record and convert the quaternion */
/* to a C-matrix. */
/* The linear interpolation performed by this routine is defined */
/* as follows: */
/* 1) Let t be the time for which pointing is requested and */
/* let CMAT1 and CMAT2 be C-matrices associated with times */
/* t1 and t2 where: */
/* t1 < t2, and t1 <= t, and t <= t2. */
/* 2) Assume that the spacecraft frame rotates about a fixed */
/* axis at a constant angular rate from time t1 to time t2. */
/* The angle and rotation axis can be obtained from the */
/* rotation matrix ROT12 where: */
/* T T */
/* CMAT2 = ROT12 * CMAT1 */
/* or */
/* T */
/* ROT12 = CMAT2 * CMAT1 */
/* ROT12 ==> ( ANGLE, AXIS ) */
/* 3) To obtain pointing at time t, rotate the spacecraft frame */
/* about the vector AXIS from its orientation at time t1 by the */
/* angle THETA where: */
/* ( t - t1 ) */
/* THETA = ANGLE * ----------- */
/* ( t2 - t1 ) */
/* 4) Thus if ROT1t is the matrix that rotates vectors by the */
/* angle THETA about the vector AXIS, then the output C-matrix */
/* is given by: */
/* T T */
/* CMAT = ROT1t * CMAT1 */
/* T */
/* CMAT = CMAT1 * ROT1t */
/* 5) The angular velocity is treated independently of the */
/* C-matrix. If it is requested, then the AV at time t is */
/* the weighted average of the angular velocity vectors at */
/* the times t1 and t2: */
/* ( t - t1 ) */
/* W = ----------- */
/* ( t2 - t1 ) */
/* AV = ( 1 - W ) * AV1 + W * AV2 */
/* $ Examples */
/* The CKRnn routines are usually used in tandem with the CKEnn */
/* routines, which evaluate the record returned by CKRnn to give */
/* the pointing information and output time. */
/* The following code fragment searches through all of the segments */
/* in a file applicable to the Mars Observer spacecraft bus that */
/* are of data type 3, for a particular spacecraft clock time. */
/* It then evaluates the pointing for that epoch and prints the */
/* result. */
/* CHARACTER*(20) SCLKCH */
/* CHARACTER*(20) SCTIME */
/* CHARACTER*(40) IDENT */
/* INTEGER I */
/* INTEGER SC */
/* INTEGER INST */
/* INTEGER HANDLE */
/* INTEGER DTYPE */
/* INTEGER ICD ( 6 ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOL */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION DESCR ( 5 ) */
/* DOUBLE PRECISION DCD ( 2 ) */
/* DOUBLE PRECISION RECORD ( 17 ) */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION AV ( 3 ) */
/* LOGICAL NEEDAV */
/* LOGICAL FND */
/* LOGICAL SFND */
/* SC = -94 */
/* INST = -94000 */
/* DTYPE = 3 */
/* NEEDAV = .FALSE. */
/* C */
/* C Load the MO SCLK kernel and the C-kernel. */
/* C */
/* CALL FURNSH ( 'MO_SCLK.TSC' ) */
/* CALL DAFOPR ( 'MO_CK.BC', HANDLE ) */
/* C */
/* C Get the spacecraft clock time. Then encode it for use */
/* C in the C-kernel. */
/* C */
/* WRITE (*,*) 'Enter spacecraft clock time string:' */
/* READ (*,FMT='(A)') SCLKCH */
/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */
/* C */
/* C Use a tolerance of 2 seconds ( half of the nominal */
/* C separation between MO pointing instances ). */
/* C */
/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */
/* C */
/* C Search from the beginning of the CK file through all */
/* C of the segments. */
/* C */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( SFND ) */
/* FND = .FALSE. */
/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */
/* C */
/* C Get the segment identifier and descriptor. */
/* C */
/* CALL DAFGN ( IDENT ) */
/* CALL DAFGS ( DESCR ) */
/* C */
/* C Unpack the segment descriptor into its integer and */
/* C double precision components. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* C */
/* C Determine if this segment should be processed. */
/* C */
/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */
/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */
/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */
/* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */
/* CALL CKR03 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FND ) */
/* IF ( FND ) THEN */
/* CALL CKE03 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */
/* CALL SCDECD ( SC, CLKOUT, SCTIME ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Segment identifier: ', IDENT */
/* WRITE (*,*) */
/* WRITE (*,*) 'Pointing returned for time: ', */
/* . SCTIME */
/* WRITE (*,*) */
/* WRITE (*,*) 'C-matrix:' */
/* WRITE (*,*) */
/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */
/* WRITE (*,*) */
/* END IF */
/* END IF */
/* CALL DAFFNA ( SFND ) */
/* END DO */
/* $ Restrictions */
/* 1) No explicit checking is done on the input RECORD. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.M. Lynch (JPL) */
/* F.S. Turner (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 2.0.0, 13-JUN-2002 (FST) */
/* This routine now participates in error handling properly. */
/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */
/* -& */
/* $ Index_Entries */
/* evaluate ck type_3 pointing data record */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 13-JUN-2002 (FST) */
/* Calls to CHKIN and CHKOUT in the standard SPICE error */
/* handling style were added. Versions prior to 2.0.0 */
/* were error free, however changes to RAXISA from error */
/* free to error signaling forced this update. */
/* Additionally, FAILED is now checked after the call to */
/* RAXISA. This prevents garbage from being placed into */
/* the output arguments. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKE03", (ftnlen)5);
}
/* Unpack the record, for easier reading. */
t = record[16];
t1 = record[0];
t2 = record[8];
moved_(&record[1], &c__4, q1);
moved_(&record[5], &c__3, av1);
moved_(&record[9], &c__4, q2);
moved_(&record[13], &c__3, av2);
/* If T1 and T2 are the same then no interpolation or extrapolation */
/* is performed. Simply convert the quaternion to a C-matrix and */
/* return. */
if (t1 == t2) {
q2m_(q1, cmat);
*clkout = t1;
if (*needav) {
vequ_(av1, av);
}
chkout_("CKE03", (ftnlen)5);
return 0;
}
/* Interpolate between the two pointing instances to obtain pointing */
/* at the request time. */
/* Calculate what fraction of the interval the request time */
/* represents. */
frac = (t - t1) / (t2 - t1);
/* Convert the left and right quaternions to C-matrices. */
q2m_(q1, cmat1);
q2m_(q2, cmat2);
/* Find the matrix that rotates the spacecraft instrument frame from */
/* the orientation specified by CMAT1 to that specified by CMAT2. */
/* Then find the axis and angle of that rotation matrix. */
/* T T */
/* CMAT2 = ROT * CMAT1 */
/* T */
/* ROT = CMAT2 * CMAT1 */
mtxm_(cmat2, cmat1, rot);
raxisa_(rot, axis, &angle);
if (failed_()) {
chkout_("CKE03", (ftnlen)5);
return 0;
}
/* Calculate the matrix that rotates vectors about the vector AXIS */
/* by the angle ANGLE * FRAC. */
d__1 = angle * frac;
axisar_(axis, &d__1, delta);
/* The interpolated pointing at the request time is given by CMAT */
/* where: */
/* T T */
/* CMAT = DELTA * CMAT1 */
/* and */
/* T */
/* CMAT = CMAT1 * DELTA */
mxmt_(cmat1, delta, cmat);
/* Set CLKOUT equal to the time that pointing is being returned. */
*clkout = t;
/* If angular velocity is requested then take a weighted average */
/* of the angular velocities at the left and right endpoints. */
if (*needav) {
d__1 = 1. - frac;
vlcom_(&d__1, av1, &frac, av2, av);
}
chkout_("CKE03", (ftnlen)5);
return 0;
} /* cke03_ */
/* $Procedure STELAB ( Stellar Aberration ) */
/* Subroutine */ int stelab_(doublereal *pobj, doublereal *vobs, doublereal *
appobj)
{
/* Builtin functions */
double asin(doublereal);
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
doublereal vbyc[3];
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *);
doublereal h__[3], u[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *), errdp_(char *, doublereal *, ftnlen),
vcrss_(doublereal *, doublereal *, doublereal *);
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
extern doublereal clight_(void);
doublereal onebyc, sinphi;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
doublereal lensqr;
extern logical return_(void);
doublereal phi;
/* $ Abstract */
/* Correct the apparent position of an object for stellar */
/* aberration. */
/* $ 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 */
/* None. */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* POBJ I Position of an object with respect to the */
/* observer. */
/* VOBS I Velocity of the observer with respect to the */
/* Solar System barycenter. */
/* APPOBJ O Apparent position of the object with respect to */
/* the observer, corrected for stellar aberration. */
/* $ Detailed_Input */
/* POBJ is the position (x, y, z, km) of an object with */
/* respect to the observer, possibly corrected for */
/* light time. */
/* VOBS is the velocity (dx/dt, dy/dt, dz/dt, km/sec) */
/* of the observer with respect to the Solar System */
/* barycenter. */
/* $ Detailed_Output */
/* APPOBJ is the apparent position of the object relative */
/* to the observer, corrected for stellar aberration. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the velocity of the observer is greater than or equal */
/* to the speed of light, the error SPICE(VALUEOUTOFRANGE) */
/* is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Let r be the vector from the observer to the object, and v be */
/* - - */
/* the velocity of the observer with respect to the Solar System */
/* barycenter. Let w be the angle between them. The aberration */
/* angle phi is given by */
/* sin(phi) = v sin(w) / c */
/* Let h be the vector given by the cross product */
/* - */
/* h = r X v */
/* - - - */
/* Rotate r by phi radians about h to obtain the apparent position */
/* - - */
/* of the object. */
/* $ Examples */
/* In the following example, STELAB is used to correct the position */
/* of a target body for stellar aberration. */
/* (Previous subroutine calls have loaded the SPK file and */
/* the leapseconds kernel file.) */
/* C */
/* C Get the geometric state of the observer OBS relative to */
/* C the solar system barycenter. */
/* C */
/* CALL SPKSSB ( OBS, ET, 'J2000', SOBS ) */
/* C */
/* C Get the light-time corrected position TPOS of the target */
/* C body TARG as seen by the observer. Normally we would */
/* C call SPKPOS to obtain this vector, but we already have */
/* C the state of the observer relative to the solar system */
/* C barycenter, so we can avoid looking up that state twice */
/* C by calling SPKAPO. */
/* C */
/* CALL SPKAPO ( TARG, ET, 'J2000', SOBS, 'LT', TPOS, LT ) */
/* C */
/* C Apply the correction for stellar aberration to the */
/* C light-time corrected position of the target body. */
/* C The corrected position is returned in the argument */
/* C PCORR. */
/* C */
/* CALL STELAB ( TPOS, SOBS(4), PCORR ) */
/* Note that this example is somewhat contrived. The sequence */
/* of calls above could be replaced by a single call to SPKEZP, */
/* using the aberration correction flag 'LT+S'. */
/* For more information on aberration-corrected states or */
/* positions, see the headers of any of the routines */
/* SPKEZR */
/* SPKEZ */
/* SPKPOS */
/* SPKEZP */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) W.M. Owen, Jr., JPL IOM #314.8-524, "The Treatment of */
/* Aberration in Optical Navigation", 8 February 1985. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 8-JAN-2008 (NJB) */
/* The header example was updated to remove references */
/* to SPKAPP. */
/* - SPICELIB Version 1.1.0, 8-FEB-1999 (WLT) */
/* The example was corrected so that SOBS(4) is passed */
/* into STELAB instead of STARG(4). */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 8-AUG-1990 (HAN) */
/* Examples section of the header was updated to replace */
/* calls to the GEF ephemeris readers by calls to the */
/* new SPK ephemeris reader. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (WLT) */
/* -& */
/* $ Index_Entries */
/* stellar aberration */
/* -& */
/* $ Revisions */
/* - Beta Version 2.1.0, 9-MAR-1989 (HAN) */
/* Declaration of the variable LIGHT was removed from the code. */
/* The variable was declared but never used. */
/* - Beta Version 2.0.0, 28-DEC-1988 (HAN) */
/* Error handling was added to check the velocity of the */
/* observer. If the velocity of the observer is greater */
/* than or equal to the speed of light, the error */
/* SPICE(VALUEOUTOFRANGE) is signalled. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("STELAB", (ftnlen)6);
}
/* We are not going to compute the aberrated vector in exactly the */
/* way described in the particulars section. We can combine some */
/* steps and we take some precautions to prevent floating point */
/* overflows. */
/* Get a unit vector that points in the direction of the object */
/* ( u_obj ). */
vhat_(pobj, u);
/* Get the velocity vector scaled with respect to the speed of light */
/* ( v/c ). */
onebyc = 1. / clight_();
vscl_(&onebyc, vobs, vbyc);
/* If the square of the length of the velocity vector is greater than */
/* or equal to one, the speed of the observer is greater than or */
/* equal to the speed of light. The observer speed is definitely out */
/* of range. Signal an error and check out. */
lensqr = vdot_(vbyc, vbyc);
if (lensqr >= 1.) {
setmsg_("Velocity components of observer were: dx/dt = *, dy/dt = *"
", dz/dt = *.", (ftnlen)71);
errdp_("*", vobs, (ftnlen)1);
errdp_("*", &vobs[1], (ftnlen)1);
errdp_("*", &vobs[2], (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("STELAB", (ftnlen)6);
return 0;
}
/* Compute u_obj x (v/c) */
vcrss_(u, vbyc, h__);
/* If the magnitude of the vector H is zero, the observer is moving */
/* along the line of sight to the object, and no correction is */
/* required. Otherwise, rotate the position of the object by phi */
/* radians about H to obtain the apparent position. */
sinphi = vnorm_(h__);
if (sinphi != 0.) {
phi = asin(sinphi);
vrotv_(pobj, h__, &phi, appobj);
} else {
moved_(pobj, &c__3, appobj);
}
chkout_("STELAB", (ftnlen)6);
return 0;
} /* stelab_ */
/* $Procedure BODMAT ( Return transformation matrix for a body ) */
/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm)
{
/* Initialized data */
static logical first = TRUE_;
static logical found = FALSE_;
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_dnnt(doublereal *);
double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *)
;
/* Local variables */
integer cent;
char item[32];
doublereal j2ref[9] /* was [3][3] */;
extern integer zzbodbry_(integer *);
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
doublereal d__;
integer i__, j;
doublereal dcoef[3], t, w;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
doublereal delta;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal theta;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, errdp_(char *, doublereal *, ftnlen);
doublereal costh[100];
extern doublereal vdotg_(doublereal *, doublereal *, integer *);
char dtype[1];
doublereal sinth[100], tsipm[36] /* was [6][6] */;
extern doublereal twopi_(void);
static integer j2code;
doublereal ac[100], dc[100];
integer na, nd;
doublereal ra, wc[100];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern logical bodfnd_(integer *, char *, ftnlen);
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern doublereal halfpi_(void);
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
integer nw;
doublereal conepc, conref;
extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *,
doublereal *, logical *);
integer ntheta;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char fixfrm[32], errmsg[1840];
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen), errint_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
irfrot_(integer *, integer *, doublereal *);
extern logical return_(void);
char timstr[35];
extern doublereal j2000_(void);
doublereal dec;
integer dim, ref;
doublereal phi;
extern doublereal rpd_(void), spd_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return the J2000 to body Equator and Prime Meridian coordinate */
/* transformation matrix for a specified body. */
/* $ 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 */
/* PCK */
/* NAIF_IDS */
/* TIME */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ 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. */
/* Include File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ 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. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation from Inertial to PM for BODY at ET. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* transformation is requested. Bodies are numbered */
/* according to the standard NAIF numbering scheme. */
/* ET is the epoch at which the transformation is */
/* requested. (This is typically the epoch of */
/* observation minus the one-way light time from */
/* the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is the transformation matrix from Inertial to body */
/* Equator and Prime Meridian. The X axis of the PM */
/* system is directed to the intersection of the */
/* equator and prime meridian. The Z axis points north. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If data required to define the body-fixed frame associated */
/* with BODY are not found in the binary PCK system or the kernel */
/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */
/* the case of IAU style body-fixed frames, the absence of */
/* prime meridian polynomial data (which are required) is used */
/* as an indicator of missing data. */
/* 2) If the test for exception (1) passes, but in fact requested */
/* data are not available in the kernel pool, the error will be */
/* signaled by routines in the call tree of this routine. */
/* 3) If the kernel pool does not contain all of the data required */
/* to define the number of nutation precession angles */
/* corresponding to the available nutation precession */
/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */
/* signaled. */
/* 4) If the reference frame REF is not recognized, a routine */
/* called by BODMAT will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 5) If the specified body code BODY is not recognized, the */
/* error is diagnosed by a routine called by BODMAT. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine is related to the more general routine TIPBOD */
/* which returns a matrix that transforms vectors from a */
/* specified inertial reference frame to body equator and */
/* prime meridian coordinates. TIPBOD accepts an input argument */
/* REF that allows the caller to specify an inertial reference */
/* frame. */
/* The transformation represented by BODMAT's output argument TIPM */
/* is defined as follows: */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If there exists high-precision binary PCK kernel information */
/* for the body at the requested time, these angles, W, DELTA */
/* and PHI are computed directly from that file. The most */
/* recently loaded binary PCK file has first priority followed */
/* by previously loaded binary PCK files in backward time order. */
/* If no binary PCK file has been loaded, the text P_constants */
/* kernel file is used. */
/* If there is only text PCK kernel information, it is */
/* expressed in terms of RA, DEC and W (same W as above), where */
/* RA = PHI - HALFPI() */
/* DEC = HALFPI() - DELTA */
/* RA, DEC, and W are defined as follows in the text PCK file: */
/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */
/* i i */
/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */
/* i i */
/* W = W0 + W1*d + W2*d*d + w sin theta */
/* i i */
/* where: */
/* d = days past J2000. */
/* T = Julian centuries past J2000. */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0 * THETA1*T are specific to each planet. */
/* i */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* In the following code fragment, BODMAT is used to rotate */
/* the position vector (POS) from a target body (BODY) to a */
/* spacecraft from inertial coordinates to body-fixed coordinates */
/* at a specific epoch (ET), in order to compute the planetocentric */
/* longitude (PCLONG) of the spacecraft. */
/* CALL BODMAT ( BODY, ET, TIPM ) */
/* CALL MXV ( TIPM, POS, POS ) */
/* CALL RECLAT ( POS, RADIUS, PCLONG, LAT ) */
/* To compute the equivalent planetographic longitude (PGLONG), */
/* it is necessary to know the direction of rotation of the target */
/* body, as shown below. */
/* CALL BODVCD ( BODY, 'PM', 3, DIM, VALUES ) */
/* IF ( VALUES(2) .GT. 0.D0 ) THEN */
/* PGLONG = PCLONG */
/* ELSE */
/* PGLONG = TWOPI() - PCLONG */
/* END IF */
/* Note that the items necessary to compute the transformation */
/* TIPM must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the NAIF_IDS required reading file for a complete */
/* list of the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 4.1.1, 01-FEB-2008 (NJB) */
/* The routine was updated to improve the error messages created */
/* when required PCK data are not found. Now in most cases the */
/* messages are created locally rather than by the kernel pool */
/* access routines. In particular missing binary PCK data will */
/* be indicated with a reasonable error message. */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Implementation changes were made to improve robustness */
/* of the code. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* Gets TSIPM matrix from PCKMAT (instead of Euler angles */
/* from PCKEUL.) */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* Ability to get Euler angles from binary PCK file added. */
/* This uses the new routine PCKEUL. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* fetch transformation matrix for a body */
/* transformation from j2000 position to bodyfixed */
/* transformation from j2000 to bodyfixed coordinates */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Calls to deprecated kernel pool access routine RTPOOL */
/* were replaced by calls to GDPOOL. */
/* Calls to BODVAR have been replaced with calls to */
/* ZZBODVCD. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* BODMAT now get the TSIPM matrix from PCKMAT, and */
/* unpacks TIPM from it. Also the calculated but unused */
/* variable LAMBDA was removed. */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* BODMAT now uses new software to check for the */
/* existence of binary PCK files, search the for */
/* data corresponding to the requested body and time, */
/* and return the appropriate Euler angles, using the */
/* new routine PCKEUL. Otherwise the code calculates */
/* the Euler angles from the P_constants kernel file. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* BODMAT now checks the kernel pool for presence of the */
/* variables */
/* BODY#_CONSTANTS_REF_FRAME */
/* and */
/* BODY#_CONSTANTS_JED_EPOCH */
/* where # is the NAIF integer code of the barycenter of a */
/* planetary system or of a body other than a planet or */
/* satellite. If either or both of these variables are */
/* present, the P_constants for BODY are presumed to be */
/* referenced to the specified inertial frame or epoch. */
/* If the epoch of the constants is not J2000, the input */
/* time ET is converted to seconds past the reference epoch. */
/* If the frame of the constants is not J2000, the rotation from */
/* the P_constants' frame to body-fixed coordinates is */
/* transformed to the rotation from J2000 coordinates to */
/* body-fixed coordinates. */
/* For efficiency reasons, this routine now duplicates much */
/* of the code of BODEUL so that it doesn't have to call BODEUL. */
/* In some cases, BODEUL must covert Euler angles to a matrix, */
/* rotate the matrix, and convert the result back to Euler */
/* angles. If this routine called BODEUL, then in such cases */
/* this routine would convert the transformed angles back to */
/* a matrix. That would be a bit much.... */
/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */
/* Examples section completed. Declaration of unused variable */
/* FOUND removed. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODMAT", (ftnlen)6);
}
/* Get the code for the J2000 frame, if we don't have it yet. */
if (first) {
irfnum_("J2000", &j2code, (ftnlen)5);
first = FALSE_;
}
/* Get Euler angles from high precision data file. */
pckmat_(body, et, &ref, tsipm, &found);
if (found) {
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 :
s_rnge("tipm", i__1, "bodmat_", (ftnlen)485)] = tsipm[
(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("tsipm", i__2, "bodmat_", (ftnlen)485)];
}
}
} else {
/* The data for the frame of interest are not available in a */
/* loaded binary PCK file. This is not an error: the data may be */
/* present in the kernel pool. */
/* Conduct a non-error-signaling check for the presence of a */
/* kernel variable that is required to implement an IAU style */
/* body-fixed reference frame. If the data aren't available, we */
/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */
/* we want to issue the error signal locally, with a better error */
/* message. */
s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1);
if (! found) {
/* Now we do have an error. */
/* We don't have the data we'll need to produced the requested */
/* state transformation matrix. In order to create an error */
/* message understandable to the user, find, if possible, the */
/* name of the reference frame associated with the input body. */
/* Note that the body is really identified by a PCK frame class */
/* ID code, though most of the documentation just calls it a */
/* body ID code. */
ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32);
etcal_(et, timstr, (ftnlen)35);
s_copy(errmsg, "PCK data required to compute the orientation of "
"the # # for epoch # TDB were not found. If these data we"
"re to be provided by a binary PCK file, then it is possi"
"ble that the PCK file does not have coverage for the spe"
"cified body-fixed frame at the time of interest. If the "
"data were to be provided by a text PCK file, then possib"
"ly the file does not contain data for the specified body"
"-fixed frame. In either case it is possible that a requi"
"red PCK file was not loaded at all.", (ftnlen)1840, (
ftnlen)475);
/* Fill in the variable data in the error message. */
if (found) {
/* The frame system knows the name of the body-fixed frame. */
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16);
errch_("#", fixfrm, (ftnlen)1, (ftnlen)32);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
} else {
/* The frame system doesn't know the name of the */
/* body-fixed frame, most likely due to a missing */
/* frame kernel. */
suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840);
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame associated with the ID code", (
ftnlen)1, (ftnlen)44);
errint_("#", body, (ftnlen)1);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
errch_("#", "Also, a frame kernel defining the body-fixed fr"
"ame associated with body # may need to be loaded.", (
ftnlen)1, (ftnlen)96);
errint_("#", body, (ftnlen)1);
}
sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Find the body code used to label the reference frame and epoch */
/* specifiers for the orientation constants for BODY. */
/* For planetary systems, the reference frame and epoch for the */
/* orientation constants is associated with the system */
/* barycenter, not with individual bodies in the system. For any */
/* other bodies, (the Sun or asteroids, for example) the body's */
/* own code is used as the label. */
refid = zzbodbry_(body);
/* Look up the epoch of the constants. The epoch is specified */
/* as a Julian ephemeris date. The epoch defaults to J2000. */
s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32);
if (found) {
/* The reference epoch is returned as a JED. Convert to */
/* ephemeris seconds past J2000. Then convert the input ET to */
/* seconds past the reference epoch. */
conepc = spd_() * (conepc - j2000_());
epoch = *et - conepc;
} else {
epoch = *et;
}
/* Look up the reference frame of the constants. The reference */
/* frame is specified by a code recognized by CHGIRF. The */
/* default frame is J2000, symbolized by the code J2CODE. */
s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32);
if (found) {
ref = i_dnnt(&conref);
} else {
ref = j2code;
}
/* Whatever the body, it has quadratic time polynomials for */
/* the RA and Dec of the pole, and for the rotation of the */
/* Prime Meridian. */
s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7);
cleard_(&c__3, rcoef);
bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32);
s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8);
cleard_(&c__3, dcoef);
bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32);
s_copy(item, "PM", (ftnlen)32, (ftnlen)2);
cleard_(&c__3, wcoef);
bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32);
/* There may be additional nutation and libration (THETA) terms. */
ntheta = 0;
na = 0;
nd = 0;
nw = 0;
s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15);
if (bodfnd_(&refid, item, (ftnlen)32)) {
bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32);
ntheta /= 2;
}
s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32);
}
s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32);
}
s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32);
}
/* Computing MAX */
i__1 = max(na,nd);
if (max(i__1,nw) > ntheta) {
setmsg_("Insufficient number of nutation/precession angles for b"
"ody * at time #.", (ftnlen)71);
errint_("*", body, (ftnlen)1);
errdp_("#", et, (ftnlen)1);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Evaluate the time polynomials at EPOCH. */
d__ = epoch / spd_();
t = d__ / 36525.;
ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]);
dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]);
w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]);
/* Add nutation and libration as appropriate. */
i__1 = ntheta;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 :
s_rnge("tcoef", i__2, "bodmat_", (ftnlen)700)] + t *
tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 :
s_rnge("tcoef", i__3, "bodmat_", (ftnlen)700)]) * rpd_();
sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth",
i__2, "bodmat_", (ftnlen)702)] = sin(theta);
costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh",
i__2, "bodmat_", (ftnlen)703)] = cos(theta);
}
ra += vdotg_(ac, sinth, &na);
dec += vdotg_(dc, costh, &nd);
w += vdotg_(wc, sinth, &nw);
/* Convert from degrees to radians and mod by two pi. */
ra *= rpd_();
dec *= rpd_();
w *= rpd_();
d__1 = twopi_();
ra = d_mod(&ra, &d__1);
d__1 = twopi_();
dec = d_mod(&dec, &d__1);
d__1 = twopi_();
w = d_mod(&w, &d__1);
/* Convert to Euler angles. */
phi = ra + halfpi_();
delta = halfpi_() - dec;
/* Produce the rotation matrix defined by the Euler angles. */
eul2m_(&w, &delta, &phi, &c__3, &c__1, &c__3, tipm);
}
/* Convert TIPM to the J2000-to-bodyfixed rotation, if is is not */
/* already referenced to J2000. */
if (ref != j2code) {
/* Find the transformation from the J2000 frame to the frame */
/* designated by REF. Form the transformation from `REF' */
/* coordinates to body-fixed coordinates. Compose the */
/* transformations to obtain the J2000-to-body-fixed */
/* transformation. */
irfrot_(&j2code, &ref, j2ref);
mxm_(tipm, j2ref, tmpmat);
moved_(tmpmat, &c__9, tipm);
}
/* TIPM now gives the transformation from J2000 to */
/* body-fixed coordinates at epoch ET seconds past J2000, */
/* regardless of the epoch and frame of the orientation constants */
/* for the specified body. */
chkout_("BODMAT", (ftnlen)6);
return 0;
} /* bodmat_ */
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
char oname[40];
doublereal descr[5];
integer ctarg[20];
char ident[40], tname[40];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
moved_(doublereal *, integer *, doublereal *);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal starg[120] /* was [6][20] */;
logical nofrm;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
extern doublereal clight_(void);
integer tframe[20];
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer tmpfrm;
extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *),
spksfs_(integer *, doublereal *, integer *, doublereal *, char *,
logical *, ftnlen);
extern integer frstnp_(char *, ftnlen);
extern logical return_(void);
doublereal psxfrm[9] /* was [3][3] */;
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), intstr_(integer *, char *,
ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ Abstract */
/* Compute the geometric position of a target body relative to an */
/* observing body. */
/* $ 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 */
/* This file contains the number of inertial reference */
/* frames that are currently known by the SPICE toolkit */
/* software. */
/* $ 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 */
/* None. */
/* $ Keywords */
/* FRAMES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NINERT P Number of known inertial reference frames. */
/* $ Parameters */
/* NINERT is the number of recognized inertial reference */
/* frames. This value is needed by both CHGIRF */
/* ZZFDAT, and FRAMEX. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */
/* -& */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ 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. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* POS O Position of target. */
/* LT O Light time. */
/* $ Detailed_Input */
/* TARG is the standard NAIF ID code for a target body. */
/* ET is the epoch (ephemeris time) at which the position */
/* of the target body is to be computed. */
/* REF is the name of the reference frame to */
/* which the vectors returned by the routine should */
/* be rotated. This may be any frame supported by */
/* the SPICELIB subroutine REFCHG. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* POS contains the position of the target */
/* body, relative to the observing body. This vector is */
/* rotated into the specified reference frame. Units */
/* are always km. */
/* LT is the one-way light time from the observing body */
/* to the geometric position of the target body at the */
/* specified epoch. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If insufficient ephemeris data has been loaded to compute */
/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/* signalled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* SPKGPS computes the geometric position, T(t), of the target */
/* body and the geometric position, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric position of the target */
/* body relative to the observer. */
/* CENTER ----- O(t) */
/* | / */
/* | / */
/* | / */
/* | / T(t) - O(t) */
/* | / */
/* T(t) */
/* The one-way light time, tau, is given by */
/* | T(t) - O(t) | */
/* tau = ----------------- */
/* c */
/* For example, if the observing body is -94, the Mars Observer */
/* spacecraft, and the target body is 401, Phobos, then the */
/* first common center is probably 4, the Mars Barycenter. */
/* O(t) is the position of -94 relative to 4 and T(t) is the */
/* position of 401 relative to 4. */
/* The center could also be the Solar System Barycenter, body 0. */
/* For example, if the observer is 399, Earth, and the target */
/* is 299, Venus, then O(t) would be the position of 399 relative */
/* to 0 and T(t) would be the position of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the positions of the target body and observer */
/* relative to a common center. SPKGPS reads as many segments */
/* as necessary, from as many files as necessary, using files */
/* that have been loaded by previous calls to SPKLEF (load */
/* ephemeris file). */
/* SPKGPS is similar to SPKGEO but returns geometric positions */
/* only. */
/* $ Examples */
/* The following code example computes the geometric */
/* position of the moon with respect to the earth and */
/* then prints the distance of the moon from the */
/* the earth at a number of epochs. */
/* Assume the SPK file SAMPLE.BSP contains ephemeris data */
/* for the moon relative to earth over the time interval */
/* from BEGIN to END. */
/* INTEGER EARTH */
/* PARAMETER ( EARTH = 399 ) */
/* INTEGER MOON */
/* PARAMETER ( MOON = 301 ) */
/* INTEGER N */
/* PARAMETER ( N = 100 ) */
/* INTEGER I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the position, and */
/* C print out the epoch in UTC time and position norm. */
/* C */
/* DELTA = ( END - BEGIN ) / N */
/* DO I = 0, N */
/* ET = BEGIN + I*DELTA */
/* CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( POS ) */
/* END DO */
/* $ Restrictions */
/* 1) The ephemeris files to be used by SPKGPS must be loaded */
/* by SPKLEF before SPKGPS is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */
/* -& */
/* $ Index_Entries */
/* geometric position of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* -& */
/* This is the idea: */
/* Every body moves with respect to some center. The center */
/* is itself a body, which in turn moves about some other */
/* center. If we begin at the target body (T), follow */
/* the chain, */
/* T */
/* \ */
/* SSB \ */
/* \ C[1] */
/* \ / */
/* \ / */
/* \ / */
/* \ / */
/* C[3]-----------C[2] */
/* and avoid circular definitions (A moves about B, and B moves */
/* about A), eventually we get the position relative to the solar */
/* system barycenter (which, for our purposes, doesn't move). */
/* Thus, */
/* T = T + C[1] + C[2] + ... + C[n] */
/* SSB C[1] C[2] [C3] SSB */
/* where */
/* X */
/* Y */
/* is the position of body X relative to body Y. */
/* However, we don't want to follow each chain back to the SSB */
/* if it isn't necessary. Instead we will just follow the chain */
/* of the target body and follow the chain of the observing body */
/* until we find a common node in the tree. */
/* In the example below, C is the first common node. We compute */
/* the position of TARG relative to C and the position of OBS */
/* relative to C, then subtract the two positions. */
/* TARG */
/* \ */
/* SSB \ */
/* \ A */
/* \ / OBS */
/* \ / | */
/* \ / | */
/* \ / | */
/* B-------------C-----------------D */
/* SPICELIB functions */
/* Local parameters */
/* CHLEN is the maximum length of a chain. That is, */
/* it is the maximum number of bodies in the chain from */
/* the target or observer to the SSB. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKGPS", (ftnlen)6);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* We take care of the obvious case first. It TARG and OBS are the */
/* same we can just fill in zero. */
if (*targ == *obs) {
*lt = 0.;
cleard_(&c__3, pos);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* CTARG contains the integer codes of the bodies in the */
/* target body chain, beginning with TARG itself and then */
/* the successive centers of motion. */
/* STARG(1,I) is the position of the target body relative */
/* to CTARG(I). The id-code of the frame of this position is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and positions of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and position of the */
/* observer relative to it.) */
/* First, we construct CTARG and STARG. CTARG(1) is */
/* just the target itself, and STARG(1,1) is just a zero */
/* vector, that is, the position of the target relative */
/* to itself. */
/* Then we follow the chain, filling up CTARG and STARG */
/* as we go. We use SPKSFS to search through loaded */
/* files to find the first segment applicable to CTARG(1) */
/* and time ET. Then we use SPKPVN to compute the position */
/* of the body CTARG(1) at ET in the segment that was found */
/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */
/* We repeat the process for CTARG(2) and so on, until */
/* there is no data found for some CTARG(I) or until we */
/* reach the SSB. */
/* Next, we find centers and positions in a similar manner */
/* for the observer. It's a similar construction as */
/* described above, but I is always 1. COBS and SOBS */
/* are overwritten with each new center and position, */
/* beginning at OBS. However, we stop when we encounter */
/* a common center of motion, that is when COBS is equal */
/* to CTARG(I) for some I. */
/* Finally, we compute the desired position of the target */
/* relative to the observer by subtracting the position of */
/* the observing body relative to the common node from */
/* the position of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(ref, &refid, ref_len);
}
if (refid == 0) {
if (frstnp_(ref, ref_len) > 0) {
setmsg_("The string supplied to specify the reference frame, ('#"
"') contains non-printing characters. The two most commo"
"n causes for this kind of error are: 1. an error in the "
"call to SPKGPS; 2. an uninitialized variable. ", (ftnlen)
213);
errch_("#", ref, (ftnlen)1, ref_len);
} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
setmsg_("The string supplied to specify the reference frame is b"
"lank. The most common cause for this kind of error is a"
"n uninitialized variable. ", (ftnlen)137);
} else {
setmsg_("The string supplied to specify the reference frame was "
"'#'. This frame is not recognized. Possible causes for "
"this error are: 1. failure to load the frame definition "
"into the kernel pool; 2. An out-of-date edition of the t"
"oolkit. ", (ftnlen)231);
errch_("#", ref, (ftnlen)1, ref_len);
}
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
/* Fill in CTARG and STARG until no more data is found */
/* or until we reach the SSB. If the chain gets too */
/* long to fit in CTARG, that is if I equals CHLEN, */
/* then overwrite the last elements of CTARG and STARG. */
/* Note the check for FAILED in the loop. If SPKSFS */
/* or SPKPVN happens to fail during execution, and the */
/* current error handling action is to NOT abort, then */
/* FOUND may be stuck at TRUE, CTARG(I) will never */
/* become zero, and the loop will execute indefinitely. */
/* Construct CTARG and STARG. Begin by assigning the */
/* first elements: TARG and the position of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"spkgps_", (ftnlen)603)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)606)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "spkgps_", (ftnlen)608)] != 0) {
/* Find a file and segment that has position */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "spkgps_", (ftnlen)617)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the position of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the position is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "spkgps_", (ftnlen)627)]);
/* Here's what we have. STARG is the position of CTARG(I-1) */
/* relative to CTARG(I) in reference frame TFRAME(I) */
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
tframe[0] = tframe[1];
/* If the loop above ended because we ran out of */
/* room in the arrays CTARG and STARG, then we */
/* continue finding positions but we overwrite the */
/* last elements of CTARG and STARG. */
/* If, as a result, the first common node is */
/* overwritten, we'll just have to settle for */
/* the last common node. This will cause a small */
/* loss of precision, but it's better than other */
/* alternatives. */
if (i__ == 20) {
while(found && ctarg[19] != 0 && ctarg[19] != *obs) {
/* Find a file and segment that has position */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the position of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The position is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the position of TARG relative to */
/* the old center to get the position of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__3, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
} else {
refchg_(&tframe[19], &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[114], vtemp);
}
vadd_(vtemp, stemp, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...3,K) position of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...3,1) = ( 0, 0, 0 ) */
/* TFRAME(1) = TFRAME(2) */
/* Now follow the observer's chain. Assign */
/* the first values for COBS and SOBS. */
cobs = *obs;
cleard_(&c__6, sobs);
/* Perhaps we have a common node already. */
/* If so it will be the last node on the */
/* list CTARG. */
/* We let CTPOS will be the position of the common */
/* node in CTARG if one is found. It will */
/* be zero if COBS is not found in CTARG. */
if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg",
i__1, "spkgps_", (ftnlen)762)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)764)];
} else {
ctpos = 0;
}
/* Repeat the same loop as above, but each time */
/* we encounter a new center of motion, check to */
/* see if it is a common node. (When CTPOS is */
/* not zero, CTARG(CTPOS) is the first common node.) */
/* Note that we don't need a centers array nor a */
/* positions array, just a single center and position */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and position */
/* (SOBS-position of the target relative to COBS). */
found = TRUE_;
nofrm = TRUE_;
legs = 0;
while(found && cobs != 0 && ctpos == 0) {
/* Find a file and segment that has position */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the position of COBS; call it STEMP. */
/* The center of motion of COBS becomes the */
/* new COBS. */
if (legs == 0) {
spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
} else {
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
}
if (nofrm) {
nofrm = FALSE_;
cframe = tmpfrm;
}
/* Add STEMP to the position of OBS relative to */
/* the old COBS to get the position of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the position of the observer, we */
/* don't have to add anything, the position of the */
/* observer is already in SOBS. We only have to add when */
/* the number of legs in the observer position is one or */
/* greater. */
if (legs > 0) {
vadd_(sobs, stemp, vtemp);
vequ_(vtemp, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
} else {
refchg_(&cframe, &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* We now have one more leg of the path for OBS. Set */
/* LEGS to reflect this. Then see if the new center */
/* is a common node. If not, repeat the loop. */
++legs;
ctpos = isrchi_(&cobs, &nct, ctarg);
}
}
/* If CTPOS is zero at this point, it means we */
/* have not found a common node though we have */
/* searched through all the available data. */
if (ctpos == 0) {
bodc2n_(targ, tname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
;
} else {
intstr_(targ, tname, (ftnlen)40);
}
bodc2n_(obs, oname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
} else {
intstr_(obs, oname, (ftnlen)40);
}
setmsg_("Insufficient ephemeris data has been loaded to compute the "
"position of TARG relative to OBS at the ephemeris epoch #. ",
(ftnlen)118);
etcal_(et, tstring, (ftnlen)80);
errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
errch_("#", tstring, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The POSITION of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . N */
/* S | . O */
/* T | . I */
/* A | . T */
/* R | . I */
/* G | . S */
/* | . O */
/* | . P */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | POSITION | */
/* LT = --------- */
/* c */
/* Compute the position of the target relative to CTARG(CTPOS) */
if (ctpos == 1) {
tframe[0] = cframe;
}
i__1 = ctpos - 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
, i__2, "spkgps_", (ftnlen)960)] == tframe[(i__3 = i__) < 20
&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
ftnlen)960)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], stemp);
moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
963)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 &&
0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2
: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)967)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
970)]);
} else {
refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)974)], et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)981)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
983)]);
}
}
/* To avoid unnecessary frame transformations we'll do */
/* a bit of extra decision making here. It's a lot */
/* faster to make logical checks than it is to compute */
/* frame transformations. */
if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe",
i__1, "spkgps_", (ftnlen)996)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1000)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the position of */
/* the observer to that frame and then subtract the position */
/* of the observer from the position of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1031)], stemp, pos);
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* REFCHG to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1040)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], stemp);
vsub_(stemp, sobs, pos);
} else {
/* Use the more general routine REFCHG to make the transformation. */
refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1048)], &cframe, et,
psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1055)], stemp);
vsub_(stemp, sobs, pos);
}
/* Finally, rotate as needed into the requested frame. */
if (cframe == refid) {
/* We don't have to do anything in this case. */
} else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
/* Since both frames are inertial, we use the more direct */
/* routine IRFROT to get the transformation to REFID. */
irfrot_(&cframe, &refid, rot);
mxv_(rot, pos, stemp);
moved_(stemp, &c__3, pos);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, pos, stemp);
moved_(stemp, &c__3, pos);
}
*lt = vnorm_(pos) / clight_();
chkout_("SPKGPS", (ftnlen)6);
return 0;
} /* spkgps_ */
/* $Procedure TKFRAM (Text kernel frame transformation ) */
/* Subroutine */ int tkfram_(integer *id, doublereal *rot, integer *frame,
logical *found)
{
/* Initialized data */
static integer at = 0;
static logical first = TRUE_;
/* System generated locals */
address a__1[2];
integer i__1, i__2[2], i__3;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char name__[32];
static integer tail;
static char spec[32], item[32*14];
static integer idnt[1], axes[3];
static logical full;
static integer pool[52] /* was [2][26] */;
extern doublereal vdot_(doublereal *, doublereal *);
static char type__[1];
static doublereal qtmp[4];
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
static integer i__, n, r__;
static doublereal buffd[180] /* was [9][20] */;
static integer buffi[20] /* was [1][20] */, oldid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static char agent[32];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
ident_(doublereal *), errch_(char *, char *, ftnlen, ftnlen);
static doublereal tempd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, vhatg_(doublereal *, integer *, doublereal *);
extern integer lnktl_(integer *, integer *);
static char idstr[32];
extern integer rtrim_(char *, ftnlen);
static char versn[8], units[32];
static integer ar;
extern logical failed_(void), badkpv_(char *, char *, char *, integer *,
integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
static char frname[32];
static doublereal angles[3];
static char oldagt[32];
static logical buffrd;
extern /* Subroutine */ int locati_(integer *, integer *, integer *,
integer *, integer *, logical *), frmnam_(integer *, char *,
ftnlen), namfrm_(char *, integer *, ftnlen);
static logical update;
static char altnat[32];
extern /* Subroutine */ int lnkini_(integer *, integer *);
extern integer lnknfn_(integer *);
static integer idents[20] /* was [1][20] */;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen), gdpool_(char *, integer *,
integer *, integer *, doublereal *, logical *, ftnlen), sigerr_(
char *, ftnlen), gipool_(char *, integer *, integer *, integer *,
integer *, logical *, ftnlen), chkout_(char *, ftnlen), sharpr_(
doublereal *), dtpool_(char *, logical *, integer *, char *,
ftnlen, ftnlen), setmsg_(char *, ftnlen);
static doublereal matrix[9] /* was [3][3] */;
extern /* Subroutine */ int cvpool_(char *, logical *, ftnlen), dwpool_(
char *, ftnlen), errint_(char *, integer *, ftnlen), vsclip_(
doublereal *, doublereal *);
static doublereal quatrn[4];
extern /* Subroutine */ int convrt_(doublereal *, char *, char *,
doublereal *, ftnlen, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int q2m_(doublereal *, doublereal *), intstr_(
integer *, char *, ftnlen), swpool_(char *, integer *, char *,
ftnlen, ftnlen);
static logical fnd;
static char alt[32*14];
/* $ Abstract */
/* This routine returns the rotation from the input frame */
/* specified by ID to the associated frame given by FRAME. */
/* $ 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 */
/* FRAMES */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ---------------------------------------------- */
/* ID I Class identification code for the instrument */
/* ROT O The rotation from ID to FRAME. */
/* FRAME O The integer code of some reference frame. */
/* FOUND O TRUE if the rotation could be determined. */
/* $ Detailed_Input */
/* ID The identification code used to specify an */
/* instrument in the SPICE system. */
/* $ Detailed_Output */
/* ROT is a rotation matrix that gives the transformation */
/* from the frame specified by ID to the frame */
/* specified by FRAME. */
/* FRAME is the id code of the frame used to define the */
/* orientation of the frame given by ID. ROT gives */
/* the transformation from the IF frame to */
/* the frame specified by FRAME. */
/* FOUND is a logical indicating whether or not a frame */
/* definition for frame ID was constructed from */
/* kernel pool data. If ROT and FRAME were constructed */
/* FOUND will be returned with the value TRUE. */
/* Otherwise it will be returned with the value FALSE. */
/* $ Parameters */
/* BUFSIZ is the number of rotation, frame id pairs that */
/* can have their instance data buffered for the */
/* sake of improving run-time performance. This */
/* value MUST be positive and should probably be */
/* at least 10. */
/* $ Exceptions */
/* 1) If some instance value associated with this frame */
/* cannot be located, or does not have the proper type */
/* or dimension, the error will be diagnosed by the */
/* routine BADKPV. In such a case FOUND will be set to .FALSE. */
/* 2) If the input ID has the value 0, the error */
/* SPICE(ZEROFRAMEID) will be signaled. FOUND will be set */
/* to FALSE. */
/* 3) If the name of the frame corresponding to ID cannot be */
/* determined, the error 'SPICE(INCOMPLETEFRAME)' is signaled. */
/* 4) If the frame given by ID is defined relative to a frame */
/* that is unrecognized, the error SPICE(BADFRAMESPEC) */
/* will be signaled. FOUND will be set to FALSE. */
/* 5) If the kernel pool specification for ID is not one of */
/* MATRIX, ANGLES, or QUATERNION, then the error */
/* SPICE(UNKNOWNFRAMESPEC) will be signaled. FOUND will be */
/* set to FALSE. */
/* $ Files */
/* This routine makes use of the loaded text kernels to */
/* determine the rotation from a constant offset frame */
/* to its defining frame. */
/* $ Particulars */
/* This routine is used to construct the rotation from some frame */
/* that is a constant rotation offset from some other reference */
/* frame. This rotation is derived from data stored in the kernel */
/* pool. */
/* It is considered to be an low level routine that */
/* will need to be called directly only by persons performing */
/* high volume processing. */
/* $ Examples */
/* This is intended to be used as a low level routine by */
/* the frame system software. However, you could use this */
/* routine to directly retrieve the rotation from an offset */
/* frame to its relative frame. One instance in which you */
/* might do this is if you have a properly specified topocentric */
/* frame for some site on earth and you wish to determine */
/* the geodetic latitude and longitude of the site. Here's how. */
/* Suppose the name of the topocentric frame is: 'MYTOPO'. */
/* First we get the id-code of the topocentric frame. */
/* CALL NAMFRM ( 'MYTOPO', FRCODE ) */
/* Next get the rotation from the topocentric frame to */
/* the bodyfixed frame. */
/* CALL TKFRAM ( FRCODE, ROT, FRAME, FOUND ) */
/* Make sure the topoframe is relative to one of the earth */
/* fixed frames. */
/* CALL FRMNAM( FRAME, TEST ) */
/* IF ( TEST .NE. 'IAU_EARTH' */
/* . .AND. TEST .NE. 'EARTH_FIXED' */
/* . .AND. TEST .NE. 'ITRF93' ) THEN */
/* WRITE (*,*) 'The frame MYTOPO does not appear to be ' */
/* WRITE (*,*) 'defined relative to an earth fixed frame.' */
/* STOP */
/* END IF */
/* Things look ok. Get the location of the Z-axis in the */
/* topocentric frame. */
/* Z(1) = ROT(1,3) */
/* Z(2) = ROT(2,3) */
/* Z(3) = ROT(3,3) */
/* Convert the Z vector to latitude longitude and radius. */
/* CALL RECLAT ( Z, LAT, LONG, RAD ) */
/* WRITE (*,*) 'The geodetic coordinates of the center of' */
/* WRITE (*,*) 'the topographic frame are: ' */
/* WRITE (*,*) */
/* WRITE (*,*) 'Latitude (deg): ', LAT *DPR() */
/* WRITE (*,*) 'Longitude (deg): ', LONG*DPR() */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 23-APR-2009 (NJB) */
/* Bug fix: watch is deleted only for frames */
/* that are deleted from the buffer. */
/* - SPICELIB Version 2.0.0, 19-MAR-2009 (NJB) */
/* Bug fix: this routine now deletes watches set on */
/* kernel variables of frames that are discarded from */
/* the local buffering system. */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* - SPICELIB Version 1.1.0, 21-NOV-2001 (FST) */
/* Updated this routine to dump the buffer of frame ID codes */
/* it saves when it or one of the modules in its call tree signals */
/* an error. This fixes a bug where a frame's ID code is */
/* buffered, but the matrix and kernel pool watcher were not set */
/* properly. */
/* - SPICELIB Version 1.0.0, 18-NOV-1996 (WLT) */
/* -& */
/* $ Index_Entries */
/* Fetch the rotation and frame of a text kernel frame */
/* Fetch the rotation and frame of a constant offset frame */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 09-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in CONVRT, UCRSS, VHATG and VSCL calls. */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Local Variables */
/* Saved variables */
/* Initial values */
/* Programmer's note: this routine makes use of the *implementation* */
/* of LOCATI. If that routine is changed, the logic this routine */
/* uses to locate buffered, old frame IDs may need to change as well. */
/* Before we even check in, if N is less than 1 we can */
/* just return. */
/* Perform any initializations that might be needed for this */
/* routine. */
if (first) {
first = FALSE_;
s_copy(versn, "1.0.0", (ftnlen)8, (ftnlen)5);
lnkini_(&c__20, pool);
}
/* Now do the standard SPICE error handling. Sure this is */
/* a bit unconventional, but nothing will be hurt by doing */
/* the stuff above first. */
if (return_()) {
return 0;
}
chkin_("TKFRAM", (ftnlen)6);
/* So far, we've not FOUND the rotation to the specified frame. */
*found = FALSE_;
/* Check the ID to make sure it is non-zero. */
if (*id == 0) {
lnkini_(&c__20, pool);
setmsg_("Frame identification codes are required to be non-zero. Yo"
"u've specified a frame with ID value zero. ", (ftnlen)102);
sigerr_("SPICE(ZEROFRAMEID)", (ftnlen)18);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Find out whether our linked list pool is already full. */
/* We'll use this information later to decide whether we're */
/* going to have to delete a watcher. */
full = lnknfn_(pool) == 0;
if (full) {
/* If the input frame ID is not buffered, we'll need to */
/* overwrite an existing buffer entry. In this case */
/* the call to LOCATI we're about to make will overwrite */
/* the ID code in the slot we're about to use. We need */
/* this ID code, so extract it now while we have the */
/* opportunity. The old ID sits at the tail of the list */
/* whose head node is AT. */
tail = lnktl_(&at, pool);
oldid = idents[(i__1 = tail - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"idents", i__1, "tkfram_", (ftnlen)413)];
/* Create the name of the agent associated with the old */
/* frame. */
s_copy(oldagt, "TKFRAME_#", (ftnlen)32, (ftnlen)9);
repmi_(oldagt, "#", &oldid, oldagt, (ftnlen)32, (ftnlen)1, (ftnlen)32)
;
}
/* Look up the address of the instance data. */
idnt[0] = *id;
locati_(idnt, &c__1, idents, pool, &at, &buffrd);
if (full && ! buffrd) {
/* Since the buffer is already full, we'll delete the watcher for */
/* the kernel variables associated with OLDID, since there's no */
/* longer a need for that watcher. */
/* First clear the update status of the old agent; DWPOOL won't */
/* delete an agent with a unchecked update. */
cvpool_(oldagt, &update, (ftnlen)32);
dwpool_(oldagt, (ftnlen)32);
}
/* Until we have better information we put the identity matrix */
/* into the output rotation and set FRAME to zero. */
ident_(rot);
*frame = 0;
/* If we have to look up the data for our frame, we do */
/* it now and perform any conversions and computations that */
/* will be needed when it's time to convert coordinates to */
/* directions. */
/* Construct the name of the agent associated with the */
/* requested frame. (Each frame has its own agent). */
intstr_(id, idstr, (ftnlen)32);
frmnam_(id, frname, (ftnlen)32);
if (s_cmp(frname, " ", (ftnlen)32, (ftnlen)1) == 0) {
lnkini_(&c__20, pool);
setmsg_("The Text Kernel (TK) frame with id-code # does not have a r"
"ecognized name. ", (ftnlen)75);
errint_("#", id, (ftnlen)1);
sigerr_("SPICE(INCOMPLETFRAME)", (ftnlen)21);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = idstr;
s_cat(agent, a__1, i__2, &c__2, (ftnlen)32);
r__ = rtrim_(agent, (ftnlen)32);
/* Writing concatenation */
i__2[0] = 8, a__1[0] = "TKFRAME_";
i__2[1] = 32, a__1[1] = frname;
s_cat(altnat, a__1, i__2, &c__2, (ftnlen)32);
ar = rtrim_(altnat, (ftnlen)32);
/* If the frame is buffered, we check the kernel pool to */
/* see if there has been an update to this frame. */
if (buffrd) {
cvpool_(agent, &update, r__);
} else {
/* If the frame is not buffered we definitely need to update */
/* things. */
update = TRUE_;
}
if (! update) {
/* Just look up the rotation matrix and relative-to */
/* information from the local buffer. */
rot[0] = buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)506)];
rot[1] = buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)507)];
rot[2] = buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)508)];
rot[3] = buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)509)];
rot[4] = buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)510)];
rot[5] = buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)511)];
rot[6] = buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)512)];
rot[7] = buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)513)];
rot[8] = buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge(
"buffd", i__1, "tkfram_", (ftnlen)514)];
*frame = buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"buffi", i__1, "tkfram_", (ftnlen)516)];
} else {
/* Determine how the frame is specified and what it */
/* is relative to. The variables that specify */
/* how the frame is represented and what it is relative to */
/* are TKFRAME_#_SPEC and TKFRAME_#_RELATIVE where # is */
/* replaced by the text value of ID or the frame name. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(alt, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(alt + 32, a__1, i__2, &c__2, (ftnlen)32);
/* See if the friendlier version of the kernel pool variables */
/* are available. */
for (i__ = 1; i__ <= 2; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)537)) << 5), found,
&n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("item", i__1, "tkfram_", (ftnlen)540)) << 5),
alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ? i__3 :
s_rnge("alt", i__3, "tkfram_", (ftnlen)540)) << 5), (
ftnlen)32, (ftnlen)32);
}
}
/* If either the SPEC or RELATIVE frame are missing from */
/* the kernel pool, we simply return. */
if (badkpv_("TKFRAM", item, "=", &c__1, &c__1, "C", (ftnlen)6, (
ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM", item +
32, "=", &c__1, &c__1, "C", (ftnlen)6, (ftnlen)32, (ftnlen)1,
(ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* If we make it this far, look up the SPEC and RELATIVE frame. */
gcpool_(item, &c__1, &c__1, &n, spec, &fnd, (ftnlen)32, (ftnlen)32);
gcpool_(item + 32, &c__1, &c__1, &n, name__, &fnd, (ftnlen)32, (
ftnlen)32);
/* Look up the id-code for this frame. */
namfrm_(name__, frame, (ftnlen)32);
if (*frame == 0) {
lnkini_(&c__20, pool);
setmsg_("The frame to which frame # is relatively defined is not"
" recognized. The kernel pool specification of the relati"
"ve frame is '#'. This is not a recognized frame. ", (
ftnlen)161);
errint_("#", id, (ftnlen)1);
errch_("#", name__, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(BADFRAMESPEC)", (ftnlen)19);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Convert SPEC to upper case so that we can easily check */
/* to see if this is one of the expected specification types. */
ucase_(spec, spec, (ftnlen)32, (ftnlen)32);
if (s_cmp(spec, "MATRIX", (ftnlen)32, (ftnlen)6) == 0) {
/* This is the easiest case. Just grab the matrix */
/* from the kernel pool (and polish it up a bit just */
/* to make sure we have a rotation matrix). */
/* We give preference to the kernel pool variable */
/* TKFRAME_<name>_MATRIX if it is available. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__9, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* The variable meets current expectations, look it up */
/* from the kernel pool. */
gdpool_(item + 64, &c__1, &c__9, &n, matrix, &fnd, (ftnlen)32);
/* In this case the full transformation matrix has been */
/* specified. We simply polish it up a bit. */
moved_(matrix, &c__9, rot);
sharpr_(rot);
/* The matrix might not be right-handed, so correct */
/* the sense of the second and third columns if necessary. */
if (vdot_(&rot[3], &matrix[3]) < 0.) {
vsclip_(&c_b95, &rot[3]);
}
if (vdot_(&rot[6], &matrix[6]) < 0.) {
vsclip_(&c_b95, &rot[6]);
}
} else if (s_cmp(spec, "ANGLES", (ftnlen)32, (ftnlen)6) == 0) {
/* Look up the angles, their units and axes for the */
/* frame specified by ID. (Note that UNITS are optional). */
/* As in the previous case we give preference to the */
/* form TKFRAME_<name>_<item> over TKFRAME_<id>_<item>. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(alt + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(alt + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Again, we give preference to the more friendly form */
/* of TKFRAME specification. */
for (i__ = 3; i__ <= 5; ++i__) {
dtpool_(alt + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1 :
s_rnge("alt", i__1, "tkfram_", (ftnlen)668)) << 5),
found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + (((i__1 = i__ - 1) < 14 && 0 <= i__1 ? i__1
: s_rnge("item", i__1, "tkfram_", (ftnlen)671)) <<
5), alt + (((i__3 = i__ - 1) < 14 && 0 <= i__3 ?
i__3 : s_rnge("alt", i__3, "tkfram_", (ftnlen)671)
) << 5), (ftnlen)32, (ftnlen)32);
}
}
if (badkpv_("TKFRAM", item + 64, "=", &c__3, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1) || badkpv_("TKFRAM",
item + 96, "=", &c__3, &c__1, "N", (ftnlen)6, (ftnlen)32,
(ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
s_copy(units, "RADIANS", (ftnlen)32, (ftnlen)7);
gdpool_(item + 64, &c__1, &c__3, &n, angles, &fnd, (ftnlen)32);
gipool_(item + 96, &c__1, &c__3, &n, axes, &fnd, (ftnlen)32);
gcpool_(item + 128, &c__1, &c__1, &n, units, &fnd, (ftnlen)32, (
ftnlen)32);
/* Convert angles to radians. */
for (i__ = 1; i__ <= 3; ++i__) {
convrt_(&angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
s_rnge("angles", i__1, "tkfram_", (ftnlen)700)],
units, "RADIANS", &tempd, (ftnlen)32, (ftnlen)7);
angles[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
"angles", i__1, "tkfram_", (ftnlen)701)] = tempd;
}
if (failed_()) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Compute the rotation from instrument frame to CK frame. */
eul2m_(angles, &angles[1], &angles[2], axes, &axes[1], &axes[2],
rot);
} else if (s_cmp(spec, "QUATERNION", (ftnlen)32, (ftnlen)10) == 0) {
/* Look up the quaternion and convert it to a rotation */
/* matrix. Again there are two possible variables that */
/* may point to the quaternion. We give preference to */
/* the form TKFRAME_<name>_Q over the form TKFRAME_<id>_Q. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(alt + 64, a__1, i__2, &c__2, (ftnlen)32);
dtpool_(alt + 64, found, &n, type__, (ftnlen)32, (ftnlen)1);
if (*found) {
s_copy(item + 64, alt + 64, (ftnlen)32, (ftnlen)32);
}
if (badkpv_("TKFRAM", item + 64, "=", &c__4, &c__1, "N", (ftnlen)
6, (ftnlen)32, (ftnlen)1, (ftnlen)1)) {
lnkini_(&c__20, pool);
*frame = 0;
ident_(rot);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* In this case we have the quaternion representation. */
/* Again, we do a small amount of polishing of the input. */
gdpool_(item + 64, &c__1, &c__4, &n, quatrn, &fnd, (ftnlen)32);
vhatg_(quatrn, &c__4, qtmp);
q2m_(qtmp, rot);
} else {
/* We don't recognize the SPEC for this frame. Say */
/* so. Also note that perhaps the user needs to upgrade */
/* the toolkit. */
lnkini_(&c__20, pool);
setmsg_("The frame specification \"# = '#'\" is not one of the r"
"econized means of specifying a text-kernel constant offs"
"et frame (as of version # of the routine TKFRAM). This m"
"ay reflect a typographical error or may indicate that yo"
"u need to consider updating your version of the SPICE to"
"olkit. ", (ftnlen)284);
errch_("#", item, (ftnlen)1, (ftnlen)32);
errch_("#", spec, (ftnlen)1, (ftnlen)32);
errch_("#", versn, (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(UNKNOWNFRAMESPEC)", (ftnlen)23);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* Buffer the identifier, relative frame and rotation matrix. */
buffd[(i__1 = at * 9 - 9) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)784)] = rot[0];
buffd[(i__1 = at * 9 - 8) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)785)] = rot[1];
buffd[(i__1 = at * 9 - 7) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)786)] = rot[2];
buffd[(i__1 = at * 9 - 6) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)787)] = rot[3];
buffd[(i__1 = at * 9 - 5) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)788)] = rot[4];
buffd[(i__1 = at * 9 - 4) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)789)] = rot[5];
buffd[(i__1 = at * 9 - 3) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)790)] = rot[6];
buffd[(i__1 = at * 9 - 2) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)791)] = rot[7];
buffd[(i__1 = at * 9 - 1) < 180 && 0 <= i__1 ? i__1 : s_rnge("buffd",
i__1, "tkfram_", (ftnlen)792)] = rot[8];
buffi[(i__1 = at - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("buffi", i__1,
"tkfram_", (ftnlen)794)] = *frame;
/* If these were not previously buffered, we need to set */
/* a watch on the various items that might be used to define */
/* this frame. */
if (! buffrd) {
/* Immediately check for an update so that we will */
/* not redundantly look for this item the next time this */
/* routine is called. */
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 32, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 64, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 96, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 128, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 160, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = r__, a__1[0] = agent;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 192, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 9, a__1[1] = "_RELATIVE";
s_cat(item + 224, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_SPEC";
s_cat(item + 256, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 5, a__1[1] = "_AXES";
s_cat(item + 288, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_MATRIX";
s_cat(item + 320, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 2, a__1[1] = "_Q";
s_cat(item + 352, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 7, a__1[1] = "_ANGLES";
s_cat(item + 384, a__1, i__2, &c__2, (ftnlen)32);
/* Writing concatenation */
i__2[0] = ar, a__1[0] = altnat;
i__2[1] = 6, a__1[1] = "_UNITS";
s_cat(item + 416, a__1, i__2, &c__2, (ftnlen)32);
swpool_(agent, &c__14, item, (ftnlen)32, (ftnlen)32);
cvpool_(agent, &update, (ftnlen)32);
}
}
if (failed_()) {
lnkini_(&c__20, pool);
chkout_("TKFRAM", (ftnlen)6);
return 0;
}
/* All errors cause the routine to exit before we get to this */
/* point. If we reach this point we didn't have an error and */
/* hence did find the rotation from ID to FRAME. */
*found = TRUE_;
/* That's it */
chkout_("TKFRAM", (ftnlen)6);
return 0;
} /* tkfram_ */
/* $Procedure CKR03 ( C-kernel, read pointing record, data type 3 ) */
/* Subroutine */ int ckr03_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
*found)
{
/* Initialized data */
static doublereal prevs = -1.;
static doublereal prevn = -1.;
static integer lhand = 0;
static integer lbeg = -1;
static integer lend = -1;
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer addr__, skip, psiz, i__, n;
doublereal ldiff;
integer laddr;
doublereal rdiff;
integer raddr;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer nidir;
doublereal lsclk;
extern doublereal dpmax_(void);
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer nrdir;
doublereal rsclk;
integer group;
doublereal start;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
extern logical failed_(void);
integer grpadd;
doublereal buffer[100];
integer remain, dirloc;
extern integer lstled_(doublereal *, integer *, doublereal *);
integer numrec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
integer numint;
doublereal nstart;
extern logical return_(void);
doublereal dcd[2];
integer beg, icd[6], end;
logical fnd;
/* $ Abstract */
/* Read a pointing record from a CK segment, data type 3. */
/* $ 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Pointing request time. */
/* TOL I Time tolerance. */
/* NEEDAV I Angular velocity request flag. */
/* RECORD O Pointing data record. */
/* FOUND O True when data is found. */
/* $ Detailed_Input */
/* HANDLE is the integer handle of the CK file containing the */
/* segment. */
/* DESCR is the descriptor of the segment. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is being requested. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. */
/* When SCLKDP falls within the bounds of one of the */
/* interpolation intervals then the tolerance has no */
/* effect because pointing will be returned at the */
/* request time. */
/* However, if the request time is not in one of the */
/* intervals, then the tolerance is used to determine */
/* if pointing at one of the interval endpoints should */
/* be returned. */
/* NEEDAV is true if angular velocity is requested. */
/* $ Detailed_Output */
/* RECORD is the record that CKE03 will evaluate to determine */
/* the pointing. */
/* When the request time falls within an interval for */
/* which linear interpolation is valid, the values of */
/* the two pointing instances that bracket the request */
/* time are returned in RECORD as follows: */
/* RECORD( 1 ) = Left bracketing SCLK time. */
/* RECORD( 2 ) = lq0 \ */
/* RECORD( 3 ) = lq1 \ Left bracketing */
/* RECORD( 4 ) = lq2 / quaternion. */
/* RECORD( 5 ) = lq3 / */
/* RECORD( 6 ) = lav1 \ Left bracketing */
/* RECORD( 7 ) = lav2 angular velocity */
/* RECORD( 8 ) = lav3 / ( optional ) */
/* RECORD( 9 ) = Right bracketing SCLK time. */
/* RECORD( 10 ) = rq0 \ */
/* RECORD( 11 ) = rq1 \ Right bracketing */
/* RECORD( 12 ) = rq2 / quaternion. */
/* RECORD( 13 ) = rq3 / */
/* RECORD( 14 ) = rav1 \ Right bracketing */
/* RECORD( 15 ) = rav2 angular velocity */
/* RECORD( 16 ) = rav3 / ( optional ) */
/* RECORD( 17 ) = pointing request time, SCLKDP. */
/* The quantities lq0 - lq3 and rq0 - rq3 are the */
/* components of the quaternions that represent the */
/* C-matrices associated with the times that bracket */
/* the requested time. */
/* The quantities lav1, lav2, lav3 and rav1, rav2, rav3 */
/* are the components of the angular velocity vectors at */
/* the respective bracketing times. The components of the */
/* angular velocity vectors are specified relative to */
/* the inertial reference frame of the segment. */
/* If the request time does not fall within an */
/* interpolation interval, but is within TOL of an */
/* interval endpoint, the values of that pointing */
/* instance are returned in both parts of RECORD */
/* ( i.e. RECORD(1-9) and RECORD(10-16) ). */
/* FOUND is true if a record was found to satisfy the pointing */
/* request. This occurs when the time for which pointing */
/* is requested falls inside one of the interpolation */
/* intervals, or when the request time is within the */
/* tolerance of an interval endpoint. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the specified handle does not belong to an open DAF file, */
/* an error is diagnosed by a routine that this routine calls. */
/* 2) If DESCR is not a valid descriptor of a segment in the CK */
/* file specified by HANDLE, the results of this routine are */
/* unpredictable. */
/* 3) If the segment is not of data type 3, as specified in the */
/* third integer component of the segment descriptor, then */
/* the error SPICE(WRONGDATATYPE) is signalled. */
/* 4) If angular velocity data was requested but the segment */
/* contains no such data, the error SPICE(NOAVDATA) is signalled. */
/* $ Files */
/* The file containing the segment is specified by its handle and */
/* should be opened for read or write access, either by CKLPF, */
/* DAFOPR, or DAFOPW. */
/* $ Particulars */
/* See the CK Required Reading file for a detailed description of */
/* the structure of a type 3 pointing segment. */
/* When the time for which pointing was requested falls within an */
/* interpolation interval, then FOUND will be true and RECORD will */
/* contain the pointing instances in the segment that bracket the */
/* request time. CKE03 will evaluate RECORD to give pointing at */
/* the request time. */
/* However, when the request time is not within any of the */
/* interpolation intervals, then FOUND will be true only if the */
/* interval endpoint closest to the request time is within the */
/* tolerance specified by the user. In this case both parts of */
/* RECORD will contain this closest pointing instance, and CKE03 */
/* will evaluate RECORD to give pointing at the time associated */
/* with the returned pointing instance. */
/* $ Examples */
/* The CKRnn routines are usually used in tandem with the CKEnn */
/* routines, which evaluate the record returned by CKRnn to give */
/* the pointing information and output time. */
/* The following code fragment searches through all of the segments */
/* in a file applicable to the Mars Observer spacecraft bus that */
/* are of data type 3, for a particular spacecraft clock time. */
/* It then evaluates the pointing for that epoch and prints the */
/* result. */
/* CHARACTER*(20) SCLKCH */
/* CHARACTER*(20) SCTIME */
/* CHARACTER*(40) IDENT */
/* INTEGER I */
/* INTEGER SC */
/* INTEGER INST */
/* INTEGER HANDLE */
/* INTEGER DTYPE */
/* INTEGER ICD ( 6 ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOL */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION DESCR ( 5 ) */
/* DOUBLE PRECISION DCD ( 2 ) */
/* DOUBLE PRECISION RECORD ( 17 ) */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION AV ( 3 ) */
/* LOGICAL NEEDAV */
/* LOGICAL FND */
/* LOGICAL SFND */
/* SC = -94 */
/* INST = -94000 */
/* DTYPE = 3 */
/* NEEDAV = .FALSE. */
/* C */
/* C Load the MO SCLK kernel and the C-kernel. */
/* C */
/* CALL FURNSH ( 'MO_SCLK.TSC' ) */
/* CALL DAFOPR ( 'MO_CK.BC', HANDLE ) */
/* C */
/* C Get the spacecraft clock time. Then encode it for use */
/* C in the C-kernel. */
/* C */
/* WRITE (*,*) 'Enter spacecraft clock time string:' */
/* READ (*,FMT='(A)') SCLKCH */
/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */
/* C */
/* C Use a tolerance of 2 seconds ( half of the nominal */
/* C separation between MO pointing instances ). */
/* C */
/* CALL SCTIKS ( SC, '0000000002:000', TOL ) */
/* C */
/* C Search from the beginning of the CK file through all */
/* C of the segments. */
/* C */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( SFND ) */
/* FND = .FALSE. */
/* DO WHILE ( ( SFND ) .AND. ( .NOT. FND ) ) */
/* C */
/* C Get the segment identifier and descriptor. */
/* C */
/* CALL DAFGN ( IDENT ) */
/* CALL DAFGS ( DESCR ) */
/* C */
/* C Unpack the segment descriptor into its integer and */
/* C double precision components. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* C */
/* C Determine if this segment should be processed. */
/* C */
/* IF ( ( INST .EQ. ICD( 1 ) ) .AND. */
/* . ( SCLKDP + TOL .GE. DCD( 1 ) ) .AND. */
/* . ( SCLKDP - TOL .LE. DCD( 2 ) ) .AND. */
/* . ( DTYPE .EQ. ICD( 3 ) ) ) THEN */
/* CALL CKR03 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FND ) */
/* IF ( FND ) THEN */
/* CALL CKE03 (NEEDAV,RECORD,CMAT,AV,CLKOUT) */
/* CALL SCDECD ( SC, CLKOUT, SCTIME ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Segment identifier: ', IDENT */
/* WRITE (*,*) */
/* WRITE (*,*) 'Pointing returned for time: ', */
/* . SCTIME */
/* WRITE (*,*) */
/* WRITE (*,*) 'C-matrix:' */
/* WRITE (*,*) */
/* WRITE (*,*) ( CMAT(1,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(2,I), I = 1, 3 ) */
/* WRITE (*,*) ( CMAT(3,I), I = 1, 3 ) */
/* WRITE (*,*) */
/* END IF */
/* END IF */
/* CALL DAFFNA ( SFND ) */
/* END DO */
/* $ Restrictions */
/* 1) The file containing the segment should be opened for read */
/* or write access either by CKLPF, DAFOPR, or DAFOPW. */
/* 2) The record returned by this routine is intended to be */
/* evaluated by CKE03. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 1.1.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* Added IMPLICIT NONE. */
/* - SPICELIB Version 1.0.0, 25-NOV-1992 (JML) */
/* -& */
/* $ Index_Entries */
/* read ck type_3 pointing data record */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* DIRSIZ is the directory size. */
/* BUFSIZ is the maximum number of double precision numbers */
/* that we will read from the DAF file at one time. */
/* BUFSIZ is normally set equal to DIRSIZ. */
/* ND is the number of double precision components in an */
/* unpacked C-kernel segment descriptor. */
/* NI is the number of integer components in an unpacked */
/* C-kernel segment descriptor. */
/* QSIZ is the number of double precision numbers making up */
/* the quaternion portion of a pointing record. */
/* QAVSIZ is the number of double precision numbers making up */
/* the quaternion and angular velocity portion of a */
/* pointing record. */
/* DTYPE is the data type of the segment that this routine */
/* operates on. */
/* Local variables */
/* Saved variables. */
/* Initial values. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKR03", (ftnlen)5);
}
/* Start off with FOUND equal to false just in case a SPICELIB error */
/* is signalled and the return mode is not set to ABORT. */
*found = FALSE_;
/* We need to look at a few of the descriptor components. */
/* The unpacked descriptor contains the following information */
/* about the segment: */
/* DCD(1) Initial encoded SCLK */
/* DCD(2) Final encoded SCLK */
/* ICD(1) Instrument */
/* ICD(2) Inertial reference frame */
/* ICD(3) Data type */
/* ICD(4) Angular velocity flag */
/* ICD(5) Initial address of segment data */
/* ICD(6) Final address of segment data */
dafus_(descr, &c__2, &c__6, dcd, icd);
/* Check to make sure that the segment is type 3. */
if (icd[2] != 3) {
setmsg_("The segment is not a type 3 segment. Type is #", (ftnlen)47)
;
errint_("#", &icd[2], (ftnlen)1);
sigerr_("SPICE(WRONGDATATYPE)", (ftnlen)20);
chkout_("CKR03", (ftnlen)5);
return 0;
}
/* Does this segment contain angular velocity? */
if (icd[3] == 1) {
psiz = 7;
} else {
psiz = 4;
if (*needav) {
setmsg_("Segment does not contain angular velocity data.", (
ftnlen)47);
sigerr_("SPICE(NOAVDATA)", (ftnlen)15);
chkout_("CKR03", (ftnlen)5);
return 0;
}
}
/* The beginning and ending addresses of the segment are in the */
/* descriptor. */
beg = icd[4];
end = icd[5];
/* The procedure used in finding a record to satisfy the request */
/* for pointing is as follows: */
/* 1) Find the two pointing instances in the segment that bracket */
/* the request time. */
/* The pointing instance that brackets the request time on the */
/* left is defined to be the one associated with the largest */
/* time in the segment that is less than or equal to SCLKDP. */
/* The pointing instance that brackets the request time on the */
/* right is defined to be the one associated with the first */
/* time in the segment greater than SCLKDP. */
/* Since the times in the segment are strictly increasing the */
/* left and right bracketing pointing instances are always */
/* adjacent. */
/* 2) Determine if the bracketing times are in the same */
/* interpolation interval. */
/* 3) If they are, then pointing at the request time may be */
/* linearly interpolated from the bracketing times. */
/* 4) If the times that bracket the request time are not in the */
/* same interval then, since they are adjacent in the segment */
/* and since intervals begin and end at actual times, they must */
/* both be interval endpoints. Return the pointing instance */
/* associated with the endpoint closest to the request time, */
/* provided that it is within the tolerance. */
/* Get the number of intervals and pointing instances ( records ) */
/* in this segment, and from that determine the number of respective */
/* directory epochs. */
i__1 = end - 1;
dafgda_(handle, &i__1, &end, buffer);
numint = i_dnnt(buffer);
numrec = i_dnnt(&buffer[1]);
nidir = (numint - 1) / 100;
nrdir = (numrec - 1) / 100;
/* Check the FAILED flag just in case HANDLE is not attached to */
/* any DAF file and the error action is not set to ABORT. You need */
/* need to do this only after the first call to DAFGDA. */
if (failed_()) {
chkout_("CKR03", (ftnlen)5);
return 0;
}
/* To find the times that bracket the request time we will first */
/* find the greatest directory time less than the request time. */
/* This will narrow down the search to a group of DIRSIZ or fewer */
/* times where the Jth group is defined to contain SCLK times */
/* ((J-1)*DIRSIZ + 1) through (J*DIRSIZ). */
/* For example if DIRSIZ = 100 then: */
/* group first time # last time # */
/* ----- --------------- ------------ */
/* 1 1 100 */
/* 2 101 200 */
/* . . . */
/* . . . */
/* 10 901 1000 */
/* . . . */
/* . . . */
/* NRDIR+1 (NRDIR)*100+1 NUMREC */
/* Thus if the Ith directory time is the largest one less than */
/* our request time SCLKDP, then we know that: */
/* SCLKS ( DIRSIZ * I ) < SCLKDP <= SCLKS ( DIRSIZ * (I+1) ) */
/* where SCLKS is taken to be the array of NUMREC times associated */
/* with the pointing instances. */
/* Therefore, at least one of the bracketing times will come from */
/* the (I+1)th group. */
/* There is only one group if there are no directory epochs. */
if (nrdir == 0) {
group = 1;
} else {
/* Compute the location of the first directory epoch. From the */
/* beginning of the segment, we need to go through all of the */
/* pointing numbers (PSIZ*NUMREC of them) and then through all of */
/* the NUMREC SCLK times. */
dirloc = beg + (psiz + 1) * numrec;
/* Search through the directory times. Read in as many as BUFSIZ */
/* directory epochs at a time for comparison. */
fnd = FALSE_;
remain = nrdir;
group = 0;
while(! fnd) {
/* The number of records to read into the buffer. */
n = min(remain,100);
i__1 = dirloc + n - 1;
dafgda_(handle, &dirloc, &i__1, buffer);
remain -= n;
/* Determine the last directory element in BUFFER that's less */
/* than SCLKDP. */
i__ = lstltd_(sclkdp, &n, buffer);
if (i__ < n) {
group = group + i__ + 1;
fnd = TRUE_;
} else if (remain == 0) {
/* The request time is greater than the last directory time */
/* so we want the last group in the segment. */
group = nrdir + 1;
fnd = TRUE_;
} else {
/* Need to read another block of directory times. */
dirloc += n;
group += n;
}
}
}
/* Now we know which group of DIRSIZ (or less) times to look at. */
/* Out of the NUMREC SCLK times, the number that we should skip over */
/* to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
skip = (group - 1) * 100;
/* From this we can compute the address in the segment of the group */
/* of times we want. From the beginning, we need to pass through */
/* PSIZ * NUMREC pointing numbers to get to the first SCLK time. */
/* Then we skip over the number just computed above. */
grpadd = beg + numrec * psiz + skip;
/* The number of times that we have to look at may be less than */
/* DIRSIZ. However many there are, go ahead and read them into the */
/* buffer. */
/* Computing MIN */
i__1 = 100, i__2 = numrec - skip;
n = min(i__1,i__2);
i__1 = grpadd + n - 1;
dafgda_(handle, &grpadd, &i__1, buffer);
/* Find the largest time in the group less than or equal to the input */
/* time. */
i__ = lstled_(sclkdp, &n, buffer);
/* Find the pointing instances in the segment that bracket the */
/* request time and calculate the addresses for the pointing data */
/* associated with these times. For cases in which the request time */
/* is equal to one of the times in the segment, that time will be */
/* the left bracketing time of the returned pair. */
/* Need to handle the cases when the request time is greater than */
/* the last or less than the first time in the segment separately. */
if (i__ == 0) {
if (group == 1) {
/* The time occurs before the first time in the segment. Since */
/* this time cannot possibly be in any of the intervals, the */
/* first time can satisfy the request for pointing only if it */
/* is within the tolerance of the request time. */
if (buffer[0] - *sclkdp <= *tol) {
record[0] = buffer[0];
record[8] = buffer[0];
/* Calculate the address of the quaternion and angular */
/* velocity data. Then read it from the file. */
i__1 = beg + psiz - 1;
dafgda_(handle, &beg, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
record[16] = *sclkdp;
*found = TRUE_;
}
chkout_("CKR03", (ftnlen)5);
return 0;
} else {
/* The first time in the current group brackets the request */
/* time on the right and the last time from the preceding */
/* group brackets on the left. */
rsclk = buffer[0];
raddr = beg + skip * psiz;
i__1 = grpadd - 1;
i__2 = grpadd - 1;
dafgda_(handle, &i__1, &i__2, &lsclk);
laddr = raddr - psiz;
}
} else if (i__ == n) {
/* There are two possible cases, but the same action can handle */
/* both. */
/* 1) If this is the last group ( NRDIR + 1 ) then the request */
/* time occurs on or after the last time in the segment. */
/* In either case this last time can satisfy the request for */
/* pointing only if it is within the tolerance of the request */
/* time. */
/* 2) The request time is greater than or equal to the last time */
/* in this group. Since this time is the same as the (I+1)th */
/* directory time, and since the search on the directory times */
/* used a strictly less than test, we know that the request */
/* time must be equal to this time. Just return the pointing */
/* instance associated with the request time. ( Note that */
/* SCLKDP - BUFFER(N) will be zero in this case. ) */
if (*sclkdp - buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)826)] <= *tol) {
record[0] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)828)];
record[8] = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)829)];
/* Calculate the address of the quaternion and angular */
/* velocity data. Then read it from the file. */
addr__ = beg + psiz * (skip + n - 1);
i__1 = addr__ + psiz - 1;
dafgda_(handle, &addr__, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
record[16] = *sclkdp;
*found = TRUE_;
}
chkout_("CKR03", (ftnlen)5);
return 0;
} else {
/* The bracketing times are contained in this group. */
lsclk = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 : s_rnge(
"buffer", i__1, "ckr03_", (ftnlen)855)];
rsclk = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge("buff"
"er", i__1, "ckr03_", (ftnlen)856)];
laddr = beg + (skip + i__ - 1) * psiz;
raddr = laddr + psiz;
}
/* At this point we have the two times in the segment that bracket */
/* the request time. We also have the addresses of the pointing */
/* data associated with those times. The task now is to determine */
/* if the bracketing times fall in the same interval. If so then */
/* we can interpolate between them. If they don't then return */
/* pointing for whichever of the two times is closest to the */
/* request time, provided that it is within the tolerance. */
/* Find the interpolation interval that the request time is in and */
/* determine if the bracketing SCLK's are both in it. */
/* First check if the request time falls in the same interval as */
/* it did last time. We need to make sure that we are dealing */
/* with the same segment as well as the same time range. */
/* PREVS is the start time of the interval that satisfied */
/* the previous request for pointing. */
/* PREVN is the start time of the interval that followed */
/* the interval specified above. */
/* LHAND is the handle of the file that PREVS and PREVN */
/* were found in. */
/* LBEG, are the beginning and ending addresses of the */
/* LEND segment in the file LHAND that PREVS and PREVN */
/* were found in. */
if (*handle == lhand && beg == lbeg && end == lend && *sclkdp >= prevs &&
*sclkdp < prevn) {
start = prevs;
nstart = prevn;
} else {
/* The START times of all of the intervals are stored in the */
/* segment and a directory of every hundredth START is also */
/* stored. The procedure to find the bracketing interval start */
/* times is identical to the one used above for finding the */
/* bracketing times. */
/* The directory epochs narrow down the search for the times that */
/* bracket the request time to a group of DIRSIZ or fewer records. */
/* There is only one group if there are no directory epochs. */
if (nidir == 0) {
group = 1;
} else {
/* Compute the location of the first directory epoch. From the */
/* beginning of the segment, we need to go through all of the */
/* pointing numbers (PSIZ*NUMREC of them), then through all of */
/* the NUMREC SCLK times and NRDIR directory times, and then */
/* finally through the NUMINT interval start times. */
dirloc = beg + (psiz + 1) * numrec + nrdir + numint;
/* Locate the largest directory time less than the */
/* request time SCLKDP. */
/* Read in as many as BUFSIZ directory epochs at a time for */
/* comparison. */
fnd = FALSE_;
remain = nidir;
group = 0;
while(! fnd) {
/* The number of records to read into the buffer. */
n = min(remain,100);
i__1 = dirloc + n - 1;
dafgda_(handle, &dirloc, &i__1, buffer);
remain -= n;
/* Determine the last directory element in BUFFER that's */
/* less than SCLKDP. */
i__ = lstltd_(sclkdp, &n, buffer);
if (i__ < n) {
group = group + i__ + 1;
fnd = TRUE_;
} else if (remain == 0) {
/* The request time is greater than the last directory */
/* time so we want the last group in the segment. */
group = nidir + 1;
fnd = TRUE_;
} else {
/* Need to read another block of directory times. */
dirloc += n;
group += n;
}
}
}
/* Now we know which group of DIRSIZ (or less) times to look at. */
/* Out of the NUMINT SCLK START times, the number that we should */
/* skip over to get to the proper group is DIRSIZ * ( GROUP - 1 ). */
skip = (group - 1) * 100;
/* From this we can compute the address in the segment of the */
/* group of times we want. To get to the first interval start */
/* time we must pass over PSIZ * NUMREC pointing numbers, NUMREC */
/* SCLK times, and NRDIR SCLK directory times. Then we skip */
/* over the number just computed above. */
grpadd = beg + (psiz + 1) * numrec + nrdir + skip;
/* The number of times that we have to look at may be less than */
/* DIRSIZ. However many there are, go ahead and read them into */
/* the buffer. */
/* Computing MIN */
i__1 = 100, i__2 = numint - skip;
n = min(i__1,i__2);
i__1 = grpadd + n - 1;
dafgda_(handle, &grpadd, &i__1, buffer);
/* Find the index of the largest time in the group that is less */
/* than or equal to the input time. */
i__ = lstled_(sclkdp, &n, buffer);
if (i__ == 0) {
/* The first start time in the buffer is the start of the */
/* interval following the one containing the request time. */
/* We don't need to check if GROUP = 1 because the case of */
/* the request time occurring before the first time in the */
/* segment has already been handled. */
nstart = buffer[0];
addr__ = grpadd - 1;
dafgda_(handle, &addr__, &addr__, &start);
} else if (i__ == n) {
if (group == nidir + 1) {
/* This is the last interval in the segment. */
start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)1040)];
nstart = dpmax_();
} else {
/* The last START time in this group is equal to the */
/* request time. */
start = buffer[(i__1 = n - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)1049)];
addr__ = grpadd + n;
dafgda_(handle, &addr__, &addr__, &nstart);
}
} else {
/* The bracketing START times are contained in this group. */
start = buffer[(i__1 = i__ - 1) < 100 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "ckr03_", (ftnlen)1061)];
nstart = buffer[(i__1 = i__) < 100 && 0 <= i__1 ? i__1 : s_rnge(
"buffer", i__1, "ckr03_", (ftnlen)1062)];
}
/* Save the information about the interval and segment. */
lhand = *handle;
lbeg = beg;
lend = end;
prevs = start;
prevn = nstart;
}
/* Check and see if the bracketing pointing instances belong */
/* to the same interval. If they do then we can interpolate */
/* between them, if not then check to see if the closer of */
/* the two to the request time lies within the tolerance. */
/* The left bracketing time will always belong to the same */
/* interval as the request time, therefore we need to check */
/* only that the right bracketing time is less than the start */
/* time of the next interval. */
if (rsclk < nstart) {
record[0] = lsclk;
i__1 = laddr + psiz - 1;
dafgda_(handle, &laddr, &i__1, &record[1]);
record[8] = rsclk;
i__1 = raddr + psiz - 1;
dafgda_(handle, &raddr, &i__1, &record[9]);
record[16] = *sclkdp;
*found = TRUE_;
} else {
ldiff = *sclkdp - lsclk;
rdiff = rsclk - *sclkdp;
if (ldiff <= *tol || rdiff <= *tol) {
/* Return the pointing instance closest to the request time. */
/* If the request time is midway between LSCLK and RSCLK then */
/* grab the pointing instance associated with the greater time. */
if (ldiff < rdiff) {
record[0] = lsclk;
record[8] = lsclk;
i__1 = laddr + psiz - 1;
dafgda_(handle, &laddr, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
} else {
record[0] = rsclk;
record[8] = rsclk;
i__1 = raddr + psiz - 1;
dafgda_(handle, &raddr, &i__1, buffer);
moved_(buffer, &psiz, &record[1]);
moved_(buffer, &psiz, &record[9]);
}
record[16] = *sclkdp;
*found = TRUE_;
}
}
chkout_("CKR03", (ftnlen)5);
return 0;
} /* ckr03_ */
/* $Procedure CKR05 ( Read CK record from segment, type 05 ) */
/* Subroutine */ int ckr05_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
*found)
{
/* Initialized data */
static integer lbeg = -1;
static integer lend = -1;
static integer lhand = 0;
static doublereal prevn = -1.;
static doublereal prevnn = -1.;
static doublereal prevs = -1.;
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer high;
doublereal rate;
integer last, type__, i__, j, n;
doublereal t;
integer begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer nidir;
extern doublereal dpmax_(void);
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer npdir, nsrch;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer lsize, first, nints, rsize;
doublereal start;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal dc[2];
integer ic[6];
extern logical failed_(void);
integer bufbas, dirbas;
doublereal hepoch;
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal lepoch;
integer npread, nsread, remain, pbegix, sbegix, timbas;
doublereal pbuffr[101];
extern integer lstled_(doublereal *, integer *, doublereal *);
doublereal sbuffr[103];
integer pendix, sendix, packsz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer maxwnd;
doublereal contrl[5];
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
doublereal nstart;
extern logical return_(void);
integer pgroup, sgroup, wndsiz, wstart, subtyp;
doublereal nnstrt;
extern logical odd_(integer *);
integer end, low;
/* $ Abstract */
/* Read a single CK data record from a segment of type 05 */
/* (MEX/Rosetta Attitude file interpolation). */
/* $ 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 */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to CK type 05. */
/* $ 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 */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */
/* -& */
/* CK type 5 subtype codes: */
/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */
/* and quaternion derivatives only, no angular velocity */
/* vector provided. Quaternion elements are listed */
/* first, followed by derivatives. Angular velocity is */
/* derived from the quaternions and quaternion */
/* derivatives. */
/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */
/* only. Angular velocity is derived by differentiating */
/* the interpolating polynomials. */
/* Subtype 2: Hermite interpolation, 14-element packets. */
/* Quaternion and angular angular velocity vector, as */
/* well as derivatives of each, are provided. The */
/* quaternion comes first, then quaternion derivatives, */
/* then angular velocity and its derivatives. */
/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */
/* and angular velocity vector provided. The quaternion */
/* comes first. */
/* Packet sizes associated with the various subtypes: */
/* End of file ck05.inc. */
/* $ 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 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 */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK4RSZ.) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Pointing request time. */
/* TOL I Lookup tolerance. */
/* NEEDAV I Angular velocity flag. */
/* RECORD O Data record. */
/* FOUND O Flag indicating whether record was found. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* a CK segment of type 05. */
/* SCLKDP is an encoded spacecraft clock time indicating */
/* the epoch for which pointing is desired. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. */
/* When SCLKDP falls within the bounds of one of the */
/* interpolation intervals then the tolerance has no */
/* effect because pointing will be returned at the */
/* request time. */
/* However, if the request time is not in one of the */
/* intervals, then the tolerance is used to determine */
/* if pointing at one of the interval endpoints should */
/* be returned. */
/* NEEDAV is true if angular velocity is requested. */
/* $ Detailed_Output */
/* RECORD is a set of data from the specified segment which, */
/* when evaluated at epoch SCLKDP, will give the */
/* attitude and angular velocity of some body, relative */
/* to the reference frame indicated by DESCR. */
/* The structure of the record is as follows: */
/* +----------------------+ */
/* | evaluation epoch | */
/* +----------------------+ */
/* | subtype code | */
/* +----------------------+ */
/* | number of packets (n)| */
/* +----------------------+ */
/* | nominal SCLK rate | */
/* +----------------------+ */
/* | packet 1 | */
/* +----------------------+ */
/* | packet 2 | */
/* +----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------+ */
/* | packet n | */
/* +----------------------+ */
/* | epochs 1--n | */
/* +----------------------+ */
/* The packet size is a function of the subtype code. */
/* All packets in a record have the same size. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* This routine follows the pattern established in the lower-numbered */
/* CK data type readers of not explicitly performing error */
/* diagnoses. Exceptions are listed below nonetheless. */
/* 1) If the input HANDLE does not designate a loaded CK file, the */
/* error will be diagnosed by routines called by this routine. */
/* 2) If the segment specified by DESCR is not of data type 05, */
/* the error 'SPICE(WRONGCKTYPE)' is signaled. */
/* 3) If the input SCLK value is not within the range specified */
/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */
/* is signaled. */
/* 4) If the window size is non-positive or greater than the */
/* maximum allowed value, the error SPICE(INVALIDVALUE) is */
/* signaled. */
/* 5) If the window size is not compatible with the segment */
/* subtype, the error SPICE(INVALIDVALUE) is signaled. */
/* 6) If the segment subtype is not recognized, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 7) If the tolerance is negative, the error SPICE(VALUEOUTOFRANGE) */
/* is signaled. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the CK Required Reading file for a description of the */
/* structure of a data type 05 segment. */
/* $ Examples */
/* The data returned by the CKRnn 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 CKRxx */
/* 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 */
/* C CALL CKBSS ( INST, SCLKDP, TOL, NEEDAV ) */
/* CALL CKSNS ( HANDLE, DESCR, SEGID, SFND ) */
/* IF ( .NOT. SFND ) THEN */
/* [Handle case of pointing not being found] */
/* END IF */
/* 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. 05 ) THEN */
/* CALL CKR05 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* [Handle case of pointing not being found] */
/* END IF */
/* [Look at the RECORD data] */
/* . */
/* . */
/* . */
/* END IF */
/* $ Restrictions */
/* 1) Correctness of inputs must be ensured by the caller of */
/* this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 06-SEP-2002 (NJB) */
/* -& */
/* $ Index_Entries */
/* read record from type_5 ck segment */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Maximum polynomial degree: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKR05", (ftnlen)5);
/* No pointing found so far. */
*found = FALSE_;
/* Unpack the segment descriptor, and get the start and end addresses */
/* of the segment. */
dafus_(descr, &c__2, &c__6, dc, ic);
type__ = ic[2];
begin = ic[4];
end = ic[5];
/* Make sure that this really is a type 05 data segment. */
if (type__ != 5) {
setmsg_("You are attempting to locate type * data in a type 5 data s"
"egment.", (ftnlen)66);
errint_("*", &type__, (ftnlen)1);
sigerr_("SPICE(WRONGCKTYPE)", (ftnlen)18);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative but was actually *.", (ftnlen)
50);
errdp_("*", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the request time and tolerance against the bounds in */
/* the segment descriptor. */
if (*sclkdp + *tol < dc[0] || *sclkdp - *tol > dc[1]) {
/* The request time is too far outside the segment's coverage */
/* interval for any pointing to satisfy the request. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Set the request time to use for searching. */
t = brcktd_(sclkdp, dc, &dc[1]);
/* From this point onward, we assume the segment was constructed */
/* correctly. In particular, we assume: */
/* 1) The segment descriptor's time bounds are in order and are */
/* distinct. */
/* 2) The epochs in the segment are in strictly increasing */
/* order. */
/* 3) The interpolation interval start times in the segment are */
/* in strictly increasing order. */
/* 4) The degree of the interpolating polynomial specified by */
/* the segment is at least 1 and is no larger than MAXDEG. */
i__1 = end - 4;
dafgda_(handle, &i__1, &end, contrl);
/* Check the FAILED flag just in case HANDLE is not attached to */
/* any DAF file and the error action is not set to ABORT. We */
/* do this only after the first call to DAFGDA, as in CKR03. */
if (failed_()) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
rate = contrl[0];
subtyp = i_dnnt(&contrl[1]);
wndsiz = i_dnnt(&contrl[2]);
nints = i_dnnt(&contrl[3]);
n = i_dnnt(&contrl[4]);
/* Set the packet size, which is a function of the subtype. */
if (subtyp == 0) {
packsz = 8;
} else if (subtyp == 1) {
packsz = 4;
} else if (subtyp == 2) {
packsz = 14;
} else if (subtyp == 3) {
packsz = 7;
} else {
setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", (
ftnlen)55);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the window size. */
if (wndsiz <= 0) {
setmsg_("Window size in type 05 segment was #; must be positive.", (
ftnlen)55);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (subtyp == 0 || subtyp == 2) {
/* These are the Hermite subtypes. */
maxwnd = 8;
if (wndsiz > maxwnd) {
setmsg_("Window size in type 05 segment was #; max allowed value"
" is # for subtypes 0 and 2 (Hermite, 8 or 14-element pac"
"kets).", (ftnlen)117);
errint_("#", &wndsiz, (ftnlen)1);
errint_("#", &maxwnd, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (odd_(&wndsiz)) {
setmsg_("Window size in type 05 segment was #; must be even for "
"subtypes 0 and 2 (Hermite, 8 or 14-element packets).", (
ftnlen)107);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
} else if (subtyp == 1 || subtyp == 3) {
/* These are the Lagrange subtypes. */
maxwnd = 16;
if (wndsiz > maxwnd) {
setmsg_("Window size in type 05 segment was #; max allowed value"
" is # for subtypes 1 and 3 (Lagrange, 4 or 7-element pac"
"kets).", (ftnlen)117);
errint_("#", &wndsiz, (ftnlen)1);
errint_("#", &maxwnd, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (odd_(&wndsiz)) {
setmsg_("Window size in type 05 segment was #; must be even for "
"subtypes 1 and 3 (Lagrange, 4 or 7-element packets).", (
ftnlen)107);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
} else {
setmsg_("This point should not be reached. Getting here may indicate"
" that the code needs to updated to handle the new subtype #",
(ftnlen)118);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* We now need to select the pointing values to interpolate */
/* in order to satisfy the pointing request. The first step */
/* is to use the pointing directories (if any) to locate a set of */
/* epochs bracketing the request time. Note that the request */
/* time might not be bracketed: it could precede the first */
/* epoch or follow the last epoch. */
/* We'll use the variable PGROUP to refer to the set of epochs */
/* to search. The first group consists of the epochs prior to */
/* and including the first pointing directory entry. The last */
/* group consists of the epochs following the last pointing */
/* directory entry. Other groups consist of epochs following */
/* one pointing directory entry up to and including the next */
/* pointing directory entry. */
npdir = (n - 1) / 100;
dirbas = begin + n * packsz + n - 1;
if (npdir == 0) {
/* There's no mystery about which group of epochs to search. */
pgroup = 1;
} else {
/* There's at least one directory. Find the first directory */
/* whose time is greater than or equal to the request time, if */
/* there is such a directory. We'll search linearly through the */
/* directory entries, reading up to DIRSIZ of them at a time. */
/* Having found the correct set of directory entries, we'll */
/* perform a binary search within that set for the desired entry. */
bufbas = dirbas;
npread = min(npdir,100);
i__1 = bufbas + 1;
i__2 = bufbas + npread;
dafgda_(handle, &i__1, &i__2, pbuffr);
remain = npdir - npread;
while(pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)633)] < t && remain > 0) {
bufbas += npread;
npread = min(remain,100);
/* Note: NPREAD is always > 0 here. */
i__1 = bufbas + 1;
i__2 = bufbas + npread;
dafgda_(handle, &i__1, &i__2, pbuffr);
remain -= npread;
}
/* At this point, BUFBAS - DIRBAS is the number of directory */
/* entries preceding the one contained in PBUFFR(1). */
/* PGROUP is one more than the number of directories we've */
/* passed by. */
pgroup = bufbas - dirbas + lstltd_(&t, &npread, pbuffr) + 1;
}
/* PGROUP now indicates the set of epochs in which to search for the */
/* request epoch. The following cases can occur: */
/* PGROUP = 1 */
/* ========== */
/* NPDIR = 0 */
/* -------- */
/* The request time may precede the first time tag */
/* of the segment, exceed the last time tag, or lie */
/* in the closed interval bounded by these time tags. */
/* NPDIR >= 1 */
/* --------- */
/* The request time may precede the first time tag */
/* of the group but does not exceed the last epoch */
/* of the group. */
/* 1 < PGROUP <= NPDIR */
/* =================== */
/* The request time follows the last time of the */
/* previous group and is less than or equal to */
/* the pointing directory entry at index PGROUP. */
/* 1 < PGROUP = NPDIR + 1 */
/* ====================== */
/* The request time follows the last time of the */
/* last pointing directory entry. The request time */
/* may exceed the last time tag. */
/* Now we'll look up the time tags in the group of epochs */
/* we've identified. */
/* We'll use the variable names PBEGIX and PENDIX to refer to */
/* the indices, relative to the set of time tags, of the first */
/* and last time tags in the set we're going to look up. */
if (pgroup == 1) {
pbegix = 1;
pendix = min(n,100);
} else {
/* If the group index is greater than 1, we'll include the last */
/* time tag of the previous group in the set of time tags we look */
/* up. That way, the request time is strictly bracketed on the */
/* low side by the time tag set we look up. */
pbegix = (pgroup - 1) * 100;
/* Computing MIN */
i__1 = pbegix + 100;
pendix = min(i__1,n);
}
timbas = dirbas - n;
i__1 = timbas + pbegix;
i__2 = timbas + pendix;
dafgda_(handle, &i__1, &i__2, pbuffr);
npread = pendix - pbegix + 1;
/* At this point, we'll deal with the cases where T lies outside */
/* of the range of epochs we've buffered. */
if (t < pbuffr[0]) {
/* This can happen only if PGROUP = 1 and T precedes all epochs. */
/* If the input request time is too far from PBUFFR(1) on */
/* the low side, we're done. */
if (*sclkdp + *tol < pbuffr[0]) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Bracket T to move it within the range of buffered epochs. */
t = pbuffr[0];
} else if (t > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 :
s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)748)]) {
/* This can happen only if T follows all epochs. */
if (*sclkdp - *tol > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)752)]) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Bracket T to move it within the range of buffered epochs. */
t = pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)762)];
}
/* At this point, */
/* | T - SCLKDP | <= TOL */
/* Also, one of the following is true: */
/* T is the first time of the segment */
/* T is the last time of the segment */
/* T equals SCLKDP */
/* Find two adjacent time tags bounding the request epoch. The */
/* request time cannot be greater than all of time tags in the */
/* group, and it cannot precede the first element of the group. */
i__ = lstltd_(&t, &npread, pbuffr);
/* The variables LOW and HIGH are the indices of a pair of time */
/* tags that bracket the request time. Remember that NPREAD could */
/* be equal to 1, in which case we would have LOW = HIGH. */
if (i__ == 0) {
/* This can happen only if PGROUP = 1 and T = PBUFFR(1). */
low = 1;
lepoch = pbuffr[0];
if (n == 1) {
high = 1;
} else {
high = 2;
}
hepoch = pbuffr[(i__1 = high - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)805)];
} else {
low = pbegix + i__ - 1;
lepoch = pbuffr[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)810)];
high = low + 1;
hepoch = pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbu"
"ffr", i__1, "ckr05_", (ftnlen)813)];
}
/* We now need to find the interpolation interval containing */
/* T, if any. We may be able to use the interpolation */
/* interval found on the previous call to this routine. If */
/* this is the first call or if the previous interval is not */
/* applicable, we'll search for the interval. */
/* First check if the request time falls in the same interval as */
/* it did last time. We need to make sure that we are dealing */
/* with the same segment as well as the same time range. */
/* PREVS is the start time of the interval that satisfied */
/* the previous request for pointing. */
/* PREVN is the start time of the interval that followed */
/* the interval specified above. */
/* PREVNN is the start time of the interval that followed */
/* the interval starting at PREVN. */
/* LHAND is the handle of the file that PREVS and PREVN */
/* were found in. */
/* LBEG, are the beginning and ending addresses of the */
/* LEND segment in the file LHAND that PREVS and PREVN */
/* were found in. */
if (*handle == lhand && begin == lbeg && end == lend && t >= prevs && t <
prevn) {
start = prevs;
nstart = prevn;
nnstrt = prevnn;
} else {
/* Search for the interpolation interval. */
nidir = (nints - 1) / 100;
dirbas = end - 5 - nidir;
if (nidir == 0) {
/* There's no mystery about which group of epochs to search. */
sgroup = 1;
} else {
/* There's at least one directory. Find the first directory */
/* whose time is greater than or equal to the request time, if */
/* there is such a directory. We'll search linearly through */
/* the directory entries, reading up to DIRSIZ of them at a */
/* time. Having found the correct set of directory entries, */
/* we'll perform a binary search within that set for the */
/* desired entry. */
bufbas = dirbas;
nsread = min(nidir,100);
remain = nidir - nsread;
i__1 = bufbas + 1;
i__2 = bufbas + nsread;
dafgda_(handle, &i__1, &i__2, sbuffr);
while(sbuffr[(i__1 = nsread - 1) < 103 && 0 <= i__1 ? i__1 :
s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)885)] < t &&
remain > 0) {
bufbas += nsread;
nsread = min(remain,100);
remain -= nsread;
/* Note: NSREAD is always > 0 here. */
i__1 = bufbas + 1;
i__2 = bufbas + nsread;
dafgda_(handle, &i__1, &i__2, sbuffr);
}
/* At this point, BUFBAS - DIRBAS is the number of directory */
/* entries preceding the one contained in SBUFFR(1). */
/* SGROUP is one more than the number of directories we've */
/* passed by. */
sgroup = bufbas - dirbas + lstltd_(&t, &nsread, sbuffr) + 1;
}
/* SGROUP now indicates the set of interval start times in which */
/* to search for the request epoch. */
/* Now we'll look up the time tags in the group of epochs we've */
/* identified. */
/* We'll use the variable names SBEGIX and SENDIX to refer to the */
/* indices, relative to the set of start times, of the first and */
/* last start times in the set we're going to look up. */
if (sgroup == 1) {
sbegix = 1;
sendix = min(nints,102);
} else {
/* Look up the start times for the group of interest. Also */
/* buffer last start time from the previous group. Also, it */
/* turns out to be useful to pick up two extra start */
/* times---the first two start times of the next group---if */
/* they exist. */
sbegix = (sgroup - 1) * 100;
/* Computing MIN */
i__1 = sbegix + 102;
sendix = min(i__1,nints);
}
timbas = dirbas - nints;
i__1 = timbas + sbegix;
i__2 = timbas + sendix;
dafgda_(handle, &i__1, &i__2, sbuffr);
nsread = sendix - sbegix + 1;
/* Find the last interval start time less than or equal to the */
/* request time. We know T is greater than or equal to the */
/* first start time, so I will be > 0. */
nsrch = min(101,nsread);
i__ = lstled_(&t, &nsrch, sbuffr);
start = sbuffr[(i__1 = i__ - 1) < 103 && 0 <= i__1 ? i__1 : s_rnge(
"sbuffr", i__1, "ckr05_", (ftnlen)956)];
/* Let NSTART ("next start") be the start time that follows */
/* START, if START is not the last start time. If NSTART */
/* has a successor, let NNSTRT be that start time. */
if (i__ < nsread) {
nstart = sbuffr[(i__1 = i__) < 103 && 0 <= i__1 ? i__1 : s_rnge(
"sbuffr", i__1, "ckr05_", (ftnlen)965)];
if (i__ + 1 < nsread) {
nnstrt = sbuffr[(i__1 = i__ + 1) < 103 && 0 <= i__1 ? i__1 :
s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)969)];
} else {
nnstrt = dpmax_();
}
} else {
nstart = dpmax_();
nnstrt = dpmax_();
}
}
/* If T does not lie within the interpolation interval starting */
/* at time START, we'll determine whether T is closer to this */
/* interval or the next. If the distance between T and the */
/* closer interval is less than or equal to TOL, we'll map T */
/* to the closer endpoint of the closer interval. Otherwise, */
/* we return without finding pointing. */
if (hepoch == nstart) {
/* The first time tag greater than or equal to T is the start */
/* time of the next interpolation interval. */
/* The request time lies between interpolation intervals. */
/* LEPOCH is the last time tag of the first interval; HEPOCH */
/* is the first time tag of the next interval. */
if ((d__1 = t - lepoch, abs(d__1)) <= (d__2 = hepoch - t, abs(d__2)))
{
/* T is closer to the first interval... */
if ((d__1 = t - lepoch, abs(d__1)) > *tol) {
/* ...But T is too far from the interval. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Map T to the right endpoint of the preceding interval. */
t = lepoch;
high = low;
hepoch = lepoch;
} else {
/* T is closer to the second interval... */
if ((d__1 = hepoch - t, abs(d__1)) > *tol) {
/* ...But T is too far from the interval. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Map T to the left endpoint of the next interval. */
t = hepoch;
low = high;
lepoch = hepoch;
/* Since we're going to be picking time tags from the next */
/* interval, we'll need to adjust START and NSTART. */
start = nstart;
nstart = nnstrt;
}
}
/* We now have */
/* LEPOCH < T < HEPOCH */
/* - - */
/* where LEPOCH and HEPOCH are the time tags at indices */
/* LOW and HIGH, respectively. */
/* Now select the set of packets used for interpolation. Note */
/* that the window size is known to be even. */
/* Unlike CK types 8, 9, 12, and 13, for type 05 we adjust */
/* the window size to keep the request time within the central */
/* interval of the window. */
/* The nominal bracketing epochs we've found are the (WNDSIZ/2)nd */
/* and (WNDSIZ/2 + 1)st of the interpolating set. If the request */
/* time is too close to one end of the interpolation interval, we */
/* reduce the window size, after which one endpoint of the window */
/* will coincide with an endpoint of the interpolation interval. */
/* We start out by looking up the set of time tags we'd use */
/* if there were no gaps in the coverage. We then trim our */
/* time tag set to ensure all tags are in the interpolation */
/* interval. It's possible that the interpolation window will */
/* collapse to a single point as a result of this last step. */
/* Let LSIZE be the size of the "left half" of the window: the */
/* size of the set of window epochs to the left of the request time. */
/* We want this size to be WNDSIZ/2, but if not enough states are */
/* available, the set ranges from index 1 to index LOW. */
/* Computing MIN */
i__1 = wndsiz / 2;
lsize = min(i__1,low);
/* RSIZE is defined analogously for the right half of the window. */
/* Computing MIN */
i__1 = wndsiz / 2, i__2 = n - high + 1;
rsize = min(i__1,i__2);
/* The window size is simply the sum of LSIZE and RSIZE. */
wndsiz = lsize + rsize;
/* FIRST and LAST are the endpoints of the range of indices of */
/* time tags (and packets) we'll collect in the output record. */
first = low - lsize + 1;
last = first + wndsiz - 1;
/* Buffer the epochs. */
wstart = begin + n * packsz + first - 1;
i__1 = wstart + wndsiz - 1;
dafgda_(handle, &wstart, &i__1, pbuffr);
/* Discard any epochs less than START or greater than or equal */
/* to NSTART. The set of epochs we want ranges from indices */
/* I+1 to J. This range is non-empty unless START and NSTART */
/* are both DPMAX(). */
i__ = lstltd_(&start, &wndsiz, pbuffr);
j = lstltd_(&nstart, &wndsiz, pbuffr);
if (i__ == j) {
/* Fuggedaboudit. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Update FIRST, LAST, and WNDSIZ. */
wndsiz = j - i__;
first += i__;
last = first + wndsiz - 1;
/* Put the subtype into the output record. The size of the group */
/* of packets is derived from the subtype, so we need not include */
/* the size. */
record[0] = t;
record[1] = (doublereal) subtyp;
record[2] = (doublereal) wndsiz;
record[3] = rate;
/* Read the packets. */
i__1 = begin + (first - 1) * packsz;
i__2 = begin + last * packsz - 1;
dafgda_(handle, &i__1, &i__2, &record[4]);
/* Finally, add the epochs to the output record. */
i__2 = j - i__;
moved_(&pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbuffr",
i__1, "ckr05_", (ftnlen)1158)], &i__2, &record[wndsiz * packsz +
4]);
/* Save the information about the interval and segment. */
lhand = *handle;
lbeg = begin;
lend = end;
prevs = start;
prevn = nstart;
prevnn = nnstrt;
/* Indicate pointing was found. */
*found = TRUE_;
chkout_("CKR05", (ftnlen)5);
return 0;
} /* ckr05_ */
/* $Procedure DASADD ( DAS, add data, double precision ) */
/* Subroutine */ int dasadd_(integer *handle, integer *n, doublereal *data)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer free;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer ncomc, recno, lastd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer ncomr, numdp;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int dascud_(integer *, integer *, integer *),
dashfs_(integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
doublereal record[128];
integer lastla[3];
extern /* Subroutine */ int dasurd_(integer *, integer *, integer *,
integer *, doublereal *), daswrd_(integer *, integer *,
doublereal *);
integer lastrc[3], clsize;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer lastwd[3], nresvc, wordno;
extern logical return_(void);
integer nresvr, nwritn;
/* $ Abstract */
/* Add an array of double precision numbers to a DAS file. */
/* $ 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 */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* N I Number of d.p. numbers to add to DAS file. */
/* DATA I Array of d.p. numbers to add. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* N is a the number of double precision `words' to */
/* add to the DAS file specified by HANDLE. */
/* DATA is an array of double precision numbers to be */
/* added to the specified DAS file. Elements */
/* 1 through N are appended to the double precision */
/* data in the file. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If an I/O error occurs during the data addition attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. */
/* 3) If the input count N is less than 1, no data will be */
/* added to the specified DAS file. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine adds double precision data to a DAS file by */
/* `appending' it after any double precision data already in the */
/* file. The sense in which the data is `appended' is that the */
/* data will occupy a range of logical addresses for double precision */
/* data that immediately follow the last logical address of a double */
/* precision number that is occupied at the time this routine is */
/* called. The diagram below illustrates this addition: */
/* +-------------------------+ */
/* | (already in use) | D.p. logical address 1 */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | (already in use) | Last d.p. logical address */
/* +-------------------------+ in use before call to DASADD */
/* | DATA(1) | */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | DATA(N) | */
/* +-------------------------+ */
/* The logical organization of the double precision numbers in the */
/* DAS file is independent of the order of addition to the file or */
/* physical location of any data of integer or character type. */
/* The actual physical write operations that add the input array */
/* DATA to the indicated DAS file may not take place before this */
/* routine returns, since the DAS system buffers data that is */
/* written as well as data that is read. In any case, the data */
/* will be flushed to the file at the time the file is closed, if */
/* not earlier. A physical write of all buffered records can be */
/* forced by calling the SPICELIB routine DASWBR ( DAS, write */
/* buffered records ). */
/* In order to update double precision logical addresses that */
/* already contain data, the SPICELIB routine DASUDD */
/* ( DAS update data, double precision ) should be used. */
/* $ Examples */
/* 1) Create the new DAS file TEST.DAS and add 200 double */
/* precision numbers to it. Close the file, then re-open */
/* it and read the data back out. */
/* PROGRAM TEST_ADD */
/* CHARACTER*(4) TYPE */
/* DOUBLE PRECISION DATA ( 200 ) */
/* INTEGER HANDLE */
/* INTEGER I */
/* C */
/* C Open a new DAS file. Use the file name as */
/* C the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Fill the array DATA with the double precision */
/* C numbers 1.D0 through 100.D0, and add this array */
/* C to the file. */
/* C */
/* DO I = 1, 100 */
/* DATA(I) = DBLE(I) */
/* END DO */
/* CALL DASADD ( HANDLE, 100, DATA ) */
/* C */
/* C Now append the array DATA to the file again. */
/* C */
/* CALL DASADD ( HANDLE, 100, DATA ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now verify the addition of data by opening the */
/* C file for read access and retrieving the data. */
/* C */
/* CALL DASRDD ( HANDLE, 1, 200, DATA ) */
/* C */
/* C Dump the data to the screen. We should see the */
/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. The */
/* C numbers will be represented as double precision */
/* C numbers in the output. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Data from TEST.DAS: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) DATA */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0 10-APR-2014 (NJB) */
/* Deleted declarations of unused parameters. */
/* Corrected header comments: routine that flushes */
/* written, buffered records is DASWBR, not DASWUR. */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* add double precision data to a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L, DASURD or */
/* DASWRD signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASADD", (ftnlen)6);
}
/* Get the file summary for this DAS. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
lastd = lastla[1];
/* We will keep track of the location that we wish to write to */
/* with the variables RECNO and WORDNO. RECNO will be the record */
/* number of the record we'll write to; WORDNO will be the number */
/* preceding the word index, within record number RECNO, that we'll */
/* write to. For example, if we're about to write to the first */
/* double precision number in record 10, RECNO will be 10 and */
/* WORDNO will be 0. Of course, when WORDNO reaches NWD, we'll */
/* have to find a free record before writing anything. */
/* Prepare the variables RECNO and WORDNO: use the physical */
/* location of the last double precision address, if there are any */
/* double precision data in the file. Otherwise, RECNO becomes the */
/* first record available for double precision data. */
if (lastd >= 1) {
dasa2l_(handle, &c__2, &lastd, &clbase, &clsize, &recno, &wordno);
} else {
recno = free;
wordno = 0;
}
/* Set the number of double precision words already written. Keep */
/* writing to the file until this number equals the number of */
/* elements in DATA. */
/* Note that if N is non-positive, the loop doesn't get exercised. */
nwritn = 0;
while(nwritn < *n && ! failed_()) {
/* Write as much data as we can (or need to) into the current */
/* record. We assume that RECNO, WORDNO, and NWRITN have been */
/* set correctly at this point. */
/* Find out how many words to write into the current record. */
/* There may be no space left in the current record. */
/* Computing MIN */
i__1 = *n - nwritn, i__2 = 128 - wordno;
numdp = min(i__1,i__2);
if (numdp > 0) {
/* Write NUMDP words into the current record. If the record */
/* is new, write the entire record. Otherwise, just update */
/* the part we're interested in. */
if (wordno == 0) {
moved_(&data[nwritn], &numdp, record);
daswrd_(handle, &recno, record);
} else {
i__1 = wordno + 1;
i__2 = wordno + numdp;
dasurd_(handle, &recno, &i__1, &i__2, &data[nwritn]);
}
nwritn += numdp;
wordno += numdp;
} else {
/* It's time to start on a new record. If the record we */
/* just finished writing to (or just attempted writing to, */
/* if it was full) was FREE or a higher-numbered record, */
/* then we are writing to a contiguous set of data records: */
/* the next record to write to is the immediate successor */
/* of the last one. Otherwise, FREE is the next record */
/* to write to. */
/* We intentionally leave FREE at the value it had before */
/* we starting adding data to the file. */
if (recno >= free) {
++recno;
} else {
recno = free;
}
wordno = 0;
}
}
/* Update the DAS file directories to reflect the addition of N */
/* double precision words. DASCUD will also update the file summary */
/* accordingly. */
dascud_(handle, &c__2, n);
chkout_("DASADD", (ftnlen)6);
return 0;
} /* dasadd_ */
/* $Procedure SPKE15 ( Evaluate a type 15 SPK data record) */
/* Subroutine */ int spke15_(doublereal *et, doublereal *recin, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), d_mod(doublereal *, doublereal *), d_sign(
doublereal *, doublereal *);
/* Local variables */
doublereal near__, dmdt;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer j2flg;
doublereal p, angle, dnode, z__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, speed, dperi, theta, manom;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
errdp_(char *, doublereal *, ftnlen), vcrss_(doublereal *,
doublereal *, doublereal *);
extern doublereal twopi_(void);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal oneme2, state0[6];
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal pa[3], gm, ta, dt;
extern doublereal pi_(void);
doublereal tp[3], pv[3], cosinc;
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen);
doublereal tmpsta[6], oj2;
extern logical return_(void);
doublereal ecc;
extern doublereal dpr_(void);
doublereal dot, rpl, k2pi;
/* $ Abstract */
/* Evaluates a single SPK data record from a segment of type 15 */
/* (Precessing Conic Propagation). */
/* $ 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECIN I Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, specified as ephemeris seconds past */
/* J2000, at which a state vector is to be computed. */
/* RECIN is a data record 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. */
/* The structure of RECIN is: */
/* RECIN(1) epoch of periapsis */
/* in ephemeris seconds past J2000. */
/* RECIN(2)-RECIN(4) unit trajectory pole vector */
/* RECIN(5)-RECIN(7) unit periapsis vector */
/* RECIN(8) semi-latus rectum---p in the */
/* equation: */
/* r = p/(1 + ECC*COS(Nu)) */
/* RECIN(9) eccentricity */
/* RECIN(10) J2 processing flag describing */
/* what J2 corrections are to be */
/* applied when the orbit is */
/* propagated. */
/* All J2 corrections are applied */
/* if this flag has a value that */
/* is not 1,2 or 3. */
/* If the value of the flag is 3 */
/* no corrections are done. */
/* If the value of the flag is 1 */
/* no corrections are computed for */
/* the precession of the line */
/* of apsides. However, regression */
/* of the line of nodes is */
/* performed. */
/* If the value of the flag is 2 */
/* no corrections are done for */
/* the regression of the line of */
/* nodes. However, precession of the */
/* line of apsides is performed. */
/* Note that J2 effects are computed */
/* only if the orbit is elliptic and */
/* does not intersect the central */
/* body. */
/* RECIN(11)-RECIN(13) unit central body pole vector */
/* RECIN(14) central body GM */
/* RECIN(15) central body J2 */
/* RECIN(16) central body radius */
/* Units are radians, km, seconds */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECIN at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity is less than zero, the error */
/* 'SPICE(BADECCENTRICITY)' will be signalled. */
/* 2) If the semi-latus rectum is non-positive, the error */
/* 'SPICE(BADLATUSRECTUM)' is signalled. */
/* 3) If the pole vector, trajectory pole vector or periapsis vector */
/* has zero length, the error 'SPICE(BADVECTOR)' is signalled. */
/* 4) If the trajectory pole vector and the periapsis vector are */
/* not orthogonal, the error 'SPICE(BADINITSTATE)' is */
/* signalled. The test for orthogonality is very crude. The */
/* routine simply checks that the absolute value of the dot */
/* product of the unit vectors parallel to the trajectory pole */
/* and periapse vectors is less than 0.00001. This check is */
/* intended to catch blunders, not to enforce orthogonality to */
/* double precision tolerance. */
/* 5) If the mass of the central body is non-positive, the error */
/* 'SPICE(NONPOSITIVEMASS)' is signalled. */
/* 6) If the radius of the central body is negative, the error */
/* 'SPICE(BADRADIUS)' is signalled. */
/* $ Particulars */
/* This algorithm applies J2 corrections for precessing the */
/* node and argument of periapse for an object orbiting an */
/* oblate spheroid. */
/* Note the effects of J2 are incorporated only for elliptic */
/* orbits that do not intersect the central body. */
/* While the derivation of the effect of the various harmonics */
/* of gravitational field are beyond the scope of this header */
/* the effect of the J2 term of the gravity model are as follows */
/* The line of node precesses. Over one orbit average rate of */
/* precession, DNode/dNu, is given by */
/* 3 J2 */
/* dNode/dNu = - ----------------- DCOS( inc ) */
/* 2 (P/RPL)**2 */
/* (Since this is always less than zero for oblate spheroids, this */
/* should be called regression of nodes.) */
/* The line of apsides precesses. The average rate of precession */
/* DPeri/dNu is given by */
/* 3 J2 */
/* dPeri/dNu = ----------------- ( 5*DCOS ( inc ) - 1 ) */
/* 2 (P/RPL)**2 */
/* Details of these formulae are given in the Battin's book (see */
/* literature references below). */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR15 as shown here: */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECIN ) */
/* CALL SPKE15 ( ET, RECIN, STATE ) */
/* where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 15 data segment. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* 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 SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* 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. 15 ) THEN */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE15 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* S. Schlaifer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* [1] `Fundamentals of Celestial Mechanics', Second Edition 1989 */
/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */
/* Richmond Virginia; pp 345-347. */
/* [2] `Astronautical Guidance', by Richard H. Battin. 1964 */
/* McGraw-Hill Book Company, San Francisco. pp 199 */
/* $ Version */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* $ Index_Entries */
/* evaluate type_15 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKE15", (ftnlen)6);
/* Fetch the various entities from the input record, first the epoch. */
epoch = recin[0];
/* The trajectory pole vector. */
vequ_(&recin[1], tp);
/* The periapsis vector. */
vequ_(&recin[4], pa);
/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */
/* and eccentricity. */
p = recin[7];
ecc = recin[8];
/* J2 processing flag. */
j2flg = (integer) recin[9];
/* Central body pole vector. */
vequ_(&recin[10], pv);
/* The central mass, J2 and radius of the central body. */
gm = recin[13];
oj2 = recin[14];
rpl = recin[15];
/* Check all the inputs here for obvious failures. Yes, perhaps */
/* this is overkill. However, there is a lot more computation */
/* going on in this routine so that the small amount of overhead */
/* here should not be significant. */
if (p <= 0.) {
setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator"
" was non-positive. This value must be positive. The value s"
"upplied was #.", (ftnlen)133);
errdp_("#", &p, (ftnlen)1);
sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (ecc < 0.) {
setmsg_("The eccentricity supplied for a type 15 segment is negative"
". It must be non-negative. The value supplied to the type 1"
"5 evaluator was #. ", (ftnlen)138);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (gm <= 0.) {
setmsg_("The mass supplied for the central body of a type 15 segment"
" was non-positive. Masses must be positive. The value suppl"
"ied was #. ", (ftnlen)130);
errdp_("#", &gm, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(tp)) {
setmsg_("The trajectory pole vector supplied to SPKE15 had length ze"
"ro. The most likely cause of this problem is a corrupted SPK"
" (ephemeris) file. ", (ftnlen)138);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pa)) {
setmsg_("The periapse vector supplied to SPKE15 had length zero. The"
" most likely cause of this problem is a corrupted SPK (ephem"
"eris) file. ", (ftnlen)131);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pv)) {
setmsg_("The central pole vector supplied to SPKE15 had length zero."
" The most likely cause of this problem is a corrupted SPK (e"
"phemeris) file. ", (ftnlen)135);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (rpl < 0.) {
setmsg_("The central body radius was negative. It must be zero or po"
"sitive. The value supplied was #. ", (ftnlen)94);
errdp_("#", &rpl, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Convert TP, PV and PA to unit vectors. */
/* (It won't hurt to polish them up a bit here if they are already */
/* unit vectors.) */
vhatip_(pa);
vhatip_(tp);
vhatip_(pv);
/* One final check. Make sure the pole and periapse vectors are */
/* orthogonal. (We will use a very crude check but this should */
/* rule out any obvious errors.) */
dot = vdot_(pa, tp);
if (abs(dot) > 1e-5) {
angle = vsep_(pa, tp) * dpr_();
setmsg_("The periapsis and trajectory pole vectors are not orthogona"
"l. The anglebetween them is # degrees. ", (ftnlen)98);
errdp_("#", &angle, (ftnlen)1);
sigerr_("SPICE(BADINITSTATE)", (ftnlen)19);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Compute the distance and speed at periapse. */
near__ = p / (ecc + 1.);
speed = sqrt(gm / p) * (ecc + 1.);
/* Next get the position at periapse ... */
vscl_(&near__, pa, state0);
/* ... and the velocity at periapsis. */
vcrss_(tp, pa, &state0[3]);
vsclip_(&speed, &state0[3]);
/* Determine the elapsed time from periapse to the requested */
/* epoch and propagate the state at periapsis to the epoch of */
/* interest. */
/* Note that we are making use of the following fact. */
/* If R is a rotation, then the states obtained by */
/* the following blocks of code are mathematically the */
/* same. (In reality they may differ slightly due to */
/* roundoff.) */
/* Code block 1. */
/* CALL MXV ( R, STATE0, STATE0 ) */
/* CALL MXV ( R, STATE0(4), STATE0(4) ) */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* Code block 2. */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* CALL MXV ( R, STATE, STATE ) */
/* CALL MXV ( R, STATE(4), STATE(4) ) */
/* This allows us to first compute the propagation of our initial */
/* state and then if needed perform the precession of the line */
/* of nodes and apsides by simply precessing the resulting state. */
dt = *et - epoch;
prop2b_(&gm, state0, &dt, state);
/* If called for, handle precession needed due to the J2 term. Note */
/* that the motion of the lines of nodes and apsides is formulated */
/* in terms of the true anomaly. This means we need the accumulated */
/* true anomaly in order to properly transform the state. */
if (j2flg != 3 && oj2 != 0. && ecc < 1. && near__ > rpl) {
/* First compute the change in mean anomaly since periapsis. */
/* Computing 2nd power */
d__1 = ecc;
oneme2 = 1. - d__1 * d__1;
dmdt = oneme2 / p * sqrt(gm * oneme2 / p);
manom = dmdt * dt;
/* Next compute the angle THETA such that THETA is between */
/* -pi and pi and such than MANOM = THETA + K*2*pi for */
/* some integer K. */
d__1 = twopi_();
theta = d_mod(&manom, &d__1);
if (abs(theta) > pi_()) {
d__1 = twopi_();
theta -= d_sign(&d__1, &theta);
}
k2pi = manom - theta;
/* We can get the accumulated true anomaly from the propagated */
/* state theta and the accumulated mean anomaly prior to this */
/* orbit. */
ta = vsep_(pa, state);
ta = d_sign(&ta, &theta);
ta += k2pi;
/* Determine how far the line of nodes and periapsis have moved. */
cosinc = vdot_(pv, tp);
/* Computing 2nd power */
d__1 = rpl / p;
z__ = ta * 1.5 * oj2 * (d__1 * d__1);
dnode = -z__ * cosinc;
/* Computing 2nd power */
d__1 = cosinc;
dperi = z__ * (d__1 * d__1 * 2.5 - .5);
/* Precess the periapsis by rotating the state vector about the */
/* trajectory pole */
if (j2flg != 1) {
vrotv_(state, tp, &dperi, tmpsta);
vrotv_(&state[3], tp, &dperi, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* Regress the line of nodes by rotating the state */
/* about the pole of the central body. */
if (j2flg != 2) {
vrotv_(state, pv, &dnode, tmpsta);
vrotv_(&state[3], pv, &dnode, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* We could perform the rotations above in the other order, */
/* but we would also have to rotate the pole before precessing */
/* the line of apsides. */
}
/* That's all folks. Check out and return. */
chkout_("SPKE15", (ftnlen)6);
return 0;
} /* spke15_ */
/* $Procedure TIPBOD ( Transformation, inertial position to bodyfixed ) */
/* Subroutine */ int tipbod_(char *ref, integer *body, doublereal *et,
doublereal *tipm, ftnlen ref_len)
{
doublereal ref2j[9] /* was [3][3] */;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
extern logical failed_(void);
extern /* Subroutine */ int bodmat_(integer *, doublereal *, doublereal *)
, chkout_(char *, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int irftrn_(char *, char *, doublereal *, ftnlen,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return a 3x3 matrix that transforms positions in inertial */
/* coordinates to positions in body-equator-and-prime-meridian */
/* coordinates. */
/* $ 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 */
/* PCK */
/* NAIF_IDS */
/* ROTATION */
/* TIME */
/* $ Keywords */
/* TRANSFORMATION */
/* ROTATION */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* REF I ID of inertial reference frame to transform from. */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation (position), inertial to prime */
/* meridian. */
/* $ Detailed_Input */
/* REF is the NAIF name for an inertial reference frame. */
/* Acceptable names include: */
/* Name Description */
/* -------- -------------------------------- */
/* 'J2000' Earth mean equator, dynamical */
/* equinox of J2000 */
/* 'B1950' Earth mean equator, dynamical */
/* equinox of B1950 */
/* 'FK4' Fundamental Catalog (4) */
/* 'DE-118' JPL Developmental Ephemeris (118) */
/* 'DE-96' JPL Developmental Ephemeris ( 96) */
/* 'DE-102' JPL Developmental Ephemeris (102) */
/* 'DE-108' JPL Developmental Ephemeris (108) */
/* 'DE-111' JPL Developmental Ephemeris (111) */
/* 'DE-114' JPL Developmental Ephemeris (114) */
/* 'DE-122' JPL Developmental Ephemeris (122) */
/* 'DE-125' JPL Developmental Ephemeris (125) */
/* 'DE-130' JPL Developmental Ephemeris (130) */
/* 'GALACTIC' Galactic System II */
/* 'DE-200' JPL Developmental Ephemeris (200) */
/* 'DE-202' JPL Developmental Ephemeris (202) */
/* (See the routine CHGIRF for a full list of names.) */
/* The output TIPM will give the transformation */
/* from this frame to the bodyfixed frame specified by */
/* BODY at the epoch specified by ET. */
/* BODY is the integer ID code of the body for which the */
/* position transformation matrix is requested. Bodies */
/* are numbered according to the standard NAIF */
/* numbering scheme. The numbering scheme is */
/* explained in the NAIF_IDS required reading file. */
/* ET is the epoch at which the position transformation */
/* matrix is requested. (This is typically the */
/* epoch of observation minus the one-way light time */
/* from the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is a 3x3 coordinate transformation matrix. It is */
/* used to transform positions from inertial */
/* coordinates to body fixed (also called equator and */
/* prime meridian --- PM) coordinates. */
/* Given a position P in the inertial reference frame */
/* specified by REF, the corresponding bodyfixed */
/* position is given by the matrix vector product: */
/* TIPM * S */
/* The X axis of the PM system is directed to the */
/* intersection of the equator and prime meridian. */
/* The Z axis points along the spin axis and points */
/* towards the same side of the invariable plane of */
/* the solar system as does earth's north pole. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the kernel pool does not contain all of the data required */
/* for computing the transformation matrix, TIPM, the error */
/* SPICE(INSUFFICIENTANGLES) is signalled. */
/* 2) If the reference frame, REF, is not recognized, a routine */
/* called by TIPBOD will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 3) If the specified body code, BODY, is not recognized, the */
/* error is diagnosed by a routine called by TIPBOD. */
/* $ Files */
/* None. */
/* $ Particulars */
/* TIPBOD takes PCK information as input, either in the */
/* form of a binary or text PCK file. High precision */
/* binary files are searched for first (the last loaded */
/* file takes precedence); then it defaults to the text */
/* PCK file. If binary information is found for the */
/* requested body and time, the Euler angles are */
/* evaluated and the transformation matrix is calculated */
/* from them. Using the Euler angles PHI, DELTA and W */
/* we compute */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If no appropriate binary PCK files have been loaded, */
/* the text PCK file is used. Here information is found */
/* as RA, DEC and W (with the possible addition of nutation */
/* and libration terms for satellites). Again, the Euler */
/* angles are found, and the transformation matrix is */
/* calculated from them. The transformation from inertial to */
/* bodyfixed coordinates is represented as: */
/* TIPM = [W] [HALFPI-DEC] [RA+HALFPI] */
/* 3 1 3 */
/* These are basically the Euler angles, PHI, DELTA and W: */
/* RA = PHI - HALFPI */
/* DEC = HALFPI - DELTA */
/* W = W */
/* In the text file, RA, DEC, and W are defined as follows: */
/* 2 ____ */
/* RA2*t \ */
/* RA = RA0 + RA1*t/T + ------ + / a sin theta */
/* 2 ---- i i */
/* T i */
/* 2 ____ */
/* DEC2*t \ */
/* DEC = DEC0 + DEC1*t/T + ------- + / d cos theta */
/* 2 ---- i i */
/* T i */
/* 2 ____ */
/* W2*t \ */
/* W = W0 + W1*t/d + ----- + / w sin theta */
/* 2 ---- i i */
/* d i */
/* where: */
/* d = seconds/day */
/* T = seconds/Julian century */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0(i) + THETA1(i)*t/T are specific to each */
/* i */
/* planet. */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* Note that the items necessary to compute the Euler angles */
/* must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). The Euler angles are typically */
/* stored in the P_constants kernel file that comes with */
/* SPICELIB. */
/* 1) In the following code fragment, TIPBOD is used to transform */
/* a position in J2000 inertial coordinates to a state in */
/* bodyfixed coordinates. */
/* The 3-vectors POSTN represents the inertial position */
/* of an object with respect to the center of the */
/* body at time ET. */
/* C */
/* C First load the kernel pool. */
/* C */
/* CALL FURNSH ( 'PLANETARY_CONSTANTS.KER' ) */
/* C */
/* C Next get the transformation and its derivative. */
/* C */
/* CALL TIPBOD ( 'J2000', BODY, ET, TIPM ) */
/* C */
/* C Convert position, the first three elements of */
/* C STATE, to bodyfixed coordinates. */
/* C */
/* CALL MXVG ( TIPM, POSTN, BDPOS ) */
/* $ Restrictions */
/* The kernel pool must be loaded with the appropriate */
/* coefficients (from the P_constants kernel or binary PCK file) */
/* prior to calling this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. Replaced header references to LDPOOL with */
/* references to FURNSH. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.3, 10-MAR-1994 (KSZ) */
/* Underlying BODMAT code changed to look for binary PCK */
/* data files, and use them to get orientation information if */
/* they are available. Only the comments to TIPBOD changed. */
/* - SPICELIB Version 1.0.2, 06-JUL-1993 (HAN) */
/* Example in header was corrected. Previous version had */
/* incorrect matrix dimension specifications passed to MXVG. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 05-AUG-1991 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* transformation from inertial position to bodyfixed */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 06-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. Replaced header references to LDPOOL with */
/* references to FURNSH. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. The new checks */
/* are intended to prevent arithmetic operations from */
/* being performed with uninitialized or invalid data. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("TIPBOD", (ftnlen)6);
}
/* Get the transformation from the inertial from REF to J2000 */
/* coordinates. */
irftrn_(ref, "J2000", ref2j, ref_len, (ftnlen)5);
/* Get the transformation from J2000 to body-fixed coordinates */
/* for the requested epoch. */
bodmat_(body, et, tipm);
if (failed_()) {
chkout_("TIPBOD", (ftnlen)6);
return 0;
}
/* Compose the transformations to arrive at the REF-to-J2000 */
/* transformation. */
mxm_(tipm, ref2j, tmpmat);
moved_(tmpmat, &c__9, tipm);
/* That's all folks. Check out and get out. */
chkout_("TIPBOD", (ftnlen)6);
return 0;
} /* tipbod_ */
/* $Procedure SPKE10 ( Evaluate SPK record, type 10 ) */
/* Subroutine */ int spke10_(doublereal *et, doublereal *record, doublereal *
state)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
static doublereal dwdt, mypi;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mxvg_(
doublereal *, doublereal *, integer *, integer *, doublereal *);
static doublereal my2pi, w;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static doublereal denom, precm[36] /* was [6][6] */;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
static doublereal vcomp[3], numer, n0;
extern doublereal twopi_(void);
static doublereal s1[6], s2[6], t1, t2;
extern /* Subroutine */ int ev2lin_(doublereal *, doublereal *,
doublereal *, doublereal *);
extern doublereal pi_(void);
static doublereal dargdt;
extern /* Subroutine */ int dpspce_(doublereal *, doublereal *,
doublereal *, doublereal *);
static doublereal mnrate;
extern /* Subroutine */ int vlcomg_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *), chkout_(char *,
ftnlen);
static doublereal invprc[36] /* was [6][6] */;
static logical loworb;
static doublereal tmpsta[6];
extern /* Subroutine */ int zzteme_(doublereal *, doublereal *);
extern logical return_(void);
extern /* Subroutine */ int invstm_(doublereal *, doublereal *);
static doublereal arg;
/* $ Abstract */
/* Evaluate 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECORD I Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, specified as ephemeris seconds past */
/* J2000, at which a state vector is to be computed. */
/* RECORD is a data record 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. */
/* The structure of RECORD is: */
/* RECORD(1) */
/* . Geophysical Constants such as */
/* . GM, J2, J3, J4, etc. */
/* . */
/* RECORD(NGEOCN) */
/* RECORD(NGEOCN + 1) */
/* . */
/* . elements and epoch for the body */
/* . at epoch 1. */
/* . */
/* RECORD(NGEOCN + NELEMN ) */
/* RECORD(NGEOCN + NELEMN + 1) */
/* . */
/* . elements and epoch for the body */
/* . at epoch 2. */
/* . */
/* RECORD(NGEOCN + 2*NELEMN ) */
/* Epoch 1 and epoch 2 are the times in the segment that */
/* bracket ET. If ET is less than the first time in the */
/* segment then both epochs 1 and 2 are equal to the */
/* first time. And if ET is greater than the last time */
/* then, epochs 1 and 2 are set equal to this last time. */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECORD at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If there is a problem evaluating the two-line elements, */
/* the error will be diagnosed by EV2LIN. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine interpolates a state from the two reference sets */
/* of two-line element sets contained in RECORD. */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR10 as shown here: */
/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */
/* CALL SPKE10 ( ET, RECORD, STATE ) */
/* Where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 10 data segment. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* 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 SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* 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. 10 ) THEN */
/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE10 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 01-JAN-2011 (EDW) */
/* Correction of state transformation calculation. Algorithm */
/* now computes state transformation as from TEME to J2000. */
/* The previous version of this routine calculated TETE to */
/* J2000. */
/* - SPICELIB Version 1.1.0, 01-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MTXV and VADD calls. */
/* - SPICELIB Version 1.0.0 18-JUL-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* evaluate type_10 spk segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* The following parameters give the location of the various */
/* geophysical parameters needed for the two line element */
/* sets. We need these only so that we can count how many there */
/* are (NGEOCN). */
/* KJ2 --- location of J2 */
/* KJ3 --- location of J3 */
/* KJ4 --- location if J4 */
/* KKE --- location of KE = sqrt(GM) in earth-radii**1.5/MIN */
/* KQO --- upper bound of atmospheric model in KM */
/* KSO --- lower bound of atmospheric model in KM */
/* KER --- earth equatorial radius in KM. */
/* KAE --- distance units/earth radius */
/* An enumeration of the various components of the */
/* a two-line element set. These are needed so that we */
/* can locate the epochs in the two sets and so that */
/* we can count the number of elements in a two-line */
/* element set. */
/* KNDT20 */
/* KNDD60 */
/* KBSTAR */
/* KINCL */
/* KNODE0 */
/* KECC */
/* KOMEGA */
/* KMO */
/* KNO */
/* KEPOCH */
/* The nutation in obliquity and longitude as well as their rates */
/* follow the elements. So we've got four angles/angle rates */
/* following the elements */
/* The locations of the epochs and the starts of the element */
/* sets are given below. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKE10", (ftnlen)6);
}
if (first) {
first = FALSE_;
mypi = pi_();
my2pi = twopi_();
}
/* Fetch the mean motion from the first set of two-line elements */
/* stored in the record. */
n0 = record[16];
mnrate = my2pi / 225.;
loworb = n0 >= mnrate;
/* Fetch the two epochs stored in the record. */
t1 = record[17];
t2 = record[31];
/* Evaluate the two states. Call them s_1(t) and s_2(t). */
/* Let the position and velocity components be: p_1, v_1, p_2, v_2. */
/* The final position is a weighted average. */
/* Let */
/* W(t) = 0.5 + 0.5*COS( PI*(t-t1)/(t2-t1) ) */
/* then */
/* p = W(t)*p_1(t) + (1 - W(t))*p_2(t) */
/* v = W(t)*v_1(t) + (1 - W(t))*v_2(t) + W'(t)*(p_1(t) - p_2(t)) */
/* If t1 = t2, the state is just s(t1). */
/* Note: there are a number of weighting schemes we could have */
/* used. This one has the nice property that */
/* The graph of W is symmetric about the point */
/* ( (t1+t2)/2, W( (t1+t2)/2 ) ) */
/* The range of W is from 1 to 0. The derivative of W is */
/* symmetric and zero at both t1 and t2. */
if (t1 != t2) {
if (loworb) {
ev2lin_(et, record, &record[8], s1);
ev2lin_(et, record, &record[22], s2);
} else {
dpspce_(et, record, &record[8], s1);
dpspce_(et, record, &record[22], s2);
}
/* Compute the weighting function that we'll need later */
/* when we combine states 1 and 2. */
numer = *et - t1;
denom = t2 - t1;
arg = numer * mypi / denom;
dargdt = mypi / denom;
w = cos(arg) * .5 + .5;
dwdt = sin(arg) * -.5 * dargdt;
/* Now compute the weighted average of the two states. */
d__1 = 1. - w;
vlcomg_(&c__6, &w, s1, &d__1, s2, state);
d__1 = -dwdt;
vlcom_(&dwdt, s1, &d__1, s2, vcomp);
vadd_(&state[3], vcomp, &tmpsta[3]);
vequ_(&tmpsta[3], &state[3]);
} else {
if (loworb) {
ev2lin_(et, record, &record[8], state);
} else {
dpspce_(et, record, &record[8], state);
}
}
/* Finally, convert the TEME state to J2000. First get */
/* the rotation from J2000 to TEME... */
zzteme_(et, precm);
/* ...now convert STATE to J2000. Invert the state transformation */
/* operator (important to correctly do this). */
invstm_(precm, invprc);
/* Map STATE to the corresponding expression in J2000. */
mxvg_(invprc, state, &c__6, &c__6, tmpsta);
moved_(tmpsta, &c__6, state);
chkout_("SPKE10", (ftnlen)6);
return 0;
} /* spke10_ */
/* $Procedure ZZWIND2D ( Find winding number of polygon about point ) */
integer zzwind2d_(integer *n, doublereal *vertcs, doublereal *point)
{
/* System generated locals */
integer vertcs_dim2, ret_val, i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *);
/* Local variables */
doublereal rvec[2];
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
extern doublereal vdotg_(doublereal *, doublereal *, integer *), vsepg_(
doublereal *, doublereal *, integer *);
extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal rperp[2], rnext[2];
extern doublereal twopi_(void);
doublereal atotal;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
doublereal sep;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Find the winding number of a planar polygon about a specified */
/* point in 2-dimensional space. */
/* $ 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 */
/* PLANES */
/* $ Keywords */
/* GEOMETRY */
/* MATH */
/* PLANE */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* N I Number of vertices of polygon. */
/* VERTCS I Vertices of polygon. */
/* POINT I Point in PLANE. */
/* The function returns the winding number of the input polygon */
/* about the input point. */
/* $ Detailed_Input */
/* N, */
/* VERTCS are, respectively, the number vertices defining */
/* the polygon and the vertices themselves. Each */
/* pair of consecutive vectors in the array VERTCS */
/* defines an edge of the polygon. */
/* $ Detailed_Output */
/* The function returns the winding number of the input polygon */
/* about the input point. The winding number measures the "net" */
/* number of times the polygon wraps around POINT: this is */
/* the number of times the polygon wraps around POINT in the */
/* counterclockwise sense minus the number of times the polygon */
/* wraps around POINT in the clockwise sense. */
/* The possible values and meanings of the winding number are: */
/* ZZWIND2D > 0: The polygon winds about POINT a total */
/* of ZZWIND2D times in the counterclockwise */
/* direction. */
/* POINT is inside the polygon. */
/* ZZWIND2D < 0: The polygon winds about POINT a total */
/* of ZZWIND2D times in the clockwise */
/* direction. */
/* POINT is inside the polygon. */
/* ZZWIND2D = 0: The number of times the polygon wraps around */
/* POINT in the counterclockwise sense is equal */
/* to the number of times the polygon wraps around */
/* POINT in the clockwise sense. */
/* POINT is outside the polygon. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the number of boundary vectors N is not at least 3, */
/* or if the number exceeds MAXFOV, the error */
/* SPICE(INVALIDCOUNT) will be signaled. */
/* 2) The input point and vertices are expected to lie in */
/* the input plane. To avoid problems introduced by */
/* round-off errors, all of these vectors are projected */
/* orthogonally onto the plane before the winding number */
/* is computed. If the input point or vertices are "far" */
/* from the input plane, no error will be signaled. */
/* 3) If the input plane as a zero normal vector, the error */
/* SPICE(ZEROVECTOR) will be signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Find the winding number of a 2-D polygon about a specified */
/* point. */
/* This routine supports determination of whether an ellipsoidal */
/* body is in the field of view of a remote-sensing instrument */
/* with a field of view having polygonal cross section. */
/* The winding number is actually defined for closed, piecewise */
/* differentiable curves in the complex plane. If z(t), t in */
/* [0, 2*Pi], is a parameterization of such a curve, then if the */
/* symbol I is used to represent the integration operator, z0 is the */
/* complex point of interest, and w is the winding number, we have */
/* 1 */
/* w = ------- * I ( d ( log(z-z0) ) ) */
/* 2*Pi*i z(t) */
/* 1 */
/* = ------- * I ( ( 1 / (z-z0) ) dz ) */
/* 2*Pi*i z(t) */
/* Because of Cauchy's theorem, we can transform the problem, */
/* without loss of generality (leaving out *many* steps here), to */
/* one for which the curve has the simple form */
/* i n*(t-t0) */
/* z(t) = z0 + r e */
/* for some real values r, n, and t0. So */
/* 1 */
/* w = ------- * I ( 1 / (z-z0) ) */
/* 2*Pi*i z(t) */
/* 1 t=2*pi i n*(t-t0) i n*(t-t0) */
/* = ------- * I ( (1/r e ) * ( r i n e )dt ) */
/* 2*Pi*i t=0 */
/* 1 t=2*pi */
/* = ------- * I ( i n dt ) */
/* 2*Pi*i t=0 */
/* 1 */
/* = ------ * ( 2 * Pi * i * n ) */
/* 2*Pi*i */
/* = n */
/* Given the simplified form of z(t) we've chosen, it's now clear */
/* that n is the winding number. */
/* In the simple case of a polygonal curve, the integral can be */
/* computed for a corresponding polygon whose vertices have been */
/* scaled to have equal magnitude; the integral can be expressed as */
/* the telescoping sum */
/* N */
/* ___ */
/* \ */
/* / ( argument of vertex(i+1) - argument of vertex(i) ) */
/* --- */
/* i=1 */
/* where vertex N+1 is considered have length identical to that of */
/* vertex 1 and argument differing from that of vertex 1 by w*2*pi. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 08-JUL-2008 (NJB) */
/* -& */
/* $ Index_Entries */
/* find winding number of polygon about point */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Initialize the function return value. */
/* Parameter adjustments */
vertcs_dim2 = *n;
/* Function Body */
ret_val = 0;
if (return_()) {
return ret_val;
}
chkin_("ZZWIND2D", (ftnlen)8);
/* Check the number of sides of the polygon. */
if (*n < 3) {
setmsg_("Polygon must have at least 3 sides; N = #.", (ftnlen)42);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZWIND2D", (ftnlen)8);
return ret_val;
}
/* The total "wrap angle" starts at zero. */
atotal = 0.;
vsubg_(&vertcs[(i__1 = 0) < vertcs_dim2 << 1 ? i__1 : s_rnge("vertcs",
i__1, "zzwind2d_", (ftnlen)285)], point, &c__2, rvec);
i__1 = *n + 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (i__ <= *n) {
j = i__;
} else {
j = 1;
}
/* Find the angular separation of RVEC and the next vector */
/* RNEXT. */
vsubg_(&vertcs[(i__2 = (j << 1) - 2) < vertcs_dim2 << 1 && 0 <= i__2 ?
i__2 : s_rnge("vertcs", i__2, "zzwind2d_", (ftnlen)299)],
point, &c__2, rnext);
sep = vsepg_(rnext, rvec, &c__2);
/* Create a normal vector to RVEC by rotating RVEC pi/2 radians */
/* counterclockwise. We'll use this vector RPERP to determine */
/* whether the next point is reached by clockwise or */
/* counterclockwise rotation from RVEC. */
rperp[0] = -rvec[1];
rperp[1] = rvec[0];
if (vdotg_(rnext, rperp, &c__2) >= 0.) {
/* RNEXT is reached by counterclockwise rotation from */
/* RVEC. Note that in the case of zero rotation, the */
/* sign doesn't matter because the contribution is zero. */
atotal += sep;
} else {
atotal -= sep;
}
/* Update RVEC. */
moved_(rnext, &c__2, rvec);
}
/* The above sum is 2 * pi * <the number of times the polygon */
/* wraps around P>. Let ZZWIND2D be the wrap count. */
d__1 = atotal / twopi_();
ret_val = i_dnnt(&d__1);
chkout_("ZZWIND2D", (ftnlen)8);
return ret_val;
} /* zzwind2d_ */
/* $Procedure SGMETA ( Generic segments: Fetch meta data value ) */
/* Subroutine */ int sgmeta_(integer *handle, doublereal *descr, integer *
mnemon, integer *value)
{
/* Initialized data */
static integer lstbeg = -1;
static integer lsthan = 0;
/* System generated locals */
integer i__1, i__2, i__3;
static doublereal equiv_0[2];
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *);
/* Local variables */
static integer meta[17];
integer begm1, i__, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen);
#define dtemp (equiv_0)
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
doublereal xmeta[17];
#define itemp ((integer *)equiv_0)
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
integer niovr2, nd;
extern logical failed_(void);
integer ni;
extern /* Subroutine */ int dafhsf_(integer *, integer *, integer *);
integer begmta, endmta, ametas;
static logical nieven;
static integer ioffst;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal dmtasz;
static integer metasz;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
integer end;
/* $ Abstract */
/* Obtain the value of a specified generic segment meta data item. */
/* $ 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 Handle of a DAF open for reading. */
/* DESCR I Descriptor for a generic segment in the DAF. */
/* MNEMON I An integer mnemonic for the desired meta data. */
/* VALUE O The value of the meta data item requested. */
/* $ Detailed_Input */
/* HANDLE is the handle of a DAF opened for reading that */
/* contains the generic segment described by DESCR. */
/* DESCR is the descriptor of a generic segment. This must */
/* be the descriptor for a generic segment in the DAF */
/* associated with HANDLE. */
/* MNEMON is the mnemonic used to represent the desired piece of */
/* meta data. See the file 'sgparam.inc' for details, the */
/* mnemonics, and their values. */
/* $ Detailed_Output */
/* VALUE is the value of the meta data item associated with */
/* the mnemonic MNEMON that is in the generic segment */
/* specified by HANDLE and DESCR. */
/* $ Parameters */
/* This subroutine makes use of parameters defined in the file */
/* 'sgparam.inc'. */
/* $ Files */
/* See the description of HANDLE above. */
/* $ Exceptions */
/* 1) If the mnemonic for the meta data item is not valid, the error */
/* SPICE(UNKNOWNMETAITEM) will be signalled. */
/* 2) If the last address in the DAF segment that reports the number */
/* of meta data items that exist in the segment is less than */
/* MNMETA, the error SPICE(INVALIDMETADATA) will be signaled. */
/* $ Particulars */
/* This routine is a utility for fetching the meta data associated */
/* with a DAF 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 segment is */
/* required. The other data partitions may occur in any order in the */
/* segment because the meta data will contain pointers to the */
/* appropriate locations of the other data partitions within the */
/* segment. */
/* The meta data for the segment should be obtained only through */
/* use of this routine, SGMETA. */
/* $ Examples */
/* Suppose that we would like to know how many constants, data */
/* packets, and reference values are in the generic segment that we */
/* have located in the DAF file associated with HANDLE. */
/* C */
/* C Get the number of constants. */
/* C */
/* CALL SGMETA ( HANDLE, DESCR, NCON, NCONST ) */
/* C */
/* C Get the number of data packets. */
/* C */
/* CALL SGMETA ( HANDLE, DESCR, NPKT, NPKTS ) */
/* C */
/* C Get the number of constants. */
/* C */
/* CALL SGMETA ( HANDLE, DESCR, NREF, NREFS ) */
/* C */
/* C Print the values. */
/* C */
/* WRITE (*, *) 'Number of Constants : ', NCONST */
/* WRITE (*, *) 'Number of Data Packets : ', NPKTS */
/* WRITE (*, *) 'Number of Reference Values: ', NREFS */
/* $ 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) */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.4.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* - SPICELIB Version 1.3.0, 14-JUN-1999 (FST) */
/* Altered the check in/out structure to be more reasonable. */
/* This introduced redundant code, but only to increase the */
/* efficiency of the normal mode of operation. */
/* - SPICELIB Version 1.2.0, 24-SEP-1998 (FST) */
/* Modified the code that handles reading the meta data from the */
/* DAF to handle the case when the number of meta data items in */
/* the file exceeds the current maximum defined in sgparam.inc. */
/* In the event that this situation occurs, the routine loads */
/* what meta data it can interpret and ignores the rest. In */
/* this event if NMETA is requested, it is returned as MXMETA in */
/* sgparam.inc. */
/* An additional exception is now trapped by the routine. If */
/* a generic segment in a DAF reports less than the known minimum */
/* number of meta data items, then the routine signals the */
/* error SPICE(INVALIDMETADATA). */
/* The conditions that cause the SPICE(UNKNOWNMETAITEM) to be */
/* signaled have been altered. Now if the integer mnemonic */
/* is not between 1 and METASZ inclusive, or NMETA the error */
/* is signaled. In the versions preceding this change, for */
/* segments that reported less than NMETA items of meta data */
/* could not use this routine to request the number of meta */
/* data items without signalling SPICE(UNKNOWNMETAITEM). */
/* - SPICELIB Version 1.1.0, 11-APR-1995 (KRG) */
/* Modified the code that deals with the EQUIVALENCEd part */
/* descriptor. We now call MOVED rather than using a direct */
/* assignment. */
/* - SPICELIB Version 1.0.0, 11-APR-1995 (KRG) (WLT) */
/* -& */
/* $ Index_Entries */
/* retrieve a meta data value for a generic segment */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Include the mnemonic values for the generic segment declarations. */
/* 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;
}
/* Handle the case when we are looking at the same file and segment */
/* descriptor first. This will result in duplicated code, but will */
/* increase efficiency for the usual execution case. We need not */
/* worry about the first time through, since LSTHAN and LSTBEG are */
/* set to values that are bogus for actual DAF files. */
if (*handle == lsthan) {
/* Get the begin and end values from the descriptor. They are */
/* located in the last two "integer" positions of the descriptor. */
if (nieven) {
moved_(&descr[ioffst - 1], &c__1, dtemp);
begin = itemp[0];
end = itemp[1];
} else {
moved_(&descr[ioffst - 1], &c__2, dtemp);
begin = itemp[1];
end = itemp[2];
}
/* Check the segment start address. This will tell us whether we */
/* are looking at the same segment. */
if (lstbeg == begin) {
/* The only acceptable integer mnemonics at this point are 1 */
/* through METASZ inclusive, and NMETA. All other requests */
/* should signal the SPICE(UNKNOWNMETAITEM) error, since the */
/* current segment has no knowledge of these values. */
if (*mnemon <= 0 || *mnemon > metasz && *mnemon != 17) {
chkin_("SGMETA", (ftnlen)6);
*value = -1;
setmsg_("The item requested, #, is not one of the recognized"
" meta data items associated with this generic segmen"
"t.", (ftnlen)105);
errint_("#", mnemon, (ftnlen)1);
sigerr_("SPICE(UNKNOWNMETAITEM)", (ftnlen)22);
chkout_("SGMETA", (ftnlen)6);
return 0;
}
/* Set the value for the desired meta data item and return. */
*value = meta[(i__1 = *mnemon - 1) < 17 && 0 <= i__1 ? i__1 :
s_rnge("meta", i__1, "sgmeta_", (ftnlen)364)];
return 0;
}
}
/* At this point we are going to have to load the meta data. If */
/* the new handle and the old handle are the same, then the above */
/* code has already retrieved the relevant segment addresses. If not */
/* we need to fetch them. First check in. */
chkin_("SGMETA", (ftnlen)6);
if (*handle != lsthan) {
dafhsf_(handle, &nd, &ni);
if (failed_()) {
chkout_("SGMETA", (ftnlen)6);
return 0;
}
niovr2 = ni / 2;
nieven = niovr2 << 1 == ni;
ioffst = nd + niovr2;
lsthan = *handle;
/* Get the begin and end values from the descriptor. They are */
/* located in the last two "integer" positions of the descriptor. */
if (nieven) {
moved_(&descr[ioffst - 1], &c__1, dtemp);
begin = itemp[0];
end = itemp[1];
} else {
moved_(&descr[ioffst - 1], &c__2, dtemp);
begin = itemp[1];
end = itemp[2];
}
}
/* Save the new begin address. Remember we have either just computed */
/* this from the IF block above, or we computed it in the very */
/* first IF block. */
lstbeg = begin;
/* Compute the begin address of the meta data and compute the */
/* end address of the number we will be collecting. */
dafgda_(handle, &end, &end, &dmtasz);
if (failed_()) {
chkout_("SGMETA", (ftnlen)6);
return 0;
}
metasz = i_dnnt(&dmtasz);
/* Store the actual meta size in AMETAS, in case METASZ ends up */
/* being modified to conform to our current understanding of */
/* meta data items. */
ametas = metasz;
/* Check to see if METASZ is an unacceptable value. */
if (metasz < 15) {
*value = -1;
setmsg_("This segment reports that it has # meta data items. Every g"
"eneric segment must have at least #.", (ftnlen)95);
errint_("#", &metasz, (ftnlen)1);
errint_("#", &c__15, (ftnlen)1);
sigerr_("SPICE(INVALIDMETADATA)", (ftnlen)22);
chkout_("SGMETA", (ftnlen)6);
return 0;
/* If it is not, we may need to fix a few things to work around some */
/* older files that have been delivered. We perform these kludges */
/* here. Originally, the number of meta data items was not */
/* considered to be part of the meta data. It now is, so if we */
/* encounter an older version of the file, we need to increment the */
/* meta data size by 1. The number of meta data items is always */
/* after all of the meta data items, so we can do this. */
} else if (metasz == 15) {
++metasz;
ametas = metasz;
/* If not check to see if METASZ is greater than the known MXMETA. */
/* If it is then this segment most likely was constructed from */
/* some newer version of the toolkit. Load what meta data we */
/* currently know about as laid out in sgparam.inc. */
} else if (metasz > 17) {
/* Leave AMETAS alone, since we need to know how far back */
/* into the DAF file to begin reading. */
metasz = 17;
}
/* The address computations that follow are precisely the same */
/* as the previous version of the file, except when AMETAS is not */
/* METASZ. This only happens when METASZ is greater than MXMETA. */
begmta = end - ametas + 1;
endmta = begmta + metasz - 1;
dafgda_(handle, &begmta, &endmta, xmeta);
if (failed_()) {
chkout_("SGMETA", (ftnlen)6);
return 0;
}
/* Convert all of the meta data values into integers. */
i__1 = metasz;
for (i__ = 1; i__ <= i__1; ++i__) {
meta[(i__2 = i__ - 1) < 17 && 0 <= i__2 ? i__2 : s_rnge("meta", i__2,
"sgmeta_", (ftnlen)503)] = i_dnnt(&xmeta[(i__3 = i__ - 1) <
17 && 0 <= i__3 ? i__3 : s_rnge("xmeta", i__3, "sgmeta_", (
ftnlen)503)]);
}
/* The kludge continues... NMETA and MXMETA are ALWAYS the same */
/* value, and any missing values must appear between the last known */
/* value, META(METASZ-1), and the end value, META(NMETA), so we zero */
/* them out. */
meta[16] = metasz;
for (i__ = metasz; i__ <= 16; ++i__) {
meta[(i__1 = i__ - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge("meta", i__1,
"sgmeta_", (ftnlen)515)] = 0;
}
/* Adjust the bases so that the N'th item of a partition is at */
/* address META(PARTITION_BASE) + N */
begm1 = begin - 1;
meta[0] += begm1;
meta[5] += begm1;
meta[2] += begm1;
meta[7] += begm1;
meta[10] += begm1;
meta[12] += begm1;
/* The only acceptable integer mnemonics at this point are 1 through */
/* METASZ inclusive, and NMETA. All other requests should signal */
/* the SPICE(UNKNOWNMETAITEM) error, since the current segment has */
/* no knowledge of these values. */
if (*mnemon <= 0 || *mnemon > metasz && *mnemon != 17) {
*value = -1;
setmsg_("The item requested, #, is not one of the recognized meta da"
"ta items associated with this generic segment.", (ftnlen)105);
errint_("#", mnemon, (ftnlen)1);
sigerr_("SPICE(UNKNOWNMETAITEM)", (ftnlen)22);
chkout_("SGMETA", (ftnlen)6);
return 0;
}
/* Set the value for the desired meta data item, check out if we */
/* need to, and return. */
*value = meta[(i__1 = *mnemon - 1) < 17 && 0 <= i__1 ? i__1 : s_rnge(
"meta", i__1, "sgmeta_", (ftnlen)555)];
chkout_("SGMETA", (ftnlen)6);
return 0;
} /* sgmeta_ */
/* $Procedure TWOVEC ( Two vectors defining an orthonormal frame ) */
/* Subroutine */ int twovec_(doublereal *axdef, integer *indexa, doublereal *
plndef, integer *indexp, doublereal *mout)
{
/* Initialized data */
static integer seqnce[5] = { 1,2,3,1,2 };
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), chkin_(
char *, ftnlen), moved_(doublereal *, integer *, doublereal *);
doublereal mtemp[9] /* was [3][3] */;
integer i1, i2, i3;
extern /* Subroutine */ int xpose_(doublereal *, doublereal *), ucrss_(
doublereal *, doublereal *, doublereal *), sigerr_(char *, ftnlen)
, chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *
, integer *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Find the transformation to the right-handed frame having a */
/* given vector as a specified axis and having a second given */
/* vector lying in a specified coordinate plane. */
/* $ 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 */
/* None. */
/* $ Keywords */
/* AXES, FRAME, ROTATION, TRANSFORMATION */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ------------------------------------------------- */
/* AXDEF I Vector defining a principal axis. */
/* INDEXA I Principal axis number of AXDEF (X=1, Y=2, Z=3). */
/* PLNDEF I Vector defining (with AXDEF) a principal plane. */
/* INDEXP I Second axis number (with INDEXA) of principal */
/* plane. */
/* MOUT O Output rotation matrix. */
/* $ Detailed_Input */
/* AXDEF is a vector defining one of the priciple axes of a */
/* coordinate frame. */
/* INDEXA is a number that determines which of the three */
/* coordinate axes contains AXDEF. */
/* If INDEXA is 1 then AXDEF defines the X axis of the */
/* coordinate frame. */
/* If INDEXA is 2 then AXDEF defines the Y axis of the */
/* coordinate frame. */
/* If INDEXA is 3 then AXDEF defines the Z axis of the */
/* coordinate frame */
/* PLNDEF is a vector defining (with AXDEF) a principal plane of */
/* the coordinate frame. AXDEF and PLNDEF must be */
/* linearly independent. */
/* INDEXP is the second axis of the principal frame determined */
/* by AXDEF and PLNDEF. INDEXA, INDEXP must be different */
/* and be integers from 1 to 3. */
/* If INDEXP is 1, the second axis of the principal */
/* plane is the X-axis. */
/* If INDEXP is 2, the second axis of the principal */
/* plane is the Y-axis. */
/* If INDEXP is 3, the second axis of the principal plane */
/* is the Z-axis. */
/* $ Detailed_Output */
/* MOUT is a rotation matrix that transforms coordinates given */
/* in the input frame to the frame determined by AXDEF, */
/* PLNDEF, INDEXA and INDEXP. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If INDEXA or INDEXP is not in the set {1,2,3} the error */
/* SPICE(BADINDEX) will be signaled. */
/* 2) If INDEXA and INDEXP are the same the error */
/* SPICE(UNDEFINEDFRAME) will be signaled. */
/* 3) If the cross product of the vectors AXDEF and PLNDEF is zero, */
/* the error SPICE(DEPENDENTVECTORS) will be signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Given two linearly independent vectors there is a unique */
/* right-handed coordinate frame having: */
/* AXDEF lying along the INDEXA axis. */
/* PLNDEF lying in the INDEXA-INDEXP coordinate plane. */
/* This routine determines the transformation matrix that transforms */
/* from coordinates used to represent the input vectors to the */
/* the system determined by AXDEF and PLNDEF. Thus a vector */
/* (x,y,z) in the input coordinate system will have coordinates */
/* t */
/* MOUT* (x,y,z) */
/* in the frame determined by AXDEF and PLNDEF. */
/* $ Examples */
/* The rotation matrix TICC from inertial to Sun-Canopus */
/* (celestial) coordinates is found by the call */
/* CALL TWOVEC (Sun vector, 3, Canopus vector, 1, TICC) */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.M. Owen (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL call. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) */
/* -& */
/* $ Index_Entries */
/* define an orthonormal frame from two vectors */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 31-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL call. */
/* - Beta Version 2.0.0, 10-JAN-1989 (WLT) */
/* Error checking was added and the algorithm somewhat redesigned. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling */
if (return_()) {
return 0;
} else {
chkin_("TWOVEC", (ftnlen)6);
}
/* Check for obvious bad inputs. */
if (max(*indexp,*indexa) > 3 || min(*indexp,*indexa) < 1) {
setmsg_("The definition indexs must lie in the range from 1 to 3. T"
"he value of INDEXA was #. The value of INDEXP was #. ", (
ftnlen)112);
errint_("#", indexa, (ftnlen)1);
errint_("#", indexp, (ftnlen)1);
sigerr_("SPICE(BADINDEX)", (ftnlen)15);
chkout_("TWOVEC", (ftnlen)6);
return 0;
} else if (*indexa == *indexp) {
setmsg_("The values of INDEXA and INDEXP were the same, namely #. T"
"hey are required to be different.", (ftnlen)92);
errint_("#", indexa, (ftnlen)1);
sigerr_("SPICE(UNDEFINEDFRAME)", (ftnlen)21);
chkout_("TWOVEC", (ftnlen)6);
return 0;
}
/* Get indices for right-handed axes */
/* First AXDEF ... */
i1 = *indexa;
/* ... then the other two. */
i2 = seqnce[(i__1 = *indexa) < 5 && 0 <= i__1 ? i__1 : s_rnge("seqnce",
i__1, "twovec_", (ftnlen)270)];
i3 = seqnce[(i__1 = *indexa + 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("seqnce"
, i__1, "twovec_", (ftnlen)271)];
/* Row I1 contains normalized AXDEF (store in columns for now) */
vhat_(axdef, &mout[(i__1 = i1 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge(
"mout", i__1, "twovec_", (ftnlen)276)]);
/* Obtain rows I2 and I3 using cross products. Which order to use */
/* depends on whether INDEXP = I2 (next axis in right-handed order) */
/* or INDEXP = I3 (previous axis in right-handed order). */
if (*indexp == i2) {
ucrss_(axdef, plndef, &mout[(i__1 = i3 * 3 - 3) < 9 && 0 <= i__1 ?
i__1 : s_rnge("mout", i__1, "twovec_", (ftnlen)285)]);
ucrss_(&mout[(i__1 = i3 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge(
"mout", i__1, "twovec_", (ftnlen)286)], axdef, &mout[(i__2 =
i2 * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("mout", i__2,
"twovec_", (ftnlen)286)]);
} else {
ucrss_(plndef, axdef, &mout[(i__1 = i2 * 3 - 3) < 9 && 0 <= i__1 ?
i__1 : s_rnge("mout", i__1, "twovec_", (ftnlen)290)]);
ucrss_(axdef, &mout[(i__1 = i2 * 3 - 3) < 9 && 0 <= i__1 ? i__1 :
s_rnge("mout", i__1, "twovec_", (ftnlen)291)], &mout[(i__2 =
i3 * 3 - 3) < 9 && 0 <= i__2 ? i__2 : s_rnge("mout", i__2,
"twovec_", (ftnlen)291)]);
}
/* Finally, check to see that we actually got something non-zero */
/* in one of the one columns of MOUT(1,I2) and MOUT(1,I3) (we need */
/* only check one of them since they are related by a cross product). */
if (mout[(i__1 = i2 * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("mout",
i__1, "twovec_", (ftnlen)300)] == 0. && mout[(i__2 = i2 * 3 - 2) <
9 && 0 <= i__2 ? i__2 : s_rnge("mout", i__2, "twovec_", (ftnlen)
300)] == 0. && mout[(i__3 = i2 * 3 - 1) < 9 && 0 <= i__3 ? i__3 :
s_rnge("mout", i__3, "twovec_", (ftnlen)300)] == 0.) {
setmsg_("The input vectors AXDEF and PLNDEF are linearly dependent.",
(ftnlen)58);
sigerr_("SPICE(DEPENDENTVECTORS)", (ftnlen)23);
}
/* Transpose MOUT. */
xpose_(mout, mtemp);
moved_(mtemp, &c__9, mout);
chkout_("TWOVEC", (ftnlen)6);
return 0;
} /* twovec_ */
/* $Procedure SPKW17 ( SPK, write a type 17 segment ) */
/* Subroutine */ int spkw17_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *
decpol, ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
doublereal a, h__;
integer i__;
doublereal k;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_(
doublereal *, integer *), dafbna_(integer *, doublereal *, char *,
ftnlen), dafena_(void);
extern logical failed_(void);
doublereal record[12];
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen), spkpds_(integer *, integer *, char *, integer *,
doublereal *, doublereal *, doublereal *, ftnlen);
extern logical return_(void);
doublereal ecc;
/* $ Abstract */
/* Write an SPK segment of type 17 given a type 17 data record. */
/* $ 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I Body code for ephemeris object. */
/* CENTER I Body code for the center of motion of the body. */
/* FRAME I The reference frame of the states. */
/* FIRST I First valid time for which states can be computed. */
/* LAST I Last valid time for which states can be computed. */
/* SEGID I Segment identifier. */
/* EPOCH I Epoch of elements in seconds past J2000 */
/* EQEL I Array of equinoctial elements */
/* RAPOL I Right Ascension of the pole of the reference plane */
/* DECPOL I Declination of the pole of the reference plane */
/* $ Detailed_Input */
/* HANDLE is the file handle of an SPK file that has been */
/* opened for writing. */
/* BODY is the NAIF ID for the body whose states are */
/* to be recorded in an SPK file. */
/* CENTER is the NAIF ID for the center of motion associated */
/* with BODY. */
/* FRAME is the reference frame that states are referenced to, */
/* for example 'J2000'. */
/* FIRST are the bounds on the ephemeris times, expressed as */
/* LAST seconds past J2000. */
/* SEGID is the segment identifier. An SPK segment identifier */
/* may contain up to 40 characters. */
/* EPOCH is the epoch of equinoctial elements in seconds */
/* past the J2000 epoch. */
/* EQEL is an array of 9 double precision numbers that */
/* are the equinoctial elements for some orbit relative */
/* to the equatorial frame of a central body. */
/* ( The z-axis of the equatorial frame is the direction */
/* of the pole of the central body relative to FRAME. */
/* The x-axis is given by the cross product of the */
/* Z-axis of FRAME with the direction of the pole of */
/* the central body. The Y-axis completes a right */
/* handed frame. ) */
/* The specific arrangement of the elements is spelled */
/* out below. The following terms are used in the */
/* discussion of elements of EQEL */
/* INC --- inclination of the orbit */
/* ARGP --- argument of periapse */
/* NODE --- longitude of the ascending node */
/* E --- eccentricity of the orbit */
/* EQEL(1) is the semi-major axis (A) of the orbit in km. */
/* EQEL(2) is the value of H at the specified epoch. */
/* ( E*SIN(ARGP+NODE) ). */
/* EQEL(3) is the value of K at the specified epoch */
/* ( E*COS(ARGP+NODE) ). */
/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */
/* the epoch of the elements measured in radians. */
/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */
/* the specified epoch. */
/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */
/* the specified epoch. */
/* EQEL(7) is the rate of the longitude of periapse */
/* (dARGP/dt + dNODE/dt ) at the epoch of */
/* the elements. This rate is assumed to hold */
/* for all time. The rate is measured in */
/* radians per second. */
/* EQEL(8) is the derivative of the mean longitude */
/* ( dM/dt + dARGP/dt + dNODE/dt ). This */
/* rate is assumed to be constant and is */
/* measured in radians/second. */
/* EQEL(9) is the rate of the longitude of the ascending */
/* node ( dNODE/dt). This rate is measured */
/* in radians per second. */
/* RAPOL Right Ascension of the pole of the reference plane */
/* relative to FRAME measured in radians. */
/* DECPOL Declination of the pole of the reference plane */
/* relative to FRAME measured in radians. */
/* $ Detailed_Output */
/* None. A type 17 segment is written to the file attached */
/* to HANDLE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the semi-major axis is less than or equal to zero, the error */
/* 'SPICE(BADSEMIAXIS)' is signalled. */
/* 2) If the eccentricity of the orbit corresponding to the values */
/* of H and K ( EQEL(2) and EQEL(3) ) is greater than 0.9 the */
/* error 'SPICE(ECCOUTOFRANGE)' is signalled. */
/* 3) If the segment identifier has more than 40 non-blank characters */
/* the error 'SPICE(SEGIDTOOLONG)' is signalled. */
/* 4) If the segment identifier contains non-printing characters */
/* the error 'SPICE(NONPRINTABLECHARS)' is signalled. */
/* 5) If there are inconsistencies in the BODY, CENTER, FRAME or */
/* FIRST and LAST times, the problem will be diagnosed by */
/* a routine in the call tree of this routine. */
/* $ Files */
/* A new type 17 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 17 data segment to the open SPK */
/* file according to the format described in the type 17 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* $ Examples */
/* Suppose that at time EPOCH you have the classical elements */
/* of some BODY relative to the equatorial frame of some central */
/* body CENTER. These can be converted to equinoctial elements */
/* and stored in an SPK file as a type 17 segment so that this */
/* body can be used within the SPK subsystem of the SPICE system. */
/* Below is a list of the variables used to represent the */
/* classical elements */
/* Variable Meaning */
/* -------- ---------------------------------- */
/* A Semi-major axis in km */
/* ECC Eccentricity of orbit */
/* INC Inclination of orbit */
/* NODE Longitude of the ascending node at epoch */
/* OMEGA Argument of periapse at epoch */
/* M Mean anomaly at epoch */
/* DMDT Mean anomaly rate in radians/second */
/* DNODE Rate of change of longitude of ascending node */
/* in radians/second */
/* DOMEGA Rate of change of argument of periapse in */
/* radians/second */
/* EPOCH is the epoch of the elements in seconds past */
/* the J2000 epoch. */
/* These elements are converted to equinoctial elements (in */
/* the order compatible with type 17) as shown below. */
/* EQEL(1) = A */
/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */
/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */
/* EQEL(4) = M + OMEGA + NODE */
/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */
/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */
/* EQEL(7) = DOMEGA */
/* EQEL(8) = DOMEGA + DMDT + DNODE */
/* EQEL(9) = DNODE */
/* C */
/* C Now add the segment. */
/* C */
/* CALL SPKW17 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */
/* . SEGID, EPOCH, EQEL, RAPOL, DECPOL ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 24-Jun-1999 (WLT) */
/* Corrected typographical errors in the header. */
/* - SPICELIB Version 1.0.0, 8-Jan-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Write a type 17 spk segment */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Segment descriptor size */
/* Segment identifier size */
/* SPK data type */
/* Range of printing characters */
/* Number of items in a segment */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW17", (ftnlen)6);
/* Fetch the various entities from the inputs and put them into */
/* the data record, first the epoch. */
record[0] = *epoch;
/* The trajectory pole vector. */
moved_(eqel, &c__9, &record[1]);
record[10] = *rapol;
record[11] = *decpol;
a = record[1];
h__ = record[2];
k = record[3];
ecc = sqrt(h__ * h__ + k * k);
/* Check all the inputs here for obvious failures. It's much */
/* better to check them now and quit than it is to get a bogus */
/* segment into an SPK file and diagnose it later. */
if (a <= 0.) {
setmsg_("The semimajor axis supplied to the SPK type 17 evaluator wa"
"s non-positive. This value must be positive. The value supp"
"lied was #.", (ftnlen)130);
errdp_("#", &a, (ftnlen)1);
sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18);
chkout_("SPKW17", (ftnlen)6);
return 0;
} else if (ecc > .9) {
setmsg_("The eccentricity supplied for a type 17 segment is greater "
"than 0.9. It must be less than 0.9.The value supplied to th"
"e type 17 evaluator was #. ", (ftnlen)146);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKW17", (ftnlen)6);
return 0;
}
/* Make sure the segment identifier is not too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("SPKW17", (ftnlen)6);
return 0;
}
/* Make sure the segment identifier has only printing characters. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
value = *(unsigned char *)&segid[i__ - 1];
if (value < 32 || value > 126) {
setmsg_("The segment identifier contains the nonprintable charac"
"ter having ascii code #.", (ftnlen)79);
errint_("#", &value, (ftnlen)1);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("SPKW17", (ftnlen)6);
return 0;
}
}
/* All of the obvious checks have been performed on the input */
/* record. Create the segment descriptor. (FIRST and LAST are */
/* checked by SPKPDS as well as consistency between BODY and CENTER). */
spkpds_(body, center, frame, &c__17, first, last, descr, frame_len);
if (failed_()) {
chkout_("SPKW17", (ftnlen)6);
return 0;
}
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW17", (ftnlen)6);
return 0;
}
dafada_(record, &c__12);
if (! failed_()) {
dafena_();
}
chkout_("SPKW17", (ftnlen)6);
return 0;
} /* spkw17_ */
/* $Procedure ZZGFSSOB ( GF, state of sub-observer point ) */
/* Subroutine */ int zzgfssob_(char *method, integer *trgid, doublereal *et,
char *fixref, char *abcorr, integer *obsid, doublereal *radii,
doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen
abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer prvobs = 0;
static integer prvtrg = 0;
static char svobs[36] = " ";
static char svtarg[36] = " ";
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal dalt[2];
logical near__, geom;
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_(
doublereal *, doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
logical xmit;
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *);
doublereal upos[3];
extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal
*, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *,
doublereal *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen);
doublereal t;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal savel[3];
logical found;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vsubg_(doublereal *, doublereal *, integer *, doublereal *);
doublereal stemp[6];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal xform[36] /* was [6][6] */;
logical uselt;
extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen);
doublereal ssbtg0[6];
extern logical failed_(void);
doublereal sa[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal lt;
integer frcode;
extern doublereal clight_(void);
extern logical return_(void);
doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6]
*/, fxosta[6], fxpsta[6], fxpvel[3], fxtsta[6], obspnt[6], obssta[
12] /* was [6][2] */, obstrg[6], acc[3], pntsta[6], raysta[6],
sastat[6], spoint[3], srfvec[3], ssbobs[6], ssbtrg[6], trgepc;
integer center, clssid, frclss;
logical attblk[6], usestl;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
logical fnd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *,
integer *, integer *, integer *, logical *), errint_(char *,
integer *, ftnlen), spkgeo_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), vminug_(
doublereal *, integer *, doublereal *), dnearp_(doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, logical *), surfpv_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, logical *)
, subpnt_(char *, char *, doublereal *, char *, char *, char *,
doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen, ftnlen), spkssb_(integer *, doublereal *, char *,
doublereal *, ftnlen);
doublereal dlt;
extern /* Subroutine */ int sxform_(char *, char *, doublereal *,
doublereal *, ftnlen, ftnlen), qderiv_(integer *, doublereal *,
doublereal *, doublereal *, doublereal *), invstm_(doublereal *,
doublereal *);
/* $ Abstract */
/* SPICE private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due to the */
/* volatile nature of this routine. */
/* Return the state of a sub-observer point used to define */
/* coordinates referenced in a GF search. */
/* $ 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 */
/* GF */
/* SPK */
/* TIME */
/* NAIF_IDS */
/* FRAMES */
/* $ Keywords */
/* GEOMETRY */
/* PRIVATE */
/* SEARCH */
/* $ Declarations */
/* $ Abstract */
/* This file contains public, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) subsystem. */
/* $ 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 */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.E. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.3.0, 01-OCT-2011 (NJB) */
/* Added NWILUM parameter. */
/* - SPICELIB Version 1.2.0, 14-SEP-2010 (EDW) */
/* Added NWPA parameter. */
/* - SPICELIB Version 1.1.0, 08-SEP-2009 (EDW) */
/* Added NWRR parameter. */
/* Added NWUDS parameter. */
/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */
/* -& */
/* Root finding parameters: */
/* CNVTOL is the default convergence tolerance used by the */
/* high-level GF search API routines. This tolerance is */
/* used to terminate searches for binary state transitions: */
/* when the time at which a transition occurs is bracketed */
/* by two times that differ by no more than CNVTOL, the */
/* transition time is considered to have been found. */
/* Units are TDB seconds. */
/* NWMAX is the maximum number of windows allowed for user-defined */
/* workspace array. */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */
/* Currently no more than twelve windows are required; the three */
/* extra windows are spares. */
/* Callers of GFEVNT can include this file and use the parameter */
/* NWMAX to declare the second dimension of the workspace array */
/* if necessary. */
/* Callers of GFIDST should declare their workspace window */
/* count using NWDIST. */
/* Callers of GFSEP should declare their workspace window */
/* count using NWSEP. */
/* Callers of GFRR should declare their workspace window */
/* count using NWRR. */
/* Callers of GFUDS should declare their workspace window */
/* count using NWUDS. */
/* Callers of GFPA should declare their workspace window */
/* count using NWPA. */
/* Callers of GFILUM should declare their workspace window */
/* count using NWILUM. */
/* ADDWIN is a parameter used to expand each interval of the search */
/* (confinement) window by a small amount at both ends in order to */
/* accommodate searches using equality constraints. The loaded */
/* kernel files must accommodate these expanded time intervals. */
/* FRMNLN is a string length for frame names. */
/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */
/* FOVTLN -- maximum length for FOV string. */
/* Specify the character strings that are allowed in the */
/* specification of field of view shapes. */
/* Character strings that are allowed in the */
/* specification of occultation types: */
/* Occultation target shape specifications: */
/* Specify the number of supported occultation types and occultation */
/* type string length: */
/* Instrument field-of-view (FOV) parameters */
/* Maximum number of FOV boundary vectors: */
/* FOV shape parameters: */
/* circle */
/* ellipse */
/* polygon */
/* rectangle */
/* End of file gf.inc. */
/* $ Abstract */
/* SPICE private include file intended solely for the support of */
/* SPICE routines. Users should not include this routine in their */
/* source code due to the volatile nature of this file. */
/* This file contains private, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) subsystem. */
/* $ 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 */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */
/* -& */
/* The set of supported coordinate systems */
/* System Coordinates */
/* ---------- ----------- */
/* Rectangular X, Y, Z */
/* Latitudinal Radius, Longitude, Latitude */
/* Spherical Radius, Colatitude, Longitude */
/* RA/Dec Range, Right Ascension, Declination */
/* Cylindrical Radius, Longitude, Z */
/* Geodetic Longitude, Latitude, Altitude */
/* Planetographic Longitude, Latitude, Altitude */
/* Below we declare parameters for naming coordinate systems. */
/* User inputs naming coordinate systems must match these */
/* when compared using EQSTR. That is, user inputs must */
/* match after being left justified, converted to upper case, */
/* and having all embedded blanks removed. */
/* Below we declare names for coordinates. Again, user */
/* inputs naming coordinates must match these when */
/* compared using EQSTR. */
/* Note that the RA parameter value below matches */
/* 'RIGHT ASCENSION' */
/* when extra blanks are compressed out of the above value. */
/* Parameters specifying types of vector definitions */
/* used for GF coordinate searches: */
/* All string parameter values are left justified, upper */
/* case, with extra blanks compressed out. */
/* POSDEF indicates the vector is defined by the */
/* position of a target relative to an observer. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the sub-observer point on */
/* that body, for a given observer and target. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the surface intercept point on */
/* that body, for a given observer, ray, and target. */
/* Number of workspace windows used by ZZGFREL: */
/* Number of additional workspace windows used by ZZGFLONG: */
/* Index of "existence window" used by ZZGFCSLV: */
/* Progress report parameters: */
/* MXBEGM, */
/* MXENDM are, respectively, the maximum lengths of the progress */
/* report message prefix and suffix. */
/* Note: the sum of these lengths, plus the length of the */
/* "percent complete" substring, should not be long enough */
/* to cause wrap-around on any platform's terminal window. */
/* Total progress report message length upper bound: */
/* End of file zzgf.inc. */
/* $ Abstract */
/* Include file zzabcorr.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters below define the structure of an aberration */
/* correction attribute block. */
/* $ 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. */
/* $ Parameters */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TRGID I Target ID code. */
/* ET I Computation epoch. */
/* FIXREF I Reference frame name. */
/* ABCORR I Aberration correction. */
/* OBSID I Observer ID code. */
/* RADII I Target radii. */
/* STATE O State used to define coordinates. */
/* $ Detailed_Input */
/* METHOD is a short string providing parameters defining */
/* the computation method to be used. Any value */
/* supported by SUBPNT may be used. */
/* TRGID is the NAIF ID code of the target object. */
/* *This routine assumes that the target is modeled */
/* as a tri-axial ellipsoid.* */
/* ET is the time, expressed as ephemeris seconds past J2000 */
/* TDB, at which the specified state is to be computed. */
/* FIXREF is the name of the reference frame relative to which */
/* the state of interest is specified. */
/* FIXREF must be centered on the target body. */
/* Case, leading and trailing blanks are not significant */
/* in the string FIXREF. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the state of the target body to account for one-way */
/* light time and stellar aberration. The orientation */
/* of the target body will also be corrected for one-way */
/* light time when light time corrections are requested. */
/* Supported aberration correction options for */
/* observation (case where radiation is received by */
/* observer at ET) are: */
/* NONE No correction. */
/* LT Light time only. */
/* LT+S Light time and stellar aberration. */
/* CN Converged Newtonian (CN) light time. */
/* CN+S CN light time and stellar aberration. */
/* Supported aberration correction options for */
/* transmission (case where radiation is emitted from */
/* observer at ET) are: */
/* XLT Light time only. */
/* XLT+S Light time and stellar aberration. */
/* XCN Converged Newtonian (CN) light time. */
/* XCN+S CN light time and stellar aberration. */
/* For detailed information, see the geometry finder */
/* required reading, gf.req. Also see the header of */
/* SPKEZR, which contains a detailed discussion of */
/* aberration corrections. */
/* Case, leading and trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSID is the NAIF ID code of the observer. */
/* RADII is an array containing three radii defining */
/* a reference ellipsoid for the target body. */
/* $ Detailed_Output */
/* STATE is the state of the sub-observer point at ET. */
/* The first three components of STATE contain the */
/* sub-observer point itself; the last three */
/* components contain the derivative with respect to */
/* time of the position. The state is expressed */
/* relative to the body-fixed frame designated by */
/* FIXREF. */
/* Units are km and km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the aberration correction ABCORR is not recognized, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 2) If the frame FIXREF is not recognized by the frames */
/* subsystem, the error will be diagnosed by routines in the */
/* call tree of this routine. */
/* 3) FIXREF must be centered on the target body; if it isn't, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 4) Any error that occurs while look up the state of the target */
/* or observer will be diagnosed by routines in the call tree of */
/* this routine. */
/* 5) Any error that occurs while look up the orientation of */
/* the target will be diagnosed by routines in the call tree of */
/* this routine. */
/* 6) If the input method is not recognized, the error */
/* SPICE(NOTSUPPORTED) will be signaled. */
/* $ Files */
/* Appropriate kernels must be loaded by the calling program before */
/* this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - PCK data: if the target body shape is modeled as an */
/* ellipsoid, triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must be */
/* loaded. These may be provided in a text or binary PCK file. */
/* - Frame data: if a frame definition is required to convert the */
/* observer and target states to the body-fixed frame of the */
/* target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine isolates the computation of the sub-observer state */
/* (that is, the sub-observer point and its derivative with respect */
/* to time). */
/* This routine is used by the GF coordinate utility routines in */
/* order to solve for time windows on which specified mathematical */
/* conditions involving coordinates are satisfied. The role of */
/* this routine is to provide Cartesian state vectors enabling */
/* the GF coordinate utilities to determine the signs of the */
/* derivatives with respect to time of coordinates of interest. */
/* $ Examples */
/* See ZZGFCOST. */
/* $ Restrictions */
/* 1) This routine is restricted to use with ellipsoidal target */
/* shape models. */
/* 2) The computations performed by this routine are intended */
/* to be compatible with those performed by the SPICE */
/* routine SUBPNT. If that routine changes, this routine */
/* may need to be updated. */
/* 3) This routine presumes that error checking of inputs */
/* has, where possible, already been performed by the */
/* GF coordinate utility initialization routine. */
/* 4) The interface and functionality of this set of routines may */
/* change without notice. These routines should be called only */
/* by SPICELIB routines. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */
/* Upgraded to support targets and observers having */
/* no names associated with their ID codes. */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* sub-observer state */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSSOB", (ftnlen)8);
if (first || *trgid != prvtrg) {
bodc2s_(trgid, svtarg, (ftnlen)36);
prvtrg = *trgid;
}
if (first || *obsid != prvobs) {
bodc2s_(obsid, svobs, (ftnlen)36);
prvobs = *obsid;
}
first = FALSE_;
/* Parse the aberration correction specifier. */
zzprscor_(abcorr, attblk, abcorr_len);
geom = attblk[0];
uselt = attblk[1];
usestl = attblk[2];
xmit = attblk[4];
/* Decide whether the sub-observer point is computed using */
/* the "near point" or "surface intercept" method. Only */
/* ellipsoids may be used a shape models for this computation. */
if (eqstr_(method, "Near point: ellipsoid", method_len, (ftnlen)21)) {
near__ = TRUE_;
} else if (eqstr_(method, "Intercept: ellipsoid", method_len, (ftnlen)20))
{
near__ = FALSE_;
} else {
setmsg_("Sub-observer point computation method # is not supported by"
" this routine.", (ftnlen)73);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (geom) {
/* This is the geometric case. */
/* We need to check the body-fixed reference frame here. */
namfrm_(fixref, &frcode, fixref_len);
frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (! fnd) {
setmsg_("Input reference frame # was not recognized.", (ftnlen)43)
;
errch_("#", fixref, (ftnlen)1, fixref_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (center != *trgid) {
setmsg_("Input reference frame # is centered on body # instead o"
"f body #.", (ftnlen)64);
errch_("#", fixref, (ftnlen)1, fixref_len);
errint_("#", ¢er, (ftnlen)1);
errint_("#", trgid, (ftnlen)1);
sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Get the state of the target with respect to the observer, */
/* expressed relative to the target body-fixed frame. We don't */
/* need to propagate states to the solar system barycenter in */
/* this case. */
spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the state of the observer with respect to the target */
/* in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the sub-observer */
/* point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &found)
;
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. DNEARP re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface */
/* intercept point." The ray direction is simply */
/* the negative of the observer's position relative */
/* to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to */
/* be unable to compute an intercept state, it *is* */
/* an error in this case, since the ray points toward */
/* the center of the target. */
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. SURFPV re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
} else if (uselt) {
/* Light time and possibly stellar aberration corrections are */
/* applied. */
/* Most our work consists of getting ready to call either of the */
/* SPICELIB routines DNEARP or SURFPV. In order to make this */
/* call, we'll need the velocity of the observer relative to the */
/* target body's center in the target body-fixed frame. We must */
/* evaluate the rotation state of the target at the correct */
/* epoch, and account for the rate of change of light time, if */
/* light time corrections are used. The algorithm we use depends */
/* on the algorithm used in SUBPNT, since we're computing the */
/* derivative with respect to time of the solution found by that */
/* routine. */
/* In this algorithm, we must take into account the fact that */
/* SUBPNT performs light time and stellar aberration corrections */
/* for the sub-observer point, not for the center of the target */
/* body. */
/* If light time and stellar aberration corrections are used, */
/* - Find the aberration corrected sub-observer point and the */
/* light time-corrected epoch TRGEPC associated with the */
/* sub-observer point. */
/* - Use TRGEPC to find the position of the target relative to */
/* the solar system barycenter. */
/* - Use TRGEPC to find the orientation of the target relative */
/* to the J2000 reference frame. */
/* - Find the light-time corrected position of the */
/* sub-observer point; use this to compute the stellar */
/* aberration offset that applies to the sub-observer point, */
/* as well as the velocity of this offset. */
/* - Find the corrected state of the target center as seen */
/* from the observer, where the corrections are those */
/* applicable to the sub-observer point. */
/* - Negate the corrected target center state to obtain the */
/* state of the observer relative to the target. */
/* - Express the state of the observer relative to the target */
/* in the target body fixed frame at TRGEPC. */
/* Below, we'll use the convention that vectors expressed */
/* relative to the body-fixed frame have names of the form */
/* FX* */
/* Note that SUBPNT will signal an error if FIXREF is not */
/* actually centered on the target body. */
subpnt_(method, svtarg, et, fixref, abcorr, svobs, spoint, &trgepc,
srfvec, method_len, (ftnlen)36, fixref_len, abcorr_len, (
ftnlen)36);
/* Get J2000-relative states of observer and target with respect */
/* to the solar system barycenter at their respective epochs of */
/* participation. */
spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5);
spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5);
/* Get the uncorrected J2000 to body-fixed to state */
/* transformation at TRGEPC. */
sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Initialize the state of the sub-observer point in the */
/* body-fixed frame. At this point we don't know the */
/* point's velocity; set it to zero. */
moved_(spoint, &c__3, fxpsta);
cleard_(&c__3, &fxpsta[3]);
if (usestl) {
/* We're going to need the acceleration of the observer */
/* relative to the SSB. Compute this now. */
for (i__ = 1; i__ <= 2; ++i__) {
/* The epoch is ET -/+ TDELTA. */
t = *et + ((i__ << 1) - 3) * 1.;
spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12
&& 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss"
"ob_", (ftnlen)652)], (ftnlen)5);
}
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the observer's acceleration using a quadratic */
/* approximation. */
qderiv_(&c__3, &obssta[3], &obssta[9], &c_b40, acc);
}
/* The rest of the algorithm is iterative. On the first */
/* iteration, we don't have a good estimate of the velocity */
/* of the sub-observer point relative to the body-fixed */
/* frame. Since we're using this velocity as an input */
/* to the aberration velocity computations, we */
/* expect that treating this velocity as zero on the first */
/* pass yields a reasonable estimate. On the second pass, */
/* we'll use the velocity derived on the first pass. */
cleard_(&c__3, fxpvel);
/* We'll also estimate the rate of change of light time */
/* as zero on the first pass. */
dlt = 0.;
for (i__ = 1; i__ <= 2; ++i__) {
/* Correct the target's velocity for the rate of */
/* change of light time. */
if (xmit) {
scale = dlt + 1.;
} else {
scale = 1. - dlt;
}
/* Scale the velocity portion of the target state to */
/* correct the velocity for the rate of change of light */
/* time. */
moved_(ssbtg0, &c__3, ssbtrg);
vscl_(&scale, &ssbtg0[3], &ssbtrg[3]);
/* Get the state of the target with respect to the observer. */
vsubg_(ssbtrg, ssbobs, &c__6, obstrg);
/* Correct the J2000 to body-fixed state transformation matrix */
/* for the rate of change of light time. */
zzcorsxf_(&xmit, &dlt, xform, corxfm);
/* Invert CORXFM to obtain the corrected */
/* body-fixed to J2000 state transformation. */
invstm_(corxfm, corxfi);
/* Convert the sub-observer point state to the J2000 frame. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
/* Find the J2000-relative state of the sub-observer */
/* point with respect to the target. */
vaddg_(obstrg, pntsta, &c__6, obspnt);
if (usestl) {
/* Now compute the stellar aberration correction */
/* applicable to OBSPNT. We need the velocity of */
/* this correction as well. */
zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel);
moved_(sa, &c__3, sastat);
moved_(savel, &c__3, &sastat[3]);
/* Adding the stellar aberration state to the target center */
/* state gives us the state of the target center with */
/* respect to the observer, corrected for the aberrations */
/* applicable to the sub-observer point. */
vaddg_(obstrg, sastat, &c__6, stemp);
} else {
moved_(obstrg, &c__6, stemp);
}
/* Convert STEMP to the body-fixed reference frame. */
mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta);
/* At long last, compute the state of the observer */
/* with respect to the target in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the */
/* sub-observer point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &
found);
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. "
"DNEARP returned \"not found.\"", (ftnlen)123);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface intercept */
/* point." The ray direction is simply the negative of the */
/* observer's position relative to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to be */
/* unable to compute an intercept state, it *is* an error */
/* in this case, since the ray points toward the center of */
/* the target. */
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. S"
"URFPV returned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
/* At this point we can update the surface point */
/* velocity and light time derivative estimates. */
/* In order to compute the light time rate, we'll */
/* need the J2000-relative velocity of the sub-observer */
/* point with respect to the observer. First convert */
/* the sub-observer state to the J2000 frame, then */
/* add the result to the state of the target center */
/* with respect to the observer. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
vaddg_(obstrg, pntsta, &c__6, obspnt);
/* Now that we have an improved estimate of the */
/* sub-observer state, we can estimate the rate of */
/* change of light time as */
/* range rate */
/* ---------- */
/* c */
/* If we're correcting for stellar aberration, *ideally* we */
/* should remove that correction now, since the light time */
/* rate is based on light time between the observer and the */
/* light-time corrected sub-observer point. But the error made */
/* by including stellar aberration is too small to make it */
/* worthwhile to make this adjustment. */
vhat_(obspnt, upos);
dlt = vdot_(&obspnt[3], upos) / clight_();
/* With FXPVEL and DLT updated, we'll repeat our */
/* computations. */
}
} else {
/* We should never get here. */
setmsg_("Aberration correction # was not recognized.", (ftnlen)43);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Copy the computed state to the output argument STATE. */
moved_(fxpsta, &c__6, state);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
} /* zzgfssob_ */
/* $Procedure MXMT ( Matrix times matrix transpose, 3x3 ) */
/* Subroutine */ int mxmt_(doublereal *m1, doublereal *m2, doublereal *mout)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer i__, j;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
doublereal prodm[9] /* was [3][3] */;
/* $ Abstract */
/* Multiply a 3x3 matrix and the transpose of another 3x3 matrix. */
/* $ 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 */
/* None. */
/* $ Keywords */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* M1 I 3x3 double precision matrix. */
/* M2 I 3x3 double precision matrix. */
/* MOUT O 3x3 double precision matrix. MOUT is the */
/* product M1 * M2**T. */
/* $ Detailed_Input */
/* M1 is an arbitrary 3x3 double precision matrix. */
/* M2 is an arbitrary 3x3 double precision matrix. */
/* Typically, M2 will be a rotation matrix since */
/* then its transpose is its inverse (but this is */
/* NOT a requirement). */
/* $ Detailed_Output */
/* MOUT is a 3x3 double precision matrix. MOUT is the */
/* product (M1) x (M2**T). */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The code reflects precisely the following mathematical expression */
/* For each value of the subscripts I and J from 1 to 3: */
/* MOUT(I,J) = Summation from K=1 to 3 of ( M1(I,K) * M2(J,K) ) */
/* Note that the reversal of the K and J subscripts in the right- */
/* hand matrix M2 is what makes MOUT the product of the TRANSPOSE of */
/* M2 and not simply of M2 itself. */
/* $ Examples */
/* Let M1 = | 0.0D0 1.0D0 0.0D0 | */
/* | | */
/* | -1.0D0 0.0D0 0.0D0 | */
/* | | */
/* | 0.0D0 0.0D0 1.0D0 | */
/* M2 = | 0.0D0 1.0D0 0.0D0 | */
/* | | */
/* | -1.0D0 0.0D0 0.0D0 | */
/* | | */
/* | 0.0D0 0.0D0 1.0D0 | */
/* then the call */
/* CALL MXMT ( M1, M2, MOUT ) */
/* produces the matrix */
/* MOUT = | 1.0D0 0.0D0 0.0D0 | */
/* | | */
/* | 0.0D0 1.0D0 0.0D0 | */
/* | | */
/* | 0.0D0 0.0D0 1.0D0 | */
/* $ Restrictions */
/* The user is responsible for checking the magnitudes of the */
/* elements of M1 and M2 so that a floating point overflow does */
/* not occur. (In the typical use where M1 and M2 are rotation */
/* matrices, this not a risk at all.) */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.M. Owen (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */
/* Header correction: assertions that the output */
/* can overwrite the input have been removed. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) */
/* -& */
/* $ Index_Entries */
/* matrix times matrix_transpose 3x3_case */
/* -& */
/* Local variables */
/* Perform the matrix multiplication */
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
prodm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge(
"prodm", i__1, "mxmt_", (ftnlen)174)] = m1[(i__2 = i__ -
1) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, "mxmt_", (
ftnlen)174)] * m2[(i__3 = j - 1) < 9 && 0 <= i__3 ? i__3 :
s_rnge("m2", i__3, "mxmt_", (ftnlen)174)] + m1[(i__4 =
i__ + 2) < 9 && 0 <= i__4 ? i__4 : s_rnge("m1", i__4,
"mxmt_", (ftnlen)174)] * m2[(i__5 = j + 2) < 9 && 0 <=
i__5 ? i__5 : s_rnge("m2", i__5, "mxmt_", (ftnlen)174)] +
m1[(i__6 = i__ + 5) < 9 && 0 <= i__6 ? i__6 : s_rnge(
"m1", i__6, "mxmt_", (ftnlen)174)] * m2[(i__7 = j + 5) <
9 && 0 <= i__7 ? i__7 : s_rnge("m2", i__7, "mxmt_", (
ftnlen)174)];
}
}
/* Move the result into MOUT */
moved_(prodm, &c__9, mout);
return 0;
} /* mxmt_ */
/* $Procedure CKGP ( C-kernel, get pointing ) */
/* Subroutine */ int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol,
char *ref, doublereal *cmat, doublereal *clkout, logical *found,
ftnlen ref_len)
{
logical pfnd, sfnd;
integer sclk;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer type1, type2;
char segid[40];
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), ckbss_(integer *, doublereal *,
doublereal *, logical *), ckpfs_(integer *, doublereal *,
doublereal *, doublereal *, logical *, doublereal *, doublereal *,
doublereal *, logical *), moved_(doublereal *, integer *,
doublereal *), cksns_(integer *, doublereal *, char *, logical *,
ftnlen);
logical gotit;
extern logical failed_(void);
doublereal av[3], et;
integer handle;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
logical needav;
extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen);
integer refseg, center;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frinfo_(
integer *, integer *, integer *, integer *, logical *);
integer refreq, typeid;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern logical return_(void);
doublereal dcd[2];
integer icd[6];
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
doublereal rot[9] /* was [3][3] */;
/* $ Abstract */
/* Get pointing (attitude) for a specified spacecraft clock time. */
/* $ 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 */
/* SCLK */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ 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. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* INST I NAIF ID of instrument, spacecraft, or structure. */
/* SCLKDP I Encoded spacecraft clock time. */
/* TOL I Time tolerance. */
/* REF I Reference frame. */
/* CMAT O C-matrix pointing data. */
/* CLKOUT O Output encoded spacecraft clock time. */
/* FOUND O True when requested pointing is available. */
/* $ Detailed_Input */
/* INST is the NAIF integer ID for the instrument, spacecraft, */
/* or other structure for which pointing is requested. */
/* For brevity we will refer to this object as the */
/* "instrument," and the frame fixed to this object as */
/* the "instrument frame" or "instrument-fixed" frame. */
/* SCLKDP is the encoded spacecraft clock time for which */
/* pointing is requested. */
/* The SPICELIB routines SCENCD and SCE2C respectively */
/* convert spacecraft clock strings and ephemeris time to */
/* encoded spacecraft clock. The inverse conversions are */
/* performed by SCDECD and SCT2E. */
/* TOL is a time tolerance in ticks, the units of encoded */
/* spacecraft clock time. */
/* The SPICELIB routine SCTIKS converts a spacecraft */
/* clock tolerance duration from its character string */
/* representation to ticks. SCFMT performs the inverse */
/* conversion. */
/* The C-matrix returned by CKGP is the one whose time */
/* tag is closest to SCLKDP and within TOL units of */
/* SCLKDP. (More in Particulars, below.) */
/* In general, because using a non-zero tolerance */
/* affects selection of the segment from which the */
/* data is obtained, users are strongly discouraged */
/* from using a non-zero tolerance when reading CKs */
/* with continuous data. Using a non-zero tolerance */
/* should be reserved exclusively to reading CKs with */
/* discrete data because in practice obtaining data */
/* from such CKs using a zero tolerance is often not */
/* possible due to time round off. */
/* REF is the desired reference frame for the returned */
/* pointing. The returned C-matrix CMAT gives the */
/* orientation of the instrument designated by INST */
/* relative to the frame designated by REF. When a */
/* vector specified relative to frame REF is left- */
/* multiplied by CMAT, the vector is rotated to the */
/* frame associated with INST. See the discussion of */
/* CMAT below for details. */
/* Consult the SPICE document "Frames" for a discussion */
/* of supported reference frames. */
/* $ Detailed_Output */
/* CMAT is a rotation matrix that transforms the components of */
/* a vector expressed in the reference frame specified by */
/* REF to components expressed in the frame tied to the */
/* instrument, spacecraft, or other structure at time */
/* CLKOUT (see below). */
/* Thus, if a vector v has components x,y,z in the REF */
/* reference frame, then v has components x',y',z' in the */
/* instrument fixed frame at time CLKOUT: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* If you know x', y', z', use the transpose of the */
/* C-matrix to determine x, y, z as follows: */
/* [ x ] [ ]T [ x' ] */
/* | y | = | CMAT | | y' | */
/* [ z ] [ ] [ z' ] */
/* (Transpose of CMAT) */
/* CLKOUT is the encoded spacecraft clock time associated with */
/* the returned C-matrix. This value may differ from the */
/* requested time, but never by more than the input */
/* tolerance TOL. */
/* The particulars section below describes the search */
/* algorithm used by CKGP to satisfy a pointing */
/* request. This algorithm determines the pointing */
/* instance (and therefore the associated time value) */
/* that is returned. */
/* FOUND is true if a record was found to satisfy the pointing */
/* request. FOUND will be false otherwise. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If a C-kernel file has not been loaded using FURNSH prior to */
/* a call to this routine, an error is signaled by a routine in */
/* the call tree of this routine. */
/* 2) If TOL is negative, found is set to .FALSE. */
/* 3) If REF is not a supported reference frame, an error is */
/* signaled by a routine in the call tree of this routine and */
/* FOUND is set to .FALSE. */
/* $ Files */
/* CKGP searches through files loaded by FURNSH to locate a */
/* segment that can satisfy the request for pointing for instrument */
/* INST at time SCLKDP. You must load a C-kernel file using FURNSH */
/* prior to calling this routine. */
/* $ Particulars */
/* How the tolerance argument is used */
/* ================================== */
/* Reading a type 1 CK segment (discrete pointing instances) */
/* --------------------------------------------------------- */
/* In the diagram below */
/* - "0" is used to represent discrete pointing instances */
/* (quaternions and associated time tags). */
/* - "( )" are used to represent the end points of the time */
/* interval covered by a segment in a CK file. */
/* - SCLKDP is the time at which you requested pointing. */
/* The location of SCLKDP relative to the time tags of the */
/* pointing instances is indicated by the "+" sign. */
/* - TOL is the time tolerance specified in the pointing */
/* request. The square brackets "[ ]" represent the */
/* endpoints of the time interval */
/* SCLKDP-TOL : SCLKDP+TOL */
/* - The quaternions occurring in the segment need not be */
/* evenly spaced in time. */
/* Case 1: pointing is available */
/* ------------------------------ */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (0-----0--0--0--0--0--0---0--0------------0--0--0--0) */
/* ^ */
/* | */
/* CKGP returns this instance. */
/* Case 2: pointing is not available */
/* ---------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) */
/* CKGP returns no pointing; the output */
/* FOUND flag is set to .FALSE. */
/* Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) */
/* ------------------------------------------------------------- */
/* In the diagrams below */
/* - "==" is used to represent periods of continuous pointing. */
/* - "--" is used to represent gaps in the pointing coverage. */
/* - "( )" are used to represent the end points of the time */
/* interval covered by a segment in a CK file. */
/* - SCLKDP is the time at which you requested pointing. */
/* The location of SCLKDP relative to the time tags of the */
/* pointing instances is indicated by the "+" sign. */
/* - TOL is the time tolerance specified in the pointing */
/* request. The square brackets "[ ]" represent the */
/* endpoints of the time interval */
/* SCLKDP-TOL : SCLKDP+TOL */
/* - The quaternions occurring in the periods of continuous */
/* pointing need not be evenly spaced in time. */
/* Case 1: pointing is available at the request time */
/* -------------------------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* . . . */
/* Segment (==---===========---=======----------===--) */
/* ^ */
/* | */
/* The request time lies within an interval where */
/* continuous pointing is available. CKGP returns */
/* pointing at the requested epoch. */
/* Case 2: pointing is available "near" the request time */
/* ------------------------------------------------------ */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (==---===========----=======---------===--) */
/* ^ */
/* | */
/* The request time lies in a gap: an interval where */
/* continuous pointing is *not* available. CKGP */
/* returns pointing for the epoch closest to the */
/* request time SCLKDP. */
/* Case 3: pointing is not available */
/* ---------------------------------- */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment (==---===========----=======---------===--) */
/* CKGP returns no pointing; the output */
/* FOUND flag is set to .FALSE. */
/* Tolerance and segment priority */
/* ============================== */
/* CKGP searches through loaded C-kernels to satisfy a pointing */
/* request. Last-loaded files are searched first. Individual files */
/* are searched in backwards order, so that between competing */
/* segments (segments containing data for the same object, for */
/* overlapping time ranges), the one closest to the end of the file */
/* has highest priority. */
/* The search ends when a segment is found that can provide pointing */
/* for the specified instrument at a time falling within the */
/* specified tolerance on either side of the request time. Within */
/* that segment, the instance closest to the input time is located */
/* and returned. */
/* The following four cases illustrate this search procedure. */
/* Segments A and B are in the same file, with segment A located */
/* further towards the end of the file than segment B. Both segments */
/* A and B contain discrete pointing data, indicated by the number */
/* 0. */
/* Case 1: Pointing is available in the first segment searched. */
/* Because segment A has the highest priority and can */
/* satisfy the request, segment B is not searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* ^ */
/* | */
/* | */
/* CKGP returns this instance */
/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/* Case 2: Pointing is not available in the first segment searched. */
/* Because segment A cannot satisfy the request, segment B */
/* is searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* . . . */
/* Segment B (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segments that contain continuous pointing data are searched in */
/* the same manner as segments containing discrete pointing data. */
/* For request times that fall within the bounds of continuous */
/* intervals, CKGP will return pointing at the request time. When */
/* the request time does not fall within an interval, then a time at */
/* an endpoint of an interval may be returned if it is the closest */
/* time in the segment to the user request time and is also within */
/* the tolerance. */
/* In the following examples, segment A is located further towards */
/* the end of the file than segment C. Segment A contains discrete */
/* pointing data and segment C contains continuous data, indicated */
/* by the "=" character. */
/* Case 3: Pointing is not available in the first segment searched. */
/* Because segment A cannot satisfy the request, segment C */
/* is searched. */
/* SCLKDP */
/* \ TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment A (0-----------------0--------0--0-----0) */
/* . . . */
/* . . . */
/* Segment C (---=============-----====--------==--) */
/* ^ */
/* | */
/* | */
/* CKGP returns this instance */
/* In the next case, assume that the order of segments A and C in the */
/* file is reversed: A is now closer to the front, so data from */
/* segment C are considered first. */
/* Case 4: Pointing is available in the first segment searched. */
/* Because segment C has the highest priority and can */
/* satisfy the request, segment A is not searched. */
/* SCLKDP */
/* / */
/* | TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment C (---=============-----====--------==--) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segment A (0-----------------0--------0--0-----0) */
/* ^ */
/* | */
/* "Best" answer */
/* The next case illustrates an unfortunate side effect of using */
/* a non-zero tolerance when reading multi-segment CKs with */
/* continuous data. In all cases when the look-up interval */
/* formed using tolerance overlaps a segment boundary and */
/* the request time falls within the coverage of the lower */
/* priority segment, the data at the end of the higher priority */
/* segment will be picked instead of the data from the lower */
/* priority segment. */
/* Case 5: Pointing is available in the first segment searched. */
/* Because segment C has the highest priority and can */
/* satisfy the request, segment A is not searched. */
/* SCLKDP */
/* / */
/* | TOL */
/* | / */
/* |/\ */
/* Your request [--+--] */
/* . . . */
/* . . . */
/* Segment C (===============) */
/* ^ */
/* | */
/* CKGP returns this instance */
/* Segment A (=====================) */
/* ^ */
/* | */
/* "Best" answer */
/* $ Examples */
/* Suppose you have two C-kernel files containing data for the */
/* Voyager 2 narrow angle camera. One file contains predict values, */
/* and the other contains corrected pointing for a selected group */
/* of images, that is, for a subset of images from the first file. */
/* The following example program uses CKGP to get C-matrices for a */
/* set of images whose SCLK counts (un-encoded character string */
/* versions) are contained in the array SCLKCH. */
/* If available, the program will get the corrected pointing values. */
/* Otherwise, predict values will be used. */
/* For each C-matrix, a unit pointing vector is constructed */
/* and printed. */
/* C */
/* C Constants for this program. */
/* C */
/* C -- The code for the Voyager 2 spacecraft clock is -32 */
/* C */
/* C -- The code for the narrow angle camera on the Voyager 2 */
/* C spacecraft is -32001. */
/* C */
/* C -- Spacecraft clock times for successive Voyager images */
/* C always differ by more than 0:0:400. This is an */
/* C acceptable tolerance, and must be converted to "ticks" */
/* C (units of encoded SCLK) for input to CKGP. */
/* C */
/* C -- The reference frame we want is FK4. */
/* C */
/* C -- The narrow angle camera boresight defines the third */
/* C axis of the instrument-fixed coordinate system. */
/* C Therefore, the vector ( 0, 0, 1 ) represents */
/* C the boresight direction in the camera-fixed frame. */
/* C */
/* IMPLICIT NONE */
/* INTEGER FILEN */
/* PARAMETER ( FILEN = 255 ) */
/* INTEGER NPICS */
/* PARAMETER ( NPICS = 2 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 30 ) */
/* INTEGER REFLEN */
/* PARAMETER ( REFLEN = 32 ) */
/* CHARACTER*(TIMLEN) CLKCH */
/* CHARACTER*(FILEN) CKPRED */
/* CHARACTER*(FILEN) CKCORR */
/* CHARACTER*(REFLEN) REF */
/* CHARACTER*(FILEN) SCLK */
/* CHARACTER*(TIMLEN) SCLKCH ( NPICS ) */
/* CHARACTER*(TIMLEN) TOLVGR */
/* DOUBLE PRECISION CLKOUT */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* DOUBLE PRECISION SCLKDP */
/* DOUBLE PRECISION TOLTIK */
/* DOUBLE PRECISION VCFIX ( 3 ) */
/* DOUBLE PRECISION VINERT ( 3 ) */
/* INTEGER SC */
/* INTEGER I */
/* INTEGER INST */
/* LOGICAL FOUND */
/* CKPRED = 'voyager2_predict.bc' */
/* CKCORR = 'voyager2_corrected.bc' */
/* SCLK = 'voyager2_sclk.tsc' */
/* SC = -32 */
/* INST = -32001 */
/* SCLKCH(1) = '4/08966:30:768' */
/* SCLKCH(2) = '4/08970:58:768' */
/* TOLVGR = '0:0:400' */
/* REF = 'FK4' */
/* VCFIX( 1 ) = 0.D0 */
/* VCFIX( 2 ) = 0.D0 */
/* VCFIX( 3 ) = 1.D0 */
/* C */
/* C Loading the files in this order ensures that the */
/* C corrected file will get searched first. */
/* C */
/* CALL FURNSH ( CKPRED ) */
/* CALL FURNSH ( CKCORR ) */
/* C */
/* C Need to load a Voyager 2 SCLK kernel to convert from */
/* C clock strings to ticks. */
/* C */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Convert tolerance from VGR formatted character string */
/* C SCLK to ticks which are units of encoded SCLK. */
/* C */
/* CALL SCTIKS ( SC, TOLVGR, TOLTIK ) */
/* DO I = 1, NPICS */
/* C */
/* C CKGP requires encoded spacecraft clock. */
/* C */
/* CALL SCENCD ( SC, SCLKCH( I ), SCLKDP ) */
/* CALL CKGP ( INST, SCLKDP, TOLTIK, REF, CMAT, */
/* . CLKOUT, FOUND ) */
/* IF ( FOUND ) THEN */
/* C */
/* C Use the transpose of the C-matrix to transform the */
/* C boresight vector from camera-fixed to reference */
/* C coordinates. */
/* C */
/* CALL MTXV ( CMAT, VCFIX, VINERT ) */
/* CALL SCDECD ( SC, CLKOUT, CLKCH ) */
/* WRITE (*,*) 'VGR 2 SCLK Time: ', CLKCH */
/* WRITE (*,*) 'VGR 2 NA ISS boresight ' */
/* . // 'pointing vector: ', VINERT */
/* ELSE */
/* WRITE (*,*) 'Pointing not found for time ', SCLKCH(I) */
/* END IF */
/* END DO */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* J.M. Lynch (JPL) */
/* B.V. Semenov (JPL) */
/* M.J. Spencer (JPL) */
/* R.E. Thurman (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 5.3.1, 09-JUN-2010 (BVS) */
/* Header update: description of the tolerance and Particulars */
/* section were expanded to address some problems arising from */
/* using a non-zero tolerance. */
/* - SPICELIB Version 5.3.0, 23-APR-2010 (NJB) */
/* Bug fix: this routine now obtains the rotation */
/* from the request frame to the applicable CK segment's */
/* base frame via a call to REFCHG. Formerly the routine */
/* used FRMCHG, which required that angular velocity data */
/* be available for this transformation. */
/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* - SPICELIB Version 5.1.2, 29-JAN-2004 (NJB) */
/* Header update: description of input argument REF was */
/* expanded. */
/* - SPICELIB Version 5.1.1, 27-JUL-2003 (CHA) (NJB) */
/* Various header corrections were made. */
/* - SPICELIB Version 3.2.0, 23-FEB-1999 (WLT) */
/* The previous editions of this routine did not properly handle */
/* the case when TOL was negative. The routine now returns a */
/* value of .FALSE. for FOUND as is advertised above. */
/* - SPICELIB Version 3.1.0, 13-APR-1998 (WLT) */
/* The call to CHKOUT in the case when FAILED returned the */
/* value TRUE used to check out with the name 'CKGPAV'. This */
/* has been changed to a CKGP. */
/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */
/* The routine was upgraded to support non-inertial frames. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */
/* The Particulars section was updated to show how the */
/* search algorithm processes segments with continuous */
/* pointing data. */
/* The example program now loads an SCLK kernel. */
/* FAILED is checked after the call to IRFROT to handle the */
/* case where the reference frame is invalid and the error */
/* handling is not set to abort. */
/* FAILED is checked in the DO WHILE loop to handle the case */
/* where an error is detected by a SPICELIB routine inside the */
/* loop and the error handling is not set to abort. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* - SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */
/* -& */
/* $ Index_Entries */
/* get ck pointing */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* - SPICELIB Version 3.1.0, 20-DEC-1995 (WLT) */
/* A call to FRINFO did not have enough arguments and */
/* went undetected until Howard Taylor of ACT. Many */
/* thanks go out to Howard for tracking down this error. */
/* - SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */
/* The routine was upgraded to support non-inertial frames. */
/* Calls to NAMIRF and IRFROT were replaced with calls to */
/* NAMFRM and FRMCHG respectively. */
/* - SPICELIB Version 1.0.2, 30-AUG-1991 (JML) */
/* 1) The Particulars section was updated to show how the */
/* search algorithm processes segments with continuous */
/* pointing data. */
/* 2) The example program now loads an SCLK kernel. */
/* 3) FAILED is checked after the call to IRFROT to handle the */
/* case where the reference frame is invalid and the error */
/* handling is not set to abort. */
/* 4) FAILED is checked in the DO WHILE loop to handle the case */
/* where an error is detected by a SPICELIB routine inside the */
/* loop and the error handling is not set to abort. */
/* - SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */
/* 1) The restriction that a C-kernel file must be loaded */
/* was explicitly stated. */
/* 2) Minor changes were made to the wording of the header. */
/* - Beta Version 1.1.0, 29-AUG-1990 (MJS) */
/* The following changes were made as a result of the */
/* NAIF CK Code and Documentation Review: */
/* 1) The variable SCLK was changed to SCLKDP. */
/* 2) The variable INSTR was changed to INST. */
/* 3) The variable IDENT was changed to SEGID. */
/* 4) The declarations for the parameters NDC, NIC, NC, and */
/* IDLEN were moved from the "Declarations" section of the */
/* header to the "Local parameters" section of the code below */
/* the header. These parameters are not meant to modified by */
/* users. */
/* 5) The header was updated to reflect the changes. */
/* - Beta Version 1.0.0, 04-MAY-1990 (RET) (IMU) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* NDC is the number of double precision components in an */
/* unpacked C-kernel segment descriptor. */
/* NIC is the number of integer components in an unpacked */
/* C-kernel segment descriptor. */
/* NC is the number of components in a packed C-kernel */
/* descriptor. All DAF summaries have this formulaic */
/* relationship between the number of its integer and */
/* double precision components and the number of packed */
/* components. */
/* IDLEN is the length of the C-kernel segment identifier. */
/* All DAF names have this formulaic relationship */
/* between the number of summary components and */
/* the length of the name (You will notice that */
/* a name and a summary have the same length in bytes.) */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKGP", (ftnlen)4);
}
/* Don't need angular velocity data. */
/* Assume the segment won't be found until it really is. */
needav = FALSE_;
*found = FALSE_;
/* If the tolerance is less than zero, we go no further. */
if (*tol < 0.) {
chkout_("CKGP", (ftnlen)4);
return 0;
}
/* Begin a search for this instrument and time, and get the first */
/* applicable segment. */
ckbss_(inst, sclkdp, tol, &needav);
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
/* Keep trying candidate segments until a segment can produce a */
/* pointing instance within the specified time tolerance of the */
/* input time. */
/* Check FAILED to prevent an infinite loop if an error is detected */
/* by a SPICELIB routine and the error handling is not set to abort. */
while(sfnd && ! failed_()) {
ckpfs_(&handle, descr, sclkdp, tol, &needav, cmat, av, clkout, &pfnd);
if (pfnd) {
/* Found one. If the C-matrix doesn't already rotate from the */
/* requested frame, convert it to one that does. */
dafus_(descr, &c__2, &c__6, dcd, icd);
refseg = icd[1];
/* Look up the id code for the requested reference frame. */
namfrm_(ref, &refreq, ref_len);
if (refreq != refseg) {
/* We may need to convert the output ticks CLKOUT to ET */
/* so that we can get the needed state transformation */
/* matrix. This is the case if either of the frames */
/* is non-inertial. */
frinfo_(&refreq, ¢er, &type1, &typeid, &gotit);
frinfo_(&refseg, ¢er, &type2, &typeid, &gotit);
if (type1 == 1 && type2 == 1) {
/* Any old value of ET will do in this case. We'll */
/* use zero. */
et = 0.;
} else {
/* Look up the spacecraft clock id to use to convert */
/* the output CLKOUT to ET. */
ckmeta_(inst, "SCLK", &sclk, (ftnlen)4);
sct2e_(&sclk, clkout, &et);
}
/* Get the transformation from the requested frame to */
/* the segment frame at ET. */
refchg_(&refreq, &refseg, &et, rot);
/* If REFCHG detects that the reference frame is invalid */
/* then return from this routine with FOUND equal to false. */
if (failed_()) {
chkout_("CKGP", (ftnlen)4);
return 0;
}
/* Transform the attitude information: convert CMAT so that */
/* it maps from request frame to C-matrix frame. */
mxm_(cmat, rot, tmpmat);
moved_(tmpmat, &c__9, cmat);
}
*found = TRUE_;
chkout_("CKGP", (ftnlen)4);
return 0;
}
cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
}
/* $Procedure SAELGV ( Semi-axes of ellipse from generating vectors ) */
/* Subroutine */ int saelgv_(doublereal *vec1, doublereal *vec2, doublereal *
smajor, doublereal *sminor)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern doublereal vdot_(doublereal *, doublereal *);
doublereal c__[4] /* was [2][2] */;
integer i__;
doublereal s[4] /* was [2][2] */, scale;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer major;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
integer minor;
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int diags2_(doublereal *, doublereal *,
doublereal *);
doublereal tmpvc1[3], tmpvc2[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal eigval[4] /* was [2][2] */;
extern /* Subroutine */ int chkout_(char *, ftnlen), vsclip_(doublereal *,
doublereal *);
extern logical return_(void);
/* $ Abstract */
/* Find semi-axis vectors of an ellipse generated by two arbitrary */
/* three-dimensional vectors. */
/* $ 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 */
/* ELLIPSES */
/* $ Keywords */
/* ELLIPSE */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* VEC1, */
/* VEC2 I Two vectors used to generate an ellipse. */
/* SMAJOR O Semi-major axis of ellipse. */
/* SMINOR O Semi-minor axis of ellipse. */
/* $ Detailed_Input */
/* VEC1, */
/* VEC2 are two vectors that define an ellipse. */
/* The ellipse is the set of points in 3-space */
/* CENTER + cos(theta) VEC1 + sin(theta) VEC2 */
/* where theta is in the interval ( -pi, pi ] and */
/* CENTER is an arbitrary point at which the ellipse */
/* is centered. An ellipse's semi-axes are */
/* independent of its center, so the vector CENTER */
/* shown above is not an input to this routine. */
/* VEC2 and VEC1 need not be linearly independent; */
/* degenerate input ellipses are allowed. */
/* $ Detailed_Output */
/* SMAJOR */
/* SMINOR are semi-major and semi-minor axes of the ellipse, */
/* respectively. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If one or more semi-axes of the ellipse is found to be the */
/* zero vector, the input ellipse is degenerate. This case is */
/* not treated as an error; the calling program must determine */
/* whether the semi-axes are suitable for the program's intended */
/* use. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Two linearly independent but not necessarily orthogonal vectors */
/* VEC1 and VEC2 can define an ellipse centered at the origin: the */
/* ellipse is the set of points in 3-space */
/* CENTER + cos(theta) VEC1 + sin(theta) VEC2 */
/* where theta is in the interval (-pi, pi] and CENTER is an */
/* arbitrary point at which the ellipse is centered. */
/* This routine finds vectors that constitute semi-axes of an */
/* ellipse that is defined, except for the location of its center, */
/* by VEC1 and VEC2. The semi-major axis is a vector of largest */
/* possible magnitude in the set */
/* cos(theta) VEC1 + sin(theta) VEC2 */
/* There are two such vectors; they are additive inverses of each */
/* other. The semi-minor axis is an analogous vector of smallest */
/* possible magnitude. The semi-major and semi-minor axes are */
/* orthogonal to each other. If SMAJOR and SMINOR are choices of */
/* semi-major and semi-minor axes, then the input ellipse can also */
/* be represented as the set of points */
/* CENTER + cos(theta) SMAJOR + sin(theta) SMINOR */
/* where theta is in the interval (-pi, pi]. */
/* The capability of finding the axes of an ellipse is useful in */
/* finding the image of an ellipse under a linear transformation. */
/* Finding this image is useful for determining the orthogonal and */
/* gnomonic projections of an ellipse, and also for finding the limb */
/* and terminator of an ellipsoidal body. */
/* $ Examples */
/* 1) An example using inputs that can be readily checked by */
/* hand calculation. */
/* Let */
/* VEC1 = ( 1.D0, 1.D0, 1.D0 ) */
/* VEC2 = ( 1.D0, -1.D0, 1.D0 ) */
/* The subroutine call */
/* CALL SAELGV ( VEC1, VEC2, SMAJOR, SMINOR ) */
/* returns */
/* SMAJOR = ( -1.414213562373095D0, */
/* 0.0D0, */
/* -1.414213562373095D0 ) */
/* and */
/* SMINOR = ( -2.4037033579794549D-17 */
/* 1.414213562373095D0, */
/* -2.4037033579794549D-17 ) */
/* 2) This example is taken from the code of the SPICELIB routine */
/* PJELPL, which finds the orthogonal projection of an ellipse */
/* onto a plane. The code listed below is the portion used to */
/* find the semi-axes of the projected ellipse. */
/* C */
/* C Project vectors defining axes of ellipse onto plane. */
/* C */
/* CALL VPERP ( VEC1, NORMAL, PROJ1 ) */
/* CALL VPERP ( VEC2, NORMAL, PROJ2 ) */
/* . */
/* . */
/* . */
/* CALL SAELGV ( PROJ1, PROJ2, SMAJOR, SMINOR ) */
/* The call to SAELGV determines the required semi-axes. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] Calculus, Vol. II. Tom Apostol. John Wiley & Sons, 1969. */
/* See Chapter 5, `Eigenvalues of Operators Acting on Euclidean */
/* Spaces'. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 22-APR-2010 (NJB) */
/* Header correction: assertions that the output */
/* can overwrite the input have been removed. */
/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* semi-axes of ellipse from generating vectors */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SAELGV", (ftnlen)6);
}
/* Let the notation */
/* < a, b > */
/* indicate the inner product of the vectors a and b. */
/* The semi-major and semi-minor axes of the input ellipse are */
/* vectors of maximum and minimum norm in the set */
/* cos(x) VEC1 + sin(x) VEC2 */
/* where x is in the interval (-pi, pi]. */
/* The square of the norm of a vector in this set is */
/* 2 */
/* || cos(x) VEC1 + sin(x) VEC2 || */
/* = < cos(x)VEC1 + sin(x)VEC2, cos(x)VEC1 + sin(x)VEC2 > ; */
/* this last expression can be written as the matrix product */
/* T */
/* X S X, (1) */
/* where X is the unit vector */
/* +- -+ */
/* | cos(x) | */
/* | | */
/* | sin(x) | */
/* +- -+ */
/* and S is the symmetric matrix */
/* +- -+ */
/* | < VEC1, VEC1 > < VEC1, VEC2 > | */
/* | |. */
/* | < VEC1, VEC2 > < VEC2, VEC2 > | */
/* +- -+ */
/* Because the 2x2 matrix above is symmetric, there exists a */
/* rotation matrix that allows us to diagonalize it: */
/* T */
/* C S C = D, */
/* where D is a diagonal matrix. Since rotation matrices are */
/* orthogonal, we have */
/* T */
/* C C = I. */
/* If the unit vector U is defined by */
/* T */
/* U = C X, */
/* then */
/* T T T T T */
/* X S X = ( U C ) C D C ( C U ) = U D U. */
/* So, letting */
/* +- -+ */
/* | u | */
/* | | = U, */
/* | v | */
/* +- -+ */
/* we may re-write the original quadratic expression (1) as */
/* +- -+ +- -+ +- -+ */
/* | u v | | D1 0 | | u |, */
/* +- -+ | | | | */
/* | | | v | */
/* | 0 D2 | +- -+ */
/* +- -+ */
/* or */
/* 2 2 */
/* D1 u + D2 v, */
/* where the diagonal matrix above is D. The eigenvalues D1 and */
/* D2 are non-negative because they are eigenvalues of a positive */
/* semi-definite matrix of the form */
/* T */
/* M M. */
/* We may require that */
/* D1 > D2; */
/* - */
/* then the maximum and minimum values of */
/* 2 2 */
/* D1 u + D2 v (2) */
/* are D1 and D2 respectively. These values are the squares */
/* of the lengths of the semi-major and semi-minor axes of the */
/* ellipse, since the expression (2) is the square of the norm */
/* of the point */
/* cos(x) VEC1 + sin(x) VEC2. */
/* Now we must find some eigenvectors. Since the extrema of (2) */
/* occur when */
/* +- -+ +- -+ */
/* | 1 | | 0 | */
/* U = | | or U = | |, */
/* | 0 | | 1 | */
/* +- -+ +- -+ */
/* and since */
/* X = C U, */
/* we conclude that the extrema occur when X = C1 or X = C2, where */
/* C1 and C2 are the first and second columns of C. Looking at */
/* the definition of X, we see that the extrema occur when */
/* cos(x) = C1(1) */
/* sin(x) = C1(2) */
/* and when */
/* cos(x) = C2(1), */
/* sin(x) = C2(2) */
/* So the semi-major and semi-minor axes of the ellipse are */
/* C(1,1) VEC1 + C(2,1) VEC2 */
/* and */
/* C(1,2) VEC1 + C(2,2) VEC2 */
/* (the negatives of these vectors are also semi-axes). */
/* Copy the input vectors. */
moved_(vec1, &c__3, tmpvc1);
moved_(vec2, &c__3, tmpvc2);
/* Scale the vectors to try to prevent arithmetic unpleasantness. */
/* We avoid using the quotient 1/SCALE, as this value may overflow. */
/* No need to go further if SCALE turns out to be zero. */
/* Computing MAX */
d__1 = vnorm_(tmpvc1), d__2 = vnorm_(tmpvc2);
scale = max(d__1,d__2);
if (scale == 0.) {
cleard_(&c__3, smajor);
cleard_(&c__3, sminor);
chkout_("SAELGV", (ftnlen)6);
return 0;
}
for (i__ = 1; i__ <= 3; ++i__) {
tmpvc1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("tmpvc1",
i__1, "saelgv_", (ftnlen)435)] = tmpvc1[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("tmpvc1", i__2, "saelgv_", (
ftnlen)435)] / scale;
tmpvc2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("tmpvc2",
i__1, "saelgv_", (ftnlen)436)] = tmpvc2[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("tmpvc2", i__2, "saelgv_", (
ftnlen)436)] / scale;
}
/* Compute S and diagonalize it: */
s[0] = vdot_(tmpvc1, tmpvc1);
s[1] = vdot_(tmpvc1, tmpvc2);
s[2] = s[1];
s[3] = vdot_(tmpvc2, tmpvc2);
diags2_(s, eigval, c__);
/* Find the semi-axes. */
if (abs(eigval[0]) >= abs(eigval[3])) {
/* The first eigenvector ( first column of C ) corresponds */
/* to the semi-major axis of the ellipse. */
major = 1;
minor = 2;
} else {
/* The second eigenvector corresponds to the semi-major axis. */
major = 2;
minor = 1;
}
vlcom_(&c__[(i__1 = (major << 1) - 2) < 4 && 0 <= i__1 ? i__1 : s_rnge(
"c", i__1, "saelgv_", (ftnlen)469)], tmpvc1, &c__[(i__2 = (major
<< 1) - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("c", i__2, "saelgv_",
(ftnlen)469)], tmpvc2, smajor);
vlcom_(&c__[(i__1 = (minor << 1) - 2) < 4 && 0 <= i__1 ? i__1 : s_rnge(
"c", i__1, "saelgv_", (ftnlen)470)], tmpvc1, &c__[(i__2 = (minor
<< 1) - 1) < 4 && 0 <= i__2 ? i__2 : s_rnge("c", i__2, "saelgv_",
(ftnlen)470)], tmpvc2, sminor);
/* Undo the initial scaling. */
vsclip_(&scale, smajor);
vsclip_(&scale, sminor);
chkout_("SAELGV", (ftnlen)6);
return 0;
} /* saelgv_ */
/* $Procedure SYSELD ( Select a subset of the values of a symbol ) */
/* Subroutine */ int syseld_(char *name__, integer *begin, integer *end, char
*tabsym, integer *tabptr, doublereal *tabval, doublereal *values,
logical *found, ftnlen name_len, ftnlen tabsym_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer nsym;
extern integer cardc_(char *, ftnlen);
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
extern integer sumai_(integer *, integer *), bsrchc_(char *, integer *,
char *, ftnlen, ftnlen);
integer locval;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer locsym;
extern logical return_(void);
/* $ Abstract */
/* Select a subset of the values associated with a particular */
/* symbol in a double precision symbol table. */
/* $ 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 */
/* SYMBOLS */
/* $ Keywords */
/* SYMBOLS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NAME I Name of the symbol whose associated values are to */
/* be returned. */
/* BEGIN I Index of the first associated value to be returned. */
/* END I Index of the last associated value to be returned. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL I Components of the symbol table. */
/* VALUES O Subset of the values associated with the symbol */
/* NAME. */
/* FOUND O True if the subset of values exists. */
/* $ Detailed_Input */
/* NAME is the name of the symbol whose subset of associated */
/* values to be returned. If NAME is not in the symbol */
/* table, FOUND is false. */
/* BEGIN is the index of the first associated value to be */
/* returned. If BEGIN is out of range (BEGIN < 1 or */
/* BEGIN > END) FOUND is false. */
/* END is the index of the last associated value to be */
/* returned. If END is out of range (END < 1 or */
/* END > is greater than the dimension of NAME) */
/* FOUND is false. */
/* TABSYM, */
/* TABPTR, */
/* TABVAL are components of the double precision symbol table. */
/* $ Detailed_Output */
/* VALUES is a subset of the values associated with the */
/* symbol NAME. If the subset specified by BEGIN and */
/* END exists, as many values as will fit in VALUES */
/* are returned. If the subset does not exist, no */
/* values are returned and FOUND is false. */
/* FOUND is true if the subset of values is exists. */
/* FOUND is false if BEGIN < 1, BEGIN > END, END < 1, */
/* END > the dimension of NAME, or NAME is not */
/* in the symbol table. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This subroutine does not check to see if the output array */
/* VALUES is large enough to hold the selected set of values. */
/* The caller must provide the required space. */
/* $ Files */
/* None. */
/* $ Particulars */
/* FOUND will be false if the bounds of the subset specified by */
/* BEGIN and END are out of range. Values of BEGIN and END which */
/* specify bounds out of range are BEGIN < 1, BEGIN > END, */
/* END < 1, or END > the dimension of NAME. FOUND is also false */
/* if the symbol NAME is not in the symbol table. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BODY4_POLE_RA --> 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0 */
/* DELTA_T_A --> 3.2184D1 */
/* K --> 1.657D-3 */
/* MEAN_ANOM --> 6.239996D0 */
/* 1.99096871D-7 */
/* ORBIT_ECC --> 1.671D-2 */
/* Let the dimension of the array VALUES be 3. */
/* The ouput values of VALUES and FOUND for the input values of */
/* NAME, BEGIN, and END are contained in this table: */
/* NAME BEGIN END VALUES FOUND */
/* ------------- ----- --- --------------------- ------- */
/* MEAN_ANOM 1 2 6.239996D0 TRUE */
/* 1.99096871D-7 */
/* BODY4_POLE_RA 1 3 3.17681D2 */
/* 1.08D-1 */
/* 0.0D0 */
/* BODY4_PRIME 1 3 FALSE */
/* MEAN_ANOM 2 1 FALSE */
/* ORBIT_ECC 1 -2 FALSE */
/* K 1 5 FALSE */
/* ---------------------------------------------------------------- */
/* Note that FOUND is FALSE for examples 3 through 6 because: */
/* - In the 3rd example, the symbol 'BODY4_PRIME' is not in the */
/* symbol table. */
/* - In the 4th example, BEGIN > END. */
/* - In the 5th example, END < 0. */
/* - In the 6th example, END is greater than the dimension of the */
/* symbol 'K'. */
/* $ Restrictions */
/* 1) See Exceptions section. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 03-NOV-2005 (NJB) */
/* Various header corrections were made. In particular, */
/* the header no longer asserts that this routine will */
/* "return as many values as will fit" in the output array */
/* VALUES. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* select a subset of the values of a symbol */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYSELD", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
/* Is this symbol even in the table? */
locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
tabsym_len);
/* If it's not in the table, it's definitely a problem. */
if (locsym == 0) {
*found = FALSE_;
} else {
/* We could still have a problem: do these components exist? */
/* Does this request even make sense? */
n = tabptr[locsym + 5];
if (*begin >= 1 && *begin <= n && *end >= 1 && *end <= n && *begin <=
*end) {
*found = TRUE_;
i__1 = locsym - 1;
locval = sumai_(&tabptr[6], &i__1) + 1;
i__1 = *end - *begin + 1;
moved_(&tabval[locval + *begin + 4], &i__1, values);
} else {
*found = FALSE_;
}
}
chkout_("SYSELD", (ftnlen)6);
return 0;
} /* syseld_ */
/* $Procedure SPKE08 ( S/P Kernel, evaluate, type 8 ) */
/* Subroutine */ int spke08_(doublereal *et, doublereal *record, doublereal *
state)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer i__, n;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
doublereal locrec[129];
extern doublereal lgresp_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int xposeg_(doublereal *, integer *, integer *,
doublereal *);
extern logical return_(void);
integer ystart;
/* $ Abstract */
/* Evaluate a single SPK data record from a segment of type 8 */
/* (equally spaced discrete states, interpolated by Lagrange */
/* polynomials). */
/* $ 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 */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Declare SPK data record size. This record is declared in */
/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */
/* (SPKExx) routines. */
/* $ 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 */
/* SPK */
/* $ Restrictions */
/* 1) If new SPK types are added, it may be necessary to */
/* increase the size of this record. The header of SPKPVN */
/* should be updated as well to show the record size */
/* requirement for each data type. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */
/* -& */
/* End include file spkrec.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECORD I-O Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, at which a state vector is to */
/* be computed. */
/* RECORD is a data record 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. Normally, the caller of this routine */
/* will obtain RECORD by calling SPKR08. */
/* The structure of the record is as follows: */
/* +----------------------+ */
/* | number of states (n) | */
/* +----------------------+ */
/* | start epoch | */
/* +----------------------+ */
/* | step size | */
/* +----------------------+ */
/* | state 1 (6 elts.) | */
/* +----------------------+ */
/* | state 2 (6 elts.) | */
/* +----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------+ */
/* | state n (6 elts.) | */
/* +----------------------+ */
/* $ Detailed_Output */
/* RECORD is the input record, modified by use as a work area. */
/* On output, RECORD no longer contains useful */
/* information. */
/* STATE is the state. In order, the elements are */
/* X, Y, Z, X', Y', and Z' */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) The caller of this routine must ensure that the input record */
/* is appropriate for the supplied ET value. Otherwise, */
/* arithmetic overflow may result. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The exact format and structure of type 8 (equally spaced discrete */
/* states, interpolated by Lagrange polynomials) segments are */
/* described in the SPK Required Reading file. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* 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 SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* 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. 8 ) THEN */
/* CALL SPKR08 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE08 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in XPOSEG and LGRESP calls. */
/* - SPICELIB Version 1.0.0, 14-AUG-1993 (NJB) */
/* -& */
/* $ Index_Entries */
/* evaluate type_8 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in XPOSEG and LGRESP calls. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Size of a state vector: */
/* Indices of input record elements: */
/* -- size */
/* -- start epoch */
/* -- step size */
/* -- start of state information */
/* Local variables */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
/* We'll transpose the state information in the input record */
/* so that contiguous pieces of it can be shoved directly into the */
/* interpolation routine LGRESP. */
n = i_dnnt(record);
xposeg_(&record[3], &c__6, &n, locrec);
i__1 = n * 6;
moved_(locrec, &i__1, &record[3]);
/* We interpolate each state component in turn. */
for (i__ = 1; i__ <= 6; ++i__) {
ystart = n * (i__ - 1) + 4;
state[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1,
"spke08_", (ftnlen)274)] = lgresp_(&n, &record[1], &record[2]
, &record[ystart - 1], locrec, et);
}
return 0;
} /* spke08_ */
/* $Procedure ZZXLATED ( Private --- Translate Double Precision Numbers ) */
/* Subroutine */ int zzxlated_(integer *inbff, char *input, integer *space,
doublereal *output, ftnlen input_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer natbff = 0;
/* System generated locals */
integer i__1, i__2, i__3;
char ch__1[1];
static doublereal equiv_0[128];
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int zzddhgsd_(char *, integer *, char *, ftnlen,
ftnlen), zzplatfm_(char *, char *, ftnlen, ftnlen);
integer i__, j, k;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
integer value;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer numdp;
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
static integer bigint;
#define dpbufr (equiv_0)
static char strbff[8*4];
#define inbufr ((integer *)equiv_0)
integer lenipt;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
extern integer intmin_(void);
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
static integer smlint;
extern logical return_(void);
char tmpstr[8];
integer outpos;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Convert double precision values from one binary file format */
/* to another. */
/* $ 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 */
/* None. */
/* $ Keywords */
/* PRIVATE */
/* $ Declarations */
/* $ Abstract */
/* Parameter declarations for the DAF/DAS handle manager. */
/* $ 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, DAS */
/* $ Keywords */
/* PRIVATE */
/* $ Particulars */
/* This include file contains parameters defining limits and */
/* integer codes that are utilized in the DAF/DAS handle manager */
/* routines. */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 1.0.1, 17-JUL-2002 */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 1.0.0, 07-NOV-2001 */
/* -& */
/* Unit and file table size parameters. */
/* FTSIZE is the maximum number of files (DAS and DAF) that a */
/* user may have open simultaneously. */
/* RSVUNT is the number of units protected from being locked */
/* to a particular handle by ZZDDHHLU. */
/* SCRUNT is the number of units protected for use by scratch */
/* files. */
/* UTSIZE is the maximum number of logical units this manager */
/* will utilize at one time. */
/* Access method enumeration. These parameters are used to */
/* identify which access method is associated with a particular */
/* handle. They need to be synchronized with the STRAMH array */
/* defined in ZZDDHGSD in the following fashion: */
/* STRAMH ( READ ) = 'READ' */
/* STRAMH ( WRITE ) = 'WRITE' */
/* STRAMH ( SCRTCH ) = 'SCRATCH' */
/* STRAMH ( NEW ) = 'NEW' */
/* These values are used in the file table variable FTAMH. */
/* Binary file format enumeration. These parameters are used to */
/* identify which binary file format is associated with a */
/* particular handle. They need to be synchronized with the STRBFF */
/* array defined in ZZDDHGSD in the following fashion: */
/* STRBFF ( BIGI3E ) = 'BIG-IEEE' */
/* STRBFF ( LTLI3E ) = 'LTL-IEEE' */
/* STRBFF ( VAXGFL ) = 'VAX-GFLT' */
/* STRBFF ( VAXDFL ) = 'VAX-DFLT' */
/* These values are used in the file table variable FTBFF. */
/* Some random string lengths... more documentation required. */
/* For now this will have to suffice. */
/* Architecture enumeration. These parameters are used to identify */
/* which file architecture is associated with a particular handle. */
/* They need to be synchronized with the STRARC array defined in */
/* ZZDDHGSD in the following fashion: */
/* STRARC ( DAF ) = 'DAF' */
/* STRARC ( DAS ) = 'DAS' */
/* These values will be used in the file table variable FTARC. */
/* For the following environments, record length is measured in */
/* characters (bytes) with eight characters per double precision */
/* number. */
/* Environment: Sun, Sun FORTRAN */
/* Source: Sun Fortran Programmer's Guide */
/* Environment: PC, MS FORTRAN */
/* Source: Microsoft Fortran Optimizing Compiler User's Guide */
/* Environment: Macintosh, Language Systems FORTRAN */
/* Source: Language Systems FORTRAN Reference Manual, */
/* Version 1.2, page 12-7 */
/* Environment: PC/Linux, g77 */
/* Source: Determined by experiment. */
/* Environment: PC, Lahey F77 EM/32 Version 4.0 */
/* Source: Lahey F77 EM/32 Language Reference Manual, */
/* page 144 */
/* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
/* Source: FORTRAN/9000 Reference-Series 700 Computers, */
/* page 5-110 */
/* Environment: NeXT Mach OS (Black Hardware), */
/* Absoft Fortran Version 3.2 */
/* Source: NAIF Program */
/* The following parameter defines the size of a string used */
/* to store a filenames on this target platform. */
/* The following parameter controls the size of the character record */
/* buffer used to read data from non-native files. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* INBFF I Binary file format of d.p. values in INPUT. */
/* INPUT I String containing d.p. values read as characters. */
/* SPACE I Number of d.p. values that can be placed in OUTPUT. */
/* OUTPUT O Translated d.p. values. */
/* $ Detailed_Input */
/* INBFF is an integer code that indicates the binary file */
/* format of INPUT. Acceptable values are the */
/* parameters: */
/* BIGI3E */
/* LTLI3E */
/* VAXGFL */
/* VAXDFL */
/* as defined in the include file 'zzddhman.inc'. */
/* INPUT is a string containing a group of d.p. values read */
/* from a file as a character string. The length of */
/* this string must be a multiple of the number of */
/* bytes used to store a d.p. value in a file utilizing */
/* INBFF. */
/* SPACE is the number of d.p. values that OUTPUT has room to */
/* store. */
/* $ Detailed_Output */
/* OUTPUT is an array of double precision values containing */
/* the translated values from INPUT into the native */
/* binary format. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* This routine signals several SPICE(BUG) exceptions. They are */
/* signaled when improperly specified inputs are passed into the */
/* routine or if the module or modules in its calling tree are */
/* improperly configured to run on this platform. Callers that */
/* prevent invalid inputs from being passed into this routine */
/* need not check in. See the $Restrictions section for a */
/* discussion of input argument restrictions. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine translates double precision values from a non-native */
/* binary format read from a file as a sequence of characters to the */
/* native format. */
/* $ Examples */
/* See ZZDAFGSR or ZZDAFGDR. */
/* $ Restrictions */
/* 1) Numeric data when read as characters from a file preserves */
/* the bit patterns present in the file in memory. */
/* 2) The intrinsic ICHAR preserves the bit pattern of the character */
/* byte read from a file. Namely if one examines the integer */
/* created the 8 least significant bits will be precisely those */
/* found in the character. */
/* 3) The size of double precision values on the target environment */
/* are a multiple of some number of bytes. */
/* 4) The length of the INPUT string is a multiple of the number */
/* of bytes for a double precision value in the INBFF format. */
/* 5) INBFF is supported for reading on this platform, and not */
/* equivalent to NATBFF on this platform. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* F.S. Turner (JPL) */
/* $ Version */
/* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL. */
/* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-CC_C. */
/* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
/* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
/* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
/* Updated for PC-WINDOWS-64BIT-IFORT. */
/* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
/* Updated for PC-LINUX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
/* Updated for PC-64BIT-MS_C. */
/* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-INTEL_C. */
/* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-IFORT. */
/* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
/* Updated for MAC-OSX-64BIT-GFORTRAN. */
/* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
/* Updated for PC-LINUX-GFORTRAN. */
/* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
/* Updated for MAC-OSX-GFORTRAN. */
/* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
/* Updated for PC-LINUX-IFORT. */
/* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
/* Updated for PC-LINUX-64BIT-GCC_C. */
/* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-INTEL_C. */
/* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
/* Updated for MAC-OSX-IFORT. */
/* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
/* Updated for PC-WINDOWS-IFORT. */
/* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
/* Updated for SUN-SOLARIS-64BIT-GCC_C. */
/* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN_C. */
/* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
/* Updated for PC-CYGWIN. */
/* - SPICELIB Version 1.0.1, 17-JUL-2002 (BVS) */
/* Added MAC-OSX environments. */
/* - SPICELIB Version 1.0.0, 12-NOV-2001 (FST) */
/* -& */
/* SPICELIB Functions */
/* Local Parameters */
/* Length of the double precision and integer buffers that */
/* are equivalenced. */
/* These parameters are used for arithmetic shifting. */
/* Local Variables */
/* Equivalence DPBUFR to INBUFR. */
/* Statement Functions */
/* Saved Variables */
/* Data Statements */
/* Statement Function Definitions */
/* This function controls the conversion of characters to integers. */
/* On some supported environments, ICHAR is not sufficient to */
/* produce the desired results. This, however, is not the case */
/* with this particular environment. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZXLATED", (ftnlen)8);
}
/* Perform some initialization tasks. */
if (first) {
/* Populate STRBFF. */
for (i__ = 1; i__ <= 4; ++i__) {
zzddhgsd_("BFF", &i__, strbff + (((i__1 = i__ - 1) < 4 && 0 <=
i__1 ? i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
354)) << 3), (ftnlen)3, (ftnlen)8);
}
/* Fetch the native binary file format. */
zzplatfm_("FILE_FORMAT", tmpstr, (ftnlen)11, (ftnlen)8);
ucase_(tmpstr, tmpstr, (ftnlen)8, (ftnlen)8);
natbff = isrchc_(tmpstr, &c__4, strbff, (ftnlen)8, (ftnlen)8);
if (natbff == 0) {
setmsg_("The binary file format, '#', is not supported by this v"
"ersion of the toolkit. This is a serious problem, contac"
"t NAIF.", (ftnlen)118);
errch_("#", tmpstr, (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Store the largest value a 32-bit integer can actually */
/* hold. */
bigint = 2147483647;
/* Prepare the smallest value a 32-bit integer can actually */
/* store, regardless of what INTMIN returns. */
smlint = intmin_();
/* Set SMLINT to the appropriate value if INTMIN is too large. */
if (smlint == -2147483647) {
--smlint;
}
/* Do not perform initialization tasks again. */
first = FALSE_;
}
/* Check to see if INBFF makes sense. */
if (*inbff < 1 || *inbff > 4) {
setmsg_("The integer code used to indicate the binary file format of"
" the input integers, #, is out of range. This error should "
"never occur.", (ftnlen)131);
errint_("#", inbff, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Retrieve the length of the input string, and set the position */
/* into the output buffer to the beginning. */
lenipt = i_len(input, input_len);
outpos = 1;
/* Now branch based on NATBFF. */
if (natbff == 1) {
if (*inbff == 2) {
/* Check to see that the length of the input string is */
/* appropriate. Since this is a string containing LTL-IEEE */
/* d.p. values, and this is a BIG-IEEE machine characters */
/* are 1-byte and d.p. values are 8-bytes. So the length */
/* of INPUT must be a multiple of 8. */
numdp = lenipt / 8;
if (lenipt - (numdp << 3) != 0) {
setmsg_("The input string that is to be translated from the "
"binary format # to format # has a length that is not"
" a multiple of 4 bytes. This error should never occ"
"ur.", (ftnlen)158);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
450)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
451)) << 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Verify there is enough room to store the results of */
/* the translation. */
if (numdp > *space) {
setmsg_("The caller specified that # double precision number"
"s are to be translated from binary format # to #. H"
"owever there is only room to hold # integers in the "
"output array. This error should never occur.", (
ftnlen)200);
errint_("#", &numdp, (ftnlen)1);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
471)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
472)) << 3), (ftnlen)1, (ftnlen)8);
errint_("#", space, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* The remainder of this branch is devoted to translating */
/* and copying blocks of DPBLEN double precision numbers */
/* into OUTPUT. Initialize K, the integer index into the */
/* buffer equivalenced to DPBUFR. */
k = 1;
/* Start looping over each 8 character package in INPUT and */
/* converting it to double precision numbers. */
i__1 = numdp;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute the substring index of the first character */
/* in INPUT for this integer. */
j = (i__ - 1 << 3) + 1;
/* Now arrange the bytes properly. Since these characters */
/* were read from a file utilizing LTL-IEEE: */
/* . */
/* . */
/* . */
/* ------- */
/* | J | - Least Significant Byte of Mantissa */
/* ------- */
/* | J+1 | - Sixth Most Significant Mantissa Byte */
/* ------- */
/* | J+2 | - Fifth Most Significant Mantissa Byte */
/* ------- */
/* | J+3 | - Fourth Most Significant Mantissa Byte */
/* ------- */
/* | J+4 | - Third Most Significant Mantissa Byte */
/* ------- */
/* | J+5 | - Second Most Significant Mantissa Byte */
/* ------- */
/* | J+6 | - Tail of Exponent, Most Significant */
/* ------- Bits of the Mantissa */
/* | J+7 | - Sign Bit, Head of Exponent */
/* ------- */
/* . */
/* . */
/* . */
/* Now rearrange the bytes to place them in the */
/* proper order for d.p. values on BIG-IEEE machines. */
/* This is accomplished in the following manner: */
/* INPUT(J+4:J+4) */
/* INPUT(J+5:J+5)*SHFT8 */
/* INPUT(J+6:J+6)*SHFT16 */
/* + INPUT(J+7:J+7)*SHFT24 */
/* ------------------------- */
/* INBUFR(K) */
/* INPUT(J:J) */
/* INPUT(J+1:J+1)*SHFT8 */
/* INPUT(J+2:J+2)*SHFT16 */
/* + INPUT(J+3:J+3)*SHFT24 */
/* ------------------------- */
/* INBUFR(K+1) */
/* Utilize the military extension bit manipulation */
/* intrinsics to perform the necessary computations. */
/* It has been determined empirically that on these */
/* environments this is faster than arithmetic. */
i__2 = j + 3;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 4 - i__2);
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)553)] = value;
i__2 = j + 4;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 5 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)557)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)557)] | value;
i__2 = j + 5;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 6 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)561)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)561)] | value;
i__2 = j + 6;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 7 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)565)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)565)] | value;
*(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1];
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)569)] = value;
i__2 = j;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)573)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)573)] | value;
i__2 = j + 1;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)577)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)577)] | value;
i__2 = j + 2;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)581)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)581)] | value;
/* Check to see if the local buffer is full and the */
/* double precision numbers need to be moved into the */
/* next block of OUTPUT. */
if (k == 255) {
moved_(dpbufr, &c__128, &output[outpos - 1]);
outpos += 128;
k = 1;
/* Otherwise, increment K. */
} else {
k += 2;
}
}
/* Copy any remaining double precision numbers from DPBUFR */
/* into OUTPUT. */
if (k != 1) {
i__1 = k / 2;
moved_(dpbufr, &i__1, &output[outpos - 1]);
}
} else {
setmsg_("Unable to translate double precision values from binary"
" file format # to #. This error should never occur and i"
"s indicative of a bug. Contact NAIF.", (ftnlen)148);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)618))
<< 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)619))
<< 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
} else if (natbff == 2) {
if (*inbff == 1) {
/* Check to see that the length of the input string is */
/* appropriate. Since this is a string containing BIG-IEEE */
/* d.p. values, and this is a LTL-IEEE machine characters */
/* are 1-byte and d.p. values are 8-bytes. So the length */
/* of INPUT must be a multiple of 8. */
numdp = lenipt / 8;
if (lenipt - (numdp << 3) != 0) {
setmsg_("The input string that is to be translated from the "
"binary format # to format # has a length that is not"
" a multiple of 4 bytes. This error should never occ"
"ur.", (ftnlen)158);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
646)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
647)) << 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* Verify there is enough room to store the results of */
/* the translation. */
if (numdp > *space) {
setmsg_("The caller specified that # double precision number"
"s are to be translated from binary format # to #. H"
"owever there is only room to hold # integers in the "
"output array. This error should never occur.", (
ftnlen)200);
errint_("#", &numdp, (ftnlen)1);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
667)) << 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)
668)) << 3), (ftnlen)1, (ftnlen)8);
errint_("#", space, (ftnlen)1);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* The remainder of this branch is devoted to translating */
/* and copying blocks of DPBLEN double precision numbers */
/* into OUTPUT. Initialize K, the integer index into the */
/* buffer equivalenced to DPBUFR. */
k = 1;
/* Start looping over each 8 character package in INPUT and */
/* converting them to double precision numbers. */
i__1 = numdp;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute the substring index of the first character */
/* in INPUT for this integer. */
j = (i__ - 1 << 3) + 1;
/* Now arrange the bytes properly. Since these characters */
/* were read from a file utilizing BIG-IEEE: */
/* . */
/* . */
/* . */
/* ------- */
/* | J | - Sign Bit, Head of Exponent */
/* ------- */
/* | J+1 | - Tail of Exponent, Most Significant */
/* ------- Bits of the Mantissa */
/* | J+2 | - Second Most Significant Mantissa Byte */
/* ------- */
/* | J+3 | - Third Most Significant Mantissa Byte */
/* ------- */
/* | J+4 | - Fourth Most Significant Mantissa Byte */
/* ------- */
/* | J+5 | - Fifth Most Significant Mantissa Byte */
/* ------- */
/* | J+6 | - Sixth Most Significant Mantissa Byte */
/* ------- */
/* | J+7 | - Least Significant Byte of Mantissa */
/* ------- */
/* . */
/* . */
/* . */
/* Now rearrange the bytes to place them in the */
/* proper order for d.p. values on LTL-IEEE machines. */
/* This is accomplished in the following manner: */
/* INPUT(J+7:J+7) */
/* INPUT(J+6:J+6)*SHFT8 */
/* INPUT(J+5:J+5)*SHFT16 */
/* + INPUT(J+4:J+4)*SHFT24 */
/* ------------------------- */
/* INBUFR(K) */
/* INPUT(J+3:J+3) */
/* INPUT(J+2:J+2)*SHFT8 */
/* INPUT(J+1:J+1)*SHFT16 */
/* + INPUT(J:J)*SHFT24 */
/* ------------------------- */
/* INBUFR(K+1) */
/* Utilize the military extension bit manipulation */
/* intrinsics to perform the necessary computations. */
/* It has been determined empirically that on these */
/* environments this is faster than arithmetic. */
i__2 = j + 6;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 7 - i__2);
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)749)] = value;
i__2 = j + 5;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 6 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)753)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)753)] | value;
i__2 = j + 4;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 5 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)757)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)757)] | value;
i__2 = j + 3;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 4 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k - 1) < 256 && 0 <= i__2 ? i__2 : s_rnge(
"inbufr", i__2, "zzxlated_", (ftnlen)761)] = inbufr[(
i__3 = k - 1) < 256 && 0 <= i__3 ? i__3 : s_rnge(
"inbufr", i__3, "zzxlated_", (ftnlen)761)] | value;
i__2 = j + 2;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 3 - i__2);
value = *(unsigned char *)&ch__1[0];
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)765)] = value;
i__2 = j + 1;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 2 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 8;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)769)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)769)] | value;
i__2 = j;
s_copy(ch__1, input + i__2, (ftnlen)1, j + 1 - i__2);
value = *(unsigned char *)&ch__1[0];
value <<= 16;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)773)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)773)] | value;
*(unsigned char *)&ch__1[0] = *(unsigned char *)&input[j - 1];
value = *(unsigned char *)&ch__1[0];
value <<= 24;
inbufr[(i__2 = k) < 256 && 0 <= i__2 ? i__2 : s_rnge("inbufr",
i__2, "zzxlated_", (ftnlen)777)] = inbufr[(i__3 = k)
< 256 && 0 <= i__3 ? i__3 : s_rnge("inbufr", i__3,
"zzxlated_", (ftnlen)777)] | value;
/* Check to see if the local buffer is full and the */
/* double precision numbers need to be moved into the */
/* next block of OUTPUT. */
if (k == 255) {
moved_(dpbufr, &c__128, &output[outpos - 1]);
outpos += 128;
k = 1;
/* Otherwise, increment K. */
} else {
k += 2;
}
}
/* Copy any remaining double precision numbers from DPBUFR */
/* into OUTPUT. */
if (k != 1) {
i__1 = k / 2;
moved_(dpbufr, &i__1, &output[outpos - 1]);
}
} else {
setmsg_("Unable to translate double precision values from binary"
" file format # to #. This error should never occur and i"
"s indicative of a bug. Contact NAIF.", (ftnlen)148);
errch_("#", strbff + (((i__1 = *inbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)814))
<< 3), (ftnlen)1, (ftnlen)8);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ?
i__1 : s_rnge("strbff", i__1, "zzxlated_", (ftnlen)815))
<< 3), (ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
/* The native binary file format on this platform is not supported */
/* for the conversion of integers. This is a bug, as this branch */
/* of code should never be reached in normal operation. */
} else {
setmsg_("The native binary file format of this toolkit build, #, is "
"not currently supported for translation of double precision "
"numbers from non-native formats.", (ftnlen)151);
errch_("#", strbff + (((i__1 = natbff - 1) < 4 && 0 <= i__1 ? i__1 :
s_rnge("strbff", i__1, "zzxlated_", (ftnlen)833)) << 3), (
ftnlen)1, (ftnlen)8);
sigerr_("SPICE(BUG)", (ftnlen)10);
chkout_("ZZXLATED", (ftnlen)8);
return 0;
}
chkout_("ZZXLATED", (ftnlen)8);
return 0;
} /* zzxlated_ */
/* $Procedure RQUAD ( Roots of a quadratic equation ) */
/* Subroutine */ int rquad_(doublereal *a, doublereal *b, doublereal *c__,
doublereal *root1, doublereal *root2)
{
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
doublereal discrm;
logical zeroed;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
doublereal con, lin, sqr;
/* $ Abstract */
/* Find the roots of a quadratic equation. */
/* $ 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 */
/* None. */
/* $ Keywords */
/* MATH */
/* POLYNOMIAL */
/* ROOT */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* A I Coefficient of quadratic term. */
/* B I Coefficient of linear term. */
/* C I Constant. */
/* ROOT1 O Root built from positive discriminant term. */
/* ROOT2 O Root built from negative discriminant term. */
/* $ Detailed_Input */
/* A, */
/* B, */
/* C are the coefficients of a quadratic polynomial */
/* 2 */
/* Ax + Bx + C. */
/* $ Detailed_Output */
/* ROOT1, */
/* ROOT2 are the roots of the equation, */
/* 2 */
/* Ax + Bx + C = 0. */
/* ROOT1 and ROOT2 are both arrays of length 2. The */
/* first element of each array is the real part of a */
/* root; the second element contains the complex part */
/* of the same root. */
/* When A is non-zero, ROOT1 represents the root */
/* _____________ */
/* / 2 */
/* - B + \/ B - 4AC */
/* --------------------------- */
/* 2A */
/* and ROOT2 represents the root */
/* _____________ */
/* / 2 */
/* - B - \/ B - 4AC */
/* --------------------------- . */
/* 2A */
/* When A is zero and B is non-zero, ROOT1 and ROOT2 */
/* both represent the root */
/* - C / B. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input coefficients A and B are both zero, the error */
/* SPICE(DEGENERATECASE) is signalled. The output arguments */
/* are not modified. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* 1) Humor us and suppose we want to compute the "golden ratio." */
/* The quantity r is defined by the equation */
/* 1/r = r/(1-r), */
/* which is equivalent to */
/* 2 */
/* r + r - 1 = 0. */
/* The following code frament does the job. */
/* C */
/* C Compute "golden ratio." The root we want, */
/* C */
/* C ___ */
/* C / */
/* C -1 + \/ 5 */
/* C -----------, */
/* C 2 */
/* C */
/* C */
/* C is contained in ROOT1. */
/* C */
/* CALL RQUAD ( 1.D0, 1.D0, -1.D0, ROOT1, ROOT2 ) */
/* PRINT *, 'The "golden ratio" is ', ROOT1(1) */
/* 2) The equation, */
/* 2 */
/* x + 1 = 0 */
/* can be solved by the code fragment */
/* C */
/* C Let's do one with imaginary roots just for fun. */
/* C */
/* CALL RQUAD ( 1.D0, 0.D0, 1.D0, ROOT1, ROOT2 ) */
/* PRINT *, 'ROOT1 is ', ROOT1 */
/* PRINT *, 'ROOT2 is ', ROOT2 */
/* The printed results will be something like: */
/* ROOT1 is 0.000000000000000 1.000000000000000 */
/* ROOT2 is 0.000000000000000 -1.000000000000000 */
/* $ Restrictions */
/* No checks for overflow of the roots are performed. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 10-JUL-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* roots of a quadratic equation */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("RQUAD", (ftnlen)5);
}
/* The degree of the equation is zero unless at least one of the */
/* second or first degree coefficients is non-zero. */
if (*a == 0. && *b == 0.) {
setmsg_("Both 1st and 2nd degree coefficients are zero.", (ftnlen)46);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("RQUAD", (ftnlen)5);
return 0;
}
/* If we can scale the coefficients without zeroing any of them out, */
/* we will do so, to help prevent overflow. */
/* Computing MAX */
d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__);
scale = max(d__1,d__2);
zeroed = *a != 0. && *a / scale == 0. || *b != 0. && *b / scale == 0. || *
c__ != 0. && *c__ / scale == 0.;
if (! zeroed) {
sqr = *a / scale;
lin = *b / scale;
con = *c__ / scale;
} else {
sqr = *a;
lin = *b;
con = *c__;
}
/* If the second-degree coefficient is non-zero, we have a bona fide */
/* quadratic equation, as opposed to a linear equation. */
if (sqr != 0.) {
/* Compute the discriminant. */
/* Computing 2nd power */
d__1 = lin;
discrm = d__1 * d__1 - sqr * 4. * con;
/* A non-negative discriminant indicates that the roots are */
/* real. */
if (discrm >= 0.) {
/* The imaginary parts of both roots are zero. */
root1[1] = 0.;
root2[1] = 0.;
/* We can take advantage of the fact that CON/SQR is the */
/* product of the roots to improve the accuracy of the root */
/* having the smaller magnitude. We compute the larger root */
/* first and then divide CON/SQR by it to obtain the smaller */
/* root. */
if (lin < 0.) {
/* ROOT1 will contain the root of larger magnitude. */
root1[0] = (-lin + sqrt(discrm)) / (sqr * 2.);
root2[0] = con / sqr / root1[0];
} else if (lin > 0.) {
/* ROOT2 will contain the root of larger magnitude. */
root2[0] = (-lin - sqrt(discrm)) / (sqr * 2.);
root1[0] = con / sqr / root2[0];
} else {
/* The roots have the same magnitude. */
root1[0] = sqrt(discrm) / (sqr * 2.);
root2[0] = -root1[0];
}
/* The only other possibility is that the roots are complex. */
} else {
/* The roots are complex conjugates, so they have equal */
/* magnitudes. */
root1[0] = -lin / (sqr * 2.);
root1[1] = sqrt(-discrm) / (sqr * 2.);
root2[0] = root1[0];
root2[1] = -root1[1];
}
/* If the second-degree coefficient is zero, we actually have a */
/* linear equation. */
} else if (lin != 0.) {
root1[0] = -con / lin;
root1[1] = 0.;
/* We set the second root equal to the first, rather than */
/* leaving it undefined. */
moved_(root1, &c__2, root2);
}
chkout_("RQUAD", (ftnlen)5);
return 0;
} /* rquad_ */
/* $Procedure VROTV ( Vector rotation about an axis ) */
/* Subroutine */ int vrotv_(doublereal *v, doublereal *axis, doublereal *
theta, doublereal *r__)
{
/* Builtin functions */
double cos(doublereal), sin(doublereal);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
), vhat_(doublereal *, doublereal *), vsub_(doublereal *,
doublereal *, doublereal *);
doublereal c__, p[3], s, x[3];
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *), vproj_(doublereal *, doublereal *, doublereal *);
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal
*);
doublereal v1[3], v2[3], rplane[3];
/* $ Abstract */
/* Rotate a vector about a specified axis vector by a specified */
/* angle and return the rotated vector. */
/* $ 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 */
/* ROTATION */
/* $ Keywords */
/* ROTATION, VECTOR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* V I Vector to be rotated. */
/* AXIS I Axis of the rotation. */
/* THETA I Angle of rotation (radians). */
/* R O Result of rotating V about AXIS by THETA. */
/* $ Detailed_Input */
/* V is a 3-dimensional vector to be rotated. */
/* AXIS is the axis about which the rotation is to be */
/* performed. */
/* THETA is the angle through which V is to be rotated about */
/* AXIS. */
/* $ Detailed_Output */
/* R is the result of rotating V about AXIS by THETA. */
/* If AXIS is the zero vector, R = V. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If the input axis is the zero vector R will be returned */
/* as V. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine computes the result of rotating (in a right handed */
/* sense) the vector V about the axis represented by AXIS through */
/* an angle of THETA radians. */
/* If W is a unit vector parallel to AXIS, then R is given by: */
/* R = V + ( 1 - cos(THETA) ) Wx(WxV) + sin(THETA) (WxV) */
/* where "x" above denotes the vector cross product. */
/* $ Examples */
/* If AXIS = ( 0, 0, 1 ) and THETA = PI/2 then the following results */
/* for R will be obtained */
/* V R */
/* ------------- ---------------- */
/* ( 1, 2, 3 ) ( -2, 1, 3 ) */
/* ( 1, 0, 0 ) ( 0, 1, 0 ) */
/* ( 0, 1, 0 ) ( -1, 0, 0 ) */
/* If AXIS = ( 0, 1, 0 ) and THETA = PI/2 then the following results */
/* for R will be obtained */
/* V R */
/* ------------- ---------------- */
/* ( 1, 2, 3 ) ( 3, 2, -1 ) */
/* ( 1, 0, 0 ) ( 0, 0, -1 ) */
/* ( 0, 1, 0 ) ( 0, 1, 0 ) */
/* If AXIS = ( 1, 1, 1 ) and THETA = PI/2 then the following results */
/* for R will be obtained */
/* V R */
/* ----------------------------- ----------------------------- */
/* ( 1.0, 2.0, 3.0 ) ( 2.577.., 0.845.., 2.577.. ) */
/* ( 2.577.., 0.845.., 2.577.. ) ( 3.0 2.0, 1.0 ) */
/* ( 3.0 2.0, 1.0 ) ( 1.422.., 3.154.., 1.422.. ) */
/* ( 1.422.., 3.154.., 1.422.. ) ( 1.0 2.0, 3.0 ) */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.2, 5-FEB-2003 (NJB) */
/* Header examples were corrected. Exceptions section */
/* filled in. Miscellaneous header corrections were made. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
/* -& */
/* $ Index_Entries */
/* vector rotation about an axis */
/* -& */
/* $ Revisions */
/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */
/* Contents of the Exceptions section was changed */
/* to "error free" to reflect the decision that the */
/* module will never participate in error handling. */
/* Also, the declarations of the unused variable I and the */
/* unused function VDOT were removed. */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Just in case the user tries to rotate about the zero vector - */
/* check, and if so return the input vector */
if (vnorm_(axis) == 0.) {
moved_(v, &c__3, r__);
return 0;
}
/* Compute the unit vector that lies in the direction of the */
/* AXIS. Call it X. */
vhat_(axis, x);
/* Compute the projection of V onto AXIS. Call it P. */
vproj_(v, x, p);
/* Compute the component of V orthogonal to the AXIS. Call it V1. */
vsub_(v, p, v1);
/* Rotate V1 by 90 degrees about the AXIS and call the result V2. */
vcrss_(x, v1, v2);
/* Compute COS(THETA)*V1 + SIN(THETA)*V2. This is V1 rotated about */
/* the AXIS in the plane normal to the axis, call the result RPLANE */
c__ = cos(*theta);
s = sin(*theta);
vlcom_(&c__, v1, &s, v2, rplane);
/* Add the rotated component in the normal plane to AXIS to the */
/* projection of V onto AXIS (P) to obtain R. */
vadd_(rplane, p, r__);
return 0;
} /* vrotv_ */
/* $Procedure ZZSPKAP1 ( S/P Kernel, apparent state ) */
/* Subroutine */ int zzspkap1_(integer *targ, doublereal *et, char *ref,
doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt,
ftnlen ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT "
"XLT+S" "XCN " "XCN+S";
static char prvcor[5] = " ";
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char corr[5];
extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *,
doublereal *, ftnlen);
static logical xmit;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer i__, refid;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *);
static logical usecn;
doublereal sapos[3];
extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *,
doublereal *);
static logical uselt;
extern doublereal vnorm_(doublereal *), clight_(void);
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int stelab_(doublereal *, doublereal *,
doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
stlabx_(doublereal *, doublereal *, doublereal *);
integer ltsign;
extern /* Subroutine */ int ljucrs_(integer *, char *, char *, ftnlen,
ftnlen), setmsg_(char *, ftnlen);
doublereal tstate[6];
integer maxitr;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen);
extern logical return_(void);
static logical usestl;
extern logical odd_(integer *);
/* $ Abstract */
/* Deprecated: This routine has been superseded by SPKAPS. This */
/* routine is supported for purposes of backward compatibility only. */
/* Return the state (position and velocity) of a target body */
/* relative to an observer, optionally corrected for light time and */
/* stellar aberration. */
/* $ 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Observer epoch. */
/* REF I Inertial reference frame of observer's state. */
/* SOBS I State of observer wrt. solar system barycenter. */
/* ABCORR I Aberration correction flag. */
/* STARG O State of target. */
/* LT O One way light time between observer and target. */
/* $ Detailed_Input */
/* TARG is the NAIF ID code for a target body. The target */
/* and observer define a state vector whose position */
/* component points from the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past J2000 */
/* TDB, at which the state of the target body relative to */
/* the observer is to be computed. ET refers to time at */
/* the observer's location. */
/* REF is the inertial reference frame with respect to which */
/* the observer's state SOBS is expressed. REF must be */
/* recognized by the SPICE Toolkit. The acceptable */
/* frames are listed in the Frames Required Reading, as */
/* well as in the SPICELIB routine CHGIRF. */
/* Case and blanks are not significant in the string REF. */
/* SOBS is the geometric (uncorrected) state of the observer */
/* relative to the solar system barycenter at epoch ET. */
/* SOBS is a 6-vector: the first three components of */
/* SOBS represent a Cartesian position vector; the last */
/* three components represent the corresponding velocity */
/* vector. SOBS is expressed relative to the inertial */
/* reference frame designated by REF. */
/* Units are always km and km/sec. */
/* ABCORR indicates the aberration corrections to be applied */
/* to the state of the target body to account for one-way */
/* light time and stellar aberration. See the discussion */
/* in the Particulars section for recommendations on */
/* how to choose aberration corrections. */
/* ABCORR may be any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric state of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the state of the target at the */
/* moment it emitted photons arriving at */
/* the observer at ET. */
/* The light time correction involves */
/* iterative solution of the light time */
/* equation (see Particulars for details). */
/* The solution invoked by the 'LT' option */
/* uses one iteration. */
/* 'LT+S' Correct for one-way light time and */
/* stellar aberration using a Newtonian */
/* formulation. This option modifies the */
/* state obtained with the 'LT' option to */
/* account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The result is the apparent */
/* state of the target---the position and */
/* velocity of the target as seen by the */
/* observer. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* Whether the 'CN+S' solution is */
/* substantially more accurate than the */
/* 'LT' solution depends on the geometry */
/* of the participating objects and on the */
/* accuracy of the input data. In all */
/* cases this routine will execute more */
/* slowly when a converged solution is */
/* computed. See the Particulars section */
/* of SPKEZR for a discussion of precision */
/* of light time corrections. */
/* 'CN+S' Converged Newtonian light time */
/* correction and stellar aberration */
/* correction. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* state of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XLT+S' "Transmission" case: correct for */
/* one-way light time and stellar */
/* aberration using a Newtonian */
/* formulation This option modifies the */
/* state obtained with the 'XLT' option to */
/* account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The position component of */
/* the computed target state indicates the */
/* direction that photons emitted from the */
/* observer's location must be "aimed" to */
/* hit the target. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* 'XCN+S' "Transmission" case: converged */
/* Newtonian light time correction and */
/* stellar aberration correction. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* $ Detailed_Output */
/* STARG is a Cartesian state vector representing the position */
/* and velocity of the target body relative to the */
/* specified observer. STARG is corrected for the */
/* specified aberrations, and is expressed with respect */
/* to the specified inertial reference frame. The first */
/* three components of STARG represent the x-, y- and */
/* z-components of the target's position; last three */
/* components form the corresponding velocity vector. */
/* The position component of STARG points from the */
/* observer's location at ET to the aberration-corrected */
/* location of the target. Note that the sense of the */
/* position vector is independent of the direction of */
/* radiation travel implied by the aberration */
/* correction. */
/* The velocity component of STARG is obtained by */
/* evaluating the target's geometric state at the light */
/* time corrected epoch, so for aberration-corrected */
/* states, the velocity is not precisely equal to the */
/* time derivative of the position. */
/* Units are always km and km/sec. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target state is corrected */
/* for aberrations, then LT is the one-way light time */
/* between the observer and the light time corrected */
/* target location. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the value of ABCORR is not recognized, the error */
/* 'SPICE(SPKINVALIDOPTION)' is signaled. */
/* 2) If the reference frame requested is not a recognized */
/* inertial reference frame, the error 'SPICE(BADFRAME)' */
/* is signaled. */
/* 3) If the state of the target relative to the solar system */
/* barycenter cannot be computed, the error will be diagnosed */
/* by routines in the call tree of this routine. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. Application programs typically load */
/* kernels once before this routine is called, for example during */
/* program initialization; kernels need not be loaded repeatedly. */
/* See the routine FURNSH and the SPK and KERNEL Required Reading */
/* for further information on loading (and unloading) kernels. */
/* If any of the ephemeris data used to compute STARG are expressed */
/* relative to a non-inertial frame in the SPK files providing those */
/* data, additional kernels may be needed to enable the reference */
/* frame transformations required to compute the state. Normally */
/* these additional kernels are PCK files or frame kernels. Any */
/* such kernels must already be loaded at the time this routine is */
/* called. */
/* $ Particulars */
/* In space science or engineering applications one frequently */
/* wishes to know where to point a remote sensing instrument, such */
/* as an optical camera or radio antenna, in order to observe or */
/* otherwise receive radiation from a target. This pointing problem */
/* is complicated by the finite speed of light: one needs to point */
/* to where the target appears to be as opposed to where it actually */
/* is at the epoch of observation. We use the adjectives */
/* "geometric," "uncorrected," or "true" to refer to an actual */
/* position or state of a target at a specified epoch. When a */
/* geometric position or state vector is modified to reflect how it */
/* appears to an observer, we describe that vector by any of the */
/* terms "apparent," "corrected," "aberration corrected," or "light */
/* time and stellar aberration corrected." */
/* The SPICE Toolkit can correct for two phenomena affecting the */
/* apparent location of an object: one-way light time (also called */
/* "planetary aberration") and stellar aberration. Correcting for */
/* one-way light time is done by computing, given an observer and */
/* observation epoch, where a target was when the observed photons */
/* departed the target's location. The vector from the observer to */
/* this computed target location is called a "light time corrected" */
/* vector. The light time correction depends on the motion of the */
/* target, but it is independent of the velocity of the observer */
/* relative to the solar system barycenter. Relativistic effects */
/* such as light bending and gravitational delay are not accounted */
/* for in the light time correction performed by this routine. */
/* The velocity of the observer also affects the apparent location */
/* of a target: photons arriving at the observer are subject to a */
/* "raindrop effect" whereby their velocity relative to the observer */
/* is, using a Newtonian approximation, the photons' velocity */
/* relative to the solar system barycenter minus the velocity of the */
/* observer relative to the solar system barycenter. This effect is */
/* called "stellar aberration." Stellar aberration is independent */
/* of the velocity of the target. The stellar aberration formula */
/* used by this routine is non-relativistic. */
/* Stellar aberration corrections are applied after light time */
/* corrections: the light time corrected target position vector is */
/* used as an input to the stellar aberration correction. */
/* When light time and stellar aberration corrections are both */
/* applied to a geometric position vector, the resulting position */
/* vector indicates where the target "appears to be" from the */
/* observer's location. */
/* As opposed to computing the apparent position of a target, one */
/* may wish to compute the pointing direction required for */
/* transmission of photons to the target. This requires correction */
/* of the geometric target position for the effects of light time and */
/* stellar aberration, but in this case the corrections are computed */
/* for radiation traveling from the observer to the target. */
/* The "transmission" light time correction yields the target's */
/* location as it will be when photons emitted from the observer's */
/* location at ET arrive at the target. The transmission stellar */
/* aberration correction is the inverse of the traditional stellar */
/* aberration correction: it indicates the direction in which */
/* radiation should be emitted so that, using a Newtonian */
/* approximation, the sum of the velocity of the radiation relative */
/* to the observer and of the observer's velocity, relative to the */
/* solar system barycenter, yields a velocity vector that points in */
/* the direction of the light time corrected position of the target. */
/* The traditional aberration corrections applicable to observation */
/* and those applicable to transmission are related in a simple way: */
/* one may picture the geometry of the "transmission" case by */
/* imagining the "observation" case running in reverse time order, */
/* and vice versa. */
/* One may reasonably object to using the term "observer" in the */
/* transmission case, in which radiation is emitted from the */
/* observer's location. The terminology was retained for */
/* consistency with earlier documentation. */
/* Below, we indicate the aberration corrections to use for some */
/* common applications: */
/* 1) Find the apparent direction of a target for a remote-sensing */
/* observation. */
/* Use 'LT+S' or 'CN+S: apply both light time and stellar */
/* aberration corrections. */
/* Note that using light time corrections alone ('LT' or 'CN') */
/* is generally not a good way to obtain an approximation to */
/* an apparent target vector: since light time and stellar */
/* aberration corrections often partially cancel each other, */
/* it may be more accurate to use no correction at all than to */
/* use light time alone. */
/* 2) Find the corrected pointing direction to radiate a signal */
/* to a target. This computation is often applicable for */
/* implementing communications sessions. */
/* Use 'XLT+S' or 'XCN+S: apply both light time and stellar */
/* aberration corrections for transmission. */
/* 3) Compute the apparent position of a target body relative */
/* to a star or other distant object. */
/* Use 'LT', 'CN', 'LT+S', or 'CN+S' as needed to match the */
/* correction applied to the position of the distant */
/* object. For example, if a star position is obtained from */
/* a catalog, the position vector may not be corrected for */
/* stellar aberration. In this case, to find the angular */
/* separation of the star and the limb of a planet, the */
/* vector from the observer to the planet should be */
/* corrected for light time but not stellar aberration. */
/* 4) Obtain an uncorrected state vector derived directly from */
/* data in an SPK file. */
/* Use 'NONE'. */
/* C */
/* 5) Use a geometric state vector as a low-accuracy estimate */
/* of the apparent state for an application where execution */
/* speed is critical: */
/* Use 'NONE'. */
/* 6) While this routine cannot perform the relativistic */
/* aberration corrections required to compute states */
/* with the highest possible accuracy, it can supply the */
/* geometric states required as inputs to these computations: */
/* Use 'NONE', then apply high-accuracy aberration */
/* corrections (not available in the SPICE Toolkit). */
/* Below, we discuss in more detail how the aberration corrections */
/* applied by this routine are computed. */
/* Geometric case */
/* ============== */
/* SPKAPP begins by computing the geometric position T(ET) of the */
/* target body relative to the solar system barycenter (SSB). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the geometric position of the target body relative to the */
/* observer. The one-way light time, LT, is given by */
/* | T(ET) - O(ET) | */
/* LT = ------------------- */
/* c */
/* The geometric relationship between the observer, target, and */
/* solar system barycenter is as shown: */
/* SSB ---> O(ET) */
/* | / */
/* | / */
/* | / */
/* | / T(ET) - O(ET) */
/* V V */
/* T(ET) */
/* The returned state consists of the position vector */
/* T(ET) - O(ET) */
/* and a velocity obtained by taking the difference of the */
/* corresponding velocities. In the geometric case, the */
/* returned velocity is actually the time derivative of the */
/* position. */
/* Reception case */
/* ============== */
/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */
/* selected, SPKAPP computes the position of the target body at */
/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */
/* O(t) represent the positions of the target and observer */
/* relative to the solar system barycenter at time t; then LT is */
/* the solution of the light-time equation */
/* | T(ET-LT) - O(ET) | */
/* LT = ------------------------ (1) */
/* c */
/* The ratio */
/* | T(ET) - O(ET) | */
/* --------------------- (2) */
/* c */
/* is used as a first approximation to LT; inserting (2) into the */
/* RHS of the light-time equation (1) yields the "one-iteration" */
/* estimate of the one-way light time. Repeating the process */
/* until the estimates of LT converge yields the "converged */
/* Newtonian" light time estimate. */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the position of the target body relative to the observer: */
/* T(ET-LT) - O(ET). */
/* SSB ---> O(ET) */
/* | \ | */
/* | \ | */
/* | \ | T(ET-LT) - O(ET) */
/* | \ | */
/* V V V */
/* T(ET) T(ET-LT) */
/* The position component of the light-time corrected state */
/* is the vector */
/* T(ET-LT) - O(ET) */
/* The velocity component of the light-time corrected state */
/* is the difference */
/* T_vel(ET-LT) - O_vel(ET) */
/* where T_vel and O_vel are, respectively, the velocities of */
/* the target and observer relative to the solar system */
/* barycenter at the epochs ET-LT and ET. */
/* If correction for stellar aberration is requested, the target */
/* position is rotated toward the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as follows: */
/* Let r be the light time corrected vector from the observer */
/* to the object, and v be the velocity of the observer with */
/* respect to the solar system barycenter. Let w be the angle */
/* between them. The aberration angle phi is given by */
/* sin(phi) = v sin(w) / c */
/* Let h be the vector given by the cross product */
/* h = r X v */
/* Rotate r by phi radians about h to obtain the apparent */
/* position of the object. */
/* The velocity component of the output state STARG is */
/* not corrected for stellar aberration. */
/* Transmission case */
/* ================== */
/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */
/* selected, SPKAPP computes the position of the target body T at */
/* epoch ET+LT, where LT is the one-way light time. LT is the */
/* solution of the light-time equation */
/* | T(ET+LT) - O(ET) | */
/* LT = ------------------------ (3) */
/* c */
/* Subtracting the geometric position of the observer, O(ET), */
/* gives the position of the target body relative to the */
/* observer: T(ET-LT) - O(ET). */
/* SSB --> O(ET) */
/* / | * */
/* / | * T(ET+LT) - O(ET) */
/* / |* */
/* / *| */
/* V V V */
/* T(ET+LT) T(ET) */
/* The position component of the light-time corrected state */
/* is the vector */
/* T(ET+LT) - O(ET) */
/* The velocity component of the light-time corrected state */
/* is the difference */
/* T_vel(ET+LT) - O_vel(ET) */
/* where T_vel and O_vel are, respectively, the velocities of */
/* the target and observer relative to the solar system */
/* barycenter at the epochs ET+LT and ET. */
/* If correction for stellar aberration is requested, the target */
/* position is rotated away from the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as in the reception case, but the sign of the */
/* rotation angle is negated. */
/* The velocity component of the output state STARG is */
/* not corrected for stellar aberration. */
/* Neither special nor general relativistic effects are accounted */
/* for in the aberration corrections performed by this routine. */
/* $ Examples */
/* In the following code fragment, SPKSSB and SPKAPP are used */
/* to display the position of Io (body 501) as seen from the */
/* Voyager 2 spacecraft (Body -32) at a series of epochs. */
/* Normally, one would call the high-level reader SPKEZR to obtain */
/* state vectors. The example below illustrates the interface */
/* of this routine but is not intended as a recommendation on */
/* how to use the SPICE SPK subsystem. */
/* The use of integer ID codes is necessitated by the low-level */
/* interface of this routine. */
/* IO = 501 */
/* VGR2 = -32 */
/* DO WHILE ( EPOCH .LE. END ) */
/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */
/* CALL SPKAPP ( IO, EPOCH, 'J2000', STVGR2, */
/* . 'LT+S', STIO, LT ) */
/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */
/* WRITE (*,*) RA * DPR(), DEC * DPR() */
/* EPOCH = EPOCH + DELTA */
/* END DO */
/* $ Restrictions */
/* 1) The kernel files to be used by SPKAPP must be loaded */
/* (normally by the SPICELIB kernel loader FURNSH) before */
/* this routine is called. */
/* 2) Unlike most other SPK state computation routines, this */
/* routine requires that the input state be relative to an */
/* inertial reference frame. Non-inertial frames are not */
/* supported by this routine. */
/* 3) In a future version of this routine, the implementation */
/* of the aberration corrections may be enhanced to improve */
/* accuracy. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* B.V. Semenov (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 3.1.0, 04-JUL-2014 (NJB) (BVS) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* Last update was 21-SEP-2013 (BVS) */
/* Updated to call LJUCRS instead of CMPRSS/UCASE. */
/* - SPICELIB Version 3.0.3, 18-MAY-2010 (BVS) */
/* Index lines now state that this routine is deprecated. */
/* - SPICELIB Version 3.0.2, 08-JAN-2008 (NJB) */
/* The Abstract section of the header was updated to */
/* indicate that this routine has been deprecated. */
/* - SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */
/* Added mention that LT returns in seconds. */
/* Corrected spelling errors. */
/* - SPICELIB Version 3.0.0, 18-DEC-2001 (NJB) */
/* Updated to handle aberration corrections for transmission */
/* of radiation. Formerly, only the reception case was */
/* supported. The header was revised and expanded to explain */
/* the functionality of this routine in more detail. */
/* - SPICELIB Version 2.1.0, 09-JUL-1996 (WLT) */
/* Corrected the description of LT in the Detailed Output */
/* section of the header. */
/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */
/* The routine was modified to support the options 'CN' and */
/* 'CN+S' aberration corrections. Moreover, diagnostics were */
/* added to check for reference frames that are not recognized */
/* inertial frames. */
/* - SPICELIB Version 1.1.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */
/* In the example program, the calling sequence of SPKAPP */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */
/* The local variable CORR was added to eliminate a */
/* run-time error that occurred when SPKAPP was determining */
/* what corrections to apply to the state. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED low-level aberration correction */
/* DEPRECATED apparent state from spk file */
/* DEPRECATED get apparent state */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */
/* The routine was modified to support the options 'CN' and */
/* 'CN+S' aberration corrections. Moreover, diagnostics were */
/* added to check for reference frames that are not recognized */
/* inertial frames. */
/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */
/* In the example program, the calling sequence of SPKAPP */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */
/* The local variable CORR was added to eliminate a run-time */
/* error that occurred when SPKAPP was determining what */
/* corrections to apply to the state. If the literal string */
/* 'LT' was assigned to ABCORR, SPKAPP attempted to look at */
/* ABCORR(3:4). Because ABCORR is a passed length argument, its */
/* length is not guaranteed, and those positions may not exist. */
/* Searching beyond the bounds of a string resulted in a */
/* run-time error at NAIF because NAIF compiles SPICELIB using the */
/* CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */
/* Also, without the local variable CORR, SPKAPP would have to */
/* modify the value of a passed argument, ABCORR. That's a no no. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Indices of flags in the FLAGS array: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKAP1", (ftnlen)8);
}
if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {
/* The aberration correction flag differs from the value it */
/* had on the previous call, if any. Analyze the new flag. */
/* Remove leading and embedded white space from the aberration */
/* correction flag and convert to upper case. */
ljucrs_(&c__0, abcorr, corr, abcorr_len, (ftnlen)5);
/* Locate the flag in our list of flags. */
i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5);
if (i__ == 0) {
setmsg_("Requested aberration correction # is not supported.", (
ftnlen)51);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23);
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
}
/* The aberration correction flag is recognized; save it. */
s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);
/* Set logical flags indicating the attributes of the requested */
/* correction. */
xmit = i__ > 5;
uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7;
usestl = i__ > 1 && odd_(&i__);
usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9;
first = FALSE_;
}
/* See if the reference frame is a recognized inertial frame. */
irfnum_(ref, &refid, ref_len);
if (refid == 0) {
setmsg_("The requested frame '#' is not a recognized inertial frame. "
, (ftnlen)60);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(BADFRAME)", (ftnlen)15);
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
}
/* Determine the sign of the light time offset. */
if (xmit) {
ltsign = 1;
} else {
ltsign = -1;
}
/* Find the geometric state of the target body with respect to the */
/* solar system barycenter. Subtract the state of the observer */
/* to get the relative state. Use this to compute the one-way */
/* light time. */
zzspksb1_(targ, et, ref, starg, ref_len);
vsubg_(starg, sobs, &c__6, tstate);
moved_(tstate, &c__6, starg);
*lt = vnorm_(starg) / clight_();
/* To correct for light time, find the state of the target body */
/* at the current epoch minus the one-way light time. Note that */
/* the observer remains where he is. */
if (uselt) {
maxitr = 1;
} else if (usecn) {
maxitr = 3;
} else {
maxitr = 0;
}
i__1 = maxitr;
for (i__ = 1; i__ <= i__1; ++i__) {
d__1 = *et + ltsign * *lt;
zzspksb1_(targ, &d__1, ref, starg, ref_len);
vsubg_(starg, sobs, &c__6, tstate);
moved_(tstate, &c__6, starg);
*lt = vnorm_(starg) / clight_();
}
/* At this point, STARG contains the light time corrected */
/* state of the target relative to the observer. */
/* If stellar aberration correction is requested, perform it now. */
/* Stellar aberration corrections are not applied to the target's */
/* velocity. */
if (usestl) {
if (xmit) {
/* This is the transmission case. */
/* Compute the position vector obtained by applying */
/* "reception" stellar aberration to STARG. */
stlabx_(starg, &sobs[3], sapos);
vequ_(sapos, starg);
} else {
/* This is the reception case. */
/* Compute the position vector obtained by applying */
/* "reception" stellar aberration to STARG. */
stelab_(starg, &sobs[3], sapos);
vequ_(sapos, starg);
}
}
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
} /* zzspkap1_ */
/* $Procedure SPKE21 ( S/P Kernel, evaluate, type 21 ) */
/* Subroutine */ int spke21_(doublereal *et, doublereal *record, doublereal *
state)
{
/* Initialized data */
static doublereal fc[25] = { 1. };
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
static doublereal g[25];
static integer i__, j;
static doublereal w[27], delta;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
static integer kqmax1;
static doublereal dt[75] /* was [25][3] */, wc[24];
static integer kq[3], ks;
static doublereal tl;
static integer jx;
static doublereal tp;
static integer maxdim;
static doublereal refvel[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static doublereal refpos[3];
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
static integer mq2, ks1, kqq;
static doublereal sum;
/* $ Abstract */
/* Evaluate a single SPK data record from a segment of type 21 */
/* (Extended Difference Lines). */
/* $ 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 */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 21. */
/* $ 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 */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 25-DEC-2013 (NJB) */
/* -& */
/* MAXTRM is the maximum number of terms allowed in each */
/* component of the difference table contained in a type */
/* 21 SPK difference line. MAXTRM replaces the fixed */
/* table parameter value of 15 used in SPK type 1 */
/* segments. */
/* Type 21 segments have variable size. Let MAXDIM be */
/* the dimension of each component of the difference */
/* table within each difference line. Then the size */
/* DLSIZE of the difference line is */
/* ( 4 * MAXDIM ) + 11 */
/* MAXTRM is the largest allowed value of MAXDIM. */
/* End of include file spk21.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Evaluation epoch. */
/* RECORD I Data record. */
/* STATE O State (position and velocity). */
/* MAXTRM P Maximum number of terms per difference table */
/* component. */
/* $ Detailed_Input */
/* ET is an epoch at which a state vector is to be */
/* computed. The epoch is represented as seconds past */
/* J2000 TDB. */
/* RECORD is a data record which, when evaluated at epoch ET, */
/* will give the state (position and velocity) of an */
/* ephemeris object, relative to its center of motion, */
/* in an inertial reference frame. */
/* The contents of RECORD are as follows: */
/* RECORD(1): The difference table size per */
/* Cartesian component. Call this */
/* size MAXDIM; then the difference */
/* line (MDA) size DLSIZE is */
/* ( 4 * MAXDIM ) + 11 */
/* RECORD(2) */
/* ... */
/* RECORD(1+DLSIZE): An extended difference line. */
/* The contents are: */
/* Dimension Description */
/* --------- ---------------------------------- */
/* 1 Reference epoch of difference line */
/* MAXDIM Stepsize function vector */
/* 1 Reference position vector, x */
/* 1 Reference velocity vector, x */
/* 1 Reference position vector, y */
/* 1 Reference velocity vector, y */
/* 1 Reference position vector, z */
/* 1 Reference velocity vector, z */
/* MAXDIM,3 Modified divided difference */
/* arrays (MDAs) */
/* 1 Maximum integration order plus 1 */
/* 3 Integration order array */
/* $ Detailed_Output */
/* STATE is the state resulting from evaluation of the input */
/* record at ET. Units are km and km/sec. */
/* $ Parameters */
/* MAXTRM is the maximum number of terms allowed in */
/* each component of the difference table */
/* contained in the input argument RECORD. */
/* See the INCLUDE file spk21.inc for the value */
/* of MAXTRM. */
/* $ Exceptions */
/* 1) If the maximum table size of the input record exceeds */
/* MAXTRM, the error SPICE(DIFFLINETOOLARGE) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The exact format and structure of type 21 (difference lines) */
/* segments are described in the SPK Required Reading file. */
/* SPKE21 is a modified version of SPKE01. The routine has been */
/* generalized to support variable size difference lines. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* Unknown. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* F.T. Krogh (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-FEB-2014 (NJB) (FTK) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* evaluate type_21 spk segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* The names below are original to the routine. They correspond */
/* roughly to the original memos written by Fred Krogh to explain */
/* how all this stuff really works. */
/* Save everything between calls. */
/* Initial values */
/* Use discovery check-in. */
/* If the RETURN function is set, don't even bother with this. */
if (return_()) {
return 0;
}
/* The first element of the input record is the dimension */
/* of the difference table MAXDIM. */
maxdim = i_dnnt(record);
if (maxdim > 25) {
chkin_("SPKE21", (ftnlen)6);
setmsg_("The input record has a maximum table dimension of #, while "
"the maximum supported by this routine is #. It is possible t"
"hat this problem is due to your SPICE Toolkit being out of d"
"ate.", (ftnlen)183);
errint_("#", &maxdim, (ftnlen)1);
errint_("#", &c__25, (ftnlen)1);
sigerr_("SPICE(DIFFLINETOOLARGE)", (ftnlen)23);
chkout_("SPKE21", (ftnlen)6);
return 0;
}
/* Unpack the contents of the MDA array. */
/* Name Dimension Description */
/* ------ --------- ------------------------------- */
/* TL 1 Reference epoch of record */
/* G MAXDIM Stepsize function vector */
/* REFPOS 3 Reference position vector */
/* REFVEL 3 Reference velocity vector */
/* DT MAXDIM,NTE Modified divided difference arrays */
/* KQMAX1 1 Maximum integration order plus 1 */
/* KQ NTE Integration order array */
/* For our purposes, NTE is always 3. */
moved_(&record[1], &c__1, &tl);
moved_(&record[2], &maxdim, g);
/* Collect the reference position and velocity. */
refpos[0] = record[maxdim + 2];
refvel[0] = record[maxdim + 3];
refpos[1] = record[maxdim + 4];
refvel[1] = record[maxdim + 5];
refpos[2] = record[maxdim + 6];
refvel[2] = record[maxdim + 7];
/* Initializing the difference table is one aspect of this routine */
/* that's a bit different from SPKE01. Here the first dimension of */
/* the table in the input record can be smaller than MAXTRM. So, we */
/* must transfer separately the portions of the table corresponding */
/* to each component. */
for (i__ = 1; i__ <= 3; ++i__) {
moved_(&record[i__ * maxdim + 8], &maxdim, &dt[(i__1 = i__ * 25 - 25)
< 75 && 0 <= i__1 ? i__1 : s_rnge("dt", i__1, "spke21_", (
ftnlen)289)]);
}
kqmax1 = (integer) record[(maxdim << 2) + 8];
kq[0] = (integer) record[(maxdim << 2) + 9];
kq[1] = (integer) record[(maxdim << 2) + 10];
kq[2] = (integer) record[(maxdim << 2) + 11];
/* Next we set up for the computation of the various differences */
delta = *et - tl;
tp = delta;
mq2 = kqmax1 - 2;
ks = kqmax1 - 1;
/* This is clearly collecting some kind of coefficients. */
/* The problem is that we have no idea what they are... */
/* The G coefficients are supposed to be some kind of step size */
/* vector. */
/* TP starts out as the delta t between the request time and the */
/* difference line's reference epoch. We then change it from DELTA */
/* by the components of the stepsize vector G. */
i__1 = mq2;
for (j = 1; j <= i__1; ++j) {
/* Make sure we're not about to attempt division by zero. */
if (g[(i__2 = j - 1) < 25 && 0 <= i__2 ? i__2 : s_rnge("g", i__2,
"spke21_", (ftnlen)320)] == 0.) {
chkin_("SPKE21", (ftnlen)6);
setmsg_("A value of zero was found at index # of the step size "
"vector.", (ftnlen)62);
errint_("#", &j, (ftnlen)1);
sigerr_("SPICE(ZEROSTEP)", (ftnlen)15);
chkout_("SPKE21", (ftnlen)6);
return 0;
}
fc[(i__2 = j) < 25 && 0 <= i__2 ? i__2 : s_rnge("fc", i__2, "spke21_",
(ftnlen)332)] = tp / g[(i__3 = j - 1) < 25 && 0 <= i__3 ?
i__3 : s_rnge("g", i__3, "spke21_", (ftnlen)332)];
wc[(i__2 = j - 1) < 24 && 0 <= i__2 ? i__2 : s_rnge("wc", i__2, "spk"
"e21_", (ftnlen)333)] = delta / g[(i__3 = j - 1) < 25 && 0 <=
i__3 ? i__3 : s_rnge("g", i__3, "spke21_", (ftnlen)333)];
tp = delta + g[(i__2 = j - 1) < 25 && 0 <= i__2 ? i__2 : s_rnge("g",
i__2, "spke21_", (ftnlen)334)];
}
/* Collect KQMAX1 reciprocals. */
i__1 = kqmax1;
for (j = 1; j <= i__1; ++j) {
w[(i__2 = j - 1) < 27 && 0 <= i__2 ? i__2 : s_rnge("w", i__2, "spke2"
"1_", (ftnlen)342)] = 1. / (doublereal) j;
}
/* Compute the W(K) terms needed for the position interpolation */
/* (Note, it is assumed throughout this routine that KS, which */
/* starts out as KQMAX1-1 (the ``maximum integration'') */
/* is at least 2. */
jx = 0;
ks1 = ks - 1;
while(ks >= 2) {
++jx;
i__1 = jx;
for (j = 1; j <= i__1; ++j) {
w[(i__2 = j + ks - 1) < 27 && 0 <= i__2 ? i__2 : s_rnge("w", i__2,
"spke21_", (ftnlen)359)] = fc[(i__3 = j) < 25 && 0 <=
i__3 ? i__3 : s_rnge("fc", i__3, "spke21_", (ftnlen)359)]
* w[(i__4 = j + ks1 - 1) < 27 && 0 <= i__4 ? i__4 :
s_rnge("w", i__4, "spke21_", (ftnlen)359)] - wc[(i__5 = j
- 1) < 24 && 0 <= i__5 ? i__5 : s_rnge("wc", i__5, "spke"
"21_", (ftnlen)359)] * w[(i__6 = j + ks - 1) < 27 && 0 <=
i__6 ? i__6 : s_rnge("w", i__6, "spke21_", (ftnlen)359)];
}
ks = ks1;
--ks1;
}
/* Perform position interpolation: (Note that KS = 1 right now. */
/* We don't know much more than that.) */
for (i__ = 1; i__ <= 3; ++i__) {
kqq = kq[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("kq", i__1,
"spke21_", (ftnlen)373)];
sum = 0.;
for (j = kqq; j >= 1; --j) {
sum += dt[(i__1 = j + i__ * 25 - 26) < 75 && 0 <= i__1 ? i__1 :
s_rnge("dt", i__1, "spke21_", (ftnlen)377)] * w[(i__2 = j
+ ks - 1) < 27 && 0 <= i__2 ? i__2 : s_rnge("w", i__2,
"spke21_", (ftnlen)377)];
}
state[(i__1 = i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1,
"spke21_", (ftnlen)380)] = refpos[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("refpos", i__2, "spke21_", (ftnlen)
380)] + delta * (refvel[(i__3 = i__ - 1) < 3 && 0 <= i__3 ?
i__3 : s_rnge("refvel", i__3, "spke21_", (ftnlen)380)] +
delta * sum);
}
/* Again we need to compute the W(K) coefficients that are */
/* going to be used in the velocity interpolation. */
/* (Note, at this point, KS = 1, KS1 = 0.) */
i__1 = jx;
for (j = 1; j <= i__1; ++j) {
w[(i__2 = j + ks - 1) < 27 && 0 <= i__2 ? i__2 : s_rnge("w", i__2,
"spke21_", (ftnlen)390)] = fc[(i__3 = j) < 25 && 0 <= i__3 ?
i__3 : s_rnge("fc", i__3, "spke21_", (ftnlen)390)] * w[(i__4 =
j + ks1 - 1) < 27 && 0 <= i__4 ? i__4 : s_rnge("w", i__4,
"spke21_", (ftnlen)390)] - wc[(i__5 = j - 1) < 24 && 0 <=
i__5 ? i__5 : s_rnge("wc", i__5, "spke21_", (ftnlen)390)] * w[
(i__6 = j + ks - 1) < 27 && 0 <= i__6 ? i__6 : s_rnge("w",
i__6, "spke21_", (ftnlen)390)];
}
--ks;
/* Perform velocity interpolation: */
for (i__ = 1; i__ <= 3; ++i__) {
kqq = kq[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("kq", i__1,
"spke21_", (ftnlen)400)];
sum = 0.;
for (j = kqq; j >= 1; --j) {
sum += dt[(i__1 = j + i__ * 25 - 26) < 75 && 0 <= i__1 ? i__1 :
s_rnge("dt", i__1, "spke21_", (ftnlen)404)] * w[(i__2 = j
+ ks - 1) < 27 && 0 <= i__2 ? i__2 : s_rnge("w", i__2,
"spke21_", (ftnlen)404)];
}
state[(i__1 = i__ + 2) < 6 && 0 <= i__1 ? i__1 : s_rnge("state", i__1,
"spke21_", (ftnlen)407)] = refvel[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("refvel", i__2, "spke21_", (ftnlen)
407)] + delta * sum;
}
return 0;
} /* spke21_ */
