/* $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_ */