/* $Procedure CKE02 ( C-kernel, evaluate pointing record, data type 2 ) */
/* Subroutine */ int cke02_(logical *needav, doublereal *record, doublereal *
cmat, doublereal *av, doublereal *clkout)
{
doublereal time, quat[4];
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mxmt_(
doublereal *, doublereal *, doublereal *);
doublereal cbase[9] /* was [3][3] */, angle;
extern /* Subroutine */ int chkin_(char *, ftnlen), vequg_(doublereal *,
integer *, doublereal *);
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int axisar_(doublereal *, doublereal *,
doublereal *);
doublereal avtemp[3];
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int q2m_(doublereal *, doublereal *);
doublereal rot[9] /* was [3][3] */;
/* $ Abstract */
/* Evaluate a pointing record returned by CKR02 from a CK data type 2 */
/* segment. Return the C-matrix and angular velocity vector associated */
/* with the time CLKOUT. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK */
/* ROTATION */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* NEEDAV I True if angular velocity is requested. */
/* RECORD I Data type 2 pointing record. */
/* CMAT O C-matrix. */
/* AV O Angular velocity vector. */
/* CLKOUT O SCLK associated with C-matrix. */
/* $ Detailed_Input */
/* NEEDAV is true if angular velocity is requested. */
/* RECORD is a set of double precision numbers returned by CKR02 */
/* that contain sufficient information from a data type */
/* 2 pointing segment to evaluate the C-matrix and the */
/* angular velocity vector for a particular instance. */
/* The contents of RECORD are as follows: */
/* RECORD( 1 ) = start SCLKDP of interval */
/* RECORD( 2 ) = SCLK for which pointing was found */
/* RECORD( 3 ) = seconds / tick rate */
/* RECORD( 4 ) = q0 */
/* RECORD( 5 ) = q1 */
/* RECORD( 6 ) = q2 */
/* RECORD( 7 ) = q3 */
/* RECORD( 8 ) = av1 */
/* RECORD( 9 ) = av2 */
/* RECORD( 10 ) = av3 */
/* The quantities q0 - q3 are the components of the */
/* quaternion that represents the C - matrix associated */
/* with the start of the interval. The quantities av1, */
/* av2, and av3 are the components of the angular velocity */
/* vector. */
/* $ Detailed_Output */
/* CMAT is a rotation matrix that transforms the components */
/* of a vector expressed in the inertial frame given in */
/* the segment to components expressed in the instrument */
/* fixed frame at the returned time. */
/* Thus, if a vector v has components x, y, z in the */
/* inertial frame, then v has components x', y', z' in the */
/* instrument fixed frame where: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* If the x', y', z' components are known, use the */
/* transpose of the C-matrix to determine x, y, z as */
/* follows. */
/* [ x ] [ ]T [ x' ] */
/* | y | = | CMAT | | y' | */
/* [ z ] [ ] [ z' ] */
/* (Transpose of CMAT) */
/* AV is the angular velocity vector. The angular velocity */
/* contained in RECORD is returned only if NEEDAV is true. */
/* The direction of the angular velocity vector gives */
/* the right-handed axis about which the instrument fixed */
/* reference frame is rotating. The magnitude of AV is */
/* the magnitude of the instantaneous velocity of the */
/* rotation, in radians per second. */
/* The angular velocity vector is returned in component */
/* form */
/* AV = [ AV1 , AV2 , AV3 ] */
/* which is in terms of the inertial coordinate frame */
/* specified in the segment descriptor. */
/* CLKOUT is the encoded SCLK associated with the returned */
/* C-matrix and angular velocity vector. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) No checking is done to determine whether RECORD is valid. */
/* $ Files */
/* None. */
/* $ Particulars */
/* For a detailed description of the structure of a type 2 pointing */
/* segment, see the CK Required Reading. */
/* Pointing data in a type 2 segment consists of intervals during */
/* which the orientation of the spacecraft structure can be described */
/* by an initial C-matrix and a constant angular velocity vector. */
/* From the information contained in the pointing record returned by */
/* CKR02, this subroutine calculates and returns the C-matrix */
/* associated with the time returned by CKR02. It also returns the */
/* angular velocity vector contained in the pointing record. */
/* $ Examples */
/* A call to a CKEnn routine is almost always preceded by a call to */
/* the corresponding CKRnn routine, which gets the logical record */
/* that CKEnn evaluates. */
/* The following code fragment searches through a file (represented */
/* by HANDLE) for all segments applicable to the Voyager 2 wide angle */
/* camera, for a particular spacecraft clock time, that are of data */
/* types 1 or 2. It then evaluates the pointing for that epoch and */
/* prints the result. */
/* SC = -32 */
/* INST = -32002 */
/* C */
/* C Load the Voyager 2 spacecraft clock kernel and the C-kernel. */
/* C */
/* CALL FURNSH ( 'VGR_SCLK.TSC' ) */
/* CALL DAFOPR ( 'VGR2_CK.BC', HANDLE ) */
/* C */
/* C Get the spacecraft clock time. Must encode it for use */
/* C in the C-kernel. */
/* C */
/* WRITE (*,*) 'Enter spacecraft clock time string:' */
/* READ (*,FMT='(A)') SCLKCH */
/* CALL SCENCD ( SC, SCLKCH, SCLKDP ) */
/* C */
/* C Search from the beginning through all segments. */
/* C */
/* CALL DAFBFS ( HANDLE ) */
/* CALL DAFFNA ( SFND ) */
/* DO WHILE ( SFND ) */
/* CALL DAFGN ( IDENT ) */
/* CALL DAFGS ( DESCR ) */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* IF ( INST .EQ. ICD( 1 ) .AND. */
/* . SCLKDP + TOL .GE. DCD( 1 ) .AND. */
/* . SCLKDP - TOL .LE. DCD( 2 ) ) THEN */
/* DTYPE = ICD ( 3 ) */
/* IF ( DTYPE .EQ. 1 ) THEN */
/* CALL CKR01 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FOUND ) */
/* IF ( FOUND ) THEN */
/* CALL CKE01 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */
/* END IF */
/* ELSE IF ( DTYPE .EQ. 2 ) THEN */
/* CALL CKR02 ( HANDLE, DESCR, SCLKDP, TOL, */
/* . RECORD, FOUND ) */
/* IF ( FOUND ) THEN */
/* CALL CKE02 ( NEEDAV, RECORD, CMAT, AV, CLKOUT ) */
/* END IF */
/* END IF */
/* IF ( FOUND ) THEN */
/* WRITE (*,*) 'Segment descriptor and identifier:' */
/* WRITE (*,*) DCD, ICD */
/* WRITE (*,*) IDENT */
/* WRITE (*,*) 'C-matrix:' */
/* WRITE (*,*) CMAT */
/* END IF */
/* END IF */
/* CALL DAFFNA ( SFND ) */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.M. Lynch (JPL) */
/* W.L. Taber (JPL) */
/* E.D. Wright (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */
/* Removed non-standard end-of-declarations marker */
/* 'C%&END_DECLARATIONS' from comments. */
/* - SPICELIB Version 1.0.2, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - 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, 30-AUG-1991 (JML) */
/* -& */
/* $ Index_Entries */
/* evaluate ck type_2 pointing data record */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKE02", (ftnlen)5);
}
/* Copy the returned encoded SCLK time into CLKOUT. */
*clkout = record[1];
/* The quaternion stored in RECORD represents the C - matrix */
/* corresponding to the start time of the interval. The angular */
/* velocity vector is constant throughout the interval and gives */
/* the axis and rate by which the spacecraft is rotating. */
/* Copy the quaternion and the angular velocity from RECORD. */
/* RECORD ( 4 ) = q0 */
/* RECORD ( 5 ) = q1 */
/* RECORD ( 6 ) = q2 */
/* RECORD ( 7 ) = q3 */
/* RECORD ( 8 ) = av1 */
/* RECORD ( 9 ) = av2 */
/* RECORD ( 10 ) = av3 */
vequg_(&record[3], &c__4, quat);
vequ_(&record[7], avtemp);
/* Calculate the angle of the rotation. */
/* RECORD ( 1 ) = The start time of the interval. */
/* RECORD ( 2 ) = The time that pointing was returned for. */
/* RECORD ( 3 ) = The number of seconds per SCLK tick. */
time = (record[1] - record[0]) * record[2];
angle = time * vnorm_(avtemp);
/* Construct a matrix which rotates vectors by ANGLE radians about */
/* AVTEMP. */
axisar_(avtemp, &angle, rot);
/* Convert the quaternion to a C - matrix. */
q2m_(quat, cbase);
/* Rotate each of the axis vectors of the spacecraft instrument frame */
/* by ANGLE radians about AVTEMP. (AVTEMP is given in the same */
/* inertial frame as the C - matrix.) The resulting matrix is the */
/* transpose of the requested C - matrix. */
/* [ ] [ ] T [ ] T */
/* [ ROT ] * [ CBASE ] = [ CMAT ] */
/* [ ] [ ] [ ] */
/* OR */
/* [ ] [ ] T [ ] */
/* [ CBASE ] * [ ROT ] = [ CMAT ] */
/* [ ] [ ] [ ] */
mxmt_(cbase, rot, cmat);
/* Return the angular velocity only if it is requested. */
if (*needav) {
vequ_(avtemp, av);
}
chkout_("CKE02", (ftnlen)5);
return 0;
} /* cke02_ */
/* $Procedure VREL ( Vector relative difference, 3 dimensions ) */
doublereal vrel_(doublereal *v1, doublereal *v2)
{
/* System generated locals */
doublereal ret_val, d__1, d__2;
/* Local variables */
extern doublereal vdist_(doublereal *, doublereal *), vnorm_(doublereal *)
;
doublereal denorm, nunorm;
/* $ Abstract */
/* Return the relative difference between two 3-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 */
/* None. */
/* $ Keywords */
/* MATH */
/* VECTOR */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* V1,V2 I Input vectors. */
/* $ Detailed_Input */
/* V1, V2 are two 3-dimensional vectors for which the */
/* relative difference is to be computed. */
/* $ Detailed_Output */
/* VREL is the relative difference between V1 and V2. */
/* It is defined as: */
/* || V1 - V2 || */
/* VREL = ---------------------- */
/* MAX ( ||V1||, ||V2|| ) */
/* where || X || indicates the Euclidean norm of */
/* the vector X. */
/* VREL assumes values in the range [0,2]. If both */
/* V1 and V2 are zero vectors then VREL is defined */
/* to be zero. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* If both V1 and V2 are zero vectors then VREL is defined */
/* to be zero. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This function computes the relative difference between two */
/* 3-dimensional vectors as defined above. */
/* The function VRELG may be used to find the relative difference */
/* for two vectors of general dimension. */
/* $ Examples */
/* This example code fragment computes the relative difference */
/* between the geometric and light time corrected state of Io */
/* with respect to Voyager 2 at a given UTC time. */
/* C */
/* C The NAIF integer code for Io is 501 and the code for */
/* C Voyager 2 is -32. */
/* C */
/* INTEGER IO */
/* PARAMETER ( IO = 501 ) */
/* INTEGER VG2 */
/* PARAMETER ( VG2 = -32 ) */
/* C */
/* C Spicelib function */
/* C */
/* DOUBLE PRECISION VREL */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION STATE ( 6 ) */
/* DOUBLE PRECISION POS1 ( 3 ) */
/* DOUBLE PRECISION POS2 ( 3 ) */
/* DOUBLE PRECISION DIFF */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION ET */
/* INTEGER HANDLE */
/* CHARACTER*(20) UTC */
/* DATA UTC / '1979 JUN 25 12:00:00' / */
/* C */
/* C Load the sample SPK ephemeris file. */
/* C */
/* CALL SPKLEF ( 'VG2_JUP.BSP', HANDLE ) */
/* C */
/* C Convert the UTC time string to ephemeris time. */
/* C */
/* CALL UTC2ET ( UTC, ET ) */
/* C */
/* C First calculate the geometric state and then the light */
/* C time corrected state. */
/* C */
/* CALL SPKEZ ( IO, ET, 'J2000', 'NONE', VG2, STATE, LT ) */
/* CALL VEQU ( STATE, POS1 ) */
/* CALL SPKEZ ( IO, ET, 'J2000', 'LT', VG2, STATE, LT ) */
/* CALL VEQU ( STATE, POS2 ) */
/* C */
/* C Call VREL to find the relative difference between the */
/* C two states. */
/* C */
/* DIFF = VREL ( POS1, POS2 ) */
/* . */
/* . */
/* . */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 15-JUN-1992 (JML) */
/* -& */
/* $ Index_Entries */
/* relative difference of 3-dimensional vectors */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* If the numerator is zero then set VREL equal to zero. Otherwise, */
/* perform the rest of the calculation. */
/* This handles the case where both vectors are zero vectors since */
/* the distance between them will be zero. */
nunorm = vdist_(v1, v2);
if (nunorm == 0.) {
ret_val = 0.;
} else {
/* Computing MAX */
d__1 = vnorm_(v1), d__2 = vnorm_(v2);
denorm = max(d__1,d__2);
ret_val = nunorm / denorm;
}
return ret_val;
} /* vrel_ */
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
char oname[40];
doublereal descr[5];
integer ctarg[20];
char ident[40], tname[40];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
moved_(doublereal *, integer *, doublereal *);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal starg[120] /* was [6][20] */;
logical nofrm;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
extern doublereal clight_(void);
integer tframe[20];
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer tmpfrm;
extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *),
spksfs_(integer *, doublereal *, integer *, doublereal *, char *,
logical *, ftnlen);
extern integer frstnp_(char *, ftnlen);
extern logical return_(void);
doublereal psxfrm[9] /* was [3][3] */;
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), intstr_(integer *, char *,
ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ Abstract */
/* Compute the geometric position of a target body relative to an */
/* observing body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* This file contains the number of inertial reference */
/* frames that are currently known by the SPICE toolkit */
/* software. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* FRAMES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NINERT P Number of known inertial reference frames. */
/* $ Parameters */
/* NINERT is the number of recognized inertial reference */
/* frames. This value is needed by both CHGIRF */
/* ZZFDAT, and FRAMEX. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */
/* -& */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* POS O Position of target. */
/* LT O Light time. */
/* $ Detailed_Input */
/* TARG is the standard NAIF ID code for a target body. */
/* ET is the epoch (ephemeris time) at which the position */
/* of the target body is to be computed. */
/* REF is the name of the reference frame to */
/* which the vectors returned by the routine should */
/* be rotated. This may be any frame supported by */
/* the SPICELIB subroutine REFCHG. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* POS contains the position of the target */
/* body, relative to the observing body. This vector is */
/* rotated into the specified reference frame. Units */
/* are always km. */
/* LT is the one-way light time from the observing body */
/* to the geometric position of the target body at the */
/* specified epoch. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If insufficient ephemeris data has been loaded to compute */
/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/* signalled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* SPKGPS computes the geometric position, T(t), of the target */
/* body and the geometric position, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric position of the target */
/* body relative to the observer. */
/* CENTER ----- O(t) */
/* | / */
/* | / */
/* | / */
/* | / T(t) - O(t) */
/* | / */
/* T(t) */
/* The one-way light time, tau, is given by */
/* | T(t) - O(t) | */
/* tau = ----------------- */
/* c */
/* For example, if the observing body is -94, the Mars Observer */
/* spacecraft, and the target body is 401, Phobos, then the */
/* first common center is probably 4, the Mars Barycenter. */
/* O(t) is the position of -94 relative to 4 and T(t) is the */
/* position of 401 relative to 4. */
/* The center could also be the Solar System Barycenter, body 0. */
/* For example, if the observer is 399, Earth, and the target */
/* is 299, Venus, then O(t) would be the position of 399 relative */
/* to 0 and T(t) would be the position of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the positions of the target body and observer */
/* relative to a common center. SPKGPS reads as many segments */
/* as necessary, from as many files as necessary, using files */
/* that have been loaded by previous calls to SPKLEF (load */
/* ephemeris file). */
/* SPKGPS is similar to SPKGEO but returns geometric positions */
/* only. */
/* $ Examples */
/* The following code example computes the geometric */
/* position of the moon with respect to the earth and */
/* then prints the distance of the moon from the */
/* the earth at a number of epochs. */
/* Assume the SPK file SAMPLE.BSP contains ephemeris data */
/* for the moon relative to earth over the time interval */
/* from BEGIN to END. */
/* INTEGER EARTH */
/* PARAMETER ( EARTH = 399 ) */
/* INTEGER MOON */
/* PARAMETER ( MOON = 301 ) */
/* INTEGER N */
/* PARAMETER ( N = 100 ) */
/* INTEGER I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the position, and */
/* C print out the epoch in UTC time and position norm. */
/* C */
/* DELTA = ( END - BEGIN ) / N */
/* DO I = 0, N */
/* ET = BEGIN + I*DELTA */
/* CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( POS ) */
/* END DO */
/* $ Restrictions */
/* 1) The ephemeris files to be used by SPKGPS must be loaded */
/* by SPKLEF before SPKGPS is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */
/* -& */
/* $ Index_Entries */
/* geometric position of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* -& */
/* This is the idea: */
/* Every body moves with respect to some center. The center */
/* is itself a body, which in turn moves about some other */
/* center. If we begin at the target body (T), follow */
/* the chain, */
/* T */
/* \ */
/* SSB \ */
/* \ C[1] */
/* \ / */
/* \ / */
/* \ / */
/* \ / */
/* C[3]-----------C[2] */
/* and avoid circular definitions (A moves about B, and B moves */
/* about A), eventually we get the position relative to the solar */
/* system barycenter (which, for our purposes, doesn't move). */
/* Thus, */
/* T = T + C[1] + C[2] + ... + C[n] */
/* SSB C[1] C[2] [C3] SSB */
/* where */
/* X */
/* Y */
/* is the position of body X relative to body Y. */
/* However, we don't want to follow each chain back to the SSB */
/* if it isn't necessary. Instead we will just follow the chain */
/* of the target body and follow the chain of the observing body */
/* until we find a common node in the tree. */
/* In the example below, C is the first common node. We compute */
/* the position of TARG relative to C and the position of OBS */
/* relative to C, then subtract the two positions. */
/* TARG */
/* \ */
/* SSB \ */
/* \ A */
/* \ / OBS */
/* \ / | */
/* \ / | */
/* \ / | */
/* B-------------C-----------------D */
/* SPICELIB functions */
/* Local parameters */
/* CHLEN is the maximum length of a chain. That is, */
/* it is the maximum number of bodies in the chain from */
/* the target or observer to the SSB. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKGPS", (ftnlen)6);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* We take care of the obvious case first. It TARG and OBS are the */
/* same we can just fill in zero. */
if (*targ == *obs) {
*lt = 0.;
cleard_(&c__3, pos);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* CTARG contains the integer codes of the bodies in the */
/* target body chain, beginning with TARG itself and then */
/* the successive centers of motion. */
/* STARG(1,I) is the position of the target body relative */
/* to CTARG(I). The id-code of the frame of this position is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and positions of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and position of the */
/* observer relative to it.) */
/* First, we construct CTARG and STARG. CTARG(1) is */
/* just the target itself, and STARG(1,1) is just a zero */
/* vector, that is, the position of the target relative */
/* to itself. */
/* Then we follow the chain, filling up CTARG and STARG */
/* as we go. We use SPKSFS to search through loaded */
/* files to find the first segment applicable to CTARG(1) */
/* and time ET. Then we use SPKPVN to compute the position */
/* of the body CTARG(1) at ET in the segment that was found */
/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */
/* We repeat the process for CTARG(2) and so on, until */
/* there is no data found for some CTARG(I) or until we */
/* reach the SSB. */
/* Next, we find centers and positions in a similar manner */
/* for the observer. It's a similar construction as */
/* described above, but I is always 1. COBS and SOBS */
/* are overwritten with each new center and position, */
/* beginning at OBS. However, we stop when we encounter */
/* a common center of motion, that is when COBS is equal */
/* to CTARG(I) for some I. */
/* Finally, we compute the desired position of the target */
/* relative to the observer by subtracting the position of */
/* the observing body relative to the common node from */
/* the position of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(ref, &refid, ref_len);
}
if (refid == 0) {
if (frstnp_(ref, ref_len) > 0) {
setmsg_("The string supplied to specify the reference frame, ('#"
"') contains non-printing characters. The two most commo"
"n causes for this kind of error are: 1. an error in the "
"call to SPKGPS; 2. an uninitialized variable. ", (ftnlen)
213);
errch_("#", ref, (ftnlen)1, ref_len);
} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
setmsg_("The string supplied to specify the reference frame is b"
"lank. The most common cause for this kind of error is a"
"n uninitialized variable. ", (ftnlen)137);
} else {
setmsg_("The string supplied to specify the reference frame was "
"'#'. This frame is not recognized. Possible causes for "
"this error are: 1. failure to load the frame definition "
"into the kernel pool; 2. An out-of-date edition of the t"
"oolkit. ", (ftnlen)231);
errch_("#", ref, (ftnlen)1, ref_len);
}
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
/* Fill in CTARG and STARG until no more data is found */
/* or until we reach the SSB. If the chain gets too */
/* long to fit in CTARG, that is if I equals CHLEN, */
/* then overwrite the last elements of CTARG and STARG. */
/* Note the check for FAILED in the loop. If SPKSFS */
/* or SPKPVN happens to fail during execution, and the */
/* current error handling action is to NOT abort, then */
/* FOUND may be stuck at TRUE, CTARG(I) will never */
/* become zero, and the loop will execute indefinitely. */
/* Construct CTARG and STARG. Begin by assigning the */
/* first elements: TARG and the position of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"spkgps_", (ftnlen)603)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)606)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "spkgps_", (ftnlen)608)] != 0) {
/* Find a file and segment that has position */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "spkgps_", (ftnlen)617)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the position of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the position is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "spkgps_", (ftnlen)627)]);
/* Here's what we have. STARG is the position of CTARG(I-1) */
/* relative to CTARG(I) in reference frame TFRAME(I) */
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
tframe[0] = tframe[1];
/* If the loop above ended because we ran out of */
/* room in the arrays CTARG and STARG, then we */
/* continue finding positions but we overwrite the */
/* last elements of CTARG and STARG. */
/* If, as a result, the first common node is */
/* overwritten, we'll just have to settle for */
/* the last common node. This will cause a small */
/* loss of precision, but it's better than other */
/* alternatives. */
if (i__ == 20) {
while(found && ctarg[19] != 0 && ctarg[19] != *obs) {
/* Find a file and segment that has position */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the position of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The position is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the position of TARG relative to */
/* the old center to get the position of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__3, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
} else {
refchg_(&tframe[19], &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[114], vtemp);
}
vadd_(vtemp, stemp, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...3,K) position of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...3,1) = ( 0, 0, 0 ) */
/* TFRAME(1) = TFRAME(2) */
/* Now follow the observer's chain. Assign */
/* the first values for COBS and SOBS. */
cobs = *obs;
cleard_(&c__6, sobs);
/* Perhaps we have a common node already. */
/* If so it will be the last node on the */
/* list CTARG. */
/* We let CTPOS will be the position of the common */
/* node in CTARG if one is found. It will */
/* be zero if COBS is not found in CTARG. */
if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg",
i__1, "spkgps_", (ftnlen)762)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)764)];
} else {
ctpos = 0;
}
/* Repeat the same loop as above, but each time */
/* we encounter a new center of motion, check to */
/* see if it is a common node. (When CTPOS is */
/* not zero, CTARG(CTPOS) is the first common node.) */
/* Note that we don't need a centers array nor a */
/* positions array, just a single center and position */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and position */
/* (SOBS-position of the target relative to COBS). */
found = TRUE_;
nofrm = TRUE_;
legs = 0;
while(found && cobs != 0 && ctpos == 0) {
/* Find a file and segment that has position */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the position of COBS; call it STEMP. */
/* The center of motion of COBS becomes the */
/* new COBS. */
if (legs == 0) {
spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
} else {
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
}
if (nofrm) {
nofrm = FALSE_;
cframe = tmpfrm;
}
/* Add STEMP to the position of OBS relative to */
/* the old COBS to get the position of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the position of the observer, we */
/* don't have to add anything, the position of the */
/* observer is already in SOBS. We only have to add when */
/* the number of legs in the observer position is one or */
/* greater. */
if (legs > 0) {
vadd_(sobs, stemp, vtemp);
vequ_(vtemp, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
} else {
refchg_(&cframe, &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* We now have one more leg of the path for OBS. Set */
/* LEGS to reflect this. Then see if the new center */
/* is a common node. If not, repeat the loop. */
++legs;
ctpos = isrchi_(&cobs, &nct, ctarg);
}
}
/* If CTPOS is zero at this point, it means we */
/* have not found a common node though we have */
/* searched through all the available data. */
if (ctpos == 0) {
bodc2n_(targ, tname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
;
} else {
intstr_(targ, tname, (ftnlen)40);
}
bodc2n_(obs, oname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
} else {
intstr_(obs, oname, (ftnlen)40);
}
setmsg_("Insufficient ephemeris data has been loaded to compute the "
"position of TARG relative to OBS at the ephemeris epoch #. ",
(ftnlen)118);
etcal_(et, tstring, (ftnlen)80);
errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
errch_("#", tstring, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The POSITION of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . N */
/* S | . O */
/* T | . I */
/* A | . T */
/* R | . I */
/* G | . S */
/* | . O */
/* | . P */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | POSITION | */
/* LT = --------- */
/* c */
/* Compute the position of the target relative to CTARG(CTPOS) */
if (ctpos == 1) {
tframe[0] = cframe;
}
i__1 = ctpos - 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
, i__2, "spkgps_", (ftnlen)960)] == tframe[(i__3 = i__) < 20
&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
ftnlen)960)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], stemp);
moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
963)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 &&
0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2
: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)967)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
970)]);
} else {
refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)974)], et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)981)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
983)]);
}
}
/* To avoid unnecessary frame transformations we'll do */
/* a bit of extra decision making here. It's a lot */
/* faster to make logical checks than it is to compute */
/* frame transformations. */
if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe",
i__1, "spkgps_", (ftnlen)996)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1000)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the position of */
/* the observer to that frame and then subtract the position */
/* of the observer from the position of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1031)], stemp, pos);
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* REFCHG to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1040)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], stemp);
vsub_(stemp, sobs, pos);
} else {
/* Use the more general routine REFCHG to make the transformation. */
refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1048)], &cframe, et,
psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1055)], stemp);
vsub_(stemp, sobs, pos);
}
/* Finally, rotate as needed into the requested frame. */
if (cframe == refid) {
/* We don't have to do anything in this case. */
} else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
/* Since both frames are inertial, we use the more direct */
/* routine IRFROT to get the transformation to REFID. */
irfrot_(&cframe, &refid, rot);
mxv_(rot, pos, stemp);
moved_(stemp, &c__3, pos);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, pos, stemp);
moved_(stemp, &c__3, pos);
}
*lt = vnorm_(pos) / clight_();
chkout_("SPKGPS", (ftnlen)6);
return 0;
} /* spkgps_ */
/* $Procedure 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 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 UNORM ( Unit vector and norm, 3 dimensional ) */
/* Subroutine */ int unorm_(doublereal *v1, doublereal *vout, doublereal *
vmag)
{
extern doublereal vnorm_(doublereal *);
/* $ Abstract */
/* Normalize a double precision 3-vector and return its magnitude. */
/* $ 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 */
/* VECTOR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* V1 I Vector to be normalized. */
/* VOUT O Unit vector V1 / |V1|. */
/* If V1 is the zero vector, then VOUT will also */
/* be zero. */
/* VMAG O Magnitude of V1, i.e. |V1|. */
/* $ Detailed_Input */
/* V1 This variable may contain any 3-vector, including the */
/* zero vector. */
/* $ Detailed_Output */
/* VOUT This variable contains the unit vector in the direction */
/* of V1. If V1 is the zero vector, then VOUT will also be */
/* the zero vector. */
/* VMAG This is the magnitude of V1. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* UNORM references a function called VNORM (which itself is */
/* numerically stable) to calculate the norm of the input vector V1. */
/* If the norm is equal to zero, then each component of the output */
/* vector VOUT is set to zero. Otherwise, VOUT is calculated by */
/* dividing V1 by the norm. */
/* $ Examples */
/* The following table shows how selected V1 implies VOUT and MAG. */
/* V1 VOUT MAG */
/* ------------------ ------------------ ---- */
/* (5, 12, 0) (5/13, 12/13, 0) 13 */
/* (1D-7, 2D-7, 2D-7) (1/3, 2/3, 2/3) 3D-7 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.M. Owen (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */
/* Header correction: assertions that the output */
/* can overwrite the input have been removed. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) */
/* -& */
/* $ Index_Entries */
/* 3-dimensional unit vector and norm */
/* -& */
/* $ Revisions */
/* - Beta Version 1.0.1, 10-JAN-1989 (WLT) */
/* Error free specification added. */
/* -& */
/* SPICELIB functions */
/* Obtain the magnitude of V1 */
*vmag = vnorm_(v1);
/* If VMAG is nonzero, then normalize. Note that this process is */
/* numerically stable: overflow could only happen if VMAG were small, */
/* but this could only happen if each component of V1 were small. */
/* In fact, the magnitude of any vector is never less than the */
/* magnitude of any component. */
if (*vmag > 0.) {
vout[0] = v1[0] / *vmag;
vout[1] = v1[1] / *vmag;
vout[2] = v1[2] / *vmag;
} else {
vout[0] = 0.;
vout[1] = 0.;
vout[2] = 0.;
}
return 0;
} /* unorm_ */
/* $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 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 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 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 ZZGFDIQ ( GF, return distance between objects ) */
/* Subroutine */ int zzgfdiq_(integer *targid, doublereal *et, char *abcorr,
integer *obsid, doublereal *dist, ftnlen abcorr_len)
{
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern doublereal vnorm_(doublereal *);
extern logical failed_(void);
doublereal lt;
extern /* Subroutine */ int chkout_(char *, ftnlen), spkezp_(integer *,
doublereal *, char *, char *, integer *, doublereal *, doublereal
*, ftnlen, ftnlen);
extern logical return_(void);
doublereal pos[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. */
/* Return the distance between two ephemeris objects, optionally */
/* corrected for light time and stellar aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* NAIF_IDS */
/* SPK */
/* TIME */
/* $ Keywords */
/* DISTANCE */
/* EPHEMERIS */
/* GEOMETRY */
/* SEARCH */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TARGID I Target body. */
/* ET I Observer epoch. */
/* ABCORR I Aberration correction flag. */
/* OBSID I Observing body. */
/* DIST O Distance between target and observer. */
/* $ Detailed_Input */
/* TARGID is the NAIF ID code for a target body. The target and */
/* observer define a position vector that points from */
/* the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past */
/* J2000 TDB, at which the position of the target body */
/* relative to the observer is to be computed. ET refers */
/* to time at the observer's location. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the position of the target body to account for */
/* one-way light time and stellar aberration. Any */
/* aberration correction accepted by SPKEZR may be used. */
/* $ Detailed_Output */
/* DIST is the norm (magnitude) of the specified Cartesian */
/* 3-vector representing the position of the target body */
/* relative to the specified observer, where the */
/* position is corrected for the specified aberrations. */
/* The position vector points from the observer's */
/* location at ET to the aberration-corrected location */
/* of the target. */
/* Units are km. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If an error occurs while reading an SPK or other kernel file, */
/* the error will be diagnosed by a routine in the call tree */
/* of this routine. */
/* $ 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 for the */
/* input epoch 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. */
/* - If non-inertial reference frames are used, then PCK */
/* files, frame kernels, C-kernels, and SCLK kernels may be */
/* needed. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine centralizes distance computations performed by */
/* entry points in the GF distance utility package ZZGFDIU. */
/* $ Examples */
/* See the entry point ZZGFDIGQ in ZZGFDIU. */
/* $ Restrictions */
/* This is a SPICELIB private routine; it should not be called by */
/* user applications. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.S. Elson (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) (LSE) (WLT) (IMU) (EDW) */
/* -& */
/* $ Index_Entries */
/* compute the apparent distance between two objects */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFDIQ", (ftnlen)7);
/* Get the position of the target relative to the observer. */
spkezp_(targid, et, "J2000", abcorr, obsid, pos, <, (ftnlen)5,
abcorr_len);
if (failed_()) {
chkout_("ZZGFDIQ", (ftnlen)7);
return 0;
}
*dist = vnorm_(pos);
chkout_("ZZGFDIQ", (ftnlen)7);
return 0;
} /* zzgfdiq_ */
/* $Procedure INEDPL ( Intersection of ellipsoid and plane ) */
/* Subroutine */ int inedpl_(doublereal *a, doublereal *b, doublereal *c__,
doublereal *plane, doublereal *ellips, logical *found)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double sqrt(doublereal);
/* Local variables */
doublereal dist, span1[3], span2[3];
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal const__, point[3];
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int cgv2el_(doublereal *, doublereal *,
doublereal *, doublereal *), pl2nvc_(doublereal *, doublereal *,
doublereal *), pl2psv_(doublereal *, doublereal *, doublereal *,
doublereal *), psv2pl_(doublereal *, doublereal *, doublereal *,
doublereal *);
doublereal dplane[4];
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal maxrad, rcircl, center[3], normal[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *,
ftnlen);
doublereal invdst[3];
extern logical return_(void);
doublereal dstort[3], vec1[3], vec2[3];
/* $ Abstract */
/* Find the intersection of a triaxial ellipsoid 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 */
/* ELLIPSES */
/* PLANES */
/* $ Keywords */
/* ELLIPSE */
/* ELLIPSOID */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* 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. */
/* PLANE I Plane that intersects ellipsoid. */
/* ELLIPS O Intersection ellipse, when FOUND is .TRUE. */
/* FOUND O Flag indicating whether ellipse was found. */
/* $ Detailed_Input */
/* 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. */
/* PLANE is a SPICELIB plane. */
/* $ Detailed_Output */
/* ELLIPS is the SPICELIB ellipse formed by the intersection */
/* of the input plane and ellipsoid. ELLIPS will */
/* represent a single point if the ellipsoid and */
/* plane are tangent. */
/* If the intersection of the ellipsoid and plane is */
/* empty, ELLIPS is not modified. */
/* FOUND is .TRUE. if and only if the intersection of the */
/* ellipsoid and plane is non-empty. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If any of the lengths of the semi-axes of the input ellipsoid */
/* are non-positive, the error SPICE(DEGENERATECASE) is */
/* signaled. ELLIPS is not modified. FOUND is set to .FALSE. */
/* 2) If the input plane in invalid, in other words, if the input */
/* plane as the zero vector as its normal vector, the error */
/* SPICE(INVALIDPLANE) is signaled. ELLIPS is not modified. */
/* FOUND is set to .FALSE. */
/* 3) If the input plane and ellipsoid are very nearly tangent, */
/* roundoff error may cause this routine to give unreliable */
/* results. */
/* 4) If the input plane and ellipsoid are precisely tangent, the */
/* intersection is a single point. In this case, the output */
/* ellipse is degenerate, but FOUND will still have the value */
/* .TRUE. You must decide whether this output makes sense for */
/* your application. */
/* $ Files */
/* None. */
/* $ Particulars */
/* An ellipsoid and a plane can intersect in an ellipse, a single */
/* point, or the empty set. */
/* $ Examples */
/* 1) Suppose we wish to find the limb of a body, as observed from */
/* location LOC in body-fixed coordinates. The SPICELIB routine */
/* EDLIMB solves this problem. Here's how INEDPL is used in */
/* that solution. */
/* We assume LOC is outside of the body. The body is modelled as */
/* a triaxial ellipsoid with semi-axes of length A, B, and C. */
/* The notation */
/* < X, Y > */
/* indicates the inner product of the vectors X and Y. */
/* The limb lies on the plane defined by */
/* < X, N > = 1, */
/* where the vector N is defined as */
/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */
/* The assignments */
/* N(1) = LOC(1) / A**2 */
/* N(2) = LOC(2) / B**2 */
/* N(3) = LOC(3) / C**2 */
/* and the calls */
/* CALL NVC2PL ( N, 1.0D0, PLANE ) */
/* CALL INEDPL ( A, B, C, PLANE, LIMB, FOUND ) */
/* CALL EL2CGV ( LIMB, CENTER, SMAJOR, SMINOR ) */
/* will return the center and semi-axes of the limb. */
/* How do we know that < X, N > = 1 for all X on the limb? */
/* This is because all limb points X satisfy */
/* < LOC - X, SURFNM(X) > = 0, */
/* where SURFNM(X) is a surface normal at X. SURFNM(X) is */
/* parallel to the vector */
/* V = ( X(1) / A**2, X(2) / B**2, X(3) / C**2 ) */
/* so we have */
/* < LOC - X, V > = 0, */
/* < LOC, V > = < X, V > = 1 (from the original */
/* ellipsoid */
/* equation); */
/* and finally */
/* < X, N > = 1, */
/* where the vector N is defined as */
/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */
/* 2) Suppose we wish to find the terminator of a body. We can */
/* make a fair approximation to the location of the terminator */
/* by finding the limb of the body as seen from the vertex of */
/* the umbra; then the problem is essentially the same as in */
/* example 1. Let VERTEX be this location. We make the */
/* assignments */
/* P(1) = VERTEX(1) / A**2 */
/* P(2) = VERTEX(2) / B**2 */
/* P(3) = VERTEX(3) / C**2 */
/* and then make the calls */
/* CALL NVC2PL ( P, 1.0D0, PLANE ) */
/* CALL INEDPL ( A, B, C, PLANE, TERM, FOUND ) */
/* The SPICELIB ellipse TERM represents the terminator of the */
/* body. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */
/* Bug fix: error detection for case of invalid input plane was */
/* added. */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */
/* Removed potential numerical precision problems that could be */
/* caused by using a REAL constant in a double precision */
/* computation. The value 1.0 was repaced with the value 1.0D0 in */
/* the following three lines: */
/* DSTORT(1) = 1.0 / A */
/* DSTORT(2) = 1.0 / B */
/* DSTORT(3) = 1.0 / C */
/* Also changed was a numeric constant from 1.D0 to the */
/* equivalent, but more aesthetically pleasing 1.0D0. */
/* - 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) */
/* -& */
/* $ Index_Entries */
/* intersection of ellipsoid and plane */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */
/* Bug fix: error detection for case of invalid input plane was */
/* added. */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */
/* Removed potential numerical precision problems that could be */
/* caused by using a REAL constant in a double precision */
/* computation. The value 1.0 was repaced with the value 1.0D0 in */
/* the following three lines: */
/* DSTORT(1) = 1.0 / A */
/* DSTORT(2) = 1.0 / B */
/* DSTORT(3) = 1.0 / C */
/* Also changed was a numeric constant from 1.D0 to the */
/* equivalent, but more aesthetically pleasing 1.0D0. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("INEDPL", (ftnlen)6);
}
/* We don't want to worry about flat ellipsoids: */
if (*a <= 0. || *b <= 0. || *c__ <= 0.) {
*found = FALSE_;
setmsg_("Semi-axes: A = #, B = #, C = #.", (ftnlen)33);
errdp_("#", a, (ftnlen)1);
errdp_("#", b, (ftnlen)1);
errdp_("#", c__, (ftnlen)1);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* Check input plane for zero normal vector. */
pl2nvc_(plane, normal, &const__);
if (vzero_(normal)) {
setmsg_("Normal vector of the input PLANE is the zero vector.", (
ftnlen)52);
sigerr_("SPICE(INVALIDPLANE)", (ftnlen)19);
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* This algorithm is partitioned into a series of steps: */
/* 1) Identify a linear transformation that maps the input */
/* ellipsoid to the unit sphere. We'll call this mapping the */
/* `distortion' mapping. Apply the distortion mapping to both */
/* the input plane and ellipsoid. The image of the plane under */
/* this transformation will be a plane. */
/* 2) Find the intersection of the transformed plane and the unit */
/* sphere. */
/* 3) Apply the inverse of the distortion mapping to the */
/* intersection ellipse to find the undistorted intersection */
/* ellipse. */
/* Step 1: */
/* Find the image of the ellipsoid and plane under the distortion */
/* matrix. Since the image of the ellipsoid is the unit sphere, */
/* only the plane transformation requires any work. */
/* If the input plane is too far from the origin to possibly */
/* intersect the ellipsoid, return now. This can save us */
/* some numerical problems when we scale the plane and ellipsoid. */
/* The point returned by PL2PSV is the closest point in PLANE */
/* to the origin, so its norm gives the distance of the plane */
/* from the origin. */
pl2psv_(plane, point, span1, span2);
/* Computing MAX */
d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__);
maxrad = max(d__1,d__2);
if (vnorm_(point) > maxrad) {
*found = FALSE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* The distortion matrix and its inverse are */
/* +- -+ +- -+ */
/* | 1/A 0 0 | | A 0 0 | */
/* | 0 1/B 0 |, | 0 B 0 |. */
/* | 0 0 1/C | | 0 0 C | */
/* +- -+ +- -+ */
/* We declare them with length three, since we are going to make */
/* use of the diagonal elements only. */
dstort[0] = 1. / *a;
dstort[1] = 1. / *b;
dstort[2] = 1. / *c__;
invdst[0] = *a;
invdst[1] = *b;
invdst[2] = *c__;
/* Apply the distortion mapping to the input plane. Applying */
/* the distortion mapping to a point and two spanning vectors that */
/* define the input plane yields a point and two spanning vectors */
/* that define the distorted plane. */
for (i__ = 1; i__ <= 3; ++i__) {
point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("point", i__1,
"inedpl_", (ftnlen)449)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
449)] * point[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("point", i__3, "inedpl_", (ftnlen)449)];
span1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span1", i__1,
"inedpl_", (ftnlen)450)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
450)] * span1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("span1", i__3, "inedpl_", (ftnlen)450)];
span2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span2", i__1,
"inedpl_", (ftnlen)451)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
451)] * span2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("span2", i__3, "inedpl_", (ftnlen)451)];
}
psv2pl_(point, span1, span2, dplane);
/* Step 2: */
/* Find the intersection of the distorted plane and unit sphere. */
/* The intersection of the distorted plane and the unit sphere */
/* may be a circle, a point, or the empty set. The distance of the */
/* plane from the origin determines which type of intersection we */
/* have. If we represent the distorted plane by a unit normal */
/* vector and constant, the size of the constant gives us the */
/* distance of the plane from the origin. If the distance is greater */
/* than 1, the intersection of plane and unit sphere is empty. If */
/* the distance is equal to 1, we have the tangency case. */
/* The routine PL2PSV always gives us an output point that is the */
/* closest point to the origin in the input plane. This point is */
/* the center of the intersection circle. The spanning vectors */
/* returned by PL2PSV, after we scale them by the radius of the */
/* intersection circle, become an orthogonal pair of vectors that */
/* extend from the center of the circle to the circle itself. So, */
/* the center and these scaled vectors define the intersection */
/* circle. */
pl2psv_(dplane, center, vec1, vec2);
dist = vnorm_(center);
if (dist > 1.) {
*found = FALSE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* Scale the generating vectors by the radius of the intersection */
/* circle. */
/* Computing 2nd power */
d__2 = dist;
d__1 = 1. - d__2 * d__2;
rcircl = sqrt(brcktd_(&d__1, &c_b32, &c_b33));
vsclip_(&rcircl, vec1);
vsclip_(&rcircl, vec2);
/* Step 3: */
/* Apply the inverse distortion to the intersection circle to find */
/* the actual intersection ellipse. */
for (i__ = 1; i__ <= 3; ++i__) {
center[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("center",
i__1, "inedpl_", (ftnlen)511)] = invdst[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (
ftnlen)511)] * center[(i__3 = i__ - 1) < 3 && 0 <= i__3 ?
i__3 : s_rnge("center", i__3, "inedpl_", (ftnlen)511)];
vec1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec1", i__1,
"inedpl_", (ftnlen)512)] = invdst[(i__2 = i__ - 1) < 3 && 0 <=
i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)512)]
* vec1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
"vec1", i__3, "inedpl_", (ftnlen)512)];
vec2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec2", i__1,
"inedpl_", (ftnlen)513)] = invdst[(i__2 = i__ - 1) < 3 && 0 <=
i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)513)]
* vec2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
"vec2", i__3, "inedpl_", (ftnlen)513)];
}
/* Make an ellipse from the center and generating vectors. */
cgv2el_(center, vec1, vec2, ellips);
*found = TRUE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
} /* inedpl_ */
/* $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 VROTV ( Vector rotation about an axis ) */
/* Subroutine */ int vrotv_(doublereal *v, doublereal *axis, doublereal *
theta, doublereal *r__)
{
/* Builtin functions */
double cos(doublereal), sin(doublereal);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
), vhat_(doublereal *, doublereal *), vsub_(doublereal *,
doublereal *, doublereal *);
doublereal c__, p[3], s, x[3];
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *), vproj_(doublereal *, doublereal *, doublereal *);
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal
*);
doublereal v1[3], v2[3], rplane[3];
/* $ Abstract */
/* Rotate a vector about a specified axis vector by a specified */
/* angle and return the rotated vector. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* ROTATION */
/* $ Keywords */
/* ROTATION, VECTOR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* V I Vector to be rotated. */
/* AXIS I Axis of the rotation. */
/* THETA I Angle of rotation (radians). */
/* R O Result of rotating V about AXIS by THETA. */
/* $ Detailed_Input */
/* V is a 3-dimensional vector to be rotated. */
/* AXIS is the axis about which the rotation is to be */
/* performed. */
/* THETA is the angle through which V is to be rotated about */
/* AXIS. */
/* $ Detailed_Output */
/* R is the result of rotating V about AXIS by THETA. */
/* If AXIS is the zero vector, R = V. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If the input axis is the zero vector R will be returned */
/* as V. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine computes the result of rotating (in a right handed */
/* sense) the vector V about the axis represented by AXIS through */
/* an angle of THETA radians. */
/* If W is a unit vector parallel to AXIS, then R is given by: */
/* R = V + ( 1 - cos(THETA) ) Wx(WxV) + sin(THETA) (WxV) */
/* where "x" above denotes the vector cross product. */
/* $ Examples */
/* If AXIS = ( 0, 0, 1 ) and THETA = PI/2 then the following results */
/* for R will be obtained */
/* V R */
/* ------------- ---------------- */
/* ( 1, 2, 3 ) ( -2, 1, 3 ) */
/* ( 1, 0, 0 ) ( 0, 1, 0 ) */
/* ( 0, 1, 0 ) ( -1, 0, 0 ) */
/* If AXIS = ( 0, 1, 0 ) and THETA = PI/2 then the following results */
/* for R will be obtained */
/* V R */
/* ------------- ---------------- */
/* ( 1, 2, 3 ) ( 3, 2, -1 ) */
/* ( 1, 0, 0 ) ( 0, 0, -1 ) */
/* ( 0, 1, 0 ) ( 0, 1, 0 ) */
/* If AXIS = ( 1, 1, 1 ) and THETA = PI/2 then the following results */
/* for R will be obtained */
/* V R */
/* ----------------------------- ----------------------------- */
/* ( 1.0, 2.0, 3.0 ) ( 2.577.., 0.845.., 2.577.. ) */
/* ( 2.577.., 0.845.., 2.577.. ) ( 3.0 2.0, 1.0 ) */
/* ( 3.0 2.0, 1.0 ) ( 1.422.., 3.154.., 1.422.. ) */
/* ( 1.422.., 3.154.., 1.422.. ) ( 1.0 2.0, 3.0 ) */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.2, 5-FEB-2003 (NJB) */
/* Header examples were corrected. Exceptions section */
/* filled in. Miscellaneous header corrections were made. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
/* -& */
/* $ Index_Entries */
/* vector rotation about an axis */
/* -& */
/* $ Revisions */
/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */
/* Contents of the Exceptions section was changed */
/* to "error free" to reflect the decision that the */
/* module will never participate in error handling. */
/* Also, the declarations of the unused variable I and the */
/* unused function VDOT were removed. */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Just in case the user tries to rotate about the zero vector - */
/* check, and if so return the input vector */
if (vnorm_(axis) == 0.) {
moved_(v, &c__3, r__);
return 0;
}
/* Compute the unit vector that lies in the direction of the */
/* AXIS. Call it X. */
vhat_(axis, x);
/* Compute the projection of V onto AXIS. Call it P. */
vproj_(v, x, p);
/* Compute the component of V orthogonal to the AXIS. Call it V1. */
vsub_(v, p, v1);
/* Rotate V1 by 90 degrees about the AXIS and call the result V2. */
vcrss_(x, v1, v2);
/* Compute COS(THETA)*V1 + SIN(THETA)*V2. This is V1 rotated about */
/* the AXIS in the plane normal to the axis, call the result RPLANE */
c__ = cos(*theta);
s = sin(*theta);
vlcom_(&c__, v1, &s, v2, rplane);
/* Add the rotated component in the normal plane to AXIS to the */
/* projection of V onto AXIS (P) to obtain R. */
vadd_(rplane, p, r__);
return 0;
} /* vrotv_ */
/* $Procedure ZZSPKAP1 ( S/P Kernel, apparent state ) */
/* Subroutine */ int zzspkap1_(integer *targ, doublereal *et, char *ref,
doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt,
ftnlen ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT "
"XLT+S" "XCN " "XCN+S";
static char prvcor[5] = " ";
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char corr[5];
extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *,
doublereal *, ftnlen);
static logical xmit;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer i__, refid;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *);
static logical usecn;
doublereal sapos[3];
extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *,
doublereal *);
static logical uselt;
extern doublereal vnorm_(doublereal *), clight_(void);
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int stelab_(doublereal *, doublereal *,
doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
stlabx_(doublereal *, doublereal *, doublereal *);
integer ltsign;
extern /* Subroutine */ int ljucrs_(integer *, char *, char *, ftnlen,
ftnlen), setmsg_(char *, ftnlen);
doublereal tstate[6];
integer maxitr;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen);
extern logical return_(void);
static logical usestl;
extern logical odd_(integer *);
/* $ Abstract */
/* Deprecated: This routine has been superseded by SPKAPS. This */
/* routine is supported for purposes of backward compatibility only. */
/* Return the state (position and velocity) of a target body */
/* relative to an observer, optionally corrected for light time and */
/* stellar aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Observer epoch. */
/* REF I Inertial reference frame of observer's state. */
/* SOBS I State of observer wrt. solar system barycenter. */
/* ABCORR I Aberration correction flag. */
/* STARG O State of target. */
/* LT O One way light time between observer and target. */
/* $ Detailed_Input */
/* TARG is the NAIF ID code for a target body. The target */
/* and observer define a state vector whose position */
/* component points from the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past J2000 */
/* TDB, at which the state of the target body relative to */
/* the observer is to be computed. ET refers to time at */
/* the observer's location. */
/* REF is the inertial reference frame with respect to which */
/* the observer's state SOBS is expressed. REF must be */
/* recognized by the SPICE Toolkit. The acceptable */
/* frames are listed in the Frames Required Reading, as */
/* well as in the SPICELIB routine CHGIRF. */
/* Case and blanks are not significant in the string REF. */
/* SOBS is the geometric (uncorrected) state of the observer */
/* relative to the solar system barycenter at epoch ET. */
/* SOBS is a 6-vector: the first three components of */
/* SOBS represent a Cartesian position vector; the last */
/* three components represent the corresponding velocity */
/* vector. SOBS is expressed relative to the inertial */
/* reference frame designated by REF. */
/* Units are always km and km/sec. */
/* ABCORR indicates the aberration corrections to be applied */
/* to the state of the target body to account for one-way */
/* light time and stellar aberration. See the discussion */
/* in the Particulars section for recommendations on */
/* how to choose aberration corrections. */
/* ABCORR may be any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric state of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the state of the target at the */
/* moment it emitted photons arriving at */
/* the observer at ET. */
/* The light time correction involves */
/* iterative solution of the light time */
/* equation (see Particulars for details). */
/* The solution invoked by the 'LT' option */
/* uses one iteration. */
/* 'LT+S' Correct for one-way light time and */
/* stellar aberration using a Newtonian */
/* formulation. This option modifies the */
/* state obtained with the 'LT' option to */
/* account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The result is the apparent */
/* state of the target---the position and */
/* velocity of the target as seen by the */
/* observer. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* Whether the 'CN+S' solution is */
/* substantially more accurate than the */
/* 'LT' solution depends on the geometry */
/* of the participating objects and on the */
/* accuracy of the input data. In all */
/* cases this routine will execute more */
/* slowly when a converged solution is */
/* computed. See the Particulars section */
/* of SPKEZR for a discussion of precision */
/* of light time corrections. */
/* 'CN+S' Converged Newtonian light time */
/* correction and stellar aberration */
/* correction. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* state of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XLT+S' "Transmission" case: correct for */
/* one-way light time and stellar */
/* aberration using a Newtonian */
/* formulation This option modifies the */
/* state obtained with the 'XLT' option to */
/* account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The position component of */
/* the computed target state indicates the */
/* direction that photons emitted from the */
/* observer's location must be "aimed" to */
/* hit the target. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* 'XCN+S' "Transmission" case: converged */
/* Newtonian light time correction and */
/* stellar aberration correction. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* $ Detailed_Output */
/* STARG is a Cartesian state vector representing the position */
/* and velocity of the target body relative to the */
/* specified observer. STARG is corrected for the */
/* specified aberrations, and is expressed with respect */
/* to the specified inertial reference frame. The first */
/* three components of STARG represent the x-, y- and */
/* z-components of the target's position; last three */
/* components form the corresponding velocity vector. */
/* The position component of STARG points from the */
/* observer's location at ET to the aberration-corrected */
/* location of the target. Note that the sense of the */
/* position vector is independent of the direction of */
/* radiation travel implied by the aberration */
/* correction. */
/* The velocity component of STARG is obtained by */
/* evaluating the target's geometric state at the light */
/* time corrected epoch, so for aberration-corrected */
/* states, the velocity is not precisely equal to the */
/* time derivative of the position. */
/* Units are always km and km/sec. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target state is corrected */
/* for aberrations, then LT is the one-way light time */
/* between the observer and the light time corrected */
/* target location. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the value of ABCORR is not recognized, the error */
/* 'SPICE(SPKINVALIDOPTION)' is signaled. */
/* 2) If the reference frame requested is not a recognized */
/* inertial reference frame, the error 'SPICE(BADFRAME)' */
/* is signaled. */
/* 3) If the state of the target relative to the solar system */
/* barycenter cannot be computed, the error will be diagnosed */
/* by routines in the call tree of this routine. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. Application programs typically load */
/* kernels once before this routine is called, for example during */
/* program initialization; kernels need not be loaded repeatedly. */
/* See the routine FURNSH and the SPK and KERNEL Required Reading */
/* for further information on loading (and unloading) kernels. */
/* If any of the ephemeris data used to compute STARG are expressed */
/* relative to a non-inertial frame in the SPK files providing those */
/* data, additional kernels may be needed to enable the reference */
/* frame transformations required to compute the state. Normally */
/* these additional kernels are PCK files or frame kernels. Any */
/* such kernels must already be loaded at the time this routine is */
/* called. */
/* $ Particulars */
/* In space science or engineering applications one frequently */
/* wishes to know where to point a remote sensing instrument, such */
/* as an optical camera or radio antenna, in order to observe or */
/* otherwise receive radiation from a target. This pointing problem */
/* is complicated by the finite speed of light: one needs to point */
/* to where the target appears to be as opposed to where it actually */
/* is at the epoch of observation. We use the adjectives */
/* "geometric," "uncorrected," or "true" to refer to an actual */
/* position or state of a target at a specified epoch. When a */
/* geometric position or state vector is modified to reflect how it */
/* appears to an observer, we describe that vector by any of the */
/* terms "apparent," "corrected," "aberration corrected," or "light */
/* time and stellar aberration corrected." */
/* The SPICE Toolkit can correct for two phenomena affecting the */
/* apparent location of an object: one-way light time (also called */
/* "planetary aberration") and stellar aberration. Correcting for */
/* one-way light time is done by computing, given an observer and */
/* observation epoch, where a target was when the observed photons */
/* departed the target's location. The vector from the observer to */
/* this computed target location is called a "light time corrected" */
/* vector. The light time correction depends on the motion of the */
/* target, but it is independent of the velocity of the observer */
/* relative to the solar system barycenter. Relativistic effects */
/* such as light bending and gravitational delay are not accounted */
/* for in the light time correction performed by this routine. */
/* The velocity of the observer also affects the apparent location */
/* of a target: photons arriving at the observer are subject to a */
/* "raindrop effect" whereby their velocity relative to the observer */
/* is, using a Newtonian approximation, the photons' velocity */
/* relative to the solar system barycenter minus the velocity of the */
/* observer relative to the solar system barycenter. This effect is */
/* called "stellar aberration." Stellar aberration is independent */
/* of the velocity of the target. The stellar aberration formula */
/* used by this routine is non-relativistic. */
/* Stellar aberration corrections are applied after light time */
/* corrections: the light time corrected target position vector is */
/* used as an input to the stellar aberration correction. */
/* When light time and stellar aberration corrections are both */
/* applied to a geometric position vector, the resulting position */
/* vector indicates where the target "appears to be" from the */
/* observer's location. */
/* As opposed to computing the apparent position of a target, one */
/* may wish to compute the pointing direction required for */
/* transmission of photons to the target. This requires correction */
/* of the geometric target position for the effects of light time and */
/* stellar aberration, but in this case the corrections are computed */
/* for radiation traveling from the observer to the target. */
/* The "transmission" light time correction yields the target's */
/* location as it will be when photons emitted from the observer's */
/* location at ET arrive at the target. The transmission stellar */
/* aberration correction is the inverse of the traditional stellar */
/* aberration correction: it indicates the direction in which */
/* radiation should be emitted so that, using a Newtonian */
/* approximation, the sum of the velocity of the radiation relative */
/* to the observer and of the observer's velocity, relative to the */
/* solar system barycenter, yields a velocity vector that points in */
/* the direction of the light time corrected position of the target. */
/* The traditional aberration corrections applicable to observation */
/* and those applicable to transmission are related in a simple way: */
/* one may picture the geometry of the "transmission" case by */
/* imagining the "observation" case running in reverse time order, */
/* and vice versa. */
/* One may reasonably object to using the term "observer" in the */
/* transmission case, in which radiation is emitted from the */
/* observer's location. The terminology was retained for */
/* consistency with earlier documentation. */
/* Below, we indicate the aberration corrections to use for some */
/* common applications: */
/* 1) Find the apparent direction of a target for a remote-sensing */
/* observation. */
/* Use 'LT+S' or 'CN+S: apply both light time and stellar */
/* aberration corrections. */
/* Note that using light time corrections alone ('LT' or 'CN') */
/* is generally not a good way to obtain an approximation to */
/* an apparent target vector: since light time and stellar */
/* aberration corrections often partially cancel each other, */
/* it may be more accurate to use no correction at all than to */
/* use light time alone. */
/* 2) Find the corrected pointing direction to radiate a signal */
/* to a target. This computation is often applicable for */
/* implementing communications sessions. */
/* Use 'XLT+S' or 'XCN+S: apply both light time and stellar */
/* aberration corrections for transmission. */
/* 3) Compute the apparent position of a target body relative */
/* to a star or other distant object. */
/* Use 'LT', 'CN', 'LT+S', or 'CN+S' as needed to match the */
/* correction applied to the position of the distant */
/* object. For example, if a star position is obtained from */
/* a catalog, the position vector may not be corrected for */
/* stellar aberration. In this case, to find the angular */
/* separation of the star and the limb of a planet, the */
/* vector from the observer to the planet should be */
/* corrected for light time but not stellar aberration. */
/* 4) Obtain an uncorrected state vector derived directly from */
/* data in an SPK file. */
/* Use 'NONE'. */
/* C */
/* 5) Use a geometric state vector as a low-accuracy estimate */
/* of the apparent state for an application where execution */
/* speed is critical: */
/* Use 'NONE'. */
/* 6) While this routine cannot perform the relativistic */
/* aberration corrections required to compute states */
/* with the highest possible accuracy, it can supply the */
/* geometric states required as inputs to these computations: */
/* Use 'NONE', then apply high-accuracy aberration */
/* corrections (not available in the SPICE Toolkit). */
/* Below, we discuss in more detail how the aberration corrections */
/* applied by this routine are computed. */
/* Geometric case */
/* ============== */
/* SPKAPP begins by computing the geometric position T(ET) of the */
/* target body relative to the solar system barycenter (SSB). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the geometric position of the target body relative to the */
/* observer. The one-way light time, LT, is given by */
/* | T(ET) - O(ET) | */
/* LT = ------------------- */
/* c */
/* The geometric relationship between the observer, target, and */
/* solar system barycenter is as shown: */
/* SSB ---> O(ET) */
/* | / */
/* | / */
/* | / */
/* | / T(ET) - O(ET) */
/* V V */
/* T(ET) */
/* The returned state consists of the position vector */
/* T(ET) - O(ET) */
/* and a velocity obtained by taking the difference of the */
/* corresponding velocities. In the geometric case, the */
/* returned velocity is actually the time derivative of the */
/* position. */
/* Reception case */
/* ============== */
/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */
/* selected, SPKAPP computes the position of the target body at */
/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */
/* O(t) represent the positions of the target and observer */
/* relative to the solar system barycenter at time t; then LT is */
/* the solution of the light-time equation */
/* | T(ET-LT) - O(ET) | */
/* LT = ------------------------ (1) */
/* c */
/* The ratio */
/* | T(ET) - O(ET) | */
/* --------------------- (2) */
/* c */
/* is used as a first approximation to LT; inserting (2) into the */
/* RHS of the light-time equation (1) yields the "one-iteration" */
/* estimate of the one-way light time. Repeating the process */
/* until the estimates of LT converge yields the "converged */
/* Newtonian" light time estimate. */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the position of the target body relative to the observer: */
/* T(ET-LT) - O(ET). */
/* SSB ---> O(ET) */
/* | \ | */
/* | \ | */
/* | \ | T(ET-LT) - O(ET) */
/* | \ | */
/* V V V */
/* T(ET) T(ET-LT) */
/* The position component of the light-time corrected state */
/* is the vector */
/* T(ET-LT) - O(ET) */
/* The velocity component of the light-time corrected state */
/* is the difference */
/* T_vel(ET-LT) - O_vel(ET) */
/* where T_vel and O_vel are, respectively, the velocities of */
/* the target and observer relative to the solar system */
/* barycenter at the epochs ET-LT and ET. */
/* If correction for stellar aberration is requested, the target */
/* position is rotated toward the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as follows: */
/* Let r be the light time corrected vector from the observer */
/* to the object, and v be the velocity of the observer with */
/* respect to the solar system barycenter. Let w be the angle */
/* between them. The aberration angle phi is given by */
/* sin(phi) = v sin(w) / c */
/* Let h be the vector given by the cross product */
/* h = r X v */
/* Rotate r by phi radians about h to obtain the apparent */
/* position of the object. */
/* The velocity component of the output state STARG is */
/* not corrected for stellar aberration. */
/* Transmission case */
/* ================== */
/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */
/* selected, SPKAPP computes the position of the target body T at */
/* epoch ET+LT, where LT is the one-way light time. LT is the */
/* solution of the light-time equation */
/* | T(ET+LT) - O(ET) | */
/* LT = ------------------------ (3) */
/* c */
/* Subtracting the geometric position of the observer, O(ET), */
/* gives the position of the target body relative to the */
/* observer: T(ET-LT) - O(ET). */
/* SSB --> O(ET) */
/* / | * */
/* / | * T(ET+LT) - O(ET) */
/* / |* */
/* / *| */
/* V V V */
/* T(ET+LT) T(ET) */
/* The position component of the light-time corrected state */
/* is the vector */
/* T(ET+LT) - O(ET) */
/* The velocity component of the light-time corrected state */
/* is the difference */
/* T_vel(ET+LT) - O_vel(ET) */
/* where T_vel and O_vel are, respectively, the velocities of */
/* the target and observer relative to the solar system */
/* barycenter at the epochs ET+LT and ET. */
/* If correction for stellar aberration is requested, the target */
/* position is rotated away from the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as in the reception case, but the sign of the */
/* rotation angle is negated. */
/* The velocity component of the output state STARG is */
/* not corrected for stellar aberration. */
/* Neither special nor general relativistic effects are accounted */
/* for in the aberration corrections performed by this routine. */
/* $ Examples */
/* In the following code fragment, SPKSSB and SPKAPP are used */
/* to display the position of Io (body 501) as seen from the */
/* Voyager 2 spacecraft (Body -32) at a series of epochs. */
/* Normally, one would call the high-level reader SPKEZR to obtain */
/* state vectors. The example below illustrates the interface */
/* of this routine but is not intended as a recommendation on */
/* how to use the SPICE SPK subsystem. */
/* The use of integer ID codes is necessitated by the low-level */
/* interface of this routine. */
/* IO = 501 */
/* VGR2 = -32 */
/* DO WHILE ( EPOCH .LE. END ) */
/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */
/* CALL SPKAPP ( IO, EPOCH, 'J2000', STVGR2, */
/* . 'LT+S', STIO, LT ) */
/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */
/* WRITE (*,*) RA * DPR(), DEC * DPR() */
/* EPOCH = EPOCH + DELTA */
/* END DO */
/* $ Restrictions */
/* 1) The kernel files to be used by SPKAPP must be loaded */
/* (normally by the SPICELIB kernel loader FURNSH) before */
/* this routine is called. */
/* 2) Unlike most other SPK state computation routines, this */
/* routine requires that the input state be relative to an */
/* inertial reference frame. Non-inertial frames are not */
/* supported by this routine. */
/* 3) In a future version of this routine, the implementation */
/* of the aberration corrections may be enhanced to improve */
/* accuracy. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* B.V. Semenov (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 3.1.0, 04-JUL-2014 (NJB) (BVS) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* Last update was 21-SEP-2013 (BVS) */
/* Updated to call LJUCRS instead of CMPRSS/UCASE. */
/* - SPICELIB Version 3.0.3, 18-MAY-2010 (BVS) */
/* Index lines now state that this routine is deprecated. */
/* - SPICELIB Version 3.0.2, 08-JAN-2008 (NJB) */
/* The Abstract section of the header was updated to */
/* indicate that this routine has been deprecated. */
/* - SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */
/* Added mention that LT returns in seconds. */
/* Corrected spelling errors. */
/* - SPICELIB Version 3.0.0, 18-DEC-2001 (NJB) */
/* Updated to handle aberration corrections for transmission */
/* of radiation. Formerly, only the reception case was */
/* supported. The header was revised and expanded to explain */
/* the functionality of this routine in more detail. */
/* - SPICELIB Version 2.1.0, 09-JUL-1996 (WLT) */
/* Corrected the description of LT in the Detailed Output */
/* section of the header. */
/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */
/* The routine was modified to support the options 'CN' and */
/* 'CN+S' aberration corrections. Moreover, diagnostics were */
/* added to check for reference frames that are not recognized */
/* inertial frames. */
/* - SPICELIB Version 1.1.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */
/* In the example program, the calling sequence of SPKAPP */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */
/* The local variable CORR was added to eliminate a */
/* run-time error that occurred when SPKAPP was determining */
/* what corrections to apply to the state. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED low-level aberration correction */
/* DEPRECATED apparent state from spk file */
/* DEPRECATED get apparent state */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */
/* The routine was modified to support the options 'CN' and */
/* 'CN+S' aberration corrections. Moreover, diagnostics were */
/* added to check for reference frames that are not recognized */
/* inertial frames. */
/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */
/* In the example program, the calling sequence of SPKAPP */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */
/* The local variable CORR was added to eliminate a run-time */
/* error that occurred when SPKAPP was determining what */
/* corrections to apply to the state. If the literal string */
/* 'LT' was assigned to ABCORR, SPKAPP attempted to look at */
/* ABCORR(3:4). Because ABCORR is a passed length argument, its */
/* length is not guaranteed, and those positions may not exist. */
/* Searching beyond the bounds of a string resulted in a */
/* run-time error at NAIF because NAIF compiles SPICELIB using the */
/* CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */
/* Also, without the local variable CORR, SPKAPP would have to */
/* modify the value of a passed argument, ABCORR. That's a no no. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Indices of flags in the FLAGS array: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKAP1", (ftnlen)8);
}
if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {
/* The aberration correction flag differs from the value it */
/* had on the previous call, if any. Analyze the new flag. */
/* Remove leading and embedded white space from the aberration */
/* correction flag and convert to upper case. */
ljucrs_(&c__0, abcorr, corr, abcorr_len, (ftnlen)5);
/* Locate the flag in our list of flags. */
i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5);
if (i__ == 0) {
setmsg_("Requested aberration correction # is not supported.", (
ftnlen)51);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23);
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
}
/* The aberration correction flag is recognized; save it. */
s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);
/* Set logical flags indicating the attributes of the requested */
/* correction. */
xmit = i__ > 5;
uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7;
usestl = i__ > 1 && odd_(&i__);
usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9;
first = FALSE_;
}
/* See if the reference frame is a recognized inertial frame. */
irfnum_(ref, &refid, ref_len);
if (refid == 0) {
setmsg_("The requested frame '#' is not a recognized inertial frame. "
, (ftnlen)60);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(BADFRAME)", (ftnlen)15);
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
}
/* Determine the sign of the light time offset. */
if (xmit) {
ltsign = 1;
} else {
ltsign = -1;
}
/* Find the geometric state of the target body with respect to the */
/* solar system barycenter. Subtract the state of the observer */
/* to get the relative state. Use this to compute the one-way */
/* light time. */
zzspksb1_(targ, et, ref, starg, ref_len);
vsubg_(starg, sobs, &c__6, tstate);
moved_(tstate, &c__6, starg);
*lt = vnorm_(starg) / clight_();
/* To correct for light time, find the state of the target body */
/* at the current epoch minus the one-way light time. Note that */
/* the observer remains where he is. */
if (uselt) {
maxitr = 1;
} else if (usecn) {
maxitr = 3;
} else {
maxitr = 0;
}
i__1 = maxitr;
for (i__ = 1; i__ <= i__1; ++i__) {
d__1 = *et + ltsign * *lt;
zzspksb1_(targ, &d__1, ref, starg, ref_len);
vsubg_(starg, sobs, &c__6, tstate);
moved_(tstate, &c__6, starg);
*lt = vnorm_(starg) / clight_();
}
/* At this point, STARG contains the light time corrected */
/* state of the target relative to the observer. */
/* If stellar aberration correction is requested, perform it now. */
/* Stellar aberration corrections are not applied to the target's */
/* velocity. */
if (usestl) {
if (xmit) {
/* This is the transmission case. */
/* Compute the position vector obtained by applying */
/* "reception" stellar aberration to STARG. */
stlabx_(starg, &sobs[3], sapos);
vequ_(sapos, starg);
} else {
/* This is the reception case. */
/* Compute the position vector obtained by applying */
/* "reception" stellar aberration to STARG. */
stelab_(starg, &sobs[3], sapos);
vequ_(sapos, starg);
}
}
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
} /* zzspkap1_ */
/* $Procedure 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_ */
