/* $Procedure CONICS ( Determine state from conic elements ) */
/* Subroutine */ int conics_(doublereal *elts, doublereal *et, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal), sqrt(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal cnci, argp, snci, cosi, sini, cosn, sinn;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
doublereal cosw, sinw, n, v;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal lnode;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal m0;
extern doublereal twopi_(void);
doublereal t0;
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal dt, rp, mu, basisp[3], period, basisq[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal pstate[6], ainvrs;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
extern logical return_(void);
doublereal ecc, inc;
/* $ Abstract */
/* Determine the state (position, velocity) of an orbiting body */
/* from a set of elliptic, hyperbolic, or parabolic orbital */
/* elements. */
/* $ 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 */
/* CONIC */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ELTS I Conic elements. */
/* ET I Input time. */
/* STATE O State of orbiting body at ET. */
/* $ Detailed_Input */
/* ELTS are conic elements describing the orbit of a body */
/* around a primary. The elements are, in order: */
/* RP Perifocal distance. */
/* ECC Eccentricity. */
/* INC Inclination. */
/* LNODE Longitude of the ascending node. */
/* ARGP Argument of periapse. */
/* M0 Mean anomaly at epoch. */
/* T0 Epoch. */
/* MU Gravitational parameter. */
/* Units are km, rad, rad/sec, km**3/sec**2. The epoch */
/* is given in ephemeris seconds past J2000. The same */
/* elements are used to describe all three types */
/* (elliptic, hyperbolic, and parabolic) of conic orbit. */
/* ET is the time at which the state of the orbiting body */
/* is to be determined, in ephemeris seconds J2000. */
/* $ Detailed_Output */
/* STATE is the state (position and velocity) of the body at */
/* time ET. Components are x, y, z, dx/dt, dy/dt, dz/dt. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity supplied is less than 0, the error */
/* 'SPICE(BADECCENTRICITY)' is signalled. */
/* 2) If a non-positive periapse distance is supplied, the error */
/* 'SPICE(BADPERIAPSEVALUE)' is signalled. */
/* 3) If a non-positive value for the attracting mass is supplied, */
/* the error 'SPICE(BADGM)', is signalled. */
/* 4) Errors such as an out of bounds value for ET are diagnosed */
/* by routines called by this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* Let VINIT contain the initial state of a spacecraft relative to */
/* the center of a planet at epoch ET, and let GM be the gravitation */
/* parameter of the planet. The call */
/* CALL OSCELT ( VINIT, ET, GM, ELTS ) */
/* produces a set of osculating elements describing the nominal */
/* orbit that the spacecraft would follow in the absence of all */
/* other bodies in the solar system and non-gravitational forces */
/* on the spacecraft. */
/* Now let STATE contain the state of the same spacecraft at some */
/* other epoch, LATER. The difference between this state and the */
/* state predicted by the nominal orbit at the same epoch can be */
/* computed as follows. */
/* CALL CONICS ( ELTS, LATER, NOMINAL ) */
/* CALL VSUBG ( NOMINAL, STATE, 6, DIFF ) */
/* WRITE (*,*) 'Perturbation in x, dx/dt = ', DIFF(1), DIFF(4) */
/* WRITE (*,*) ' y, dy/dt = ', DIFF(2), DIFF(5) */
/* WRITE (*,*) ' z, dz/dt = ', DIFF(3), DIFF(6) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.0, 26-MAR-1998 (WLT) */
/* There was a coding error in the computation of the mean */
/* anomaly in the parabolic case. This problem has been */
/* corrected. */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* An error in the hyperbolic state generation was corrected. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* state from conic elements */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* These changes were prompted by the discovery that the old */
/* formulation had a severe bug for elliptic orbits and epochs */
/* prior to the epoch of the input elements, and by the discovery */
/* that the time of flight routines had problems with convergence. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* The original version of the routine had a bug in that */
/* it attempted to restrict the hyperbolic anomaly to */
/* the interval 0 to 2*PI. This has been fixed. */
/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */
/* Examples section completed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* The only real work required by this routine is the construction */
/* of a preliminary state vector from the input elements. Once this */
/* is in hand, we can simply let the routine PROP2B do the real */
/* work, free from the instabilities inherent in the classical */
/* elements formulation of two-body motion. */
/* To do this we shall construct a basis of vectors that lie in the */
/* plane of the orbit. The first vector P shall point towards the */
/* position of the orbiting body at periapse. The second */
/* vector Q shall point along the velocity vector of the body at */
/* periapse. */
/* The only other consideration is determining an epoch, TP, of */
/* this state and the delta time ET - TP. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CONICS", (ftnlen)6);
}
/* Unpack the element vector. */
rp = elts[0];
ecc = elts[1];
inc = elts[2];
lnode = elts[3];
argp = elts[4];
m0 = elts[5];
t0 = elts[6];
mu = elts[7];
/* Handle all of the exceptions first. */
if (ecc < 0.) {
setmsg_("The eccentricity supplied was negative. Only positive value"
"s are meaningful. The value was #", (ftnlen)93);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (rp <= 0.) {
setmsg_("The value of periapse range supplied was non-positive. Onl"
"y positive values are allowed. The value supplied was #. ", (
ftnlen)117);
errdp_("#", &rp, (ftnlen)1);
sigerr_("SPICE(BADPERIAPSEVALUE)", (ftnlen)23);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (mu <= 0.) {
setmsg_("The value of GM supplied was non-positive. Only positive v"
"alues are allowed. The value supplied was #. ", (ftnlen)105);
errdp_("#", &mu, (ftnlen)1);
sigerr_("SPICE(BADGM)", (ftnlen)12);
chkout_("CONICS", (ftnlen)6);
return 0;
}
/* First construct the orthonormal basis vectors that span the orbit */
/* plane. */
cosi = cos(inc);
sini = sin(inc);
cosn = cos(lnode);
sinn = sin(lnode);
cosw = cos(argp);
sinw = sin(argp);
snci = sinn * cosi;
cnci = cosn * cosi;
basisp[0] = cosn * cosw - snci * sinw;
basisp[1] = sinn * cosw + cnci * sinw;
basisp[2] = sini * sinw;
basisq[0] = -cosn * sinw - snci * cosw;
basisq[1] = -sinn * sinw + cnci * cosw;
basisq[2] = sini * cosw;
/* Next construct the state at periapse. */
/* The position at periapse is just BASISP scaled by the distance */
/* at periapse. */
/* The velocity must be constructed so that we can get an orbit */
/* of this shape. Recall that the magnitude of the specific angular */
/* momentum vector is given by DSQRT ( MU*RP*(1+ECC) ) */
/* The velocity will be given by V * BASISQ. But we must have the */
/* magnitude of the cross product of position and velocity be */
/* equal to DSQRT ( MU*RP*(1+ECC) ). So we must have */
/* RP*V = DSQRT( MU*RP*(1+ECC) ) */
/* so that: */
v = sqrt(mu * (ecc + 1.) / rp);
vscl_(&rp, basisp, pstate);
vscl_(&v, basisq, &pstate[3]);
/* Finally compute DT the elapsed time since the epoch of periapse. */
/* Ellipses first, since they are the most common. */
if (ecc < 1.) {
/* Recall that: */
/* N ( mean motion ) is given by DSQRT( MU / A**3 ). */
/* But since, A = RP / ( 1 - ECC ) ... */
ainvrs = (1. - ecc) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
period = twopi_() / n;
/* In general the mean anomaly is given by */
/* M = (T - TP) * N */
/* Where TP is the time of periapse passage. M0 is the mean */
/* anomaly at time T0 so that */
/* Thus */
/* M0 = ( T0 - TP ) * N */
/* So TP = T0-M0/N hence the time since periapse at time ET */
/* is given by ET - T0 + M0/N. Finally, since elliptic orbits are */
/* periodic, we can mod this value by the period of the orbit. */
d__1 = *et - t0 + m0 / n;
dt = d_mod(&d__1, &period);
/* Hyperbolas next. */
} else if (ecc > 1.) {
/* Again, recall that: */
/* N ( mean motion ) is given by DSQRT( MU / |A**3| ). */
/* But since, |A| = RP / ( ECC - 1 ) ... */
ainvrs = (ecc - 1.) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
dt = *et - t0 + m0 / n;
/* Finally, parabolas. */
} else {
n = sqrt(mu / (rp * 2.)) / rp;
dt = *et - t0 + m0 / n;
}
/* Now let PROP2B do the work of propagating the state. */
prop2b_(&mu, pstate, &dt, state);
chkout_("CONICS", (ftnlen)6);
return 0;
} /* conics_ */
/* $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 ZZGFSSOB ( GF, state of sub-observer point ) */
/* Subroutine */ int zzgfssob_(char *method, integer *trgid, doublereal *et,
char *fixref, char *abcorr, integer *obsid, doublereal *radii,
doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen
abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer prvobs = 0;
static integer prvtrg = 0;
static char svobs[36] = " ";
static char svtarg[36] = " ";
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal dalt[2];
logical near__, geom;
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_(
doublereal *, doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
logical xmit;
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *);
doublereal upos[3];
extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal
*, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *,
doublereal *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen);
doublereal t;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal savel[3];
logical found;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vsubg_(doublereal *, doublereal *, integer *, doublereal *);
doublereal stemp[6];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal xform[36] /* was [6][6] */;
logical uselt;
extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen);
doublereal ssbtg0[6];
extern logical failed_(void);
doublereal sa[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal lt;
integer frcode;
extern doublereal clight_(void);
extern logical return_(void);
doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6]
*/, fxosta[6], fxpsta[6], fxpvel[3], fxtsta[6], obspnt[6], obssta[
12] /* was [6][2] */, obstrg[6], acc[3], pntsta[6], raysta[6],
sastat[6], spoint[3], srfvec[3], ssbobs[6], ssbtrg[6], trgepc;
integer center, clssid, frclss;
logical attblk[6], usestl;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
logical fnd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *,
integer *, integer *, integer *, logical *), errint_(char *,
integer *, ftnlen), spkgeo_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), vminug_(
doublereal *, integer *, doublereal *), dnearp_(doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, logical *), surfpv_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, logical *)
, subpnt_(char *, char *, doublereal *, char *, char *, char *,
doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen, ftnlen), spkssb_(integer *, doublereal *, char *,
doublereal *, ftnlen);
doublereal dlt;
extern /* Subroutine */ int sxform_(char *, char *, doublereal *,
doublereal *, ftnlen, ftnlen), qderiv_(integer *, doublereal *,
doublereal *, doublereal *, doublereal *), invstm_(doublereal *,
doublereal *);
/* $ Abstract */
/* SPICE private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due to the */
/* volatile nature of this routine. */
/* Return the state of a sub-observer point used to define */
/* coordinates referenced in a GF search. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* SPK */
/* TIME */
/* NAIF_IDS */
/* FRAMES */
/* $ Keywords */
/* GEOMETRY */
/* PRIVATE */
/* SEARCH */
/* $ Declarations */
/* $ Abstract */
/* This file contains public, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) subsystem. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.E. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.3.0, 01-OCT-2011 (NJB) */
/* Added NWILUM parameter. */
/* - SPICELIB Version 1.2.0, 14-SEP-2010 (EDW) */
/* Added NWPA parameter. */
/* - SPICELIB Version 1.1.0, 08-SEP-2009 (EDW) */
/* Added NWRR parameter. */
/* Added NWUDS parameter. */
/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */
/* -& */
/* Root finding parameters: */
/* CNVTOL is the default convergence tolerance used by the */
/* high-level GF search API routines. This tolerance is */
/* used to terminate searches for binary state transitions: */
/* when the time at which a transition occurs is bracketed */
/* by two times that differ by no more than CNVTOL, the */
/* transition time is considered to have been found. */
/* Units are TDB seconds. */
/* NWMAX is the maximum number of windows allowed for user-defined */
/* workspace array. */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */
/* Currently no more than twelve windows are required; the three */
/* extra windows are spares. */
/* Callers of GFEVNT can include this file and use the parameter */
/* NWMAX to declare the second dimension of the workspace array */
/* if necessary. */
/* Callers of GFIDST should declare their workspace window */
/* count using NWDIST. */
/* Callers of GFSEP should declare their workspace window */
/* count using NWSEP. */
/* Callers of GFRR should declare their workspace window */
/* count using NWRR. */
/* Callers of GFUDS should declare their workspace window */
/* count using NWUDS. */
/* Callers of GFPA should declare their workspace window */
/* count using NWPA. */
/* Callers of GFILUM should declare their workspace window */
/* count using NWILUM. */
/* ADDWIN is a parameter used to expand each interval of the search */
/* (confinement) window by a small amount at both ends in order to */
/* accommodate searches using equality constraints. The loaded */
/* kernel files must accommodate these expanded time intervals. */
/* FRMNLN is a string length for frame names. */
/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */
/* FOVTLN -- maximum length for FOV string. */
/* Specify the character strings that are allowed in the */
/* specification of field of view shapes. */
/* Character strings that are allowed in the */
/* specification of occultation types: */
/* Occultation target shape specifications: */
/* Specify the number of supported occultation types and occultation */
/* type string length: */
/* Instrument field-of-view (FOV) parameters */
/* Maximum number of FOV boundary vectors: */
/* FOV shape parameters: */
/* circle */
/* ellipse */
/* polygon */
/* rectangle */
/* End of file gf.inc. */
/* $ Abstract */
/* SPICE private include file intended solely for the support of */
/* SPICE routines. Users should not include this routine in their */
/* source code due to the volatile nature of this file. */
/* This file contains private, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) subsystem. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */
/* -& */
/* The set of supported coordinate systems */
/* System Coordinates */
/* ---------- ----------- */
/* Rectangular X, Y, Z */
/* Latitudinal Radius, Longitude, Latitude */
/* Spherical Radius, Colatitude, Longitude */
/* RA/Dec Range, Right Ascension, Declination */
/* Cylindrical Radius, Longitude, Z */
/* Geodetic Longitude, Latitude, Altitude */
/* Planetographic Longitude, Latitude, Altitude */
/* Below we declare parameters for naming coordinate systems. */
/* User inputs naming coordinate systems must match these */
/* when compared using EQSTR. That is, user inputs must */
/* match after being left justified, converted to upper case, */
/* and having all embedded blanks removed. */
/* Below we declare names for coordinates. Again, user */
/* inputs naming coordinates must match these when */
/* compared using EQSTR. */
/* Note that the RA parameter value below matches */
/* 'RIGHT ASCENSION' */
/* when extra blanks are compressed out of the above value. */
/* Parameters specifying types of vector definitions */
/* used for GF coordinate searches: */
/* All string parameter values are left justified, upper */
/* case, with extra blanks compressed out. */
/* POSDEF indicates the vector is defined by the */
/* position of a target relative to an observer. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the sub-observer point on */
/* that body, for a given observer and target. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the surface intercept point on */
/* that body, for a given observer, ray, and target. */
/* Number of workspace windows used by ZZGFREL: */
/* Number of additional workspace windows used by ZZGFLONG: */
/* Index of "existence window" used by ZZGFCSLV: */
/* Progress report parameters: */
/* MXBEGM, */
/* MXENDM are, respectively, the maximum lengths of the progress */
/* report message prefix and suffix. */
/* Note: the sum of these lengths, plus the length of the */
/* "percent complete" substring, should not be long enough */
/* to cause wrap-around on any platform's terminal window. */
/* Total progress report message length upper bound: */
/* End of file zzgf.inc. */
/* $ Abstract */
/* Include file zzabcorr.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters below define the structure of an aberration */
/* correction attribute block. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TRGID I Target ID code. */
/* ET I Computation epoch. */
/* FIXREF I Reference frame name. */
/* ABCORR I Aberration correction. */
/* OBSID I Observer ID code. */
/* RADII I Target radii. */
/* STATE O State used to define coordinates. */
/* $ Detailed_Input */
/* METHOD is a short string providing parameters defining */
/* the computation method to be used. Any value */
/* supported by SUBPNT may be used. */
/* TRGID is the NAIF ID code of the target object. */
/* *This routine assumes that the target is modeled */
/* as a tri-axial ellipsoid.* */
/* ET is the time, expressed as ephemeris seconds past J2000 */
/* TDB, at which the specified state is to be computed. */
/* FIXREF is the name of the reference frame relative to which */
/* the state of interest is specified. */
/* FIXREF must be centered on the target body. */
/* Case, leading and trailing blanks are not significant */
/* in the string FIXREF. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the state of the target body to account for one-way */
/* light time and stellar aberration. The orientation */
/* of the target body will also be corrected for one-way */
/* light time when light time corrections are requested. */
/* Supported aberration correction options for */
/* observation (case where radiation is received by */
/* observer at ET) are: */
/* NONE No correction. */
/* LT Light time only. */
/* LT+S Light time and stellar aberration. */
/* CN Converged Newtonian (CN) light time. */
/* CN+S CN light time and stellar aberration. */
/* Supported aberration correction options for */
/* transmission (case where radiation is emitted from */
/* observer at ET) are: */
/* XLT Light time only. */
/* XLT+S Light time and stellar aberration. */
/* XCN Converged Newtonian (CN) light time. */
/* XCN+S CN light time and stellar aberration. */
/* For detailed information, see the geometry finder */
/* required reading, gf.req. Also see the header of */
/* SPKEZR, which contains a detailed discussion of */
/* aberration corrections. */
/* Case, leading and trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSID is the NAIF ID code of the observer. */
/* RADII is an array containing three radii defining */
/* a reference ellipsoid for the target body. */
/* $ Detailed_Output */
/* STATE is the state of the sub-observer point at ET. */
/* The first three components of STATE contain the */
/* sub-observer point itself; the last three */
/* components contain the derivative with respect to */
/* time of the position. The state is expressed */
/* relative to the body-fixed frame designated by */
/* FIXREF. */
/* Units are km and km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the aberration correction ABCORR is not recognized, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 2) If the frame FIXREF is not recognized by the frames */
/* subsystem, the error will be diagnosed by routines in the */
/* call tree of this routine. */
/* 3) FIXREF must be centered on the target body; if it isn't, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 4) Any error that occurs while look up the state of the target */
/* or observer will be diagnosed by routines in the call tree of */
/* this routine. */
/* 5) Any error that occurs while look up the orientation of */
/* the target will be diagnosed by routines in the call tree of */
/* this routine. */
/* 6) If the input method is not recognized, the error */
/* SPICE(NOTSUPPORTED) will be signaled. */
/* $ Files */
/* Appropriate kernels must be loaded by the calling program before */
/* this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - PCK data: if the target body shape is modeled as an */
/* ellipsoid, triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must be */
/* loaded. These may be provided in a text or binary PCK file. */
/* - Frame data: if a frame definition is required to convert the */
/* observer and target states to the body-fixed frame of the */
/* target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine isolates the computation of the sub-observer state */
/* (that is, the sub-observer point and its derivative with respect */
/* to time). */
/* This routine is used by the GF coordinate utility routines in */
/* order to solve for time windows on which specified mathematical */
/* conditions involving coordinates are satisfied. The role of */
/* this routine is to provide Cartesian state vectors enabling */
/* the GF coordinate utilities to determine the signs of the */
/* derivatives with respect to time of coordinates of interest. */
/* $ Examples */
/* See ZZGFCOST. */
/* $ Restrictions */
/* 1) This routine is restricted to use with ellipsoidal target */
/* shape models. */
/* 2) The computations performed by this routine are intended */
/* to be compatible with those performed by the SPICE */
/* routine SUBPNT. If that routine changes, this routine */
/* may need to be updated. */
/* 3) This routine presumes that error checking of inputs */
/* has, where possible, already been performed by the */
/* GF coordinate utility initialization routine. */
/* 4) The interface and functionality of this set of routines may */
/* change without notice. These routines should be called only */
/* by SPICELIB routines. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */
/* Upgraded to support targets and observers having */
/* no names associated with their ID codes. */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* sub-observer state */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSSOB", (ftnlen)8);
if (first || *trgid != prvtrg) {
bodc2s_(trgid, svtarg, (ftnlen)36);
prvtrg = *trgid;
}
if (first || *obsid != prvobs) {
bodc2s_(obsid, svobs, (ftnlen)36);
prvobs = *obsid;
}
first = FALSE_;
/* Parse the aberration correction specifier. */
zzprscor_(abcorr, attblk, abcorr_len);
geom = attblk[0];
uselt = attblk[1];
usestl = attblk[2];
xmit = attblk[4];
/* Decide whether the sub-observer point is computed using */
/* the "near point" or "surface intercept" method. Only */
/* ellipsoids may be used a shape models for this computation. */
if (eqstr_(method, "Near point: ellipsoid", method_len, (ftnlen)21)) {
near__ = TRUE_;
} else if (eqstr_(method, "Intercept: ellipsoid", method_len, (ftnlen)20))
{
near__ = FALSE_;
} else {
setmsg_("Sub-observer point computation method # is not supported by"
" this routine.", (ftnlen)73);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (geom) {
/* This is the geometric case. */
/* We need to check the body-fixed reference frame here. */
namfrm_(fixref, &frcode, fixref_len);
frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (! fnd) {
setmsg_("Input reference frame # was not recognized.", (ftnlen)43)
;
errch_("#", fixref, (ftnlen)1, fixref_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (center != *trgid) {
setmsg_("Input reference frame # is centered on body # instead o"
"f body #.", (ftnlen)64);
errch_("#", fixref, (ftnlen)1, fixref_len);
errint_("#", ¢er, (ftnlen)1);
errint_("#", trgid, (ftnlen)1);
sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Get the state of the target with respect to the observer, */
/* expressed relative to the target body-fixed frame. We don't */
/* need to propagate states to the solar system barycenter in */
/* this case. */
spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the state of the observer with respect to the target */
/* in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the sub-observer */
/* point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &found)
;
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. DNEARP re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface */
/* intercept point." The ray direction is simply */
/* the negative of the observer's position relative */
/* to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to */
/* be unable to compute an intercept state, it *is* */
/* an error in this case, since the ray points toward */
/* the center of the target. */
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. SURFPV re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
} else if (uselt) {
/* Light time and possibly stellar aberration corrections are */
/* applied. */
/* Most our work consists of getting ready to call either of the */
/* SPICELIB routines DNEARP or SURFPV. In order to make this */
/* call, we'll need the velocity of the observer relative to the */
/* target body's center in the target body-fixed frame. We must */
/* evaluate the rotation state of the target at the correct */
/* epoch, and account for the rate of change of light time, if */
/* light time corrections are used. The algorithm we use depends */
/* on the algorithm used in SUBPNT, since we're computing the */
/* derivative with respect to time of the solution found by that */
/* routine. */
/* In this algorithm, we must take into account the fact that */
/* SUBPNT performs light time and stellar aberration corrections */
/* for the sub-observer point, not for the center of the target */
/* body. */
/* If light time and stellar aberration corrections are used, */
/* - Find the aberration corrected sub-observer point and the */
/* light time-corrected epoch TRGEPC associated with the */
/* sub-observer point. */
/* - Use TRGEPC to find the position of the target relative to */
/* the solar system barycenter. */
/* - Use TRGEPC to find the orientation of the target relative */
/* to the J2000 reference frame. */
/* - Find the light-time corrected position of the */
/* sub-observer point; use this to compute the stellar */
/* aberration offset that applies to the sub-observer point, */
/* as well as the velocity of this offset. */
/* - Find the corrected state of the target center as seen */
/* from the observer, where the corrections are those */
/* applicable to the sub-observer point. */
/* - Negate the corrected target center state to obtain the */
/* state of the observer relative to the target. */
/* - Express the state of the observer relative to the target */
/* in the target body fixed frame at TRGEPC. */
/* Below, we'll use the convention that vectors expressed */
/* relative to the body-fixed frame have names of the form */
/* FX* */
/* Note that SUBPNT will signal an error if FIXREF is not */
/* actually centered on the target body. */
subpnt_(method, svtarg, et, fixref, abcorr, svobs, spoint, &trgepc,
srfvec, method_len, (ftnlen)36, fixref_len, abcorr_len, (
ftnlen)36);
/* Get J2000-relative states of observer and target with respect */
/* to the solar system barycenter at their respective epochs of */
/* participation. */
spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5);
spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5);
/* Get the uncorrected J2000 to body-fixed to state */
/* transformation at TRGEPC. */
sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Initialize the state of the sub-observer point in the */
/* body-fixed frame. At this point we don't know the */
/* point's velocity; set it to zero. */
moved_(spoint, &c__3, fxpsta);
cleard_(&c__3, &fxpsta[3]);
if (usestl) {
/* We're going to need the acceleration of the observer */
/* relative to the SSB. Compute this now. */
for (i__ = 1; i__ <= 2; ++i__) {
/* The epoch is ET -/+ TDELTA. */
t = *et + ((i__ << 1) - 3) * 1.;
spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12
&& 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss"
"ob_", (ftnlen)652)], (ftnlen)5);
}
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the observer's acceleration using a quadratic */
/* approximation. */
qderiv_(&c__3, &obssta[3], &obssta[9], &c_b40, acc);
}
/* The rest of the algorithm is iterative. On the first */
/* iteration, we don't have a good estimate of the velocity */
/* of the sub-observer point relative to the body-fixed */
/* frame. Since we're using this velocity as an input */
/* to the aberration velocity computations, we */
/* expect that treating this velocity as zero on the first */
/* pass yields a reasonable estimate. On the second pass, */
/* we'll use the velocity derived on the first pass. */
cleard_(&c__3, fxpvel);
/* We'll also estimate the rate of change of light time */
/* as zero on the first pass. */
dlt = 0.;
for (i__ = 1; i__ <= 2; ++i__) {
/* Correct the target's velocity for the rate of */
/* change of light time. */
if (xmit) {
scale = dlt + 1.;
} else {
scale = 1. - dlt;
}
/* Scale the velocity portion of the target state to */
/* correct the velocity for the rate of change of light */
/* time. */
moved_(ssbtg0, &c__3, ssbtrg);
vscl_(&scale, &ssbtg0[3], &ssbtrg[3]);
/* Get the state of the target with respect to the observer. */
vsubg_(ssbtrg, ssbobs, &c__6, obstrg);
/* Correct the J2000 to body-fixed state transformation matrix */
/* for the rate of change of light time. */
zzcorsxf_(&xmit, &dlt, xform, corxfm);
/* Invert CORXFM to obtain the corrected */
/* body-fixed to J2000 state transformation. */
invstm_(corxfm, corxfi);
/* Convert the sub-observer point state to the J2000 frame. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
/* Find the J2000-relative state of the sub-observer */
/* point with respect to the target. */
vaddg_(obstrg, pntsta, &c__6, obspnt);
if (usestl) {
/* Now compute the stellar aberration correction */
/* applicable to OBSPNT. We need the velocity of */
/* this correction as well. */
zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel);
moved_(sa, &c__3, sastat);
moved_(savel, &c__3, &sastat[3]);
/* Adding the stellar aberration state to the target center */
/* state gives us the state of the target center with */
/* respect to the observer, corrected for the aberrations */
/* applicable to the sub-observer point. */
vaddg_(obstrg, sastat, &c__6, stemp);
} else {
moved_(obstrg, &c__6, stemp);
}
/* Convert STEMP to the body-fixed reference frame. */
mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta);
/* At long last, compute the state of the observer */
/* with respect to the target in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the */
/* sub-observer point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &
found);
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. "
"DNEARP returned \"not found.\"", (ftnlen)123);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface intercept */
/* point." The ray direction is simply the negative of the */
/* observer's position relative to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to be */
/* unable to compute an intercept state, it *is* an error */
/* in this case, since the ray points toward the center of */
/* the target. */
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. S"
"URFPV returned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
/* At this point we can update the surface point */
/* velocity and light time derivative estimates. */
/* In order to compute the light time rate, we'll */
/* need the J2000-relative velocity of the sub-observer */
/* point with respect to the observer. First convert */
/* the sub-observer state to the J2000 frame, then */
/* add the result to the state of the target center */
/* with respect to the observer. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
vaddg_(obstrg, pntsta, &c__6, obspnt);
/* Now that we have an improved estimate of the */
/* sub-observer state, we can estimate the rate of */
/* change of light time as */
/* range rate */
/* ---------- */
/* c */
/* If we're correcting for stellar aberration, *ideally* we */
/* should remove that correction now, since the light time */
/* rate is based on light time between the observer and the */
/* light-time corrected sub-observer point. But the error made */
/* by including stellar aberration is too small to make it */
/* worthwhile to make this adjustment. */
vhat_(obspnt, upos);
dlt = vdot_(&obspnt[3], upos) / clight_();
/* With FXPVEL and DLT updated, we'll repeat our */
/* computations. */
}
} else {
/* We should never get here. */
setmsg_("Aberration correction # was not recognized.", (ftnlen)43);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Copy the computed state to the output argument STATE. */
moved_(fxpsta, &c__6, state);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
} /* zzgfssob_ */
/* $Procedure 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 SPKE15 ( Evaluate a type 15 SPK data record) */
/* Subroutine */ int spke15_(doublereal *et, doublereal *recin, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), d_mod(doublereal *, doublereal *), d_sign(
doublereal *, doublereal *);
/* Local variables */
doublereal near__, dmdt;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer j2flg;
doublereal p, angle, dnode, z__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, speed, dperi, theta, manom;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
errdp_(char *, doublereal *, ftnlen), vcrss_(doublereal *,
doublereal *, doublereal *);
extern doublereal twopi_(void);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal oneme2, state0[6];
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal pa[3], gm, ta, dt;
extern doublereal pi_(void);
doublereal tp[3], pv[3], cosinc;
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen);
doublereal tmpsta[6], oj2;
extern logical return_(void);
doublereal ecc;
extern doublereal dpr_(void);
doublereal dot, rpl, k2pi;
/* $ Abstract */
/* Evaluates a single SPK data record from a segment of type 15 */
/* (Precessing Conic Propagation). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECIN I Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, specified as ephemeris seconds past */
/* J2000, at which a state vector is to be computed. */
/* RECIN is a data record which, when evaluated at epoch ET, */
/* will give the state (position and velocity) of some */
/* body, relative to some center, in some inertial */
/* reference frame. */
/* The structure of RECIN is: */
/* RECIN(1) epoch of periapsis */
/* in ephemeris seconds past J2000. */
/* RECIN(2)-RECIN(4) unit trajectory pole vector */
/* RECIN(5)-RECIN(7) unit periapsis vector */
/* RECIN(8) semi-latus rectum---p in the */
/* equation: */
/* r = p/(1 + ECC*COS(Nu)) */
/* RECIN(9) eccentricity */
/* RECIN(10) J2 processing flag describing */
/* what J2 corrections are to be */
/* applied when the orbit is */
/* propagated. */
/* All J2 corrections are applied */
/* if this flag has a value that */
/* is not 1,2 or 3. */
/* If the value of the flag is 3 */
/* no corrections are done. */
/* If the value of the flag is 1 */
/* no corrections are computed for */
/* the precession of the line */
/* of apsides. However, regression */
/* of the line of nodes is */
/* performed. */
/* If the value of the flag is 2 */
/* no corrections are done for */
/* the regression of the line of */
/* nodes. However, precession of the */
/* line of apsides is performed. */
/* Note that J2 effects are computed */
/* only if the orbit is elliptic and */
/* does not intersect the central */
/* body. */
/* RECIN(11)-RECIN(13) unit central body pole vector */
/* RECIN(14) central body GM */
/* RECIN(15) central body J2 */
/* RECIN(16) central body radius */
/* Units are radians, km, seconds */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECIN at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity is less than zero, the error */
/* 'SPICE(BADECCENTRICITY)' will be signalled. */
/* 2) If the semi-latus rectum is non-positive, the error */
/* 'SPICE(BADLATUSRECTUM)' is signalled. */
/* 3) If the pole vector, trajectory pole vector or periapsis vector */
/* has zero length, the error 'SPICE(BADVECTOR)' is signalled. */
/* 4) If the trajectory pole vector and the periapsis vector are */
/* not orthogonal, the error 'SPICE(BADINITSTATE)' is */
/* signalled. The test for orthogonality is very crude. The */
/* routine simply checks that the absolute value of the dot */
/* product of the unit vectors parallel to the trajectory pole */
/* and periapse vectors is less than 0.00001. This check is */
/* intended to catch blunders, not to enforce orthogonality to */
/* double precision tolerance. */
/* 5) If the mass of the central body is non-positive, the error */
/* 'SPICE(NONPOSITIVEMASS)' is signalled. */
/* 6) If the radius of the central body is negative, the error */
/* 'SPICE(BADRADIUS)' is signalled. */
/* $ Particulars */
/* This algorithm applies J2 corrections for precessing the */
/* node and argument of periapse for an object orbiting an */
/* oblate spheroid. */
/* Note the effects of J2 are incorporated only for elliptic */
/* orbits that do not intersect the central body. */
/* While the derivation of the effect of the various harmonics */
/* of gravitational field are beyond the scope of this header */
/* the effect of the J2 term of the gravity model are as follows */
/* The line of node precesses. Over one orbit average rate of */
/* precession, DNode/dNu, is given by */
/* 3 J2 */
/* dNode/dNu = - ----------------- DCOS( inc ) */
/* 2 (P/RPL)**2 */
/* (Since this is always less than zero for oblate spheroids, this */
/* should be called regression of nodes.) */
/* The line of apsides precesses. The average rate of precession */
/* DPeri/dNu is given by */
/* 3 J2 */
/* dPeri/dNu = ----------------- ( 5*DCOS ( inc ) - 1 ) */
/* 2 (P/RPL)**2 */
/* Details of these formulae are given in the Battin's book (see */
/* literature references below). */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR15 as shown here: */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECIN ) */
/* CALL SPKE15 ( ET, RECIN, STATE ) */
/* where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 15 data segment. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 15 ) THEN */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE15 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* S. Schlaifer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* [1] `Fundamentals of Celestial Mechanics', Second Edition 1989 */
/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */
/* Richmond Virginia; pp 345-347. */
/* [2] `Astronautical Guidance', by Richard H. Battin. 1964 */
/* McGraw-Hill Book Company, San Francisco. pp 199 */
/* $ Version */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* $ Index_Entries */
/* evaluate type_15 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKE15", (ftnlen)6);
/* Fetch the various entities from the input record, first the epoch. */
epoch = recin[0];
/* The trajectory pole vector. */
vequ_(&recin[1], tp);
/* The periapsis vector. */
vequ_(&recin[4], pa);
/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */
/* and eccentricity. */
p = recin[7];
ecc = recin[8];
/* J2 processing flag. */
j2flg = (integer) recin[9];
/* Central body pole vector. */
vequ_(&recin[10], pv);
/* The central mass, J2 and radius of the central body. */
gm = recin[13];
oj2 = recin[14];
rpl = recin[15];
/* Check all the inputs here for obvious failures. Yes, perhaps */
/* this is overkill. However, there is a lot more computation */
/* going on in this routine so that the small amount of overhead */
/* here should not be significant. */
if (p <= 0.) {
setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator"
" was non-positive. This value must be positive. The value s"
"upplied was #.", (ftnlen)133);
errdp_("#", &p, (ftnlen)1);
sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (ecc < 0.) {
setmsg_("The eccentricity supplied for a type 15 segment is negative"
". It must be non-negative. The value supplied to the type 1"
"5 evaluator was #. ", (ftnlen)138);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (gm <= 0.) {
setmsg_("The mass supplied for the central body of a type 15 segment"
" was non-positive. Masses must be positive. The value suppl"
"ied was #. ", (ftnlen)130);
errdp_("#", &gm, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(tp)) {
setmsg_("The trajectory pole vector supplied to SPKE15 had length ze"
"ro. The most likely cause of this problem is a corrupted SPK"
" (ephemeris) file. ", (ftnlen)138);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pa)) {
setmsg_("The periapse vector supplied to SPKE15 had length zero. The"
" most likely cause of this problem is a corrupted SPK (ephem"
"eris) file. ", (ftnlen)131);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pv)) {
setmsg_("The central pole vector supplied to SPKE15 had length zero."
" The most likely cause of this problem is a corrupted SPK (e"
"phemeris) file. ", (ftnlen)135);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (rpl < 0.) {
setmsg_("The central body radius was negative. It must be zero or po"
"sitive. The value supplied was #. ", (ftnlen)94);
errdp_("#", &rpl, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Convert TP, PV and PA to unit vectors. */
/* (It won't hurt to polish them up a bit here if they are already */
/* unit vectors.) */
vhatip_(pa);
vhatip_(tp);
vhatip_(pv);
/* One final check. Make sure the pole and periapse vectors are */
/* orthogonal. (We will use a very crude check but this should */
/* rule out any obvious errors.) */
dot = vdot_(pa, tp);
if (abs(dot) > 1e-5) {
angle = vsep_(pa, tp) * dpr_();
setmsg_("The periapsis and trajectory pole vectors are not orthogona"
"l. The anglebetween them is # degrees. ", (ftnlen)98);
errdp_("#", &angle, (ftnlen)1);
sigerr_("SPICE(BADINITSTATE)", (ftnlen)19);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Compute the distance and speed at periapse. */
near__ = p / (ecc + 1.);
speed = sqrt(gm / p) * (ecc + 1.);
/* Next get the position at periapse ... */
vscl_(&near__, pa, state0);
/* ... and the velocity at periapsis. */
vcrss_(tp, pa, &state0[3]);
vsclip_(&speed, &state0[3]);
/* Determine the elapsed time from periapse to the requested */
/* epoch and propagate the state at periapsis to the epoch of */
/* interest. */
/* Note that we are making use of the following fact. */
/* If R is a rotation, then the states obtained by */
/* the following blocks of code are mathematically the */
/* same. (In reality they may differ slightly due to */
/* roundoff.) */
/* Code block 1. */
/* CALL MXV ( R, STATE0, STATE0 ) */
/* CALL MXV ( R, STATE0(4), STATE0(4) ) */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* Code block 2. */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* CALL MXV ( R, STATE, STATE ) */
/* CALL MXV ( R, STATE(4), STATE(4) ) */
/* This allows us to first compute the propagation of our initial */
/* state and then if needed perform the precession of the line */
/* of nodes and apsides by simply precessing the resulting state. */
dt = *et - epoch;
prop2b_(&gm, state0, &dt, state);
/* If called for, handle precession needed due to the J2 term. Note */
/* that the motion of the lines of nodes and apsides is formulated */
/* in terms of the true anomaly. This means we need the accumulated */
/* true anomaly in order to properly transform the state. */
if (j2flg != 3 && oj2 != 0. && ecc < 1. && near__ > rpl) {
/* First compute the change in mean anomaly since periapsis. */
/* Computing 2nd power */
d__1 = ecc;
oneme2 = 1. - d__1 * d__1;
dmdt = oneme2 / p * sqrt(gm * oneme2 / p);
manom = dmdt * dt;
/* Next compute the angle THETA such that THETA is between */
/* -pi and pi and such than MANOM = THETA + K*2*pi for */
/* some integer K. */
d__1 = twopi_();
theta = d_mod(&manom, &d__1);
if (abs(theta) > pi_()) {
d__1 = twopi_();
theta -= d_sign(&d__1, &theta);
}
k2pi = manom - theta;
/* We can get the accumulated true anomaly from the propagated */
/* state theta and the accumulated mean anomaly prior to this */
/* orbit. */
ta = vsep_(pa, state);
ta = d_sign(&ta, &theta);
ta += k2pi;
/* Determine how far the line of nodes and periapsis have moved. */
cosinc = vdot_(pv, tp);
/* Computing 2nd power */
d__1 = rpl / p;
z__ = ta * 1.5 * oj2 * (d__1 * d__1);
dnode = -z__ * cosinc;
/* Computing 2nd power */
d__1 = cosinc;
dperi = z__ * (d__1 * d__1 * 2.5 - .5);
/* Precess the periapsis by rotating the state vector about the */
/* trajectory pole */
if (j2flg != 1) {
vrotv_(state, tp, &dperi, tmpsta);
vrotv_(&state[3], tp, &dperi, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* Regress the line of nodes by rotating the state */
/* about the pole of the central body. */
if (j2flg != 2) {
vrotv_(state, pv, &dnode, tmpsta);
vrotv_(&state[3], pv, &dnode, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* We could perform the rotations above in the other order, */
/* but we would also have to rotate the pole before precessing */
/* the line of apsides. */
}
/* That's all folks. Check out and return. */
chkout_("SPKE15", (ftnlen)6);
return 0;
} /* spke15_ */
/* $Procedure PL2NVP ( Plane to normal vector and point ) */
/* Subroutine */ int pl2nvp_(doublereal *plane, doublereal *normal,
doublereal *point)
{
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
doublereal const__;
extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *,
doublereal *);
/* $ Abstract */
/* Return a unit normal vector and point that define a specified */
/* 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 */
/* MATH */
/* PLANE */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* PLANE I A SPICELIB plane. */
/* NORMAL, */
/* POINT O A unit normal vector and point that define PLANE. */
/* $ Detailed_Input */
/* PLANE is a SPICELIB plane. */
/* $ Detailed_Output */
/* NORMAL, */
/* POINT are, respectively, a unit normal vector and point */
/* that define the geometric plane represented by */
/* PLANE. Let the symbol < a, b > indicate the inner */
/* product of vectors a and b; then the geometric */
/* plane is the set of vectors X in three-dimensional */
/* space that satisfy */
/* < X - POINT, NORMAL > = 0. */
/* POINT is always the closest point in the input */
/* plane to the origin. POINT is always a */
/* non-negative scalar multiple of NORMAL. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) The input plane MUST have been created by one of the SPICELIB */
/* routines */
/* NVC2PL ( Normal vector and constant to plane ) */
/* NVP2PL ( Normal vector and point to plane ) */
/* PSV2PL ( Point and spanning vectors to plane ) */
/* Otherwise, the results of this routine are unpredictable. */
/* $ Files */
/* None. */
/* $ Particulars */
/* SPICELIB geometry routines that deal with planes use the `plane' */
/* data type to represent input and output planes. This data type */
/* makes the subroutine interfaces simpler and more uniform. */
/* The SPICELIB routines that produce SPICELIB planes from data that */
/* define a plane are: */
/* NVC2PL ( Normal vector and constant to plane ) */
/* NVP2PL ( Normal vector and point to plane ) */
/* PSV2PL ( Point and spanning vectors to plane ) */
/* The SPICELIB routines that convert SPICELIB planes to data that */
/* define a plane are: */
/* PL2NVC ( Plane to normal vector and constant ) */
/* PL2NVP ( Plane to normal vector and point ) */
/* PL2PSV ( Plane to point and spanning vectors ) */
/* $ Examples */
/* 1) Given a plane normal and constant, find a point in */
/* the plane. POINT is the point we seek. */
/* CALL NVC2PL ( NORMAL, CONST, PLANE ) */
/* CALL PL2NVP ( PLANE, NORMAL, POINT ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 01-NOV-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* plane to normal vector and point */
/* -& */
/* Local variables */
/* Find a unit normal and constant for the plane. Scaling the */
/* unit normal by the constant gives us the closest point in */
/* the plane to the origin. */
pl2nvc_(plane, normal, &const__);
vscl_(&const__, normal, point);
return 0;
} /* pl2nvp_ */
/* $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_ */
