/* $Procedure QXQ (Quaternion times quaternion) */ /* Subroutine */ int qxq_(doublereal *q1, doublereal *q2, doublereal *qout) { extern doublereal vdot_(doublereal *, doublereal *); doublereal cross[3]; extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal *), vlcom3_(doublereal *, doublereal *, doublereal *, doublereal * , doublereal *, doublereal *, doublereal *); /* $ Abstract */ /* Multiply two quaternions. */ /* $ 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 */ /* MATH */ /* POINTING */ /* ROTATION */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* Q1 I First SPICE quaternion factor. */ /* Q2 I Second SPICE quaternion factor. */ /* QOUT O Product of Q1 and Q2. */ /* $ Detailed_Input */ /* Q1 is a 4-vector representing a SPICE-style */ /* quaternion. See the discussion of quaternion */ /* styles in Particulars below. */ /* Note that multiple styles of quaternions */ /* are in use. This routine will not work properly */ /* if the input quaternions do not conform to */ /* the SPICE convention. See the Particulars */ /* section for details. */ /* Q2 is a second SPICE-style quaternion. */ /* $ Detailed_Output */ /* QOUT is 4-vector representing the quaternion product */ /* Q1 * Q2 */ /* Representing Q(i) as the sums of scalar (real) */ /* part s(i) and vector (imaginary) part v(i) */ /* respectively, */ /* Q1 = s1 + v1 */ /* Q2 = s2 + v2 */ /* QOUT has scalar part s3 defined by */ /* s3 = s1 * s2 - <v1, v2> */ /* and vector part v3 defined by */ /* v3 = s1 * v2 + s2 * v1 + v1 x v2 */ /* where the notation < , > denotes the inner */ /* product operator and x indicates the cross */ /* product operator. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* Error free. */ /* $ Files */ /* None. */ /* $ Particulars */ /* Quaternion Styles */ /* ----------------- */ /* There are different "styles" of quaternions used in */ /* science and engineering applications. Quaternion styles */ /* are characterized by */ /* - The order of quaternion elements */ /* - The quaternion multiplication formula */ /* - The convention for associating quaternions */ /* with rotation matrices */ /* Two of the commonly used styles are */ /* - "SPICE" */ /* > Invented by Sir William Rowan Hamilton */ /* > Frequently used in mathematics and physics textbooks */ /* - "Engineering" */ /* > Widely used in aerospace engineering applications */ /* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */ /* Quaternions of any other style must be converted to SPICE */ /* quaternions before they are passed to SPICELIB routines. */ /* Relationship between SPICE and Engineering Quaternions */ /* ------------------------------------------------------ */ /* Let M be a rotation matrix such that for any vector V, */ /* M*V */ /* is the result of rotating V by theta radians in the */ /* counterclockwise direction about unit rotation axis vector A. */ /* Then the SPICE quaternions representing M are */ /* (+/-) ( cos(theta/2), */ /* sin(theta/2) A(1), */ /* sin(theta/2) A(2), */ /* sin(theta/2) A(3) ) */ /* while the engineering quaternions representing M are */ /* (+/-) ( -sin(theta/2) A(1), */ /* -sin(theta/2) A(2), */ /* -sin(theta/2) A(3), */ /* cos(theta/2) ) */ /* For both styles of quaternions, if a quaternion q represents */ /* a rotation matrix M, then -q represents M as well. */ /* Given an engineering quaternion */ /* QENG = ( q0, q1, q2, q3 ) */ /* the equivalent SPICE quaternion is */ /* QSPICE = ( q3, -q0, -q1, -q2 ) */ /* Associating SPICE Quaternions with Rotation Matrices */ /* ---------------------------------------------------- */ /* Let FROM and TO be two right-handed reference frames, for */ /* example, an inertial frame and a spacecraft-fixed frame. Let the */ /* symbols */ /* V , V */ /* FROM TO */ /* denote, respectively, an arbitrary vector expressed relative to */ /* the FROM and TO frames. Let M denote the transformation matrix */ /* that transforms vectors from frame FROM to frame TO; then */ /* V = M * V */ /* TO FROM */ /* where the expression on the right hand side represents left */ /* multiplication of the vector by the matrix. */ /* Then if the unit-length SPICE quaternion q represents M, where */ /* q = (q0, q1, q2, q3) */ /* the elements of M are derived from the elements of q as follows: */ /* +- -+ */ /* | 2 2 | */ /* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */ /* | | */ /* | | */ /* | 2 2 | */ /* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */ /* | | */ /* | | */ /* | 2 2 | */ /* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */ /* | | */ /* +- -+ */ /* Note that substituting the elements of -q for those of q in the */ /* right hand side leaves each element of M unchanged; this shows */ /* that if a quaternion q represents a matrix M, then so does the */ /* quaternion -q. */ /* To map the rotation matrix M to a unit quaternion, we start by */ /* decomposing the rotation matrix as a sum of symmetric */ /* and skew-symmetric parts: */ /* 2 */ /* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */ /* symmetric skew-symmetric */ /* OMEGA is a skew-symmetric matrix of the form */ /* +- -+ */ /* | 0 -n3 n2 | */ /* | | */ /* OMEGA = | n3 0 -n1 | */ /* | | */ /* | -n2 n1 0 | */ /* +- -+ */ /* The vector N of matrix entries (n1, n2, n3) is the rotation axis */ /* of M and theta is M's rotation angle. Note that N and theta */ /* are not unique. */ /* Let */ /* C = cos(theta/2) */ /* S = sin(theta/2) */ /* Then the unit quaternions Q corresponding to M are */ /* Q = +/- ( C, S*n1, S*n2, S*n3 ) */ /* The mappings between quaternions and the corresponding rotations */ /* are carried out by the SPICELIB routines */ /* Q2M {quaternion to matrix} */ /* M2Q {matrix to quaternion} */ /* M2Q always returns a quaternion with scalar part greater than */ /* or equal to zero. */ /* SPICE Quaternion Multiplication Formula */ /* --------------------------------------- */ /* Given a SPICE quaternion */ /* Q = ( q0, q1, q2, q3 ) */ /* corresponding to rotation axis A and angle theta as above, we can */ /* represent Q using "scalar + vector" notation as follows: */ /* s = q0 = cos(theta/2) */ /* v = ( q1, q2, q3 ) = sin(theta/2) * A */ /* Q = s + v */ /* Let Q1 and Q2 be SPICE quaternions with respective scalar */ /* and vector parts s1, s2 and v1, v2: */ /* Q1 = s1 + v1 */ /* Q2 = s2 + v2 */ /* We represent the dot product of v1 and v2 by */ /* <v1, v2> */ /* and the cross product of v1 and v2 by */ /* v1 x v2 */ /* Then the SPICE quaternion product is */ /* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */ /* If Q1 and Q2 represent the rotation matrices M1 and M2 */ /* respectively, then the quaternion product */ /* Q1*Q2 */ /* represents the matrix product */ /* M1*M2 */ /* $ Examples */ /* 1) Let QID, QI, QJ, QK be the "basis" quaternions */ /* QID = ( 1, 0, 0, 0 ) */ /* QI = ( 0, 1, 0, 0 ) */ /* QJ = ( 0, 0, 1, 0 ) */ /* QK = ( 0, 0, 0, 1 ) */ /* respectively. Then the calls */ /* CALL QXQ ( QI, QJ, IXJ ) */ /* CALL QXQ ( QJ, QK, JXK ) */ /* CALL QXQ ( QK, QI, KXI ) */ /* produce the results */ /* IXJ = QK */ /* JXK = QI */ /* KXI = QJ */ /* All of the calls */ /* CALL QXQ ( QI, QI, QOUT ) */ /* CALL QXQ ( QJ, QJ, QOUT ) */ /* CALL QXQ ( QK, QK, QOUT ) */ /* produce the result */ /* QOUT = -QID */ /* For any quaternion Q, the calls */ /* CALL QXQ ( QID, Q, QOUT ) */ /* CALL QXQ ( Q, QID, QOUT ) */ /* produce the result */ /* QOUT = Q */ /* 2) Composition of rotations: let CMAT1 and CMAT2 be two */ /* C-matrices (which are rotation matrices). Then the */ /* following code fragment computes the product CMAT1 * CMAT2: */ /* C */ /* C Convert the C-matrices to quaternions. */ /* C */ /* CALL M2Q ( CMAT1, Q1 ) */ /* CALL M2Q ( CMAT2, Q2 ) */ /* C */ /* C Find the product. */ /* C */ /* CALL QXQ ( Q1, Q2, QOUT ) */ /* C */ /* C Convert the result to a C-matrix. */ /* C */ /* CALL Q2M ( QOUT, CMAT3 ) */ /* C */ /* C Multiply CMAT1 and CMAT2 directly. */ /* C */ /* CALL MXM ( CMAT1, CMAT2, CMAT4 ) */ /* C */ /* C Compare the results. The difference DIFF of */ /* C CMAT3 and CMAT4 should be close to the zero */ /* C matrix. */ /* C */ /* CALL VSUBG ( 9, CMAT3, CMAT4, DIFF ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 26-FEB-2008 (NJB) */ /* Updated header; added information about SPICE */ /* quaternion conventions. */ /* - SPICELIB Version 1.0.0, 18-AUG-2002 (NJB) */ /* -& */ /* $ Index_Entries */ /* quaternion times quaternion */ /* multiply quaternion by quaternion */ /* -& */ /* SPICELIB functions */ /* Local variables */ /* Compute the scalar part of the product. */ qout[0] = q1[0] * q2[0] - vdot_(&q1[1], &q2[1]); /* And now the vector part. The SPICELIB routine VLCOM3 computes */ /* a linear combination of three 3-vectors. */ vcrss_(&q1[1], &q2[1], cross); vlcom3_(q1, &q2[1], q2, &q1[1], &c_b2, cross, &qout[1]); return 0; } /* qxq_ */
/* $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 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 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 ZZSPKFLT ( SPK function, light time and rate ) */ /* Subroutine */ int zzspkflt_(S_fp trgsub, doublereal *et, char *ref, char * abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) { /* Initialized data */ static logical pass1 = TRUE_; static char prvcor[5] = " "; /* System generated locals */ doublereal d__1, d__2, d__3, d__4; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ doublereal dist; extern doublereal vdot_(doublereal *, doublereal *); static logical xmit; extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen); doublereal a, b, c__; integer i__; extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, doublereal *); integer refid; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal epoch; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); static logical usecn; extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *, integer *, doublereal *); doublereal lterr; static logical uselt; extern doublereal vnorm_(doublereal *); doublereal prvlt; extern logical failed_(void); extern doublereal clight_(void); logical attblk[15]; extern doublereal touchd_(doublereal *); extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen); doublereal ctrssb[6]; integer ltsign; extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_( char *, ftnlen); doublereal ssbtrg[6]; integer trgctr; extern /* Subroutine */ int spkssb_(integer *, doublereal *, char *, doublereal *, ftnlen); integer numitr; extern logical return_(void); logical usestl; doublereal sttctr[6]; /* $ 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 (position and velocity) of a target body */ /* relative to an observer, optionally corrected for light time, */ /* expressed relative to an inertial reference frame. An input */ /* subroutine provides the state of the target relative to its */ /* center of motion. */ /* $ 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 */ /* 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 */ /* -------- --- -------------------------------------------------- */ /* TRGSUB I Target body state subroutine. */ /* ET I Observer epoch. */ /* REF I Inertial reference frame of output state. */ /* ABCORR I Aberration correction flag. */ /* STOBS I State of the observer relative to the SSB. */ /* STARG O State of target. */ /* LT O One way light time between observer and target. */ /* DLT O Derivative of light time with respect to time. */ /* $ Detailed_Input */ /* TRGSUB is the name of an external subroutine that returns */ /* the geometric state of the target body relative to a */ /* center of motion, expressed in the inertial reference */ /* frame REF, at the epoch ET. */ /* The calling sequence of TRGSUB is */ /* SUBROUTINE TRGSUB ( ET, REF, TRGCTR, STATE ) */ /* DOUBLE PRECISION ET */ /* CHARACTER*(*) REF */ /* INTEGER TRGCTR */ /* DOUBLE PRECISION STATE ( 6 ) */ /* The inputs of TRGSUB are ET and REF; the outputs */ /* are TRGCTR and STATE. STATE is the geometric state */ /* of the target relative to the returned center of */ /* motion at ET, expressed in the frame REF. */ /* 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 input state STOBS and the output state STARG are */ /* 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. */ /* ABCORR indicates the aberration corrections to be applied to */ /* the state of the target body to account for one-way */ /* light time. See the discussion in the Particulars */ /* section for recommendations on how to choose */ /* aberration corrections. */ /* If ABCORR includes the stellar aberration correction */ /* symbol '+S', this flag is simply ignored. Aside from */ /* the possible presence of this symbol, 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 the Particulars section */ /* of SPKEZR for details.) The solution */ /* invoked by the 'LT' option uses one */ /* iteration. */ /* '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. */ /* 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. */ /* 'XCN' "Transmission" case: converged */ /* Newtonian light time 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. */ /* STOBS is the geometric (uncorrected) state of the observer */ /* relative to the solar system barycenter at epoch ET. */ /* STOBS is a 6-vector: the first three components of */ /* STOBS represent a Cartesian position vector; the last */ /* three components represent the corresponding velocity */ /* vector. STOBS is expressed relative to the inertial */ /* reference frame designated by REF. */ /* Units are always km and km/sec. */ /* $ 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 aberration, 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. */ /* 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 light time, then LT is the one-way light time */ /* between the observer and the light time-corrected */ /* target location. */ /* DLT is the derivative with respect to barycentric */ /* dynamical time of the one way light time between */ /* target and observer: */ /* DLT = d(LT)/d(ET) */ /* DLT can also be described as the rate of change of */ /* one way light time. DLT is unitless, since LT and */ /* ET both have units of TDB seconds. */ /* If the observer and target are at the same position, */ /* then DLT is set to zero. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) For the convenience of the caller, the input aberration */ /* correction flag can call for stellar aberration correction via */ /* inclusion of the '+S' suffix. This portion of the aberration */ /* correction flag is ignored if present. */ /* 2) If ABCORR calls for stellar aberration but not light */ /* time corrections, the error SPICE(NOTSUPPORTED) is */ /* signaled. */ /* 3) If ABCORR calls for relativistic light time corrections, the */ /* error SPICE(NOTSUPPORTED) is signaled. */ /* 4) If the value of ABCORR is not recognized, the error */ /* is diagnosed by a routine in the call tree of this */ /* routine. */ /* 5) If the reference frame requested is not a recognized */ /* inertial reference frame, the error SPICE(UNKNOWNFRAME) */ /* is signaled. */ /* 6) 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. */ /* 7) If the observer and target are at the same position, */ /* then DLT is set to zero. This situation could arise, */ /* for example, when the observer is Mars and the target */ /* is the Mars barycenter. */ /* 8) If a division by zero error would occur in the computation */ /* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */ /* $ 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 */ /* This routine supports higher-level routines that can */ /* perform both light time and stellar aberration corrections */ /* and that use target states provided by subroutines rather */ /* than by the conventional, public SPK APIs. For example, this */ /* routine can be used for objects having fixed positions */ /* on the surfaces of planets. */ /* $ Examples */ /* See usage in ZZSPKFAP. */ /* $ Restrictions */ /* 1) This routine must not be called by routines of the SPICE */ /* frame subsystem. It must not be called by any portion of */ /* the SPK subsystem other than the private SPK function-based */ /* component. */ /* 2) The input subroutine TRGSUB must not call this routine. */ /* or any of the supporting, private SPK routines */ /* 3) When possible, the routine SPKGEO should be used instead of */ /* this routine to compute geometric states. SPKGEO introduces */ /* less round-off error when the observer and target have common */ /* center that is closer to both objects than is the solar */ /* system barycenter. */ /* 4) Unlike most other SPK state computation routines, this */ /* routine requires that the output state be relative to an */ /* inertial reference frame. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 04-JUL-2014 (NJB) */ /* Discussion of light time corrections was updated. Assertions */ /* that converged light time corrections are unlikely to be */ /* useful were removed. */ /* Last update was 22-FEB-2012 (NJB) */ /* -& */ /* $ Index_Entries */ /* low-level light time correction */ /* light-time corrected state from spk file */ /* get light-time corrected state */ /* -& */ /* $ Revisions */ /* None. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* TOL is the tolerance used for a division-by-zero test */ /* performed prior to computation of DLT. */ /* Convergence limit: */ /* Maximum number of light time iterations for any */ /* aberration correction: */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("ZZSPKFLT", (ftnlen)8); if (pass1 || 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. */ zzvalcor_(abcorr, attblk, abcorr_len); if (failed_()) { chkout_("ZZSPKFLT", (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 is .TRUE. when the correction is for transmitted */ /* radiation. */ /* USELT is .TRUE. when any type of light time correction */ /* (normal or converged Newtonian) is specified. */ /* USECN indicates converged Newtonian light time correction. */ /* The above definitions are consistent with those used by */ /* ZZVALCOR. */ xmit = attblk[4]; uselt = attblk[1]; usecn = attblk[3]; usestl = attblk[2]; pass1 = 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(UNKNOWNFRAME)", (ftnlen)19); chkout_("ZZSPKFLT", (ftnlen)8); return 0; } /* 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. */ (*trgsub)(et, ref, &trgctr, sttctr, ref_len); spkssb_(&trgctr, et, ref, ctrssb, ref_len); if (failed_()) { chkout_("ZZSPKFLT", (ftnlen)8); return 0; } vaddg_(ctrssb, sttctr, &c__6, ssbtrg); vsubg_(ssbtrg, stobs, &c__6, starg); dist = vnorm_(starg); *lt = dist / clight_(); if (*lt == 0.) { /* This can happen only if the observer and target are at the */ /* same position. We don't consider this an error, but we're not */ /* going to compute the light time derivative. */ *dlt = 0.; chkout_("ZZSPKFLT", (ftnlen)8); return 0; } if (! uselt) { /* This is a special case: we're not using light time */ /* corrections, so the derivative */ /* of light time is just */ /* (1/c) * d(VNORM(STARG))/dt */ *dlt = vdot_(starg, &starg[3]) / (dist * clight_()); /* LT and DLT are both set, so we can return. */ chkout_("ZZSPKFLT", (ftnlen)8); return 0; } /* 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 it is. */ /* Determine the sign of the light time offset. */ if (xmit) { ltsign = 1; } else { ltsign = -1; } /* Let NUMITR be the number of iterations we'll perform to */ /* compute the light time. */ if (usecn) { numitr = 5; } else { numitr = 1; } i__ = 0; lterr = 1.; while(i__ < numitr && lterr > 1e-17) { /* LT was set either prior to this loop or */ /* during the previous loop iteration. */ d__1 = *et + ltsign * *lt; epoch = touchd_(&d__1); (*trgsub)(&epoch, ref, &trgctr, sttctr, ref_len); spkssb_(&trgctr, &epoch, ref, ctrssb, ref_len); if (failed_()) { chkout_("ZZSPKFLT", (ftnlen)8); return 0; } vaddg_(ctrssb, sttctr, &c__6, ssbtrg); vsubg_(ssbtrg, stobs, &c__6, starg); prvlt = *lt; d__1 = vnorm_(starg) / clight_(); *lt = touchd_(&d__1); /* LTERR is the magnitude of the change between the current */ /* estimate of light time and the previous estimate, relative to */ /* the previous light time corrected epoch. */ /* Computing MAX */ d__3 = 1., d__4 = abs(epoch); d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4); lterr = touchd_(&d__2); ++i__; } /* At this point, STARG contains the light time corrected */ /* state of the target relative to the observer. */ /* Compute the derivative of light time with respect */ /* to time: dLT/dt. Below we derive the formula for */ /* this quantity for the reception case. Let */ /* POBS be the position of the observer relative to the */ /* solar system barycenter. */ /* VOBS be the velocity of the observer relative to the */ /* solar system barycenter. */ /* PTARG be the position of the target relative to the */ /* solar system barycenter. */ /* VTARG be the velocity of the target relative to the */ /* solar system barycenter. */ /* S be the sign of the light time correction. S is */ /* negative for the reception case. */ /* The light-time corrected position of the target relative to */ /* the observer at observation time ET, given the one-way */ /* light time LT is: */ /* PTARG(ET+S*LT) - POBS(ET) */ /* The light-time corrected velocity of the target relative to */ /* the observer at observation time ET is */ /* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */ /* We need to compute dLT/dt. Below, we use the facts that, */ /* for a time-dependent vector X(t), */ /* ||X|| = <X,X> ** (1/2) */ /* d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */ /* = <X,X>**(-1/2) * <X,dX/dt> */ /* = <X,dX/dt> / ||X|| */ /* Newtonian light time equation: */ /* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */ /* Differentiate both sides: */ /* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* * < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */ /* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* * ( < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT) - VOBS(ET) > */ /* + < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */ /* Let */ /* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */ /* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */ /* Then */ /* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */ /* which implies */ /* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */ a = 1. / (clight_() * vnorm_(starg)); b = vdot_(starg, &starg[3]); c__ = vdot_(starg, &ssbtrg[3]); /* For physically realistic target velocities, S*C*A cannot equal 1. */ /* We'll check for this case anyway. */ if (ltsign * c__ * a > .99999999989999999) { setmsg_("Target range rate magnitude is approximately the speed of l" "ight. The light time derivative cannot be computed.", (ftnlen) 110); sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); chkout_("ZZSPKFLT", (ftnlen)8); return 0; } /* Compute DLT: the rate of change of light time. */ *dlt = a * b / (1. - ltsign * c__ * a); /* Overwrite the velocity portion of the output state */ /* with the light-time corrected velocity. */ d__1 = ltsign * *dlt + 1.; vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]); chkout_("ZZSPKFLT", (ftnlen)8); return 0; } /* zzspkflt_ */
/* $Procedure DVSEP ( Derivative of separation angle ) */ doublereal dvsep_(doublereal *s1, doublereal *s2) { /* System generated locals */ doublereal ret_val; /* Local variables */ logical safe; extern doublereal vdot_(doublereal *, doublereal *); doublereal numr; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal denom; extern /* Subroutine */ int dvhat_(doublereal *, doublereal *); extern doublereal dpmax_(void); extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal *); extern doublereal vnorm_(doublereal *); extern logical vzero_(doublereal *); doublereal u1[6], u2[6]; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); doublereal pcross[3]; extern logical return_(void); /* $ Abstract */ /* Calculate the time derivative of the separation angle between */ /* two input states, S1 and S2. */ /* $ 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 */ /* GEOMETRY */ /* DERIVATIVES */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* S1 I State vector of the first body. */ /* S2 I State vector of the second body. */ /* $ Detailed_Input */ /* S1 the state vector of the first target body as seen from */ /* the observer. */ /* S2 the state vector of the second target body as seen from */ /* the observer. */ /* An implicit assumption exists that both states lie in the same */ /* reference frame with the same observer for the same epoch. If this */ /* is not the case, the numerical result has no meaning. */ /* $ Detailed_Output */ /* The function returns the double precision value of the time */ /* derivative of the angular separation between S1 and S2. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) The error SPICE(NUMERICOVERFLOW) signals if the inputs S1, S2 */ /* define states with an angular separation rate ~ DPMAX(). */ /* 2) If called in RETURN mode, the return has value 0. */ /* 3) Linear dependent position components of S1 and S1 constitutes */ /* a non-error exception. The function returns 0 for this case. */ /* $ Files */ /* None. */ /* $ Particulars */ /* In this discussion, the notation */ /* < V1, V2 > */ /* indicates the dot product of vectors V1 and V2. The notation */ /* V1 x V2 */ /* indicates the cross product of vectors V1 and V2. */ /* To start out, note that we need consider only unit vectors, */ /* since the angular separation of any two non-zero vectors */ /* equals the angular separation of the corresponding unit vectors. */ /* Call these vectors U1 and U2; let their velocities be V1 and V2. */ /* For unit vectors having angular separation */ /* THETA */ /* the identity */ /* || U1 x U1 || = ||U1|| * ||U2|| * sin(THETA) (1) */ /* reduces to */ /* || U1 x U2 || = sin(THETA) (2) */ /* and the identity */ /* | < U1, U2 > | = || U1 || * || U2 || * cos(THETA) (3) */ /* reduces to */ /* | < U1, U2 > | = cos(THETA) (4) */ /* Since THETA is an angular separation, THETA is in the range */ /* 0 : Pi */ /* Then letting s be +1 if cos(THETA) > 0 and -1 if cos(THETA) < 0, */ /* we have for any value of THETA other than 0 or Pi */ /* 2 1/2 */ /* cos(THETA) = s * ( 1 - sin (THETA) ) (5) */ /* or */ /* 2 1/2 */ /* < U1, U2 > = s * ( 1 - sin (THETA) ) (6) */ /* At this point, for any value of THETA other than 0 or Pi, */ /* we can differentiate both sides with respect to time (T) */ /* to obtain */ /* 2 -1/2 */ /* < U1, V2 > + < V1, U2 > = s * (1/2)(1 - sin (THETA)) */ /* * (-2) sin(THETA)*cos(THETA) */ /* * d(THETA)/dT (7a) */ /* Using equation (5), and noting that s = 1/s, we can cancel */ /* the cosine terms on the right hand side */ /* -1 */ /* < U1, V2 > + < V1, U2 > = (1/2)(cos(THETA)) */ /* * (-2) sin(THETA)*cos(THETA) */ /* * d(THETA)/dT (7b) */ /* With (7b) reducing to */ /* < U1, V2 > + < V1, U2 > = - sin(THETA) * d(THETA)/dT (8) */ /* Using equation (2) and switching sides, we obtain */ /* || U1 x U2 || * d(THETA)/dT = - < U1, V2 > - < V1, U2 > (9) */ /* or, provided U1 and U2 are linearly independent, */ /* d(THETA)/dT = ( - < U1, V2 > - < V1, U2 > ) / ||U1 x U2|| (10) */ /* Note for times when U1 and U2 have angular separation 0 or Pi */ /* radians, the derivative of angular separation with respect to */ /* time doesn't exist. (Consider the graph of angular separation */ /* with respect to time; typically the graph is roughly v-shaped at */ /* the singular points.) */ /* $ Examples */ /* PROGRAM DVSEP_T */ /* IMPLICIT NONE */ /* DOUBLE PRECISION ET */ /* DOUBLE PRECISION LT */ /* DOUBLE PRECISION DSEPT */ /* DOUBLE PRECISION STATEE (6) */ /* DOUBLE PRECISION STATEM (6) */ /* INTEGER STRLEN */ /* PARAMETER ( STRLEN = 64 ) */ /* CHARACTER*(STRLEN) BEGSTR */ /* DOUBLE PRECISION DVSEP */ /* C */ /* C Load kernels. */ /* C */ /* CALL FURNSH ('standard.tm') */ /* C */ /* C An arbitrary time. */ /* C */ /* BEGSTR = 'JAN 1 2009' */ /* CALL STR2ET( BEGSTR, ET ) */ /* C */ /* C Calculate the state vectors sun to Moon, sun to earth at ET. */ /* C */ /* C */ /* CALL SPKEZR ( 'EARTH', ET, 'J2000', 'NONE', 'SUN', */ /* . STATEE, LT) */ /* CALL SPKEZR ( 'MOON', ET, 'J2000', 'NONE', 'SUN', */ /* . STATEM, LT) */ /* C */ /* C Calculate the time derivative of the angular separation of */ /* C the earth and Moon as seen from the sun at ET. */ /* C */ /* DSEPT = DVSEP( STATEE, STATEM ) */ /* WRITE(*,*) 'Time derivative of angular separation: ', DSEPT */ /* END */ /* The program compiled on OS X with g77 outputs (radians/sec): */ /* Time derivative of angular separation: 3.81211936E-09 */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* E.D. Wright (JPL) */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.1, 15-MAR-2010 (EDW) */ /* Trivial header format clean-up. */ /* - SPICELIB Version 1.0.1, 31-MAR-2009 (EDW) */ /* -& */ /* $ Index_Entries */ /* time derivative of angular separation */ /* -& */ /* SPICELIB functions */ /* Local variables */ if (return_()) { ret_val = 0.; return ret_val; } chkin_("DVSEP", (ftnlen)5); /* Compute the unit vectors and corresponding time derivatives */ /* for the input state vectors. */ dvhat_(s1, u1); dvhat_(s2, u2); /* Calculate the cross product vector of U1 and U2. As both vectors */ /* have magnitude one, the magnitude of the cross product equals */ /* sin(THETA), with THETA the angle between S1 and S2. */ vcrss_(u1, u2, pcross); /* Now calculate the time derivate of the angular separation between */ /* S1 and S2. */ /* The routine needs to guard against both division by zero */ /* and numeric overflow. Before carrying out the division */ /* indicated by equation (10), the routine should verify that */ /* || U1 x U2 || > fudge factor * | numerator | / DPMAX() */ /* A fudge factor of 10.D0 should suffice. */ /* Note that the inequality is strict. */ /* Handle the parallel and anti-parallel cases. */ if (vzero_(pcross)) { ret_val = 0.; chkout_("DVSEP", (ftnlen)5); return ret_val; } /* Now check for possible overflow. */ numr = vdot_(u1, &u2[3]) + vdot_(&u1[3], u2); denom = vnorm_(pcross); safe = denom > abs(numr) * 10. / dpmax_(); if (! safe) { ret_val = 0.; setmsg_("Numerical overflow event.", (ftnlen)25); sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22); chkout_("DVSEP", (ftnlen)5); return ret_val; } ret_val = -numr / denom; chkout_("DVSEP", (ftnlen)5); return ret_val; } /* dvsep_ */
/* $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 VPRJPI ( Vector projection onto plane, inverted ) */ /* Subroutine */ int vprjpi_(doublereal *vin, doublereal *projpl, doublereal * invpl, doublereal *vout, logical *found) { /* System generated locals */ doublereal d__1; /* Local variables */ doublereal invc, invn[3]; extern doublereal vdot_(doublereal *, doublereal *); doublereal mult; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal denom; extern doublereal dpmax_(void); doublereal projc, limit; extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal numer, projn[3]; extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, doublereal *), chkout_(char *, ftnlen); extern logical return_(void); /* $ Abstract */ /* Find the vector in a specified plane that maps to a specified */ /* vector in another plane under orthogonal projection. */ /* $ 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 */ /* VECTOR */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* VIN I The projected vector. */ /* PROJPL I Plane containing VIN. */ /* INVPL I Plane containing inverse image of VIN. */ /* VOUT O Inverse projection of VIN. */ /* FOUND O Flag indicating whether VOUT could be calculated. */ /* $ Detailed_Input */ /* VIN, */ /* PROJPL, */ /* INVPL are, respectively, a 3-vector, a SPICELIB plane */ /* containing the vector, and a SPICELIB plane */ /* containing the inverse image of the vector under */ /* orthogonal projection onto PROJPL. */ /* $ Detailed_Output */ /* VOUT is the inverse orthogonal projection of VIN. This */ /* is the vector lying in the plane INVPL whose */ /* orthogonal projection onto the plane PROJPL is */ /* VIN. VOUT is valid only when FOUND (defined below) */ /* is .TRUE. Otherwise, VOUT is undefined. */ /* FOUND indicates whether the inverse orthogonal projection */ /* of VIN could be computed. FOUND is .TRUE. if so, */ /* .FALSE. otherwise. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the geometric planes defined by PROJPL and INVPL are */ /* orthogonal, or nearly so, the inverse orthogonal projection */ /* of VIN may be undefined or have magnitude too large to */ /* represent with double precision numbers. In either such */ /* case, FOUND will be set to .FALSE. */ /* 2) Even when FOUND is .TRUE., VOUT may be a vector of extremely */ /* large magnitude, perhaps so large that it is impractical to */ /* compute with it. It's up to you to make sure that this */ /* situation does not occur in your application of this routine. */ /* $ Files */ /* None. */ /* $ Particulars */ /* Projecting a vector orthogonally onto a plane can be thought of */ /* as finding the closest vector in the plane to the original vector. */ /* This `closest vector' always exists; it may be coincident with the */ /* original vector. Inverting an orthogonal projection means finding */ /* the vector in a specified plane whose orthogonal projection onto */ /* a second specified plane is a specified vector. The vector whose */ /* projection is the specified vector is the inverse projection of */ /* the specified vector, also called the `inverse image under */ /* orthogonal projection' of the specified vector. This routine */ /* finds the inverse orthogonal projection of a vector onto a plane. */ /* Related routines are VPRJP, which projects a vector onto a plane */ /* orthogonally, and VPROJ, which projects a vector onto another */ /* vector orthogonally. */ /* $ Examples */ /* 1) Suppose */ /* VIN = ( 0.0, 1.0, 0.0 ), */ /* and that PROJPL has normal vector */ /* PROJN = ( 0.0, 0.0, 1.0 ). */ /* Also, let's suppose that INVPL has normal vector and constant */ /* INVN = ( 0.0, 2.0, 2.0 ) */ /* INVC = 4.0. */ /* Then VIN lies on the y-axis in the x-y plane, and we want to */ /* find the vector VOUT lying in INVPL such that the orthogonal */ /* projection of VOUT the x-y plane is VIN. Let the notation */ /* < a, b > indicate the inner product of vectors a and b. */ /* Since every point X in INVPL satisfies the equation */ /* < X, (0.0, 2.0, 2.0) > = 4.0, */ /* we can verify by inspection that the vector */ /* ( 0.0, 1.0, 1.0 ) */ /* is in INVPL and differs from VIN by a multiple of PROJN. So */ /* ( 0.0, 1.0, 1.0 ) */ /* must be VOUT. */ /* To find this result using SPICELIB, we can create the */ /* SPICELIB planes PROJPL and INVPL using the code fragment */ /* CALL NVP2PL ( PROJN, VIN, PROJPL ) */ /* CALL NVC2PL ( INVN, INVC, INVPL ) */ /* and then perform the inverse projection using the call */ /* CALL VPRJPI ( VIN, PROJPL, INVPL, VOUT ) */ /* VPRJPI will return the value */ /* VOUT = ( 0.0, 1.0, 1.0 ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* [1] `Calculus and Analytic Geometry', Thomas and Finney. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 17-FEB-2004 (NJB) */ /* Computation of LIMIT was re-structured to avoid */ /* run-time underflow warnings on some platforms. */ /* - 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, 01-NOV-1990 (NJB) */ /* -& */ /* $ Index_Entries */ /* vector projection onto plane inverted */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 17-FEB-2004 (NJB) */ /* Computation of LIMIT was re-structured to avoid */ /* run-time underflow warnings on some platforms. */ /* In the revised code, BOUND/DPMAX() is never */ /* scaled by a number having absolute value < 1. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* BOUND is used to bound the magnitudes of the numbers that we */ /* try to take the reciprocal of, since we can't necessarily invert */ /* any non-zero number. We won't try to invert any numbers with */ /* magnitude less than */ /* BOUND / DPMAX(). */ /* BOUND is chosen somewhat arbitrarily.... */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("VPRJPI", (ftnlen)6); } /* Unpack the planes. */ pl2nvc_(projpl, projn, &projc); pl2nvc_(invpl, invn, &invc); /* We'll first discuss the computation of VOUT in the nominal case, */ /* and then deal with the exceptional cases. */ /* When PROJPL and INVPL are not orthogonal to each other, the */ /* inverse projection of VIN will differ from VIN by a multiple of */ /* PROJN, the unit normal vector to PROJPL. We find this multiple */ /* by using the fact that the inverse projection VOUT satisfies the */ /* plane equation for the inverse projection plane INVPL. */ /* We have */ /* VOUT = VIN + MULT * PROJN; (1) */ /* since VOUT satisfies */ /* < VOUT, INVN > = INVC */ /* we must have */ /* < VIN + MULT * PROJN, INVN > = INVC */ /* which in turn implies */ /* INVC - < VIN, INVN > */ /* MULT = ------------------------. (2) */ /* < PROJN, INVN > */ /* Having MULT, we can compute VOUT according to equation (1). */ /* Now, if the denominator in the above expression for MULT is zero */ /* or just too small, performing the division would cause a */ /* divide-by-zero error or an overflow of MULT. In either case, we */ /* will avoid carrying out the division, and we'll set FOUND to */ /* .FALSE. */ /* Compute the numerator and denominator of the right side of (2). */ numer = invc - vdot_(vin, invn); denom = vdot_(projn, invn); /* If the magnitude of the denominator is greater than the absolute */ /* value of */ /* BOUND */ /* LIMIT = --------- * NUMER, */ /* DPMAX() */ /* we can safely divide the numerator by the denominator, and the */ /* magnitude of the result will be no greater than */ /* DPMAX() */ /* --------- . */ /* BOUND */ /* Note that we have ruled out the case where NUMER and DENOM are */ /* both zero by insisting on strict inequality in the comparison of */ /* DENOM and LIMIT. */ /* We never set LIMIT smaller than BOUND/DPMAX(), since */ /* the computation using NUMER causes underflow to be signaled */ /* on some systems. */ if (abs(numer) < 1.) { limit = 10. / dpmax_(); } else { limit = (d__1 = 10. / dpmax_() * numer, abs(d__1)); } if (abs(denom) > limit) { /* We can find VOUT after all. */ mult = numer / denom; vlcom_(&c_b3, vin, &mult, projn, vout); *found = TRUE_; } else { /* No dice. */ *found = FALSE_; } chkout_("VPRJPI", (ftnlen)6); return 0; } /* vprjpi_ */
/* $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 ZZEDTERM ( Ellipsoid terminator ) */ /* Subroutine */ int zzedterm_(char *type__, doublereal *a, doublereal *b, doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer * npts, doublereal *trmpts, ftnlen type_len) { /* System generated locals */ integer trmpts_dim2, i__1, i__2; doublereal d__1, d__2, d__3; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); double asin(doublereal); integer s_rnge(char *, integer, char *, integer); double d_sign(doublereal *, doublereal *); /* Local variables */ extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * ); doublereal rmin, rmax; extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal * ); extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, doublereal *); integer nitr; extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal * ), vequ_(doublereal *, doublereal *); doublereal d__, e[3]; integer i__; doublereal s, angle, v[3], x[3], delta, y[3], z__[3], inang; extern /* Subroutine */ int chkin_(char *, ftnlen), frame_(doublereal *, doublereal *, doublereal *); doublereal plane[4]; extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), vpack_(doublereal *, doublereal *, doublereal *, doublereal *); doublereal theta; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); doublereal trans[9] /* was [3][3] */, srcpt[3], vtemp[3]; extern doublereal vnorm_(doublereal *), twopi_(void); extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen), pl2nvc_(doublereal *, doublereal *, doublereal *); doublereal lambda; extern /* Subroutine */ int nvp2pl_(doublereal *, doublereal *, doublereal *); extern doublereal halfpi_(void); doublereal minang, minrad, maxang, maxrad; extern /* Subroutine */ int latrec_(doublereal *, doublereal *, doublereal *, doublereal *); doublereal angerr; logical umbral; extern doublereal touchd_(doublereal *); doublereal offset[3], prvdif; extern /* Subroutine */ int sigerr_(char *, ftnlen); doublereal outang, plcons, prvang; extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); char loctyp[50]; extern logical return_(void); extern /* Subroutine */ int vminus_(doublereal *, doublereal *); doublereal dir[3]; extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *) ; doublereal vtx[3]; /* $ 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. */ /* Compute a set of points on the umbral or penumbral terminator of */ /* a specified ellipsoid, given a spherical light source. */ /* $ 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 */ /* BODY */ /* GEOMETRY */ /* MATH */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* TYPE I Terminator type. */ /* A I Length of ellipsoid semi-axis lying on the x-axis. */ /* B I Length of ellipsoid semi-axis lying on the y-axis. */ /* C I Length of ellipsoid semi-axis lying on the z-axis. */ /* SRCRAD I Radius of light source. */ /* SRCPOS I Position of center of light source. */ /* NPTS I Number of points in terminator point set. */ /* TRMPTS O Terminator point set. */ /* $ Detailed_Input */ /* TYPE is a string indicating the type of terminator to */ /* compute: umbral or penumbral. The umbral */ /* terminator is the boundary of the portion of the */ /* ellipsoid surface in total shadow. The penumbral */ /* terminator is the boundary of the portion of the */ /* surface that is completely illuminated. Possible */ /* values of TYPE are */ /* 'UMBRAL' */ /* 'PENUMBRAL' */ /* Case and leading or trailing blanks in TYPE are */ /* not significant. */ /* A, */ /* B, */ /* C are the lengths of the semi-axes of a triaxial */ /* ellipsoid. The ellipsoid is centered at the */ /* origin and oriented so that its axes lie on the */ /* x, y and z axes. A, B, and C are the lengths of */ /* the semi-axes that point in the x, y, and z */ /* directions respectively. */ /* Length units associated with A, B, and C must */ /* match those associated with SRCRAD, SRCPOS, */ /* and the output TRMPTS. */ /* SRCRAD is the radius of the spherical light source. */ /* SRCPOS is the position of the center of the light source */ /* relative to the center of the ellipsoid. */ /* NPTS is the number of terminator points to compute. */ /* $ Detailed_Output */ /* TRMPTS is an array of points on the umbral or penumbral */ /* terminator of the ellipsoid, as specified by the */ /* input argument TYPE. The Ith point is contained */ /* in the array elements */ /* TRMPTS(J,I), J = 1, 2, 3 */ /* The terminator points are expressed in the */ /* body-fixed reference frame associated with the */ /* ellipsoid. Units are those associated with */ /* the input axis lengths. */ /* Each terminator point is the point of tangency of */ /* a plane that is also tangent to the light source. */ /* These associated points of tangency on the light */ /* source have uniform distribution in longitude when */ /* expressed in a cylindrical coordinate system whose */ /* Z-axis is SRCPOS. The magnitude of the separation */ /* in longitude between these tangency points on the */ /* light source is */ /* 2*Pi / NPTS */ /* If the target is spherical, the terminator points */ /* also are uniformly distributed in longitude in the */ /* cylindrical system described above. If the target */ /* is non-spherical, the longitude distribution of */ /* the points generally is not uniform. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the terminator type is not recognized, the error */ /* SPICE(NOTSUPPORTED) is signaled. */ /* 2) If the set size NPTS is not at least 1, the error */ /* SPICE(INVALIDSIZE) is signaled. */ /* 3) If any of the ellipsoid's semi-axis lengths is non-positive, */ /* the error SPICE(INVALIDAXISLENGTH) is signaled. */ /* 4) If the light source has non-positive radius, the error */ /* SPICE(INVALIDRADIUS) is signaled. */ /* 5) If the light source intersects the smallest sphere */ /* centered at the origin and containing the ellipsoid, the */ /* error SPICE(OBJECTSTOOCLOSE) is signaled. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine models the boundaries of shadow regions on an */ /* ellipsoid "illuminated" by a spherical light source. Light rays */ /* are assumed to travel along straight lines; refraction is not */ /* modeled. */ /* Points on the ellipsoid at which the entire cap of the light */ /* source is visible are considered to be completely illuminated. */ /* Points on the ellipsoid at which some portion (or all) of the cap */ /* of the light source are blocked are considered to be in partial */ /* (or total) shadow. */ /* In this routine, we use the term "umbral terminator" to denote */ /* the curve ususally called the "terminator": this curve is the */ /* boundary of the portion of the surface that lies in total shadow. */ /* We use the term "penumbral terminator" to denote the boundary of */ /* the completely illuminated portion of the surface. */ /* In general, the terminator on an ellipsoid is a more complicated */ /* curve than the limb (which is always an ellipse). Aside from */ /* various special cases, the terminator does not lie in a plane. */ /* However, the condition for a point X on the ellipsoid to lie on */ /* the terminator is simple: a plane tangent to the ellipsoid at X */ /* must also be tangent to the light source. If this tangent plane */ /* does not intersect the vector from the center of the ellipsoid to */ /* the center of the light source, then X lies on the umbral */ /* terminator; otherwise X lies on the penumbral terminator. */ /* $ Examples */ /* See the SPICELIB routine EDTERM. */ /* $ Restrictions */ /* This is a private SPICELIB routine. User applications should not */ /* call this routine. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 03-FEB-2007 (NJB) */ /* -& */ /* $ Index_Entries */ /* find terminator on ellipsoid */ /* find umbral terminator on ellipsoid */ /* find penumbral terminator on ellipsoid */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Standard SPICELIB error handling. */ /* Parameter adjustments */ trmpts_dim2 = *npts; /* Function Body */ if (return_()) { return 0; } chkin_("ZZEDTERM", (ftnlen)8); /* Check the terminator type. */ ljust_(type__, loctyp, type_len, (ftnlen)50); ucase_(loctyp, loctyp, (ftnlen)50, (ftnlen)50); if (s_cmp(loctyp, "UMBRAL", (ftnlen)50, (ftnlen)6) == 0) { umbral = TRUE_; } else if (s_cmp(loctyp, "PENUMBRAL", (ftnlen)50, (ftnlen)9) == 0) { umbral = FALSE_; } else { setmsg_("Terminator type must be UMBRAL or PENUMBRAL but was actuall" "y #.", (ftnlen)63); errch_("#", type__, (ftnlen)1, type_len); sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19); chkout_("ZZEDTERM", (ftnlen)8); return 0; } /* Check the terminator set dimension. */ if (*npts < 1) { setmsg_("Set must contain at least one point; NPTS = #.", (ftnlen)47) ; errint_("#", npts, (ftnlen)1); sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18); chkout_("ZZEDTERM", (ftnlen)8); return 0; } /* The ellipsoid semi-axes must have positive length. */ if (*a <= 0. || *b <= 0. || *c__ <= 0.) { setmsg_("Semi-axis lengths: A = #, B = #, C = #. ", (ftnlen)41); errdp_("#", a, (ftnlen)1); errdp_("#", b, (ftnlen)1); errdp_("#", c__, (ftnlen)1); sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24); chkout_("ZZEDTERM", (ftnlen)8); return 0; } /* Check the input light source radius. */ if (*srcrad <= 0.) { setmsg_("Light source must have positive radius; actual radius was #." , (ftnlen)60); errdp_("#", srcrad, (ftnlen)1); sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20); chkout_("ZZEDTERM", (ftnlen)8); return 0; } /* The light source must not intersect the outer bounding */ /* sphere of the ellipsoid. */ d__ = vnorm_(srcpos); /* Computing MAX */ d__1 = max(*a,*b); rmax = max(d__1,*c__); /* Computing MIN */ d__1 = min(*a,*b); rmin = min(d__1,*c__); if (*srcrad + rmax >= d__) { /* The light source is too close. */ setmsg_("Light source intersects outer bounding sphere of the ellips" "oid. Light source radius = #; ellipsoid's longest axis = #;" " sum = #; distance between centers = #.", (ftnlen)158); errdp_("#", srcrad, (ftnlen)1); errdp_("#", &rmax, (ftnlen)1); d__1 = *srcrad + rmax; errdp_("#", &d__1, (ftnlen)1); errdp_("#", &d__, (ftnlen)1); sigerr_("SPICE(OBJECTSTOOCLOSE)", (ftnlen)22); chkout_("ZZEDTERM", (ftnlen)8); return 0; } /* Find bounds on the angular size of the target as seen */ /* from the source. */ /* Computing MIN */ d__1 = rmax / d__; minang = asin((min(d__1,1.))); /* Computing MIN */ d__1 = rmin / d__; maxang = asin((min(d__1,1.))); /* Let the inverse of the ellipsoid-light source vector be the */ /* Z-axis of a frame we'll use to generate the terminator set. */ vminus_(srcpos, z__); frame_(z__, x, y); /* Create the rotation matrix required to convert vectors */ /* from the source-centered frame back to the target body-fixed */ /* frame. */ vequ_(x, trans); vequ_(y, &trans[3]); vequ_(z__, &trans[6]); /* Find the maximum and minimum target radii. */ /* Computing MAX */ d__1 = max(*a,*b); maxrad = max(d__1,*c__); /* Computing MIN */ d__1 = min(*a,*b); minrad = min(d__1,*c__); if (umbral) { /* Compute the angular offsets from the axis of rays tangent to */ /* both the source and the bounding spheres of the target, where */ /* the tangency points lie in a half-plane bounded by the line */ /* containing the origin and SRCPOS. (We'll call this line */ /* the "axis.") */ /* OUTANG corresponds to the target's outer bounding sphere; */ /* INANG to the inner bounding sphere. */ outang = asin((*srcrad - maxrad) / d__); inang = asin((*srcrad - minrad) / d__); } else { /* Compute the angular offsets from the axis of rays tangent to */ /* both the source and the bounding spheres of the target, where */ /* the tangency points lie in opposite half-planes bounded by the */ /* axis (compare the case above). */ /* OUTANG corresponds to the target's outer bounding sphere; */ /* INANG to the inner bounding sphere. */ outang = asin((*srcrad + maxrad) / d__); inang = asin((*srcrad + minrad) / d__); } /* Compute the angular delta we'll use for generating */ /* terminator points. */ delta = twopi_() / *npts; /* Generate the terminator points. */ i__1 = *npts; for (i__ = 1; i__ <= i__1; ++i__) { theta = (i__ - 1) * delta; /* Let SRCPT be the surface point on the source lying in */ /* the X-Y plane of the frame produced by FRAME */ /* and corresponding to the angle THETA. */ latrec_(srcrad, &theta, &c_b30, srcpt); /* Now solve for the angle by which SRCPT must be rotated (toward */ /* +Z in the umbral case, away from +Z in the penumbral case) */ /* so that a plane tangent to the source at SRCPT is also tangent */ /* to the target. The rotation is bracketed by OUTANG on the low */ /* side and INANG on the high side in the umbral case; the */ /* bracketing values are reversed in the penumbral case. */ if (umbral) { angle = outang; } else { angle = inang; } prvdif = twopi_(); prvang = angle + halfpi_(); nitr = 0; for(;;) { /* while(complicated condition) */ d__2 = (d__1 = angle - prvang, abs(d__1)); if (!(nitr <= 10 && touchd_(&d__2) < prvdif)) break; ++nitr; d__2 = (d__1 = angle - prvang, abs(d__1)); prvdif = touchd_(&d__2); prvang = angle; /* Find the closest point on the ellipsoid to the plane */ /* corresponding to "ANGLE". */ /* The tangent point on the source is obtained by rotating */ /* SRCPT by ANGLE towards +Z. The plane's normal vector is */ /* parallel to VTX in the source-centered frame. */ latrec_(srcrad, &theta, &angle, vtx); vequ_(vtx, dir); /* VTX and DIR are expressed in the source-centered frame. We */ /* must translate VTX to the target frame and rotate both */ /* vectors into that frame. */ mxv_(trans, vtx, vtemp); vadd_(srcpos, vtemp, vtx); mxv_(trans, dir, vtemp); vequ_(vtemp, dir); /* Create the plane defined by VTX and DIR. */ nvp2pl_(dir, vtx, plane); /* Find the closest point on the ellipsoid to the plane. At */ /* the point we seek, the outward normal on the ellipsoid is */ /* parallel to the choice of plane normal that points away */ /* from the origin. We can always obtain this choice from */ /* PL2NVC. */ pl2nvc_(plane, dir, &plcons); /* At the point */ /* E = (x, y, z) */ /* on the ellipsoid's surface, an outward normal */ /* is */ /* N = ( x/A**2, y/B**2, z/C**2 ) */ /* which is also */ /* lambda * ( DIR(1), DIR(2), DIR(3) ) */ /* Equating components in the normal vectors yields */ /* E = lambda * ( DIR(1)*A**2, DIR(2)*B**2, DIR(3)*C**2 ) */ /* Taking the inner product with the point E itself and */ /* applying the ellipsoid equation, we find */ /* lambda * <DIR, E> = < N, E > = 1 */ /* The first term above is */ /* lambda**2 * || ( A*DIR(1), B*DIR(2), C*DIR(3) ) ||**2 */ /* So the positive root lambda is */ /* 1 / || ( A*DIR(1), B*DIR(2), C*DIR(3) ) || */ /* Having lambda we can compute E. */ d__1 = *a * dir[0]; d__2 = *b * dir[1]; d__3 = *c__ * dir[2]; vpack_(&d__1, &d__2, &d__3, v); lambda = 1. / vnorm_(v); d__1 = *a * v[0]; d__2 = *b * v[1]; d__3 = *c__ * v[2]; vpack_(&d__1, &d__2, &d__3, e); vscl_(&lambda, e, &trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 && 0 <= i__2 ? i__2 : s_rnge("trmpts", i__2, "zzedterm_", (ftnlen)586)]); /* Make a new estimate of the plane rotation required to touch */ /* the target. */ vsub_(&trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 && 0 <= i__2 ? i__2 : s_rnge("trmpts", i__2, "zzedterm_", (ftnlen)592)] , vtx, offset); /* Let ANGERR be an estimate of the magnitude of angular error */ /* between the plane and the terminator. */ angerr = vsep_(dir, offset) - halfpi_(); /* Let S indicate the sign of the altitude error: where */ /* S is positive, the plane is above E. */ d__1 = vdot_(e, dir); s = d_sign(&c_b35, &d__1); if (umbral) { /* If the plane is above the target, increase the */ /* rotation angle; otherwise decrease the angle. */ angle += s * angerr; } else { /* This is the penumbral case; decreasing the angle */ /* "lowers" the plane toward the target. */ angle -= s * angerr; } } } chkout_("ZZEDTERM", (ftnlen)8); return 0; } /* zzedterm_ */
/* $Procedure SPKLTC ( S/P Kernel, light time corrected state ) */ /* Subroutine */ int spkltc_(integer *targ, doublereal *et, char *ref, char * abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len) { /* Initialized data */ static logical pass1 = TRUE_; static char prvcor[5] = " "; /* System generated locals */ doublereal d__1, d__2, d__3, d__4; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ doublereal dist; extern doublereal vdot_(doublereal *, doublereal *); static logical xmit; extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen); doublereal a, b, c__; integer i__, refid; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal epoch; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); static logical usecn; extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *, integer *, doublereal *); doublereal ssblt, lterr; static logical uselt; extern doublereal vnorm_(doublereal *); doublereal prvlt; extern logical failed_(void); extern doublereal clight_(void); logical attblk[15]; extern doublereal touchd_(doublereal *); extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); integer ltsign; extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_( char *, ftnlen); doublereal ssbtrg[6]; integer numitr; extern logical return_(void); logical usestl; /* $ Abstract */ /* Return the state (position and velocity) of a target body */ /* relative to an observer, optionally corrected for light time, */ /* expressed relative to an inertial reference 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 */ /* SPK */ /* $ Keywords */ /* EPHEMERIS */ /* $ Declarations */ /* $ 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 */ /* -------- --- -------------------------------------------------- */ /* TARG I Target body. */ /* ET I Observer epoch. */ /* REF I Inertial reference frame of output state. */ /* ABCORR I Aberration correction flag. */ /* STOBS I State of the observer relative to the SSB. */ /* STARG O State of target. */ /* LT O One way light time between observer and target. */ /* DLT O Derivative of light time with respect to time. */ /* $ 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 input state STOBS and the output state STARG are */ /* 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. */ /* ABCORR indicates the aberration corrections to be applied to */ /* the state of the target body to account for one-way */ /* light time. See the discussion in the Particulars */ /* section for recommendations on how to choose */ /* aberration corrections. */ /* If ABCORR includes the stellar aberration correction */ /* symbol '+S', this flag is simply ignored. Aside from */ /* the possible presence of this symbol, 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. */ /* '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. */ /* 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. */ /* 'XCN' "Transmission" case: converged */ /* Newtonian light time 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. */ /* STOBS is the geometric (uncorrected) state of the observer */ /* relative to the solar system barycenter at epoch ET. */ /* STOBS is a 6-vector: the first three components of */ /* STOBS represent a Cartesian position vector; the last */ /* three components represent the corresponding velocity */ /* vector. STOBS is expressed relative to the inertial */ /* reference frame designated by REF. */ /* Units are always km and km/sec. */ /* $ 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 aberration, 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. */ /* 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 light time, then LT is the one-way light time */ /* between the observer and the light time-corrected */ /* target location. */ /* DLT is the derivative with respect to barycentric */ /* dynamical time of the one way light time between */ /* target and observer: */ /* DLT = d(LT)/d(ET) */ /* DLT can also be described as the rate of change of */ /* one way light time. DLT is unitless, since LT and */ /* ET both have units of TDB seconds. */ /* If the observer and target are at the same position, */ /* then DLT is set to zero. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) For the convenience of the caller, the input aberration */ /* correction flag can call for stellar aberration correction via */ /* inclusion of the '+S' suffix. This portion of the aberration */ /* correction flag is ignored if present. */ /* 2) If the value of ABCORR is not recognized, the error */ /* is diagnosed by a routine in the call tree of this */ /* routine. */ /* 3) If the reference frame requested is not a recognized */ /* inertial reference frame, the error SPICE(BADFRAME) */ /* is signaled. */ /* 4) 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. */ /* 5) If the observer and target are at the same position, */ /* then DLT is set to zero. This situation could arise, */ /* for example, when the observer is Mars and the target */ /* is the Mars barycenter. */ /* 6) If a division by zero error would occur in the computation */ /* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */ /* $ 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 */ /* This routine supports higher-level SPK API routines that can */ /* perform both light time and stellar aberration corrections. */ /* User applications normally will not need to call this routine */ /* directly. */ /* See the header of the routine SPKEZR for a detailed discussion */ /* of aberration corrections. */ /* $ Examples */ /* The numerical results shown for this example may differ across */ /* platforms. The results depend on the SPICE kernels used as */ /* input, the compiler and supporting libraries, and the machine */ /* specific arithmetic implementation. */ /* 1) Look up a sequence of states of the Moon as seen from the */ /* Earth. Use light time corrections. Compute the first state for */ /* the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */ /* intervals of 1 hour. For each epoch, display the states, the */ /* one way light time between target and observer, and the rate of */ /* change of the one way light time. */ /* Use the following meta-kernel to specify the kernels to */ /* load: */ /* KPL/MK */ /* File name: spkltc.tm */ /* This meta-kernel is intended to support operation of SPICE */ /* example programs. The kernels shown here should not be */ /* assumed to contain adequate or correct versions of data */ /* required by SPICE-based user applications. */ /* In order for an application to use this meta-kernel, the */ /* kernels referenced here must be present in the user's */ /* current working directory. */ /* \begindata */ /* KERNELS_TO_LOAD = ( 'de421.bsp', */ /* 'pck00010.tpc', */ /* 'naif0010.tls' ) */ /* \begintext */ /* The code example follows: */ /* PROGRAM EX1 */ /* IMPLICIT NONE */ /* C */ /* C Local constants */ /* C */ /* C The meta-kernel name shown here refers to a file whose */ /* C contents are those shown above. This file and the kernels */ /* C it references must exist in your current working directory. */ /* C */ /* CHARACTER*(*) META */ /* PARAMETER ( META = 'spkltc.tm' ) */ /* C */ /* C Use a time step of 1 hour; look up 5 states. */ /* C */ /* DOUBLE PRECISION STEP */ /* PARAMETER ( STEP = 3600.0D0 ) */ /* INTEGER MAXITR */ /* PARAMETER ( MAXITR = 5 ) */ /* C */ /* C Local variables */ /* C */ /* DOUBLE PRECISION DLT */ /* DOUBLE PRECISION ET */ /* DOUBLE PRECISION ET0 */ /* DOUBLE PRECISION LT */ /* DOUBLE PRECISION STATE ( 6 ) */ /* DOUBLE PRECISION STOBS ( 6 ) */ /* INTEGER I */ /* C */ /* C Load the SPK and LSK kernels via the meta-kernel. */ /* C */ /* CALL FURNSH ( META ) */ /* C */ /* C Convert the start time to seconds past J2000 TDB. */ /* C */ /* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */ /* C */ /* C Step through a series of epochs, looking up a */ /* C state vector at each one. */ /* C */ /* DO I = 1, MAXITR */ /* ET = ET0 + (I-1)*STEP */ /* C */ /* C Look up a state vector at epoch ET using the */ /* C following inputs: */ /* C */ /* C Target: Moon (NAIF ID code 301) */ /* C Reference frame: J2000 */ /* C Aberration correction: Light time ('LT') */ /* C Observer: Earth (NAIF ID code 399) */ /* C */ /* C Before we can execute this computation, we'll need the */ /* C geometric state of the observer relative to the solar */ /* C system barycenter at ET, expressed relative to the */ /* C J2000 reference frame: */ /* C */ /* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */ /* C */ /* C Now compute the desired state vector: */ /* C */ /* CALL SPKLTC ( 301, ET, 'J2000', 'LT', */ /* . STOBS, STATE, LT, DLT ) */ /* WRITE (*,*) 'ET = ', ET */ /* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */ /* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */ /* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */ /* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */ /* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */ /* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */ /* WRITE (*,*) 'One-way light time (s): ', LT */ /* WRITE (*,*) 'Light time rate: ', DLT */ /* WRITE (*,*) ' ' */ /* END DO */ /* END */ /* On a PC/Linux/gfortran platform, the following output was */ /* produced: */ /* ET = 0.0000000000000000 */ /* J2000 x-position (km): -291569.26541282982 */ /* J2000 y-position (km): -266709.18647825718 */ /* J2000 z-position (km): -76099.155118763447 */ /* J2000 x-velocity (km/s): 0.64353061322177041 */ /* J2000 y-velocity (km/s): -0.66608181700820079 */ /* J2000 z-velocity (km/s): -0.30132283179625752 */ /* One-way light time (s): 1.3423106103251679 */ /* Light time rate: 1.07316908698977495E-007 */ /* ET = 3600.0000000000000 */ /* J2000 x-position (km): -289240.78128184378 */ /* J2000 y-position (km): -269096.44087958336 */ /* J2000 z-position (km): -77180.899725757539 */ /* J2000 x-velocity (km/s): 0.65006211520087476 */ /* J2000 y-velocity (km/s): -0.66016273921695667 */ /* J2000 z-velocity (km/s): -0.29964267390571342 */ /* One-way light time (s): 1.3426939548635302 */ /* Light time rate: 1.05652598952224259E-007 */ /* ET = 7200.0000000000000 */ /* J2000 x-position (km): -286888.88736709207 */ /* J2000 y-position (km): -271462.30170547962 */ /* J2000 z-position (km): -78256.555682137609 */ /* J2000 x-velocity (km/s): 0.65653599154284592 */ /* J2000 y-velocity (km/s): -0.65419657680401588 */ /* J2000 z-velocity (km/s): -0.29794027307420823 */ /* One-way light time (s): 1.3430713117337547 */ /* Light time rate: 1.03990456898758609E-007 */ /* ET = 10800.000000000000 */ /* J2000 x-position (km): -284513.79173691198 */ /* J2000 y-position (km): -273806.60031034052 */ /* J2000 z-position (km): -79326.043183274567 */ /* J2000 x-velocity (km/s): 0.66295190054599118 */ /* J2000 y-velocity (km/s): -0.64818380709706158 */ /* J2000 z-velocity (km/s): -0.29621577937090349 */ /* One-way light time (s): 1.3434426890693671 */ /* Light time rate: 1.02330665243423737E-007 */ /* ET = 14400.000000000000 */ /* J2000 x-position (km): -282115.70368389413 */ /* J2000 y-position (km): -276129.16976799071 */ /* J2000 z-position (km): -80389.282965712249 */ /* J2000 x-velocity (km/s): 0.66930950377548726 */ /* J2000 y-velocity (km/s): -0.64212490805688027 */ /* J2000 z-velocity (km/s): -0.29446934336246899 */ /* One-way light time (s): 1.3438080956559786 */ /* Light time rate: 1.00673403630050830E-007 */ /* $ Restrictions */ /* 1) The routine SPKGEO should be used instead of this routine */ /* to compute geometric states. SPKGEO introduces less */ /* round-off error when the observer and target have common */ /* center that is closer to both objects than is the solar */ /* system barycenter. */ /* 2) The kernel files to be used by SPKLTC must be loaded */ /* (normally by the SPICELIB kernel loader FURNSH) before */ /* this routine is called. */ /* 3) Unlike most other SPK state computation routines, this */ /* routine requires that the output state be relative to an */ /* inertial reference frame. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 04-JUL-2014 (NJB) */ /* Discussion of light time corrections was updated. Assertions */ /* that converged light time corrections are unlikely to be */ /* useful were removed. */ /* Last update was 02-MAY-2012 (NJB) */ /* Updated to ensure convergence when CN or XCN light time */ /* corrections are used. The new algorithm also terminates early */ /* (after fewer than three iterations) when convergence is */ /* attained. */ /* Call to ZZPRSCOR was replaced by a call to ZZVALCOR. */ /* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */ /* -& */ /* $ Index_Entries */ /* low-level light time correction */ /* light-time corrected state from spk file */ /* get light-time corrected state */ /* -& */ /* $ Revisions */ /* None. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* TOL is the tolerance used for a division-by-zero test */ /* performed prior to computation of DLT. */ /* Convergence limit: */ /* Maximum number of light time iterations for any */ /* aberration correction: */ /* Local variables */ /* Saved variables */ /* Initial values */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("SPKLTC", (ftnlen)6); } if (pass1 || 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. */ zzvalcor_(abcorr, attblk, abcorr_len); if (failed_()) { chkout_("SPKLTC", (ftnlen)6); 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 is .TRUE. when the correction is for transmitted */ /* radiation. */ /* USELT is .TRUE. when any type of light time correction */ /* (normal or converged Newtonian) is specified. */ /* USECN indicates converged Newtonian light time correction. */ /* The above definitions are consistent with those used by */ /* ZZVALCOR. */ xmit = attblk[4]; uselt = attblk[1]; usecn = attblk[3]; usestl = attblk[2]; pass1 = 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_("SPKLTC", (ftnlen)6); return 0; } /* 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. */ spkgeo_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len); if (failed_()) { chkout_("SPKLTC", (ftnlen)6); return 0; } vsubg_(ssbtrg, stobs, &c__6, starg); dist = vnorm_(starg); *lt = dist / clight_(); if (*lt == 0.) { /* This can happen only if the observer and target are at the */ /* same position. We don't consider this an error, but we're not */ /* going to compute the light time derivative. */ *dlt = 0.; chkout_("SPKLTC", (ftnlen)6); return 0; } if (! uselt) { /* This is a special case: we're not using light time */ /* corrections, so the derivative */ /* of light time is just */ /* (1/c) * d(VNORM(STARG))/dt */ *dlt = vdot_(starg, &starg[3]) / (dist * clight_()); /* LT and DLT are both set, so we can return. */ chkout_("SPKLTC", (ftnlen)6); return 0; } /* 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 it is. */ /* Determine the sign of the light time offset. */ if (xmit) { ltsign = 1; } else { ltsign = -1; } /* Let NUMITR be the number of iterations we'll perform to */ /* compute the light time. */ if (usecn) { numitr = 5; } else { numitr = 1; } i__ = 0; lterr = 1.; while(i__ < numitr && lterr > 1e-17) { /* LT was set either prior to this loop or */ /* during the previous loop iteration. */ epoch = *et + ltsign * *lt; spkgeo_(targ, &epoch, ref, &c__0, ssbtrg, &ssblt, ref_len); if (failed_()) { chkout_("SPKLTC", (ftnlen)6); return 0; } vsubg_(ssbtrg, stobs, &c__6, starg); prvlt = *lt; d__1 = vnorm_(starg) / clight_(); *lt = touchd_(&d__1); /* LTERR is the magnitude of the change between the current */ /* estimate of light time and the previous estimate, relative to */ /* the previous light time corrected epoch. */ /* Computing MAX */ d__3 = 1., d__4 = abs(epoch); d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4); lterr = touchd_(&d__2); ++i__; } /* At this point, STARG contains the light time corrected */ /* state of the target relative to the observer. */ /* Compute the derivative of light time with respect */ /* to time: dLT/dt. Below we derive the formula for */ /* this quantity for the reception case. Let */ /* POBS be the position of the observer relative to the */ /* solar system barycenter. */ /* VOBS be the velocity of the observer relative to the */ /* solar system barycenter. */ /* PTARG be the position of the target relative to the */ /* solar system barycenter. */ /* VTARG be the velocity of the target relative to the */ /* solar system barycenter. */ /* S be the sign of the light time correction. S is */ /* negative for the reception case. */ /* The light-time corrected position of the target relative to */ /* the observer at observation time ET, given the one-way */ /* light time LT is: */ /* PTARG(ET+S*LT) - POBS(ET) */ /* The light-time corrected velocity of the target relative to */ /* the observer at observation time ET is */ /* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */ /* We need to compute dLT/dt. Below, we use the facts that, */ /* for a time-dependent vector X(t), */ /* ||X|| = <X,X> ** (1/2) */ /* d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */ /* = <X,X>**(-1/2) * <X,dX/dt> */ /* = <X,dX/dt> / ||X|| */ /* Newtonian light time equation: */ /* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */ /* Differentiate both sides: */ /* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* * < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */ /* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* * ( < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT) - VOBS(ET) > */ /* + < PTARG(ET+S*LT) - POBS(ET), */ /* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */ /* Let */ /* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */ /* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */ /* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */ /* Then */ /* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */ /* which implies */ /* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */ a = 1. / (clight_() * vnorm_(starg)); b = vdot_(starg, &starg[3]); c__ = vdot_(starg, &ssbtrg[3]); /* For physically realistic target velocities, S*C*A cannot equal 1. */ /* We'll check for this case anyway. */ if (ltsign * c__ * a > .99999999989999999) { setmsg_("Target range rate magnitude is approximately the speed of l" "ight. The light time derivative cannot be computed.", (ftnlen) 110); sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); chkout_("SPKLTC", (ftnlen)6); return 0; } /* Compute DLT: the rate of change of light time. */ *dlt = a * b / (1. - ltsign * c__ * a); /* Overwrite the velocity portion of the output state */ /* with the light-time corrected velocity. */ d__1 = ltsign * *dlt + 1.; vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]); chkout_("SPKLTC", (ftnlen)6); return 0; } /* spkltc_ */
/* $Procedure ZZSTELAB ( Private --- stellar aberration correction ) */ /* Subroutine */ int zzstelab_(logical *xmit, doublereal *accobs, doublereal * vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr) { /* System generated locals */ integer i__1; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); integer s_rnge(char *, integer, char *, integer); /* Local variables */ extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal * ); doublereal dphi, rhat[3]; extern /* Subroutine */ int vhat_(doublereal *, doublereal *); extern doublereal vdot_(doublereal *, doublereal *); extern /* Subroutine */ int vequ_(doublereal *, doublereal *); doublereal term1[3], term2[3], term3[3], c__, lcacc[3]; integer i__; doublereal s; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal saoff[6] /* was [3][2] */, drhat[3]; extern /* Subroutine */ int dvhat_(doublereal *, doublereal *); doublereal ptarg[3], evobs[3], srhat[6], vphat[3], vtarg[3]; extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), vperp_(doublereal *, doublereal *, doublereal *); extern doublereal vnorm_(doublereal *); extern logical vzero_(doublereal *); extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), cleard_(integer *, doublereal *); doublereal vp[3]; extern doublereal clight_(void); doublereal dptmag, ptgmag, eptarg[3], dvphat[3], lcvobs[3]; extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_( char *, ftnlen), setmsg_(char *, ftnlen); doublereal svphat[6]; extern logical return_(void); extern /* Subroutine */ int vminus_(doublereal *, doublereal *); doublereal sgn, dvp[3], svp[6]; /* $ 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 (position and velocity) of a target body */ /* relative to an observing body, optionally corrected for light */ /* time (planetary aberration) 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 */ /* -------- --- -------------------------------------------------- */ /* XMIT I Reception/transmission flag. */ /* ACCOBS I Observer acceleration relative to SSB. */ /* VOBS I Observer velocity relative to to SSB. */ /* STARG I State of target relative to observer. */ /* SCORR O Stellar aberration correction for position. */ /* DSCORR O Stellar aberration correction for velocity. */ /* $ Detailed_Input */ /* XMIT is a logical flag which is set to .TRUE. for the */ /* "transmission" case in which photons *depart* from */ /* the observer's location at an observation epoch ET */ /* and arrive at the target's location at the light-time */ /* corrected epoch ET+LT, where LT is the one-way light */ /* time between observer and target; XMIT is set to */ /* .FALSE. for "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. */ /* Note that the observation epoch is not used in this */ /* routine. */ /* XMIT must be consistent with any light time */ /* corrections used for the input state STARG: if that */ /* state has been corrected for "reception" light time; */ /* XMIT must be .FALSE.; otherwise XMIT must be .TRUE. */ /* ACCOBS is the geometric acceleration of the observer */ /* relative to the solar system barycenter. Units are */ /* km/sec**2. ACCOBS must be expressed relative to */ /* an inertial reference frame. */ /* VOBS is the geometric velocity of the observer relative to */ /* the solar system barycenter. VOBS must be expressed */ /* relative to the same inertial reference frame as */ /* ACCOBS. Units are km/sec. */ /* STARG is the Cartesian state of the target relative to the */ /* observer. Normally STARG has been corrected for */ /* one-way light time, but this is not required. STARG */ /* must be expressed relative to the same inertial */ /* reference frame as ACCOBS. Components are */ /* (x, y, z, dx, dy, dz). Units are km and km/sec. */ /* $ Detailed_Output */ /* SCORR is the stellar aberration correction for the position */ /* component of STARG. Adding SCORR to this position */ /* vector produces the input observer-target position, */ /* corrected for stellar aberration. */ /* The reference frame of SCORR is the common frame */ /* relative to which the inputs ACCOBS, VOBS, and STARG */ /* are expressed. Units are km. */ /* DSCORR is the stellar aberration correction for the velocity */ /* component of STARG. Adding DSCORR to this velocity */ /* vector produces the input observer-target velocity, */ /* corrected for stellar aberration. */ /* The reference frame of DSCORR is the common frame */ /* relative to which the inputs ACCOBS, VOBS, and STARG */ /* are expressed. Units are km/s. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If attempt to divide by zero occurs, the error */ /* SPICE(DIVIDEBYZERO) will be signaled. This case may occur */ /* due to uninitialized inputs. */ /* 2) Loss of precision will occur for geometric cases in which */ /* VOBS is nearly parallel to the position component of STARG. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine computes a Newtonian estimate of the stellar */ /* aberration correction of an input state. Normally the input state */ /* has already been corrected for one-way light time. */ /* Since stellar aberration corrections are typically "small" */ /* relative to the magnitude of the input observer-target position */ /* and velocity, this routine avoids loss of precision by returning */ /* the corrections themselves rather than the corrected state */ /* vector. This allows the caller to manipulate (for example, */ /* interpolate) the corrections with greater accuracy. */ /* $ Examples */ /* See SPICELIB routine SPKACS. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* SPK Required Reading. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 15-APR-2014 (NJB) */ /* Added RETURN test and discovery check-in. */ /* Check for division by zero was added. This */ /* case might occur due to uninitialized inputs. */ /* - SPICELIB Version 1.0.1, 12-FEB-2009 (NJB) */ /* Minor updates were made to the inline documentation. */ /* - SPICELIB Version 1.0.0, 17-JAN-2008 (NJB) */ /* -& */ /* Note for the maintenance programmer */ /* =================================== */ /* The source code of the test utility T_ZZSTLABN must be */ /* kept in sync with the source code of this routine. That */ /* routine uses a value of SEPLIM that forces the numeric */ /* branch of the velocity computation to be taken in all */ /* cases. See the documentation of that routine for details. */ /* SPICELIB functions */ /* Local parameters */ /* Let PHI be the (non-negative) rotation angle of the stellar */ /* aberration correction; then SEPLIM is a limit on how close PHI */ /* may be to zero radians while stellar aberration velocity is */ /* computed analytically. When sin(PHI) is less than SEPLIM, the */ /* velocity must be computed numerically. */ /* Let TDELTA be the time interval, measured in seconds, */ /* used for numerical differentiation of the stellar */ /* aberration correction, when this is necessary. */ /* Local variables */ /* Use discovery check-in. */ if (return_()) { return 0; } /* In the discussion below, the dot product of vectors X and Y */ /* is denoted by */ /* <X,Y> */ /* The speed of light is denoted by the lower case letter "c." BTW, */ /* variable names used here are case-sensitive: upper case "C" */ /* represents a different quantity which is unrelated to the speed */ /* of light. */ /* Variable names ending in "HAT" denote unit vectors. Variable */ /* names starting with "D" denote derivatives with respect to time. */ /* We'll compute the correction SCORR and its derivative with */ /* respect to time DSCORR for the reception case. In the */ /* transmission case, we perform the same computation with the */ /* negatives of the observer velocity and acceleration. */ /* In the code below, we'll store the position and velocity portions */ /* of the input observer-target state STARG in the variables PTARG */ /* and VTARG, respectively. */ /* Let VP be the component of VOBS orthogonal to PTARG. VP */ /* is defined as */ /* VOBS - < VOBS, RHAT > RHAT (1) */ /* where RHAT is the unit vector */ /* PTARG/||PTARG|| */ /* Then */ /* ||VP||/c (2) */ /* is the magnitude of */ /* s = sin( phi ) (3) */ /* where phi is the stellar aberration correction angle. We'll */ /* need the derivative with respect to time of (2). */ /* Differentiating (1) with respect to time yields the */ /* velocity DVP, where, letting */ /* DRHAT = d(RHAT) / dt */ /* VPHAT = VP / ||VP|| */ /* DVPMAG = d( ||VP|| ) / dt */ /* we have */ /* DVP = d(VP)/dt */ /* = ACCOBS - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */ /* + <VOBS,RHAT> * DRHAT ) (4) */ /* and */ /* DVPMAG = < DVP, VPHAT > (5) */ /* Now we can find the derivative with respect to time of */ /* the stellar aberration angle phi: */ /* ds/dt = d(sin(phi))/dt = d(phi)/dt * cos(phi) (6) */ /* Using (2) and (5), we have for positive phi, */ /* ds/dt = (1/c)*DVPMAG = (1/c)*<DVP, VPHAT> (7) */ /* Then for positive phi */ /* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> (8) */ /* Equation (8) is well-defined as along as VP is non-zero: */ /* if VP is the zero vector, VPHAT is undefined. We'll treat */ /* the singular and near-singular cases separately. */ /* The aberration correction itself is a rotation by angle phi */ /* from RHAT towards VP, so the corrected vector is */ /* ( sin(phi)*VPHAT + cos(phi)*RHAT ) * ||PTARG|| */ /* and we can express the offset of the corrected vector from */ /* PTARG, which is the output SCORR, as */ /* SCORR = */ /* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| (9) */ /* Let DPTMAG be defined as */ /* DPTMAG = d ( ||PTARG|| ) / dt (10) */ /* Then the derivative with respect to time of SCORR is */ /* DSCORR = */ /* ( sin(phi)*DVPHAT */ /* + cos(phi)*d(phi)/dt * VPHAT */ /* + (cos(phi) - 1) * DRHAT */ /* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */ /* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG (11) */ /* Computations begin here: */ /* Split STARG into position and velocity components. Compute */ /* RHAT */ /* DRHAT */ /* VP */ /* DPTMAG */ if (*xmit) { vminus_(vobs, lcvobs); vminus_(accobs, lcacc); } else { vequ_(vobs, lcvobs); vequ_(accobs, lcacc); } vequ_(starg, ptarg); vequ_(&starg[3], vtarg); dvhat_(starg, srhat); vequ_(srhat, rhat); vequ_(&srhat[3], drhat); vperp_(lcvobs, rhat, vp); dptmag = vdot_(vtarg, rhat); /* Compute sin(phi) and cos(phi), which we'll call S and C */ /* respectively. Note that phi is always close to zero for */ /* realistic inputs (for which ||VOBS|| << CLIGHT), so the */ /* cosine term is positive. */ s = vnorm_(vp) / clight_(); /* Computing MAX */ d__1 = 0., d__2 = 1 - s * s; c__ = sqrt((max(d__1,d__2))); if (c__ == 0.) { /* C will be used as a divisor later (in the computation */ /* of DPHI), so we'll put a stop to the problem here. */ chkin_("ZZSTELAB", (ftnlen)8); setmsg_("Cosine of the aberration angle is 0; this cannot occur for " "realistic observer velocities. This case can arise due to un" "initialized inputs. This cosine value is used as a divisor i" "n a later computation, so it must not be equal to zero.", ( ftnlen)234); sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19); chkout_("ZZSTELAB", (ftnlen)8); return 0; } /* Compute the unit vector VPHAT and the stellar */ /* aberration correction. We avoid relying on */ /* VHAT's exception handling for the zero vector. */ if (vzero_(vp)) { cleard_(&c__3, vphat); } else { vhat_(vp, vphat); } /* Now we can use equation (9) to obtain the stellar */ /* aberration correction SCORR: */ /* SCORR = */ /* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| */ ptgmag = vnorm_(ptarg); d__1 = ptgmag * s; d__2 = ptgmag * (c__ - 1.); vlcom_(&d__1, vphat, &d__2, rhat, scorr); /* Now we use S as an estimate of PHI to decide if we're */ /* going to differentiate the stellar aberration correction */ /* analytically or numerically. */ /* Note that S is non-negative by construction, so we don't */ /* need to use the absolute value of S here. */ if (s >= 1e-6) { /* This is the analytic case. */ /* Compute DVP---the derivative of VP with respect to time. */ /* Recall equation (4): */ /* DVP = d(VP)/dt */ /* = ACCOBS - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */ /* + <VOBS,RHAT> * DRHAT ) */ d__1 = -vdot_(lcvobs, drhat) - vdot_(lcacc, rhat); d__2 = -vdot_(lcvobs, rhat); vlcom3_(&c_b7, lcacc, &d__1, rhat, &d__2, drhat, dvp); vhat_(vp, vphat); /* Now we can compute DVPHAT, the derivative of VPHAT: */ vequ_(vp, svp); vequ_(dvp, &svp[3]); dvhat_(svp, svphat); vequ_(&svphat[3], dvphat); /* Compute the DPHI, the time derivative of PHI, using equation 8: */ /* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> */ dphi = 1. / (c__ * clight_()) * vdot_(dvp, vphat); /* At long last we've assembled all of the "ingredients" required */ /* to compute DSCORR: */ /* DSCORR = */ /* ( sin(phi)*DVPHAT */ /* + cos(phi)*d(phi)/dt * VPHAT */ /* + (cos(phi) - 1) * DRHAT */ /* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */ /* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG */ d__1 = c__ * dphi; vlcom_(&s, dvphat, &d__1, vphat, term1); d__1 = c__ - 1.; d__2 = -s * dphi; vlcom_(&d__1, drhat, &d__2, rhat, term2); vadd_(term1, term2, term3); d__1 = dptmag * s; d__2 = dptmag * (c__ - 1.); vlcom3_(&ptgmag, term3, &d__1, vphat, &d__2, rhat, dscorr); } else { /* This is the numeric case. We're going to differentiate */ /* the stellar aberration correction offset vector using */ /* a quadratic estimate. */ for (i__ = 1; i__ <= 2; ++i__) { /* Set the sign of the time offset. */ if (i__ == 1) { sgn = -1.; } else { sgn = 1.; } /* Estimate the observer's velocity relative to the */ /* solar system barycenter at the current epoch. We use */ /* the local copies of the input velocity and acceleration */ /* to make a linear estimate. */ d__1 = sgn * 1.; vlcom_(&c_b7, lcvobs, &d__1, lcacc, evobs); /* Estimate the observer-target vector. We use the */ /* observer-target state velocity to make a linear estimate. */ d__1 = sgn * 1.; vlcom_(&c_b7, starg, &d__1, &starg[3], eptarg); /* Let RHAT be the unit observer-target position. */ /* Compute the component of the observer's velocity */ /* that is perpendicular to the target position; call */ /* this vector VP. Also compute the unit vector in */ /* the direction of VP. */ vhat_(eptarg, rhat); vperp_(evobs, rhat, vp); if (vzero_(vp)) { cleard_(&c__3, vphat); } else { vhat_(vp, vphat); } /* Compute the sine and cosine of the correction */ /* angle. */ s = vnorm_(vp) / clight_(); /* Computing MAX */ d__1 = 0., d__2 = 1 - s * s; c__ = sqrt((max(d__1,d__2))); /* Compute the vector offset of the correction. */ ptgmag = vnorm_(eptarg); d__1 = ptgmag * s; d__2 = ptgmag * (c__ - 1.); vlcom_(&d__1, vphat, &d__2, rhat, &saoff[(i__1 = i__ * 3 - 3) < 6 && 0 <= i__1 ? i__1 : s_rnge("saoff", i__1, "zzstelab_", ( ftnlen)597)]); } /* Now compute the derivative. */ qderiv_(&c__3, saoff, &saoff[3], &c_b7, dscorr); } /* At this point the correction offset SCORR and its derivative */ /* with respect to time DSCORR are both set. */ return 0; } /* zzstelab_ */
/* $Procedure INRYPL ( Intersection of ray and plane ) */ /* Subroutine */ int inrypl_(doublereal *vertex, doublereal *dir, doublereal * plane, integer *nxpts, doublereal *xpt) { /* System generated locals */ doublereal d__1, d__2; /* Local variables */ doublereal udir[3]; extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_( doublereal *, doublereal *, doublereal *); extern doublereal vdot_(doublereal *, doublereal *); extern /* Subroutine */ int vequ_(doublereal *, doublereal *); doublereal scale; extern /* Subroutine */ int chkin_(char *, ftnlen); extern doublereal dpmax_(void); extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal const__, prjvn; extern doublereal vnorm_(doublereal *); extern logical vzero_(doublereal *); extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *, doublereal *), cleard_(integer *, doublereal *); doublereal mscale, prjdif, sclcon, toobig, normal[3], prjdir; extern logical smsgnd_(doublereal *, doublereal *); extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *, ftnlen); extern logical return_(void); doublereal sclvtx[3]; /* $ Abstract */ /* Find the intersection of a ray and a 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 */ /* PLANES */ /* $ Keywords */ /* GEOMETRY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* VERTEX, */ /* DIR I Vertex and direction vector of ray. */ /* PLANE I A SPICELIB plane. */ /* NXPTS O Number of intersection points of ray and plane. */ /* XPT O Intersection point, if NXPTS = 1. */ /* $ Detailed_Input */ /* VERTEX, */ /* DIR are a point and direction vector that define a */ /* ray in three-dimensional space. */ /* PLANE is a SPICELIB plane. */ /* $ Detailed_Output */ /* NXPTS is the number of points of intersection of the */ /* input ray and plane. Values and meanings of */ /* NXPTS are: */ /* 0 No intersection. */ /* 1 One point of intersection. Note that */ /* this case may occur when the ray's */ /* vertex is in the plane. */ /* -1 An infinite number of points of */ /* intersection; the ray lies in the plane. */ /* XPT is the point of intersection of the input ray */ /* and plane, when there is exactly one point of */ /* intersection. Otherwise, XPT is the zero vector. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the ray's direction vector is the zero vector, the error */ /* SPICE(ZEROVECTOR) is signaled. NXPTS and XPT are not */ /* modified. */ /* 2) If the ray's vertex is further than DPMAX() / 3 from the */ /* origin, the error SPICE(VECTORTOOBIG) is signaled. NXPTS */ /* and XPT are not modified. */ /* 3) If the input plane is s further than DPMAX() / 3 from the */ /* origin, the error SPICE(VECTORTOOBIG) is signaled. NXPTS */ /* and XPT are not modified. */ /* 4) The input plane should be created by one of the SPICELIB */ /* routines */ /* NVC2PL */ /* NVP2PL */ /* PSV2PL */ /* Invalid input planes will cause unpredictable results. */ /* 5) In the interest of good numerical behavior, in the case */ /* where the ray's vertex is not in the plane, this routine */ /* considers that an intersection of the ray and plane occurs */ /* only if the distance between the ray's vertex and the */ /* intersection point is less than DPMAX() / 3. */ /* If VERTEX is not in the plane and this condition is not */ /* met, then NXPTS is set to 0 and XPT is set to the zero */ /* vector. */ /* $ Files */ /* None. */ /* $ Particulars */ /* The intersection of a ray and plane in three-dimensional space */ /* can be a the empty set, a single point, or the ray itself. */ /* $ Examples */ /* 1) Find the camera projection of the center of an extended */ /* body. For simplicity, we assume: */ /* -- The camera has no distortion; the image of a point */ /* is determined by the intersection of the focal plane */ /* and the line determined by the point and the camera's */ /* focal point. */ /* -- The camera's pointing matrix (C-matrix) is available */ /* in a C-kernel. */ /* C */ /* C Load Leapseconds and SCLK kernels to support time */ /* C conversion. */ /* C */ /* CALL FURNSH ( 'LEAP.KER' ) */ /* CALL FURNSH ( 'SCLK.KER' ) */ /* C */ /* C Load an SPK file containing ephemeris data for */ /* C observer (a spacecraft, whose NAIF integer code */ /* C is SC) and target at the UTC epoch of observation. */ /* C */ /* CALL FURNSH ( 'SPK.BSP' ) */ /* C */ /* C Load a C-kernel containing camera pointing for */ /* C the UTC epoch of observation. */ /* C */ /* CALL FURNSH ( 'CK.BC' ) */ /* C */ /* C Find the ephemeris time (barycentric dynamical time) */ /* C and encoded spacecraft clock times corresponding to */ /* C the UTC epoch of observation. */ /* C */ /* CALL UTC2ET ( UTC, ET ) */ /* CALL SCE2C ( SC, ET, SCLKDP ) */ /* C */ /* C Encode the pointing lookup tolerance. */ /* C */ /* CALL SCTIKS ( SC, TOLCH, TOLDP ) */ /* C */ /* C Find the observer-target vector at the observation */ /* C epoch. In this example, we'll use a light-time */ /* C corrected state vector. */ /* C */ /* CALL SPKEZ ( TARGET, ET, 'J2000', 'LT', SC, */ /* . STATE, LT ) */ /* C */ /* C Look up camera pointing. */ /* C */ /* CALL CKGP ( CAMERA, SCLKDP, TOLDP, 'J2000', CMAT, */ /* . CLKOUT, FOUND ) */ /* IF ( .NOT. FOUND ) THEN */ /* [Handle this case...] */ /* END IF */ /* C */ /* C Negate the spacecraft-to-target body vector and */ /* C convert it to camera coordinates. */ /* C */ /* CALL VMINUS ( STATE, DIR ) */ /* CALL MXV ( CMAT, DIR, DIR ) */ /* C */ /* C If FL is the camera's focal length, the effective */ /* C focal point is */ /* C */ /* C FL * ( 0, 0, 1 ) */ /* C */ /* CALL VSCL ( FL, ZVEC, FOCUS ) */ /* C */ /* C The camera's focal plane contains the origin in */ /* C camera coordinates, and the z-vector is orthogonal */ /* C to the plane. Make a SPICELIB plane representing */ /* C the focal plane. */ /* C */ /* CALL NVC2PL ( ZVEC, 0.D0, FPLANE ) */ /* C */ /* C The image of the target body's center in the focal */ /* C plane is defined by the intersection with the focal */ /* C plane of the ray whose vertex is the focal point and */ /* C whose direction is DIR. */ /* C */ /* CALL INRYPL ( FOCUS, DIR, FPLANE, NXPTS, IMAGE ) */ /* IF ( NXPTS .EQ. 1 ) THEN */ /* C */ /* C The body center does project to the focal plane. */ /* C Check whether the image is actually in the */ /* C camera's field of view... */ /* C */ /* . */ /* . */ /* . */ /* ELSE */ /* C */ /* C The body center does not map to the focal plane. */ /* C Handle this case... */ /* C */ /* . */ /* . */ /* . */ /* END IF */ /* 2) Find the Saturn ring plane intercept of a spacecraft-mounted */ /* instrument's boresight vector. We want the find the point */ /* in the ring plane that will be observed by an instrument */ /* with a give boresight direction at a specified time. We */ /* must account for light time and stellar aberration in order */ /* to find this point. The intercept point will be expressed */ /* in Saturn body-fixed coordinates. */ /* In this example, we assume */ /* -- The ring plane is equatorial. */ /* -- Light travels in a straight line. */ /* -- The light time correction for the ring plane intercept */ /* can be obtained by performing three light-time */ /* correction iterations. If this assumption does not */ /* lead to a sufficiently accurate result, additional */ /* iterations can be performed. */ /* -- A Newtonian approximation of stellar aberration */ /* suffices. */ /* -- The boresight vector is given in J2000 coordinates. */ /* -- The observation epoch is ET ephemeris seconds past */ /* J2000. */ /* -- The boresight vector, spacecraft and planetary */ /* ephemerides, and ring plane orientation are all known */ /* with sufficient accuracy for the application. */ /* -- All necessary kernels are loaded by the caller of */ /* this example routine. */ /* SUBROUTINE RING_XPT ( SC, ET, BORVEC, SBFXPT, FOUND ) */ /* IMPLICIT NONE */ /* CHARACTER*(*) SC */ /* DOUBLE PRECISION ET */ /* DOUBLE PRECISION BORVEC ( 3 ) */ /* DOUBLE PRECISION SBFXPT ( 3 ) */ /* LOGICAL FOUND */ /* C */ /* C SPICELIB functions */ /* C */ /* DOUBLE PRECISION CLIGHT */ /* DOUBLE PRECISION VDIST */ /* C */ /* C Local parameters */ /* C */ /* INTEGER UBPL */ /* PARAMETER ( UBPL = 4 ) */ /* INTEGER SATURN */ /* PARAMETER ( SATURN = 699 ) */ /* C */ /* C Local variables */ /* C */ /* DOUBLE PRECISION BORV2 ( 3 ) */ /* DOUBLE PRECISION CORVEC ( 3 ) */ /* DOUBLE PRECISION LT */ /* DOUBLE PRECISION PLANE ( UBPL ) */ /* DOUBLE PRECISION SATSSB ( 6 ) */ /* DOUBLE PRECISION SCPOS ( 3 ) */ /* DOUBLE PRECISION SCSSB ( 6 ) */ /* DOUBLE PRECISION STATE ( 6 ) */ /* DOUBLE PRECISION STCORR ( 3 ) */ /* DOUBLE PRECISION TAU */ /* DOUBLE PRECISION TPMI ( 3, 3 ) */ /* DOUBLE PRECISION XPT ( 3 ) */ /* DOUBLE PRECISION ZVEC ( 3 ) */ /* INTEGER I */ /* INTEGER NXPTS */ /* INTEGER SCID */ /* LOGICAL FND */ /* C */ /* C First step: account for stellar aberration. Since the */ /* C instrument pointing is given, we need to find the intercept */ /* C point such that, when the stellar aberration correction is */ /* C applied to the vector from the spacecraft to that point, */ /* C the resulting vector is parallel to BORVEC. An easy */ /* C solution is to apply the inverse of the normal stellar */ /* C aberration correction to BORVEC, and then solve the */ /* C intercept problem with this corrected boresight vector. */ /* C */ /* C Find the position of the observer relative */ /* C to the solar system barycenter at ET. */ /* C */ /* CALL BODN2C ( SC, SCID, FND ) */ /* IF ( .NOT. FND ) THEN */ /* CALL SETMSG ( 'ID code for body # was not found.' ) */ /* CALL ERRCH ( '#', SC ) */ /* CALL SIGERR ( 'SPICE(NOTRANSLATION' ) */ /* RETURN */ /* END IF */ /* CALL SPKSSB ( SCID, ET, 'J2000', SCSSB ) */ /* C */ /* C We now wish to find the vector CORVEC that, when */ /* C corrected for stellar aberration, yields BORVEC. */ /* C A good first approximation is obtained by applying */ /* C the stellar aberration correction for transmission */ /* C to BORVEC. */ /* C */ /* CALL STLABX ( BORVEC, SCSSB(4), CORVEC ) */ /* C */ /* C The inverse of the stellar aberration correction */ /* C applicable to CORVEC should be a very good estimate of */ /* C the correction we need to apply to BORVEC. Apply */ /* C this correction to BORVEC to obtain an improved estimate */ /* C of CORVEC. */ /* C */ /* CALL STELAB ( CORVEC, SCSSB(4), BORV2 ) */ /* CALL VSUB ( BORV2, CORVEC, STCORR ) */ /* CALL VSUB ( BORVEC, STCORR, CORVEC ) */ /* C */ /* C Because the ring plane intercept may be quite far from */ /* C Saturn's center, we cannot assume light time from the */ /* C intercept to the observer is well approximated by */ /* C light time from Saturn's center to the observer. */ /* C We compute the light time explicitly using an iterative */ /* C approach. */ /* C */ /* C We can however use the light time from Saturn's center to */ /* C the observer to obtain a first estimate of the actual light */ /* C time. */ /* C */ /* CALL SPKEZR ( 'SATURN', ET, 'J2000', 'LT', SC, */ /* . STATE, LT ) */ /* TAU = LT */ /* C */ /* C Find the ring plane intercept and calculate the */ /* C light time from it to the spacecraft. */ /* C Perform three iterations. */ /* C */ /* I = 1 */ /* FOUND = .TRUE. */ /* DO WHILE ( ( I .LE. 3 ) .AND. ( FOUND ) ) */ /* C */ /* C Find the position of Saturn relative */ /* C to the solar system barycenter at ET-TAU. */ /* C */ /* CALL SPKSSB ( SATURN, ET-TAU, 'J2000', SATSSB ) */ /* C */ /* C Find the Saturn-to-observer vector defined by these */ /* C two position vectors. */ /* C */ /* CALL VSUB ( SCSSB, SATSSB, SCPOS ) */ /* C */ /* C Look up Saturn's pole at ET-TAU; this is the third */ /* C column of the matrix that transforms Saturn body-fixed */ /* C coordinates to J2000 coordinates. */ /* C */ /* CALL PXFORM ( 'IAU_SATURN', 'J2000', ET-TAU, TPMI ) */ /* CALL MOVED ( TPMI(1,3), 3, ZVEC ) */ /* C */ /* C Make a SPICELIB plane representing the ring plane. */ /* C We're treating Saturn's center as the origin, so */ /* C the plane constant is 0. */ /* C */ /* CALL NVC2PL ( ZVEC, 0.D0, PLANE ) */ /* C */ /* C Find the intersection of the ring plane and the */ /* C ray having vertex SCPOS and direction vector */ /* C CORVEC. */ /* C */ /* CALL INRYPL ( SCPOS, CORVEC, PLANE, NXPTS, XPT ) */ /* C */ /* C If the number of intersection points is 1, */ /* C find the next light time estimate. */ /* C */ /* IF ( NXPTS .EQ. 1 ) THEN */ /* C */ /* C Find the light time (zero-order) from the */ /* C intercept point to the spacecraft. */ /* C */ /* TAU = VDIST ( SCPOS, XPT ) / CLIGHT() */ /* I = I + 1 */ /* ELSE */ /* FOUND = .FALSE. */ /* END IF */ /* END DO */ /* C */ /* C At this point, if FOUND is .TRUE., we iterated */ /* C 3 times, and XPT is our estimate of the */ /* C position of the ring plane intercept point */ /* C relative to Saturn in the J2000 frame. This is the */ /* C point observed by an instrument pointed in direction */ /* C BORVEC at ET at mounted on the spacecraft SC. */ /* C */ /* C If FOUND is .FALSE., the boresight ray does not */ /* C intersect the ring plane. */ /* C */ /* C As a final step, transform XPT to Saturn body-fixed */ /* C coordinates. */ /* C */ /* IF ( FOUND ) THEN */ /* CALL MTXV ( TPMI, XPT, SBFXPT ) */ /* END IF */ /* END */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 1.1.1, 07-FEB-2008 (BVS) */ /* Fixed a few typos in the header. */ /* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in VSCL call. */ /* - SPICELIB Version 1.0.3, 12-DEC-2002 (NJB) */ /* Header fix: ring plane intercept algorithm was corrected. */ /* Now light time is computed accurately, and stellar aberration */ /* is accounted for. Example was turned into a complete */ /* subroutine. */ /* - SPICELIB Version 1.0.2, 09-MAR-1999 (NJB) */ /* Reference to SCE2T replaced by reference to SCE2C. An */ /* occurrence of ENDIF was replaced by END IF. */ /* - 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, 01-APR-1991 (NJB) (WLT) */ /* -& */ /* $ Index_Entries */ /* intersection of ray and plane */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */ /* Updated to remove non-standard use of duplicate arguments */ /* in VSCL call. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("INRYPL", (ftnlen)6); } /* We'll give the name TOOBIG to the bound DPMAX() / MARGIN. */ /* If we let VTXPRJ be the orthogonal projection of VERTEX onto */ /* PLANE, and let DIFF be the vector VTXPRJ - VERTEX, then */ /* we know that */ /* || DIFF || < 2 * TOOBIG */ /* Check the distance of the ray's vertex from the origin. */ toobig = dpmax_() / 3.; if (vnorm_(vertex) >= toobig) { setmsg_("Ray's vertex is too far from the origin.", (ftnlen)40); sigerr_("SPICE(VECTORTOOBIG)", (ftnlen)19); chkout_("INRYPL", (ftnlen)6); return 0; } /* Check the distance of the plane from the origin. (The returned */ /* plane constant IS this distance.) */ pl2nvc_(plane, normal, &const__); if (const__ >= toobig) { setmsg_("Plane is too far from the origin.", (ftnlen)33); sigerr_("SPICE(VECTORTOOBIG)", (ftnlen)19); chkout_("INRYPL", (ftnlen)6); return 0; } /* Check the ray's direction vector. */ vhat_(dir, udir); if (vzero_(udir)) { setmsg_("Ray's direction vector is the zero vector.", (ftnlen)42); sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17); chkout_("INRYPL", (ftnlen)6); return 0; } /* That takes care of the error cases. Now scale the input vertex */ /* and plane to improve numerical behavior. */ /* Computing MAX */ d__1 = const__, d__2 = vnorm_(vertex); mscale = max(d__1,d__2); if (mscale != 0.) { d__1 = 1. / mscale; vscl_(&d__1, vertex, sclvtx); sclcon = const__ / mscale; } else { vequ_(vertex, sclvtx); sclcon = const__; } if (mscale > 1.) { toobig /= mscale; } /* Find the projection (coefficient) of the ray's vertex along the */ /* plane's normal direction. */ prjvn = vdot_(sclvtx, normal); /* If this projection is the plane constant, the ray's vertex lies in */ /* the plane. We have one intersection or an infinite number of */ /* intersections. It all depends on whether the ray actually lies */ /* in the plane. */ /* The absolute value of PRJDIF is the distance of the ray's vertex */ /* from the plane. */ prjdif = sclcon - prjvn; if (prjdif == 0.) { /* XPT is the original, unscaled vertex. */ vequ_(vertex, xpt); if (vdot_(normal, udir) == 0.) { /* The ray's in the plane. */ *nxpts = -1; } else { *nxpts = 1; } chkout_("INRYPL", (ftnlen)6); return 0; } /* Ok, the ray's vertex is not in the plane. The ray may still be */ /* parallel to or may point away from the plane. If the ray does */ /* point towards the plane, mathematicians would say that the */ /* ray does intersect the plane, but the computer may disagree. */ /* For this routine to find an intersection, both of the following */ /* conditions must be met: */ /* -- The ray must point toward the plane; this happens when */ /* PRJDIF has the same sign as < UDIR, NORMAL >. */ /* -- The vector difference XPT - SCLVTX must not overflow. */ /* Qualitatively, the case of interest looks something like the */ /* picture below: */ /* * SCLVTX */ /* |\ */ /* | \ <-- UDIR */ /* | \ */ /* length of this | \| */ /* segment is | -* */ /* | */ /* | PRJDIF | --> | ___________________________ */ /* |/ / */ /* | * / <-- PLANE */ /* /| XPT / */ /* / ^ / */ /* / | NORMAL / */ /* / | . / */ /* / |/| / */ /* / .---| / / */ /* / | |/ / */ /* / `---* / */ /* / Projection of SCLVTX onto the plane */ /* / / */ /* / / */ /* ---------------------------- */ /* Find the projection of the direction vector along the plane's */ /* normal vector. */ prjdir = vdot_(udir, normal); /* We're done if the ray doesn't point toward the plane. PRJDIF */ /* has already been found to be non-zero at this point; PRJDIR is */ /* zero if the ray and plane are parallel. The SPICELIB routine */ /* SMSGND will return a value of .FALSE. if PRJDIR is zero. */ if (! smsgnd_(&prjdir, &prjdif)) { /* The ray is parallel to or points away from the plane. */ *nxpts = 0; cleard_(&c__3, xpt); chkout_("INRYPL", (ftnlen)6); return 0; } /* The difference XPT - SCLVTX is the hypotenuse of a right triangle */ /* formed by SCLVTX, XPT, and the orthogonal projection of SCLVTX */ /* onto the plane. We'll obtain the hypotenuse by scaling UDIR. */ /* We must make sure that this hypotenuse does not overflow. The */ /* scale factor has magnitude */ /* | PRJDIF | */ /* -------------- */ /* | PRJDIR | */ /* and UDIR is a unit vector, so as long as */ /* | PRJDIF | < | PRJDIR | * TOOBIG */ /* the hypotenuse is no longer than TOOBIG. The product can be */ /* computed safely since PRJDIR has magnitude 1 or less. */ if (abs(prjdif) >= abs(prjdir) * toobig) { /* If the hypotenuse is too long, we say that no intersection */ /* exists. */ *nxpts = 0; cleard_(&c__3, xpt); chkout_("INRYPL", (ftnlen)6); return 0; } /* We conclude that it's safe to compute XPT. Scale UDIR and add */ /* the result to SCLVTX. The addition is safe because both addends */ /* have magnitude no larger than TOOBIG. The vector thus obtained */ /* is the intersection point. */ *nxpts = 1; scale = abs(prjdif) / abs(prjdir); vlcom_(&c_b17, sclvtx, &scale, udir, xpt); /* Re-scale XPT. This is safe, since TOOBIG has already been */ /* scaled to allow for any growth of XPT at this step. */ vsclip_(&mscale, xpt); chkout_("INRYPL", (ftnlen)6); return 0; } /* inrypl_ */
/* $Procedure DVNORM ( Derivative of vector norm ) */ doublereal dvnorm_(doublereal *state) { /* System generated locals */ doublereal ret_val; /* Local variables */ extern /* Subroutine */ int vhat_(doublereal *, doublereal *); doublereal xhat[3]; extern doublereal vdot_(doublereal *, doublereal *), vnorm_(doublereal *); /* $ Abstract */ /* Function to calculate the derivative of the norm of a 3-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 */ /* None. */ /* $ Keywords */ /* DERIVATIVE */ /* MATH */ /* VECTOR */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* STATE I A 6-vector composed of three coordinates and their */ /* derivatives. */ /* $ Detailed_Input */ /* STATE A double precision 6-vector, the second three */ /* components being the derivatives of the first three */ /* with respect to some scalar. */ /* STATE = ( x, dx ) */ /* -- */ /* ds */ /* A common form for STATE would contain position and */ /* velocity. */ /* $ Detailed_Output */ /* DVNORM The value of d||x|| corresponding to STATE. */ /* ------ */ /* ds */ /* 1/2 2 2 2 1/2 */ /* where ||x|| = < x, x > = ( x1 + x2 + x3 ) */ /* v = ( dx1, dx2, dx3 ) */ /* --- --- --- */ /* ds ds ds */ /* d||x|| < x, v > */ /* ------ = ------ = < xhat, v > */ /* ds 1/2 */ /* < x, x > */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* None. */ /* $ Files */ /* None. */ /* $ Particulars */ /* A common use for this routine is to calculate the time derivative */ /* of the radius corresponding to a state vector. */ /* $ Examples */ /* Any numerical results shown for this example may differ between */ /* platforms as the results depend on the SPICE kernels used as input */ /* and the machine specific arithmetic implementation. */ /* PROGRAM DVNORM_T */ /* IMPLICIT NONE */ /* DOUBLE PRECISION X (3) */ /* DOUBLE PRECISION MAG (3) */ /* DOUBLE PRECISION DVMAG (3) */ /* DOUBLE PRECISION Y (6) */ /* DOUBLE PRECISION DVNORM */ /* C */ /* C Create several 6-vectors (6x1 arrays) with the structure */ /* C */ /* C s = | x | */ /* C | | */ /* C | dx | */ /* C | -- | */ /* C | ds | */ /* C */ /* C where 'x' is a 3-vector (3x1 array). */ /* C */ /* C */ /* C Create 's' with 'x' of varying magnitudes. Use 'x' */ /* C and '-x' to define the derivative as parallel and */ /* C anti-parallel. */ /* C */ /* MAG(1) = -4.D0 */ /* MAG(2) = 4.D0 */ /* MAG(3) = 12.D0 */ /* X(1) = 1.D0 */ /* X(2) = DSQRT( 2.D0 ) */ /* X(3) = DSQRT( 3.D0 ) */ /* C */ /* C Parallel... */ /* C */ /* Y(1) = X(1) * 10.D0**MAG(1) */ /* Y(2) = X(2) * 10.D0**MAG(1) */ /* Y(3) = X(3) * 10.D0**MAG(1) */ /* Y(4) = X(1) */ /* Y(5) = X(2) */ /* Y(6) = X(3) */ /* WRITE(*,*) 'Parallel x, dx/ds : ', DVNORM( Y ) */ /* C */ /* C ... anti-parallel... */ /* C */ /* Y(1) = X(1) * 10.D0**MAG(2) */ /* Y(2) = X(2) * 10.D0**MAG(2) */ /* Y(3) = X(3) * 10.D0**MAG(2) */ /* Y(4) = -X(1) */ /* Y(5) = -X(2) */ /* Y(6) = -X(3) */ /* WRITE(*,*) 'Anti-parallel x, dx/ds : ', DVNORM( Y ) */ /* C */ /* C ... 'x' zero vector */ /* C */ /* Y(1) = 0.D0 */ /* Y(2) = 0.D0 */ /* Y(3) = 0.D0 */ /* Y(4) = X(1) * 10.D0**MAG(3) */ /* Y(5) = X(2) * 10.D0**MAG(3) */ /* Y(6) = X(3) * 10.D0**MAG(3) */ /* WRITE(*,*) 'Zero vector x, large dx/ds: ', DVNORM( Y ) */ /* END */ /* The program outputs: */ /* Parallel x, dx/ds : 2.44948974 */ /* Anti-parallel x, dx/ds : -2.44948974 */ /* Zero vector x, large dx/ds: 0. */ /* $ Restrictions */ /* Error free. */ /* 1) If the first three components of STATE ("x") describes the */ /* origin (zero vector) the routine returns zero as the */ /* derivative of the vector norm. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* Ed Wright (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 03-MAY-2010 (EDW) */ /* -& */ /* $ Index_Entries */ /* derivative of 3-vector norm */ /* -& */ /* SPICELIB functions. */ /* Local Variables. */ /* If "x" describes the zero vector, return zero as the derivative */ /* of the vector norm. */ if (vnorm_(state) == 0.) { ret_val = 0.; return ret_val; } /* Construct a unit vector from the x vector data */ /* in STATE. */ vhat_(state, xhat); /* Project the velocity components onto the XHAT vector. */ /* d ||x|| x */ /* ------- = v . ----- */ /* ds ||x|| */ ret_val = vdot_(&state[3], xhat); return ret_val; } /* dvnorm_ */
/* $Procedure SPKW15 ( SPK, write a type 15 segment ) */ /* Subroutine */ int spkw15_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer i__1; /* Local variables */ extern /* Subroutine */ int vhat_(doublereal *, doublereal *); doublereal mypa[3]; extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, doublereal *); extern /* Subroutine */ int vequ_(doublereal *, doublereal *); doublereal mytp[3]; integer i__; doublereal angle; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal descr[5]; integer value; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); extern logical vzero_(doublereal *); extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); doublereal record[16]; 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); extern doublereal dpr_(void); doublereal dot; /* $ Abstract */ /* Write an SPK segment of type 15 given a type 15 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 the periapse. */ /* TP I Trajectory pole vector. */ /* PA I Periapsis vector. */ /* P I Semi-latus rectum. */ /* ECC I Eccentricity. */ /* J2FLG I J2 processing flag. */ /* PV I Central body pole vector. */ /* GM I Central body GM. */ /* J2 I Central body J2. */ /* RADIUS I Equatorial radius of central body. */ /* $ 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 the orbit elements at periapse */ /* in ephemeris seconds past J2000. */ /* TP is a vector parallel to the angular momentum vector */ /* of the orbit at epoch expressed relative to FRAME. A */ /* unit vector parallel to TP will be stored in the */ /* output segment. */ /* PA is a vector parallel to the position vector of the */ /* trajectory at periapsis of EPOCH expressed relative */ /* to FRAME. A unit vector parallel to PA will be */ /* stored in the output segment. */ /* P is the semi-latus rectum--- p in the equation: */ /* r = p/(1 + ECC*COS(Nu)) */ /* ECC is the eccentricity. */ /* J2FLG is the J2 processing flag describing what J2 */ /* corrections are to be applied when the orbit is */ /* propagated. */ /* All J2 corrections are applied if the value of J2FLG */ /* 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. */ /* PV is a vector parallel to the north pole vector of the */ /* central body expressed relative to FRAME. A unit */ /* vector parallel to PV will be stored in the output */ /* segment. */ /* GM is the central body GM. */ /* J2 is the central body J2 (dimensionless). */ /* RADIUS is the equatorial radius of the central body. */ /* Units are radians, km, seconds. */ /* $ Detailed_Output */ /* None. A type 15 segment is written to the file attached */ /* to HANDLE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the eccentricity is less than zero, the error */ /* 'SPICE(BADECCENTRICITY)' will be signaled. */ /* 2) If the semi-latus rectum is 0, the error */ /* 'SPICE(BADLATUSRECTUM)' is signaled. */ /* 3) If the pole vector, trajectory pole vector or periapsis vector */ /* have zero length, the error 'SPICE(BADVECTOR)' is signaled. */ /* 4) If the trajectory pole vector and the periapsis vector are */ /* not orthogonal, the error 'SPICE(BADINITSTATE)' is signaled. */ /* The test for orthogonality is very crude. The routine simply */ /* checks that 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 capacity. */ /* 5) If the mass of the central body is non-positive, the error */ /* 'SPICE(NONPOSITIVEMASS)' is signaled. */ /* 6) If the radius of the central body is negative, the error */ /* 'SPICE(BADRADIUS)' is signaled. */ /* 7) If the segment identifier has more than 40 non-blank characters */ /* the error 'SPICE(SEGIDTOOLONG)' is signaled. */ /* 8) If the segment identifier contains non-printing characters */ /* the error 'SPICE(NONPRINTABLECHARS)' is signaled. */ /* 9) 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 15 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 15 data segment to the open SPK */ /* file according to the format described in the type 15 section of */ /* the SPK Required Reading. The SPK file must have been opened with */ /* write access. */ /* This routine is provided to provide direct support for the MASL */ /* precessing orbit formulation. */ /* $ Examples */ /* Suppose that at time EPOCH you have the J2000 periapsis */ /* state of some object relative to some central body and would */ /* like to create a type 15 SPK segment to model the motion of */ /* the object using simple regression and precession of the */ /* line of nodes and apsides. The following code fragment */ /* illustrates how you can prepare such a segment. We shall */ /* assume that you have in hand the J2000 direction of the */ /* central body's pole vector, its GM, J2 and equatorial */ /* radius. In addition we assume that you have opened an SPK */ /* file for write access and that it is attached to HANDLE. */ /* (If your state is at an epoch other than periapse the */ /* fragment below will NOT produce a "correct" type 15 segment */ /* for modeling the motion of your object.) */ /* C */ /* C First we get the osculating elements. */ /* C */ /* CALL OSCELT ( STATE, EPOCH, GM, ELTS ) */ /* C */ /* C From these collect the eccentricity and semi-latus rectum. */ /* C */ /* ECC = ELTS ( 2 ) */ /* P = ELTS ( 1 ) * ( 1.0D0 + ECC ) */ /* C */ /* C Next get the trajectory pole vector and the */ /* C periapsis vector. */ /* C */ /* CALL UCRSS ( STATE(1), STATE(4), TP ) */ /* CALL VHAT ( STATE(1), PA ) */ /* C */ /* C Enable both J2 corrections. */ /* C */ /* J2FLG = 0.0D0 */ /* C */ /* C Now add the segment. */ /* C */ /* CALL SPKW15 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ /* . SEGID, EPOCH, TP, PA, P, ECC, */ /* . J2FLG, PV, GM, J2, RADIUS ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 29-MAY-2012 (NJB) */ /* Input vectors that nominally have unit length */ /* are mapped to local copies that actually do */ /* have unit length. The applicable inputs are TP, PA, */ /* and PV. The Detailed Input header section was updated */ /* to reflect the change. */ /* Some typos in error messages were corrected. */ /* - SPICELIB Version 1.0.0, 28-NOV-1994 (WLT) */ /* -& */ /* $ Index_Entries */ /* Write a type 15 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_("SPKW15", (ftnlen)6); /* Fetch the various entities from the inputs and put them into */ /* the data record, first the epoch. */ record[0] = *epoch; /* Convert TP and PA to unit vectors. */ vhat_(pa, mypa); vhat_(tp, mytp); /* The trajectory pole vector. */ vequ_(mytp, &record[1]); /* The periapsis vector. */ vequ_(mypa, &record[4]); /* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */ /* and eccentricity. */ record[7] = *p; record[8] = *ecc; /* J2 processing flag. */ record[9] = *j2flg; /* Central body pole vector. */ vhat_(pv, &record[10]); /* The central mass, J2 and radius of the central body. */ record[13] = *gm; record[14] = *j2; record[15] = *radius; /* 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 (*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_("SPKW15", (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_("SPKW15", (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_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(tp)) { setmsg_("The trajectory pole vector supplied to SPKW15 had length ze" "ro. The most likely cause of this problem is an uninitialize" "d vector.", (ftnlen)128); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(pa)) { setmsg_("The periapse vector supplied to SPKW15 had length zero. The" " most likely cause of this problem is an uninitialized vecto" "r.", (ftnlen)121); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(pv)) { setmsg_("The central pole vector supplied to SPKW15 had length zero." " The most likely cause of this problem is an uninitialized v" "ector. ", (ftnlen)126); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (*radius < 0.) { setmsg_("The central body radius was negative. It must be zero or po" "sitive. The value supplied was #. ", (ftnlen)94); errdp_("#", radius, (ftnlen)1); sigerr_("SPICE(BADRADIUS)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } /* 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_(mypa, mytp); if (abs(dot) > 1e-5) { angle = vsep_(pa, tp) * dpr_(); setmsg_("The periapsis and trajectory pole vectors are not orthogona" "l. The angle between them is # degrees. ", (ftnlen)99); errdp_("#", &angle, (ftnlen)1); sigerr_("SPICE(BADINITSTATE)", (ftnlen)19); chkout_("SPKW15", (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_("SPKW15", (ftnlen)6); return 0; } /* Make sure it 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_("SPKW15", (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__15, first, last, descr, frame_len); if (failed_()) { chkout_("SPKW15", (ftnlen)6); return 0; } /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("SPKW15", (ftnlen)6); return 0; } dafada_(record, &c__16); if (! failed_()) { dafena_(); } chkout_("SPKW15", (ftnlen)6); return 0; } /* spkw15_ */