/* $Procedure ZZSPKFLT ( SPK function, light time and rate ) */
/* Subroutine */ int zzspkflt_(S_fp trgsub, doublereal *et, char *ref, char *
abcorr, doublereal *stobs, doublereal *starg, doublereal *lt,
doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical pass1 = TRUE_;
static char prvcor[5] = " ";
/* System generated locals */
doublereal d__1, d__2, d__3, d__4;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublereal dist;
extern doublereal vdot_(doublereal *, doublereal *);
static logical xmit;
extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen);
doublereal a, b, c__;
integer i__;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch;
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
static logical usecn;
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *,
integer *, doublereal *);
doublereal lterr;
static logical uselt;
extern doublereal vnorm_(doublereal *);
doublereal prvlt;
extern logical failed_(void);
extern doublereal clight_(void);
logical attblk[15];
extern doublereal touchd_(doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal ctrssb[6];
integer ltsign;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_(
char *, ftnlen);
doublereal ssbtrg[6];
integer trgctr;
extern /* Subroutine */ int spkssb_(integer *, doublereal *, char *,
doublereal *, ftnlen);
integer numitr;
extern logical return_(void);
logical usestl;
doublereal sttctr[6];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Return the state (position and velocity) of a target body */
/* relative to an observer, optionally corrected for light time, */
/* expressed relative to an inertial reference frame. An input */
/* subroutine provides the state of the target relative to its */
/* center of motion. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Include file zzabcorr.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters below define the structure of an aberration */
/* correction attribute block. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TRGSUB I Target body state subroutine. */
/* ET I Observer epoch. */
/* REF I Inertial reference frame of output state. */
/* ABCORR I Aberration correction flag. */
/* STOBS I State of the observer relative to the SSB. */
/* STARG O State of target. */
/* LT O One way light time between observer and target. */
/* DLT O Derivative of light time with respect to time. */
/* $ Detailed_Input */
/* TRGSUB is the name of an external subroutine that returns */
/* the geometric state of the target body relative to a */
/* center of motion, expressed in the inertial reference */
/* frame REF, at the epoch ET. */
/* The calling sequence of TRGSUB is */
/* SUBROUTINE TRGSUB ( ET, REF, TRGCTR, STATE ) */
/* DOUBLE PRECISION ET */
/* CHARACTER*(*) REF */
/* INTEGER TRGCTR */
/* DOUBLE PRECISION STATE ( 6 ) */
/* The inputs of TRGSUB are ET and REF; the outputs */
/* are TRGCTR and STATE. STATE is the geometric state */
/* of the target relative to the returned center of */
/* motion at ET, expressed in the frame REF. */
/* The target and observer define a state vector whose */
/* position component points from the observer to the */
/* target. */
/* ET is the ephemeris time, expressed as seconds past */
/* J2000 TDB, at which the state of the target body */
/* relative to the observer is to be computed. ET */
/* refers to time at the observer's location. */
/* REF is the inertial reference frame with respect to which */
/* the input state STOBS and the output state STARG are */
/* expressed. REF must be recognized by the SPICE */
/* Toolkit. The acceptable frames are listed in the */
/* Frames Required Reading, as well as in the SPICELIB */
/* routine CHGIRF. */
/* Case and blanks are not significant in the string */
/* REF. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the state of the target body to account for one-way */
/* light time. See the discussion in the Particulars */
/* section for recommendations on how to choose */
/* aberration corrections. */
/* If ABCORR includes the stellar aberration correction */
/* symbol '+S', this flag is simply ignored. Aside from */
/* the possible presence of this symbol, ABCORR may be */
/* any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric state of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the state of the target at the */
/* moment it emitted photons arriving at */
/* the observer at ET. */
/* The light time correction involves */
/* iterative solution of the light time */
/* equation. (See the Particulars section */
/* of SPKEZR for details.) The solution */
/* invoked by the 'LT' option uses one */
/* iteration. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* Whether the 'CN+S' solution is */
/* substantially more accurate than the */
/* 'LT' solution depends on the geometry */
/* of the participating objects and on the */
/* accuracy of the input data. In all */
/* cases this routine will execute more */
/* slowly when a converged solution is */
/* computed. See the Particulars section of */
/* SPKEZR for a discussion of precision of */
/* light time corrections. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* state of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* STOBS is the geometric (uncorrected) state of the observer */
/* relative to the solar system barycenter at epoch ET. */
/* STOBS is a 6-vector: the first three components of */
/* STOBS represent a Cartesian position vector; the last */
/* three components represent the corresponding velocity */
/* vector. STOBS is expressed relative to the inertial */
/* reference frame designated by REF. */
/* Units are always km and km/sec. */
/* $ Detailed_Output */
/* STARG is a Cartesian state vector representing the position */
/* and velocity of the target body relative to the */
/* specified observer. STARG is corrected for the */
/* specified aberration, and is expressed with respect */
/* to the specified inertial reference frame. The first */
/* three components of STARG represent the x-, y- and */
/* z-components of the target's position; last three */
/* components form the corresponding velocity vector. */
/* The position component of STARG points from the */
/* observer's location at ET to the aberration-corrected */
/* location of the target. Note that the sense of the */
/* position vector is independent of the direction of */
/* radiation travel implied by the aberration */
/* correction. */
/* Units are always km and km/sec. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target state is corrected */
/* for light time, then LT is the one-way light time */
/* between the observer and the light time-corrected */
/* target location. */
/* DLT is the derivative with respect to barycentric */
/* dynamical time of the one way light time between */
/* target and observer: */
/* DLT = d(LT)/d(ET) */
/* DLT can also be described as the rate of change of */
/* one way light time. DLT is unitless, since LT and */
/* ET both have units of TDB seconds. */
/* If the observer and target are at the same position, */
/* then DLT is set to zero. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) For the convenience of the caller, the input aberration */
/* correction flag can call for stellar aberration correction via */
/* inclusion of the '+S' suffix. This portion of the aberration */
/* correction flag is ignored if present. */
/* 2) If ABCORR calls for stellar aberration but not light */
/* time corrections, the error SPICE(NOTSUPPORTED) is */
/* signaled. */
/* 3) If ABCORR calls for relativistic light time corrections, the */
/* error SPICE(NOTSUPPORTED) is signaled. */
/* 4) If the value of ABCORR is not recognized, the error */
/* is diagnosed by a routine in the call tree of this */
/* routine. */
/* 5) If the reference frame requested is not a recognized */
/* inertial reference frame, the error SPICE(UNKNOWNFRAME) */
/* is signaled. */
/* 6) If the state of the target relative to the solar system */
/* barycenter cannot be computed, the error will be diagnosed */
/* by routines in the call tree of this routine. */
/* 7) If the observer and target are at the same position, */
/* then DLT is set to zero. This situation could arise, */
/* for example, when the observer is Mars and the target */
/* is the Mars barycenter. */
/* 8) If a division by zero error would occur in the computation */
/* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. Application programs typically load */
/* kernels once before this routine is called, for example during */
/* program initialization; kernels need not be loaded repeatedly. */
/* See the routine FURNSH and the SPK and KERNEL Required Reading */
/* for further information on loading (and unloading) kernels. */
/* If any of the ephemeris data used to compute STARG are expressed */
/* relative to a non-inertial frame in the SPK files providing those */
/* data, additional kernels may be needed to enable the reference */
/* frame transformations required to compute the state. Normally */
/* these additional kernels are PCK files or frame kernels. Any */
/* such kernels must already be loaded at the time this routine is */
/* called. */
/* $ Particulars */
/* This routine supports higher-level routines that can */
/* perform both light time and stellar aberration corrections */
/* and that use target states provided by subroutines rather */
/* than by the conventional, public SPK APIs. For example, this */
/* routine can be used for objects having fixed positions */
/* on the surfaces of planets. */
/* $ Examples */
/* See usage in ZZSPKFAP. */
/* $ Restrictions */
/* 1) This routine must not be called by routines of the SPICE */
/* frame subsystem. It must not be called by any portion of */
/* the SPK subsystem other than the private SPK function-based */
/* component. */
/* 2) The input subroutine TRGSUB must not call this routine. */
/* or any of the supporting, private SPK routines */
/* 3) When possible, the routine SPKGEO should be used instead of */
/* this routine to compute geometric states. SPKGEO introduces */
/* less round-off error when the observer and target have common */
/* center that is closer to both objects than is the solar */
/* system barycenter. */
/* 4) Unlike most other SPK state computation routines, this */
/* routine requires that the output state be relative to an */
/* inertial reference frame. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 04-JUL-2014 (NJB) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* Last update was 22-FEB-2012 (NJB) */
/* -& */
/* $ Index_Entries */
/* low-level light time correction */
/* light-time corrected state from spk file */
/* get light-time corrected state */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* TOL is the tolerance used for a division-by-zero test */
/* performed prior to computation of DLT. */
/* Convergence limit: */
/* Maximum number of light time iterations for any */
/* aberration correction: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZSPKFLT", (ftnlen)8);
if (pass1 || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {
/* The aberration correction flag differs from the value it */
/* had on the previous call, if any. Analyze the new flag. */
zzvalcor_(abcorr, attblk, abcorr_len);
if (failed_()) {
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
/* The aberration correction flag is recognized; save it. */
s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);
/* Set logical flags indicating the attributes of the requested */
/* correction: */
/* XMIT is .TRUE. when the correction is for transmitted */
/* radiation. */
/* USELT is .TRUE. when any type of light time correction */
/* (normal or converged Newtonian) is specified. */
/* USECN indicates converged Newtonian light time correction. */
/* The above definitions are consistent with those used by */
/* ZZVALCOR. */
xmit = attblk[4];
uselt = attblk[1];
usecn = attblk[3];
usestl = attblk[2];
pass1 = FALSE_;
}
/* See if the reference frame is a recognized inertial frame. */
irfnum_(ref, &refid, ref_len);
if (refid == 0) {
setmsg_("The requested frame '#' is not a recognized inertial frame. "
, (ftnlen)60);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
/* Find the geometric state of the target body with respect to */
/* the solar system barycenter. Subtract the state of the */
/* observer to get the relative state. Use this to compute the */
/* one-way light time. */
(*trgsub)(et, ref, &trgctr, sttctr, ref_len);
spkssb_(&trgctr, et, ref, ctrssb, ref_len);
if (failed_()) {
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
vaddg_(ctrssb, sttctr, &c__6, ssbtrg);
vsubg_(ssbtrg, stobs, &c__6, starg);
dist = vnorm_(starg);
*lt = dist / clight_();
if (*lt == 0.) {
/* This can happen only if the observer and target are at the */
/* same position. We don't consider this an error, but we're not */
/* going to compute the light time derivative. */
*dlt = 0.;
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
if (! uselt) {
/* This is a special case: we're not using light time */
/* corrections, so the derivative */
/* of light time is just */
/* (1/c) * d(VNORM(STARG))/dt */
*dlt = vdot_(starg, &starg[3]) / (dist * clight_());
/* LT and DLT are both set, so we can return. */
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
/* To correct for light time, find the state of the target body */
/* at the current epoch minus the one-way light time. Note that */
/* the observer remains where it is. */
/* Determine the sign of the light time offset. */
if (xmit) {
ltsign = 1;
} else {
ltsign = -1;
}
/* Let NUMITR be the number of iterations we'll perform to */
/* compute the light time. */
if (usecn) {
numitr = 5;
} else {
numitr = 1;
}
i__ = 0;
lterr = 1.;
while(i__ < numitr && lterr > 1e-17) {
/* LT was set either prior to this loop or */
/* during the previous loop iteration. */
d__1 = *et + ltsign * *lt;
epoch = touchd_(&d__1);
(*trgsub)(&epoch, ref, &trgctr, sttctr, ref_len);
spkssb_(&trgctr, &epoch, ref, ctrssb, ref_len);
if (failed_()) {
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
vaddg_(ctrssb, sttctr, &c__6, ssbtrg);
vsubg_(ssbtrg, stobs, &c__6, starg);
prvlt = *lt;
d__1 = vnorm_(starg) / clight_();
*lt = touchd_(&d__1);
/* LTERR is the magnitude of the change between the current */
/* estimate of light time and the previous estimate, relative to */
/* the previous light time corrected epoch. */
/* Computing MAX */
d__3 = 1., d__4 = abs(epoch);
d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4);
lterr = touchd_(&d__2);
++i__;
}
/* At this point, STARG contains the light time corrected */
/* state of the target relative to the observer. */
/* Compute the derivative of light time with respect */
/* to time: dLT/dt. Below we derive the formula for */
/* this quantity for the reception case. Let */
/* POBS be the position of the observer relative to the */
/* solar system barycenter. */
/* VOBS be the velocity of the observer relative to the */
/* solar system barycenter. */
/* PTARG be the position of the target relative to the */
/* solar system barycenter. */
/* VTARG be the velocity of the target relative to the */
/* solar system barycenter. */
/* S be the sign of the light time correction. S is */
/* negative for the reception case. */
/* The light-time corrected position of the target relative to */
/* the observer at observation time ET, given the one-way */
/* light time LT is: */
/* PTARG(ET+S*LT) - POBS(ET) */
/* The light-time corrected velocity of the target relative to */
/* the observer at observation time ET is */
/* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */
/* We need to compute dLT/dt. Below, we use the facts that, */
/* for a time-dependent vector X(t), */
/* ||X|| = <X,X> ** (1/2) */
/* d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */
/* = <X,X>**(-1/2) * <X,dX/dt> */
/* = <X,dX/dt> / ||X|| */
/* Newtonian light time equation: */
/* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */
/* Differentiate both sides: */
/* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */
/* * < PTARG(ET+S*LT) - POBS(ET), */
/* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */
/* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */
/* * ( < PTARG(ET+S*LT) - POBS(ET), */
/* VTARG(ET+S*LT) - VOBS(ET) > */
/* + < PTARG(ET+S*LT) - POBS(ET), */
/* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */
/* Let */
/* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */
/* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */
/* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */
/* Then */
/* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */
/* which implies */
/* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */
a = 1. / (clight_() * vnorm_(starg));
b = vdot_(starg, &starg[3]);
c__ = vdot_(starg, &ssbtrg[3]);
/* For physically realistic target velocities, S*C*A cannot equal 1. */
/* We'll check for this case anyway. */
if (ltsign * c__ * a > .99999999989999999) {
setmsg_("Target range rate magnitude is approximately the speed of l"
"ight. The light time derivative cannot be computed.", (ftnlen)
110);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
}
/* Compute DLT: the rate of change of light time. */
*dlt = a * b / (1. - ltsign * c__ * a);
/* Overwrite the velocity portion of the output state */
/* with the light-time corrected velocity. */
d__1 = ltsign * *dlt + 1.;
vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]);
chkout_("ZZSPKFLT", (ftnlen)8);
return 0;
} /* zzspkflt_ */
/* $Procedure ZZGFSOLVX ( Private --- GF, event finding routine ) */
/* Subroutine */ int zzgfsolvx_(U_fp udfuns, S_fp udfunb, S_fp udstep, S_fp
udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step,
doublereal *start, doublereal *finish, doublereal *tol, logical *rpt,
S_fp udrepu, doublereal *result)
{
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int zzwninsd_(doublereal *, doublereal *, char *,
doublereal *, ftnlen);
logical s;
doublereal begin, t;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
integer nloop;
logical l1, l2, savst;
doublereal t1, t2;
logical state1;
extern logical failed_(void);
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *),
touchd_(doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
logical instat;
doublereal curtim, svdtim, timest;
logical curste;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
char contxt[256];
doublereal trnstn;
/* $ 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. */
/* This routine is a root finding general purpose event location */
/* routine. Most of the HARD work has been delegated to other */
/* routines (In particular, how the dynamic step size is chosen). */
/* Sister routine to ZZGFSOLV. Copy any edits to ZZGFSOLV or */
/* ZZGFSOLVX to the sister routine. */
/* $ 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 */
/* ROOT */
/* SEARCH */
/* WINDOWS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UDFUNS I The routine that computes the scalar quantity of */
/* interest. */
/* UDFUNB I Name of the routine that compares the current state */
/* condition with-respect-to a constraint. */
/* UDSTEP I Name of the routine that computes a time step */
/* UDREFN I Name of the routine that computes a refined time. */
/* BAIL I Logical indicating program interrupt monitoring. */
/* UDBAIL I Name of a routine that signals a program interrupt. */
/* CSTEP I Logical indicating constant step size. */
/* STEP I Constant step size in seconds for finding geometric */
/* events. */
/* START I Beginning of the search interval. */
/* FINISH I End of the search interval. */
/* TOL I Maximum error in detection of state transitions. */
/* RPT I Progress reporter on ( .TRUE.) or off ( .FALSE. ) */
/* UDREPU I Function that updates the progress report. */
/* RESULT I-O SPICE window containing results. */
/* $ Detailed_Input */
/* UDFUNS the routine that returns the value of the scalar */
/* quantity of interest at time ET. The calling sequence */
/* for UDFUNS is: */
/* CALL UDFUNS ( ET, VALUE ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB at which to determine the scalar */
/* value. */
/* VALUE is the value of the scalar quantity */
/* at ET. */
/* UDFUNB the routine that determines if UDFUNS */
/* satisfies some constraint condition at epoch ET. */
/* The calling sequence: */
/* CALL UDFUNB ( UDFUNS, ET, BOOL ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB, at which to evaluate UDFUNS. */
/* BOOL a logical value indicating whether */
/* or not UDFUNS satisfies the constraint */
/* at ET (TRUE) or not (FALSE). */
/* UDSTEP the routine that computes a time step in an attempt to */
/* find a transition of the state of the specified */
/* coordinate. In the context of this routine's algorithm, */
/* a "state transition" occurs where the geometric state */
/* changes from being in the desired geometric condition */
/* event to not, or vice versa. */
/* This routine relies on UDSTEP returning step sizes */
/* small enough so that state transitions within the */
/* confinement window are not overlooked. There must */
/* never be two roots A and B separated by less than */
/* STEP, where STEP is the minimum step size returned by */
/* UDSTEP for any value of ET in the interval [A, B]. */
/* The calling sequence for UDSTEP is: */
/* CALL UDSTEP ( ET, STEP ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB, from which the algorithm is to */
/* search forward for a state transition. */
/* STEP is the output step size. STEP indicates */
/* how far to advance ET so that ET and */
/* ET+STEP may bracket a state transition and */
/* definitely do not bracket more than one */
/* state transition. Units are TDB seconds. */
/* If a constant step size is desired, the routine */
/* GFSTEP */
/* may be used. This is the default option. If using */
/* GFSTEP, the step size must be set by calling */
/* GFSSTP(STEP) */
/* prior to calling this routine. */
/* UDREFN the routine that computes a refinement in the times */
/* that bracket a transition point. In other words, once */
/* a pair of times have been detected such that the system */
/* is in different states at each of the two times, UDREFN */
/* selects an intermediate time which should be closer to */
/* the transition state than one of the two known times. */
/* The calling sequence for UDREFN is: */
/* CALL UDREFN ( T1, T2, S1, S2, T ) */
/* where the inputs are: */
/* T1 a time when the system is in state S1. */
/* T2 a time when the system is in state S2. T2 */
/* is assumed to be larger than T1. */
/* S1 a logical indicating the state of the system */
/* at time T1. */
/* S2 a logical indicating the state of the system */
/* at time T2. */
/* UDREFN may use or ignore the S1 and S2 values. */
/* The output is: */
/* T a time to check for a state transition */
/* between T1 and T2. */
/* If a simple bisection method is desired, the routine */
/* GFREFN may be used. This is the default option. */
/* BAIL is a logical indicating whether or not interrupt */
/* signaling is enabled. When `bail' is set to TRUE, */
/* the input function UDBAIL (see description below) */
/* is used to determine whether an interrupt has been */
/* issued. */
/* UDBAIL the routine that indicates whether an interrupt signal */
/* has been issued (for example, from the keyboard). */
/* UDBAIL has no arguments and returns a logical. */
/* The return value is .TRUE. if an interrupt has */
/* been issued; otherwise the value is .FALSE. */
/* ZZGFSOLVX uses UDBAIL only when BAIL (see above) is set */
/* to .TRUE., indicating that interrupt handling is */
/* enabled. When interrupt handling is enabled, ZZGFSOLVX */
/* and will call UDBAIL to determine whether to terminate */
/* processing and return immediately. */
/* If interrupt handing is not enabled, a logical */
/* function must still be passed as an input argument. */
/* The function */
/* GFBAIL */
/* may be used for this purpose. */
/* CSTEP is a logical indicating whether or not the step size */
/* used in searching is constant. If it is, the value */
/* STEP is used. Note that even if UDSTEP has the value */
/* GFSTEP, i.e. the public, constant step routine, CSTEP */
/* should still be .FALSE., in which case STEP is ignored. */
/* STEP is the step size to be used in the search. STEP must */
/* be short enough for a search using this step size */
/* to locate the time intervals where the geometric */
/* event function is monotone increasing or decreasing. */
/* However, STEP must not be *too* short, or the */
/* search will take an unreasonable amount of time. */
/* The choice of STEP affects the completeness but not */
/* the precision of solutions found by this routine; */
/* precision is controlled by the convergence */
/* the tolerance, TOL. */
/* STEP has units of TDB seconds. */
/* START is the beginning of the interval over which the state */
/* is to be detected. */
/* FINISH is the end of the interval over which the state is */
/* to be detected. */
/* TOL is a tolerance value used to determine convergence of */
/* root-finding operations. TOL is measured in seconds */
/* and is greater than zero. */
/* RPT is a logical variable which controls whether the */
/* progress reporter is enabled. When RPT is TRUE, */
/* progress reporting is enabled and the routine */
/* UDREPU (see description below) reports progress. */
/* UDREPU the routine that updates the progress report for a */
/* search. The calling sequence of UDREPU is */
/* UDREPU (IVBEG, IVEND, ET ) */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION IVBEG */
/* DOUBLE PRECISION IVEND */
/* where ET is an epoch belonging to the confinement */
/* window, IVBEG and IVEND are the start and stop times, */
/* respectively of the current confinement window */
/* interval. The ratio of the measure of the portion */
/* of CNFINE that precedes ET to the measure of CNFINE */
/* would be a logical candidate for the searches */
/* completion percentage; however the method of */
/* measurement is up to the user. */
/* If the user doesn't wish to provide a custom set of */
/* progress reporting functions, the routine */
/* GFREPU */
/* may be used. */
/* RESULT is an initialized SPICE window. RESULT may not be empty */
/* on entry and must be large enough to hold all of the */
/* intervals found by the search. */
/* $ Detailed_Output */
/* RESULT is a SPICE window containing the intersection of the */
/* results of the search and the contents of RESULT */
/* on entry. */
/* $ Parameters */
/* LBCELL is the SPICELIB cell lower bound. */
/* $ Exceptions */
/* 1) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) */
/* will signal. */
/* 2) If START +/- TOL is indistinguishable from START or */
/* FINISH +/- TOL is indistinguishable from FINISH, the */
/* error SPICE(INVALIDVALUE) will signal. */
/* 3) If START is greater than FINISH or SVDTIM is greater than */
/* CURTIM, SPICE(BADTIMECASE) will signal. */
/* 4) If the inner convergence loop fails to converge to TOL */
/* within MXLOOP iterations, the error SPICE(NOCONVERG) */
/* will signal. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. See the routine FURNSH and the SPK */
/* and KERNEL Required Reading for further information on loading */
/* (and unloading) kernels. */
/* $ Particulars */
/* This routine implements a strategy for searching for geometric */
/* state events important for planning solar system observations. */
/* The actual details of selecting time steps while searching for */
/* a state change as well as the scheme used for zeroing in on the */
/* actual time of transition are handled by lower level routines. */
/* By delegating the work of selecting search time steps and the */
/* process of refining a transition time estimate to lower level */
/* routines, the common work of the search can be isolated here. */
/* The routines that do the decision making, can be modified */
/* and made smarter as time permits. */
/* $ Examples */
/* See GFUDS and ZZGFRELX. */
/* $ Restrictions */
/* It is important that the user understand how the routines */
/* UDFUNB, UDSTEP and UDREFN are to be used and that the */
/* calling sequences match precisely with the descriptions given */
/* here. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* L. S. Elson (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 24-OCT-2010 (EDW) */
/* TOL error check now returns SPICE(INVALIDTOLERANCE) instead of */
/* previous return SPICE(VALUEOUTOFRANGE). */
/* - SPICELIB Version 1.1.0, 16-FEB-2010 (EDW) */
/* Modified version of ZZGFSOLV. */
/* - SPICELIB Version 1.0.0, 17-MAR-2009 (EDW)(LSE)(NJB) */
/* -& */
/* $ Index_Entries */
/* find times of an event */
/* -& */
/* SPICELIB functions. */
/* Local variables */
/* The maximum number of search loop iterations to execute. */
/* The default refinement method is bisection, a very slow */
/* method to convergence. Since 2**1000 ~ 10**301, */
/* 1000 loop iterations represents enough effort to assume */
/* either the search will not converge or that the refinement */
/* function operates slower than would bisection, in which */
/* case the user should use the default GFREFN function. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSOLVX", (ftnlen)9);
/* Check the convergence tolerance. */
if (*tol <= 0.) {
setmsg_("Tolerance must be positive but was #.", (ftnlen)37);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(INVALIDTOLERANCE)", (ftnlen)23);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Make sure that START is not greater than FINISH. Signal an */
/* error for START > FINISH. */
if (*start > *finish) {
setmsg_("Bad time interval result, START > FINISH.", (ftnlen)41);
sigerr_("SPICE(BADTIMECASE)", (ftnlen)18);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Make sure that TOL is not too small, i.e. that neither */
/* START + TOL nor START - TOL equals START. */
d__1 = *start - *tol;
d__2 = *start + *tol;
if (touchd_(&d__1) == *start || touchd_(&d__2) == *start) {
setmsg_("TOL has value #1. This value is too small to distinguish ST"
"ART - TOL or START + TOL from START, #2.", (ftnlen)99);
errdp_("#1", tol, (ftnlen)2);
errdp_("#2", start, (ftnlen)2);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* 5 */
/* Make sure that TOL is not too small, i.e. that neither */
/* FINISH + TOL nor FINISH - TOL equals FINISH. */
d__1 = *finish - *tol;
d__2 = *finish + *tol;
if (touchd_(&d__1) == *finish || touchd_(&d__2) == *finish) {
setmsg_("TOL has value #1. This value is too small to distinguish FI"
"NISH - TOL or FINISH + TOL from FINISH, #2.", (ftnlen)102);
errdp_("#1", tol, (ftnlen)2);
errdp_("#2", finish, (ftnlen)2);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* If active, update the progress reporter. */
if (*rpt) {
(*udrepu)(start, finish, start);
}
/* This algorithm determines those intervals when a given state */
/* is observed to occur within a specified search interval. */
/* Pairs of times are recorded. The first member of each pair */
/* denotes the time when the system changes to the state of */
/* interest. The second denotes a transition out of that state. */
/* If the system is in the state of interest at the beginning of */
/* the interval, the beginning of the time interval will be */
/* recorded. This may or may not be a transition point. */
/* Similarly if the system is in the state of interest at the end */
/* of the interval, the end of the interval will be recorded. */
/* Again, this may or may not be a transition point. */
/* Initially the current time is the beginning of the search */
/* interval. */
curtim = *start;
/* Determine if the state at the current time satisfies some */
/* constraint. This constraint may indicate only existence of */
/* a state. */
(*udfunb)((U_fp)udfuns, &curtim, &curste);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* If the system is in the state of interest, record the initial */
/* time of the search interval. */
if (curste) {
instat = TRUE_;
begin = curtim;
} else {
instat = FALSE_;
}
/* If the step size is constant, use the value supplied. */
if (*cstep) {
timest = *step;
}
/* Save the current time and state somewhere. */
svdtim = curtim;
savst = curste;
/* Once initializations have been performed keep working */
/* until the search interval has been exhausted. */
/* While time remains in the search interval. */
while(svdtim < *finish) {
/* Using the current window and internally stored */
/* information about the current state, select a new current */
/* time. */
if (! (*cstep)) {
(*udstep)(&curtim, ×t);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Add the time step to the current time. Make sure that the */
/* time does not move beyond the end of the search interval. */
/* Computing MIN */
d__1 = curtim + timest;
curtim = min(d__1,*finish);
/* Compute the state at time CURTIM. */
(*udfunb)((U_fp)udfuns, &curtim, &curste);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* While the state remains unchanged and the interval is not */
/* completely searched ... */
while(savst == curste && svdtim < *finish) {
/* First check for an interrupt signal if checking is enabled. */
if (*bail) {
if ((*udbail)()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Report the current time to the monitoring utility, if */
/* appropriate. */
if (*rpt) {
(*udrepu)(start, finish, &svdtim);
}
/* Save the current time and state somewhere. */
svdtim = curtim;
savst = curste;
/* Compute a new current time so that we will not step */
/* past the end of the interval. This time will be */
/* based on: */
/* 1. The kind of event we are looking for. */
/* 2. The objects and observer class. */
/* 3. Transition times already found. */
/* 4. A minimum time step allowed. */
if (! (*cstep)) {
(*udstep)(&curtim, ×t);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Computing MIN */
d__1 = curtim + timest;
curtim = min(d__1,*finish);
/* Compute the current state */
(*udfunb)((U_fp)udfuns, &curtim, &curste);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Loop back to see if the state has changed. */
}
/* If we have detected a state change and not merely run out */
/* of the search interval... */
if (savst != curste) {
/* Call the previous state STATE1 */
/* Call the current state STATE2 */
/* Call the time at state STATE1, T1 */
/* Call the time at state STATE2, T2 */
/* Save the current time. */
state1 = savst;
t1 = svdtim;
t2 = curtim;
/* Make sure that T1 is not greater than T2. Signal an */
/* error for T1 > T2. */
if (t1 > t2) {
setmsg_("Bad time interval result, T1 > T2.", (ftnlen)34);
sigerr_("SPICE(BADTIMECASE)", (ftnlen)18);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
svdtim = curtim;
savst = curste;
/* T1 and T2 bracket the time of transition. Squeeze this */
/* interval down until it is less than some tolerance in */
/* length. Do it as described below... */
/* Loop while the difference between the times T1 and T2 */
/* exceeds a specified tolerance. */
nloop = 0;
for(;;) { /* while(complicated condition) */
d__1 = t2 - t1;
if (!(touchd_(&d__1) > *tol))
break;
++nloop;
/* This loop count error exists to catch pathologies */
/* in the refinement function. The default bisection */
/* refinement will converge before 1000 iterations if */
/* a convergence is numerically possible. Any other */
/* refinement function should require fewer iterations */
/* compared to bisection. If not, the user should */
/* probably use bisection. */
if (nloop >= 1000) {
setmsg_("Loop run exceeds maximum loop count. Unable to "
"converge to TOL value #1 within MXLOOP value #2 "
"iterations.", (ftnlen)106);
errdp_("#1", tol, (ftnlen)2);
errint_("#2", &c__1000, (ftnlen)2);
sigerr_("SPICE(NOCONVERG)", (ftnlen)16);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
if (*bail) {
if ((*udbail)()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Select a time T, between T1 and T2 (possibly based on the */
/* values of L1 and L2). */
(*udrefn)(&t1, &t2, &l1, &l2, &t);
/* Check for an error signal. The default refinement */
/* routine, GFREFN, does not include error checks. */
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Check whether T is between T1 and T2. If */
/* not then assume that we have gone as far as */
/* we can in refining our estimate of the transition */
/* point. Set T1 and T2 equal to T. */
t = brcktd_(&t, &t1, &t2);
if (t == t1) {
t2 = t;
} else if (t == t2) {
t1 = t;
} else {
/* Compute the state time T. If this state, S, */
/* equals STATE1, set T1 to T, otherwise set */
/* T2 to T. */
(*udfunb)((U_fp)udfuns, &t, &s);
if (s == state1) {
t1 = t;
} else {
t2 = t;
}
}
}
/* Let TRNSTN be the midpoint of [T1, T2]. Record this */
/* time as marking the transition from STATE1 to STATE2. */
d__1 = (t1 + t2) * .5;
trnstn = brcktd_(&d__1, &t1, &t2);
/* In state-of-interest or not? */
if (instat) {
/* We were in the state of interest, TRNSTN marks the */
/* point in time when the state changed to "not of */
/* interest" We need to record the interval from BEGIN to */
/* FINISH and note that we are no longer in the state of */
/* interest. */
/* Add an interval starting at BEGIN and ending at TRNSTN */
/* to the result window. */
s_copy(contxt, "Adding interval [BEGIN,TRNSTN] to RESULT. TR"
"NSTN represents time of passage out of the state-of-"
"interest.", (ftnlen)256, (ftnlen)105);
zzwninsd_(&begin, &trnstn, contxt, result, (ftnlen)256);
} else {
/* We were not in the state of interest. As a result */
/* TRNSTN marks the point where we are changing to */
/* the state of interest. Note that we have transitioned */
/* to the state of interest and record the time at */
/* which the transition occurred. */
begin = trnstn;
}
/* A transition occurred either from from in-state to */
/* out-of-state or the inverse. Reverse the value of the */
/* INSTAT flag to signify the transition event. */
instat = ! instat;
/* That's it for this detection of state change. */
}
/* Continue if there is more time in the search interval. */
}
/* Check if in-state at this time (FINISH). If so record the */
/* interval. */
if (instat) {
/* Add an interval starting at BEGIN and ending at FINISH to the */
/* window. */
s_copy(contxt, "Adding interval [BEGIN,FINISH] to RESULT. FINISH rep"
"resents end of the search interval.", (ftnlen)256, (ftnlen)87)
;
zzwninsd_(&begin, finish, contxt, result, (ftnlen)256);
}
/* If active, update the progress reporter before exiting this */
/* routine. */
if (*rpt) {
(*udrepu)(start, finish, finish);
}
/* Check-out then return. */
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
} /* zzgfsolvx_ */
/* $Procedure SPKLTC ( S/P Kernel, light time corrected state ) */
/* Subroutine */ int spkltc_(integer *targ, doublereal *et, char *ref, char *
abcorr, doublereal *stobs, doublereal *starg, doublereal *lt,
doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical pass1 = TRUE_;
static char prvcor[5] = " ";
/* System generated locals */
doublereal d__1, d__2, d__3, d__4;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublereal dist;
extern doublereal vdot_(doublereal *, doublereal *);
static logical xmit;
extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen);
doublereal a, b, c__;
integer i__, refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch;
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
static logical usecn;
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *,
integer *, doublereal *);
doublereal ssblt, lterr;
static logical uselt;
extern doublereal vnorm_(doublereal *);
doublereal prvlt;
extern logical failed_(void);
extern doublereal clight_(void);
logical attblk[15];
extern doublereal touchd_(doublereal *);
extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen);
integer ltsign;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_(
char *, ftnlen);
doublereal ssbtrg[6];
integer numitr;
extern logical return_(void);
logical usestl;
/* $ Abstract */
/* Return the state (position and velocity) of a target body */
/* relative to an observer, optionally corrected for light time, */
/* expressed relative to an inertial reference frame. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Include file zzabcorr.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters below define the structure of an aberration */
/* correction attribute block. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Observer epoch. */
/* REF I Inertial reference frame of output state. */
/* ABCORR I Aberration correction flag. */
/* STOBS I State of the observer relative to the SSB. */
/* STARG O State of target. */
/* LT O One way light time between observer and target. */
/* DLT O Derivative of light time with respect to time. */
/* $ Detailed_Input */
/* TARG is the NAIF ID code for a target body. The target */
/* and observer define a state vector whose position */
/* component points from the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past */
/* J2000 TDB, at which the state of the target body */
/* relative to the observer is to be computed. ET */
/* refers to time at the observer's location. */
/* REF is the inertial reference frame with respect to which */
/* the input state STOBS and the output state STARG are */
/* expressed. REF must be recognized by the SPICE */
/* Toolkit. The acceptable frames are listed in the */
/* Frames Required Reading, as well as in the SPICELIB */
/* routine CHGIRF. */
/* Case and blanks are not significant in the string */
/* REF. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the state of the target body to account for one-way */
/* light time. See the discussion in the Particulars */
/* section for recommendations on how to choose */
/* aberration corrections. */
/* If ABCORR includes the stellar aberration correction */
/* symbol '+S', this flag is simply ignored. Aside from */
/* the possible presence of this symbol, ABCORR may be */
/* any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric state of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the state of the target at the */
/* moment it emitted photons arriving at */
/* the observer at ET. */
/* The light time correction involves */
/* iterative solution of the light time */
/* equation (see Particulars for details). */
/* The solution invoked by the 'LT' option */
/* uses one iteration. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* Whether the 'CN+S' solution is */
/* substantially more accurate than the */
/* 'LT' solution depends on the geometry */
/* of the participating objects and on the */
/* accuracy of the input data. In all */
/* cases this routine will execute more */
/* slowly when a converged solution is */
/* computed. See the Particulars section of */
/* SPKEZR for a discussion of precision of */
/* light time corrections. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* state of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* STOBS is the geometric (uncorrected) state of the observer */
/* relative to the solar system barycenter at epoch ET. */
/* STOBS is a 6-vector: the first three components of */
/* STOBS represent a Cartesian position vector; the last */
/* three components represent the corresponding velocity */
/* vector. STOBS is expressed relative to the inertial */
/* reference frame designated by REF. */
/* Units are always km and km/sec. */
/* $ Detailed_Output */
/* STARG is a Cartesian state vector representing the position */
/* and velocity of the target body relative to the */
/* specified observer. STARG is corrected for the */
/* specified aberration, and is expressed with respect */
/* to the specified inertial reference frame. The first */
/* three components of STARG represent the x-, y- and */
/* z-components of the target's position; last three */
/* components form the corresponding velocity vector. */
/* The position component of STARG points from the */
/* observer's location at ET to the aberration-corrected */
/* location of the target. Note that the sense of the */
/* position vector is independent of the direction of */
/* radiation travel implied by the aberration */
/* correction. */
/* Units are always km and km/sec. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target state is corrected */
/* for light time, then LT is the one-way light time */
/* between the observer and the light time-corrected */
/* target location. */
/* DLT is the derivative with respect to barycentric */
/* dynamical time of the one way light time between */
/* target and observer: */
/* DLT = d(LT)/d(ET) */
/* DLT can also be described as the rate of change of */
/* one way light time. DLT is unitless, since LT and */
/* ET both have units of TDB seconds. */
/* If the observer and target are at the same position, */
/* then DLT is set to zero. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) For the convenience of the caller, the input aberration */
/* correction flag can call for stellar aberration correction via */
/* inclusion of the '+S' suffix. This portion of the aberration */
/* correction flag is ignored if present. */
/* 2) If the value of ABCORR is not recognized, the error */
/* is diagnosed by a routine in the call tree of this */
/* routine. */
/* 3) If the reference frame requested is not a recognized */
/* inertial reference frame, the error SPICE(BADFRAME) */
/* is signaled. */
/* 4) If the state of the target relative to the solar system */
/* barycenter cannot be computed, the error will be diagnosed */
/* by routines in the call tree of this routine. */
/* 5) If the observer and target are at the same position, */
/* then DLT is set to zero. This situation could arise, */
/* for example, when the observer is Mars and the target */
/* is the Mars barycenter. */
/* 6) If a division by zero error would occur in the computation */
/* of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. Application programs typically load */
/* kernels once before this routine is called, for example during */
/* program initialization; kernels need not be loaded repeatedly. */
/* See the routine FURNSH and the SPK and KERNEL Required Reading */
/* for further information on loading (and unloading) kernels. */
/* If any of the ephemeris data used to compute STARG are expressed */
/* relative to a non-inertial frame in the SPK files providing those */
/* data, additional kernels may be needed to enable the reference */
/* frame transformations required to compute the state. Normally */
/* these additional kernels are PCK files or frame kernels. Any */
/* such kernels must already be loaded at the time this routine is */
/* called. */
/* $ Particulars */
/* This routine supports higher-level SPK API routines that can */
/* perform both light time and stellar aberration corrections. */
/* User applications normally will not need to call this routine */
/* directly. */
/* See the header of the routine SPKEZR for a detailed discussion */
/* of aberration corrections. */
/* $ Examples */
/* The numerical results shown for this example may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* 1) Look up a sequence of states of the Moon as seen from the */
/* Earth. Use light time corrections. Compute the first state for */
/* the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */
/* intervals of 1 hour. For each epoch, display the states, the */
/* one way light time between target and observer, and the rate of */
/* change of the one way light time. */
/* Use the following meta-kernel to specify the kernels to */
/* load: */
/* KPL/MK */
/* File name: spkltc.tm */
/* This meta-kernel is intended to support operation of SPICE */
/* example programs. The kernels shown here should not be */
/* assumed to contain adequate or correct versions of data */
/* required by SPICE-based user applications. */
/* In order for an application to use this meta-kernel, the */
/* kernels referenced here must be present in the user's */
/* current working directory. */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'de421.bsp', */
/* 'pck00010.tpc', */
/* 'naif0010.tls' ) */
/* \begintext */
/* The code example follows: */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* C */
/* C Local constants */
/* C */
/* C The meta-kernel name shown here refers to a file whose */
/* C contents are those shown above. This file and the kernels */
/* C it references must exist in your current working directory. */
/* C */
/* CHARACTER*(*) META */
/* PARAMETER ( META = 'spkltc.tm' ) */
/* C */
/* C Use a time step of 1 hour; look up 5 states. */
/* C */
/* DOUBLE PRECISION STEP */
/* PARAMETER ( STEP = 3600.0D0 ) */
/* INTEGER MAXITR */
/* PARAMETER ( MAXITR = 5 ) */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION DLT */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION ET0 */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION STATE ( 6 ) */
/* DOUBLE PRECISION STOBS ( 6 ) */
/* INTEGER I */
/* C */
/* C Load the SPK and LSK kernels via the meta-kernel. */
/* C */
/* CALL FURNSH ( META ) */
/* C */
/* C Convert the start time to seconds past J2000 TDB. */
/* C */
/* CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */
/* C */
/* C Step through a series of epochs, looking up a */
/* C state vector at each one. */
/* C */
/* DO I = 1, MAXITR */
/* ET = ET0 + (I-1)*STEP */
/* C */
/* C Look up a state vector at epoch ET using the */
/* C following inputs: */
/* C */
/* C Target: Moon (NAIF ID code 301) */
/* C Reference frame: J2000 */
/* C Aberration correction: Light time ('LT') */
/* C Observer: Earth (NAIF ID code 399) */
/* C */
/* C Before we can execute this computation, we'll need the */
/* C geometric state of the observer relative to the solar */
/* C system barycenter at ET, expressed relative to the */
/* C J2000 reference frame: */
/* C */
/* CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */
/* C */
/* C Now compute the desired state vector: */
/* C */
/* CALL SPKLTC ( 301, ET, 'J2000', 'LT', */
/* . STOBS, STATE, LT, DLT ) */
/* WRITE (*,*) 'ET = ', ET */
/* WRITE (*,*) 'J2000 x-position (km): ', STATE(1) */
/* WRITE (*,*) 'J2000 y-position (km): ', STATE(2) */
/* WRITE (*,*) 'J2000 z-position (km): ', STATE(3) */
/* WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */
/* WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */
/* WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */
/* WRITE (*,*) 'One-way light time (s): ', LT */
/* WRITE (*,*) 'Light time rate: ', DLT */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* On a PC/Linux/gfortran platform, the following output was */
/* produced: */
/* ET = 0.0000000000000000 */
/* J2000 x-position (km): -291569.26541282982 */
/* J2000 y-position (km): -266709.18647825718 */
/* J2000 z-position (km): -76099.155118763447 */
/* J2000 x-velocity (km/s): 0.64353061322177041 */
/* J2000 y-velocity (km/s): -0.66608181700820079 */
/* J2000 z-velocity (km/s): -0.30132283179625752 */
/* One-way light time (s): 1.3423106103251679 */
/* Light time rate: 1.07316908698977495E-007 */
/* ET = 3600.0000000000000 */
/* J2000 x-position (km): -289240.78128184378 */
/* J2000 y-position (km): -269096.44087958336 */
/* J2000 z-position (km): -77180.899725757539 */
/* J2000 x-velocity (km/s): 0.65006211520087476 */
/* J2000 y-velocity (km/s): -0.66016273921695667 */
/* J2000 z-velocity (km/s): -0.29964267390571342 */
/* One-way light time (s): 1.3426939548635302 */
/* Light time rate: 1.05652598952224259E-007 */
/* ET = 7200.0000000000000 */
/* J2000 x-position (km): -286888.88736709207 */
/* J2000 y-position (km): -271462.30170547962 */
/* J2000 z-position (km): -78256.555682137609 */
/* J2000 x-velocity (km/s): 0.65653599154284592 */
/* J2000 y-velocity (km/s): -0.65419657680401588 */
/* J2000 z-velocity (km/s): -0.29794027307420823 */
/* One-way light time (s): 1.3430713117337547 */
/* Light time rate: 1.03990456898758609E-007 */
/* ET = 10800.000000000000 */
/* J2000 x-position (km): -284513.79173691198 */
/* J2000 y-position (km): -273806.60031034052 */
/* J2000 z-position (km): -79326.043183274567 */
/* J2000 x-velocity (km/s): 0.66295190054599118 */
/* J2000 y-velocity (km/s): -0.64818380709706158 */
/* J2000 z-velocity (km/s): -0.29621577937090349 */
/* One-way light time (s): 1.3434426890693671 */
/* Light time rate: 1.02330665243423737E-007 */
/* ET = 14400.000000000000 */
/* J2000 x-position (km): -282115.70368389413 */
/* J2000 y-position (km): -276129.16976799071 */
/* J2000 z-position (km): -80389.282965712249 */
/* J2000 x-velocity (km/s): 0.66930950377548726 */
/* J2000 y-velocity (km/s): -0.64212490805688027 */
/* J2000 z-velocity (km/s): -0.29446934336246899 */
/* One-way light time (s): 1.3438080956559786 */
/* Light time rate: 1.00673403630050830E-007 */
/* $ Restrictions */
/* 1) The routine SPKGEO should be used instead of this routine */
/* to compute geometric states. SPKGEO introduces less */
/* round-off error when the observer and target have common */
/* center that is closer to both objects than is the solar */
/* system barycenter. */
/* 2) The kernel files to be used by SPKLTC must be loaded */
/* (normally by the SPICELIB kernel loader FURNSH) before */
/* this routine is called. */
/* 3) Unlike most other SPK state computation routines, this */
/* routine requires that the output state be relative to an */
/* inertial reference frame. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 04-JUL-2014 (NJB) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* Last update was 02-MAY-2012 (NJB) */
/* Updated to ensure convergence when CN or XCN light time */
/* corrections are used. The new algorithm also terminates early */
/* (after fewer than three iterations) when convergence is */
/* attained. */
/* Call to ZZPRSCOR was replaced by a call to ZZVALCOR. */
/* - SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */
/* -& */
/* $ Index_Entries */
/* low-level light time correction */
/* light-time corrected state from spk file */
/* get light-time corrected state */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* TOL is the tolerance used for a division-by-zero test */
/* performed prior to computation of DLT. */
/* Convergence limit: */
/* Maximum number of light time iterations for any */
/* aberration correction: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKLTC", (ftnlen)6);
}
if (pass1 || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {
/* The aberration correction flag differs from the value it */
/* had on the previous call, if any. Analyze the new flag. */
zzvalcor_(abcorr, attblk, abcorr_len);
if (failed_()) {
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
/* The aberration correction flag is recognized; save it. */
s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);
/* Set logical flags indicating the attributes of the requested */
/* correction: */
/* XMIT is .TRUE. when the correction is for transmitted */
/* radiation. */
/* USELT is .TRUE. when any type of light time correction */
/* (normal or converged Newtonian) is specified. */
/* USECN indicates converged Newtonian light time correction. */
/* The above definitions are consistent with those used by */
/* ZZVALCOR. */
xmit = attblk[4];
uselt = attblk[1];
usecn = attblk[3];
usestl = attblk[2];
pass1 = FALSE_;
}
/* See if the reference frame is a recognized inertial frame. */
irfnum_(ref, &refid, ref_len);
if (refid == 0) {
setmsg_("The requested frame '#' is not a recognized inertial frame. "
, (ftnlen)60);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(BADFRAME)", (ftnlen)15);
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
/* Find the geometric state of the target body with respect to */
/* the solar system barycenter. Subtract the state of the */
/* observer to get the relative state. Use this to compute the */
/* one-way light time. */
spkgeo_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len);
if (failed_()) {
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
vsubg_(ssbtrg, stobs, &c__6, starg);
dist = vnorm_(starg);
*lt = dist / clight_();
if (*lt == 0.) {
/* This can happen only if the observer and target are at the */
/* same position. We don't consider this an error, but we're not */
/* going to compute the light time derivative. */
*dlt = 0.;
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
if (! uselt) {
/* This is a special case: we're not using light time */
/* corrections, so the derivative */
/* of light time is just */
/* (1/c) * d(VNORM(STARG))/dt */
*dlt = vdot_(starg, &starg[3]) / (dist * clight_());
/* LT and DLT are both set, so we can return. */
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
/* To correct for light time, find the state of the target body */
/* at the current epoch minus the one-way light time. Note that */
/* the observer remains where it is. */
/* Determine the sign of the light time offset. */
if (xmit) {
ltsign = 1;
} else {
ltsign = -1;
}
/* Let NUMITR be the number of iterations we'll perform to */
/* compute the light time. */
if (usecn) {
numitr = 5;
} else {
numitr = 1;
}
i__ = 0;
lterr = 1.;
while(i__ < numitr && lterr > 1e-17) {
/* LT was set either prior to this loop or */
/* during the previous loop iteration. */
epoch = *et + ltsign * *lt;
spkgeo_(targ, &epoch, ref, &c__0, ssbtrg, &ssblt, ref_len);
if (failed_()) {
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
vsubg_(ssbtrg, stobs, &c__6, starg);
prvlt = *lt;
d__1 = vnorm_(starg) / clight_();
*lt = touchd_(&d__1);
/* LTERR is the magnitude of the change between the current */
/* estimate of light time and the previous estimate, relative to */
/* the previous light time corrected epoch. */
/* Computing MAX */
d__3 = 1., d__4 = abs(epoch);
d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4);
lterr = touchd_(&d__2);
++i__;
}
/* At this point, STARG contains the light time corrected */
/* state of the target relative to the observer. */
/* Compute the derivative of light time with respect */
/* to time: dLT/dt. Below we derive the formula for */
/* this quantity for the reception case. Let */
/* POBS be the position of the observer relative to the */
/* solar system barycenter. */
/* VOBS be the velocity of the observer relative to the */
/* solar system barycenter. */
/* PTARG be the position of the target relative to the */
/* solar system barycenter. */
/* VTARG be the velocity of the target relative to the */
/* solar system barycenter. */
/* S be the sign of the light time correction. S is */
/* negative for the reception case. */
/* The light-time corrected position of the target relative to */
/* the observer at observation time ET, given the one-way */
/* light time LT is: */
/* PTARG(ET+S*LT) - POBS(ET) */
/* The light-time corrected velocity of the target relative to */
/* the observer at observation time ET is */
/* VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */
/* We need to compute dLT/dt. Below, we use the facts that, */
/* for a time-dependent vector X(t), */
/* ||X|| = <X,X> ** (1/2) */
/* d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */
/* = <X,X>**(-1/2) * <X,dX/dt> */
/* = <X,dX/dt> / ||X|| */
/* Newtonian light time equation: */
/* LT = (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */
/* Differentiate both sides: */
/* dLT/dt = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */
/* * < PTARG(ET+S*LT) - POBS(ET), */
/* VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */
/* = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */
/* * ( < PTARG(ET+S*LT) - POBS(ET), */
/* VTARG(ET+S*LT) - VOBS(ET) > */
/* + < PTARG(ET+S*LT) - POBS(ET), */
/* VTARG(ET+S*LT) > * (S*d(LT)/d(ET)) ) */
/* Let */
/* A = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */
/* B = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */
/* C = < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */
/* Then */
/* d(LT)/d(ET) = A * ( B + C * S*d(LT)/d(ET) ) */
/* which implies */
/* d(LT)/d(ET) = A*B / ( 1 - S*C*A ) */
a = 1. / (clight_() * vnorm_(starg));
b = vdot_(starg, &starg[3]);
c__ = vdot_(starg, &ssbtrg[3]);
/* For physically realistic target velocities, S*C*A cannot equal 1. */
/* We'll check for this case anyway. */
if (ltsign * c__ * a > .99999999989999999) {
setmsg_("Target range rate magnitude is approximately the speed of l"
"ight. The light time derivative cannot be computed.", (ftnlen)
110);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("SPKLTC", (ftnlen)6);
return 0;
}
/* Compute DLT: the rate of change of light time. */
*dlt = a * b / (1. - ltsign * c__ * a);
/* Overwrite the velocity portion of the output state */
/* with the light-time corrected velocity. */
d__1 = ltsign * *dlt + 1.;
vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]);
chkout_("SPKLTC", (ftnlen)6);
return 0;
} /* spkltc_ */
/* $Procedure ZZEDTERM ( Ellipsoid terminator ) */
/* Subroutine */ int zzedterm_(char *type__, doublereal *a, doublereal *b,
doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer *
npts, doublereal *trmpts, ftnlen type_len)
{
/* System generated locals */
integer trmpts_dim2, i__1, i__2;
doublereal d__1, d__2, d__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
double asin(doublereal);
integer s_rnge(char *, integer, char *, integer);
double d_sign(doublereal *, doublereal *);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal rmin, rmax;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
integer nitr;
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *);
doublereal d__, e[3];
integer i__;
doublereal s, angle, v[3], x[3], delta, y[3], z__[3], inang;
extern /* Subroutine */ int chkin_(char *, ftnlen), frame_(doublereal *,
doublereal *, doublereal *);
doublereal plane[4];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
errch_(char *, char *, ftnlen, ftnlen), vpack_(doublereal *,
doublereal *, doublereal *, doublereal *);
doublereal theta;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal trans[9] /* was [3][3] */, srcpt[3], vtemp[3];
extern doublereal vnorm_(doublereal *), twopi_(void);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
pl2nvc_(doublereal *, doublereal *, doublereal *);
doublereal lambda;
extern /* Subroutine */ int nvp2pl_(doublereal *, doublereal *,
doublereal *);
extern doublereal halfpi_(void);
doublereal minang, minrad, maxang, maxrad;
extern /* Subroutine */ int latrec_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal angerr;
logical umbral;
extern doublereal touchd_(doublereal *);
doublereal offset[3], prvdif;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
doublereal outang, plcons, prvang;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
char loctyp[50];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
doublereal dir[3];
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
doublereal vtx[3];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Compute a set of points on the umbral or penumbral terminator of */
/* a specified ellipsoid, given a spherical light source. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* ELLIPSES */
/* $ Keywords */
/* BODY */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TYPE I Terminator type. */
/* A I Length of ellipsoid semi-axis lying on the x-axis. */
/* B I Length of ellipsoid semi-axis lying on the y-axis. */
/* C I Length of ellipsoid semi-axis lying on the z-axis. */
/* SRCRAD I Radius of light source. */
/* SRCPOS I Position of center of light source. */
/* NPTS I Number of points in terminator point set. */
/* TRMPTS O Terminator point set. */
/* $ Detailed_Input */
/* TYPE is a string indicating the type of terminator to */
/* compute: umbral or penumbral. The umbral */
/* terminator is the boundary of the portion of the */
/* ellipsoid surface in total shadow. The penumbral */
/* terminator is the boundary of the portion of the */
/* surface that is completely illuminated. Possible */
/* values of TYPE are */
/* 'UMBRAL' */
/* 'PENUMBRAL' */
/* Case and leading or trailing blanks in TYPE are */
/* not significant. */
/* A, */
/* B, */
/* C are the lengths of the semi-axes of a triaxial */
/* ellipsoid. The ellipsoid is centered at the */
/* origin and oriented so that its axes lie on the */
/* x, y and z axes. A, B, and C are the lengths of */
/* the semi-axes that point in the x, y, and z */
/* directions respectively. */
/* Length units associated with A, B, and C must */
/* match those associated with SRCRAD, SRCPOS, */
/* and the output TRMPTS. */
/* SRCRAD is the radius of the spherical light source. */
/* SRCPOS is the position of the center of the light source */
/* relative to the center of the ellipsoid. */
/* NPTS is the number of terminator points to compute. */
/* $ Detailed_Output */
/* TRMPTS is an array of points on the umbral or penumbral */
/* terminator of the ellipsoid, as specified by the */
/* input argument TYPE. The Ith point is contained */
/* in the array elements */
/* TRMPTS(J,I), J = 1, 2, 3 */
/* The terminator points are expressed in the */
/* body-fixed reference frame associated with the */
/* ellipsoid. Units are those associated with */
/* the input axis lengths. */
/* Each terminator point is the point of tangency of */
/* a plane that is also tangent to the light source. */
/* These associated points of tangency on the light */
/* source have uniform distribution in longitude when */
/* expressed in a cylindrical coordinate system whose */
/* Z-axis is SRCPOS. The magnitude of the separation */
/* in longitude between these tangency points on the */
/* light source is */
/* 2*Pi / NPTS */
/* If the target is spherical, the terminator points */
/* also are uniformly distributed in longitude in the */
/* cylindrical system described above. If the target */
/* is non-spherical, the longitude distribution of */
/* the points generally is not uniform. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the terminator type is not recognized, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 2) If the set size NPTS is not at least 1, the error */
/* SPICE(INVALIDSIZE) is signaled. */
/* 3) If any of the ellipsoid's semi-axis lengths is non-positive, */
/* the error SPICE(INVALIDAXISLENGTH) is signaled. */
/* 4) If the light source has non-positive radius, the error */
/* SPICE(INVALIDRADIUS) is signaled. */
/* 5) If the light source intersects the smallest sphere */
/* centered at the origin and containing the ellipsoid, the */
/* error SPICE(OBJECTSTOOCLOSE) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine models the boundaries of shadow regions on an */
/* ellipsoid "illuminated" by a spherical light source. Light rays */
/* are assumed to travel along straight lines; refraction is not */
/* modeled. */
/* Points on the ellipsoid at which the entire cap of the light */
/* source is visible are considered to be completely illuminated. */
/* Points on the ellipsoid at which some portion (or all) of the cap */
/* of the light source are blocked are considered to be in partial */
/* (or total) shadow. */
/* In this routine, we use the term "umbral terminator" to denote */
/* the curve ususally called the "terminator": this curve is the */
/* boundary of the portion of the surface that lies in total shadow. */
/* We use the term "penumbral terminator" to denote the boundary of */
/* the completely illuminated portion of the surface. */
/* In general, the terminator on an ellipsoid is a more complicated */
/* curve than the limb (which is always an ellipse). Aside from */
/* various special cases, the terminator does not lie in a plane. */
/* However, the condition for a point X on the ellipsoid to lie on */
/* the terminator is simple: a plane tangent to the ellipsoid at X */
/* must also be tangent to the light source. If this tangent plane */
/* does not intersect the vector from the center of the ellipsoid to */
/* the center of the light source, then X lies on the umbral */
/* terminator; otherwise X lies on the penumbral terminator. */
/* $ Examples */
/* See the SPICELIB routine EDTERM. */
/* $ Restrictions */
/* This is a private SPICELIB routine. User applications should not */
/* call this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-FEB-2007 (NJB) */
/* -& */
/* $ Index_Entries */
/* find terminator on ellipsoid */
/* find umbral terminator on ellipsoid */
/* find penumbral terminator on ellipsoid */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICELIB error handling. */
/* Parameter adjustments */
trmpts_dim2 = *npts;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZEDTERM", (ftnlen)8);
/* Check the terminator type. */
ljust_(type__, loctyp, type_len, (ftnlen)50);
ucase_(loctyp, loctyp, (ftnlen)50, (ftnlen)50);
if (s_cmp(loctyp, "UMBRAL", (ftnlen)50, (ftnlen)6) == 0) {
umbral = TRUE_;
} else if (s_cmp(loctyp, "PENUMBRAL", (ftnlen)50, (ftnlen)9) == 0) {
umbral = FALSE_;
} else {
setmsg_("Terminator type must be UMBRAL or PENUMBRAL but was actuall"
"y #.", (ftnlen)63);
errch_("#", type__, (ftnlen)1, type_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Check the terminator set dimension. */
if (*npts < 1) {
setmsg_("Set must contain at least one point; NPTS = #.", (ftnlen)47)
;
errint_("#", npts, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* The ellipsoid semi-axes must have positive length. */
if (*a <= 0. || *b <= 0. || *c__ <= 0.) {
setmsg_("Semi-axis lengths: A = #, B = #, C = #. ", (ftnlen)41);
errdp_("#", a, (ftnlen)1);
errdp_("#", b, (ftnlen)1);
errdp_("#", c__, (ftnlen)1);
sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Check the input light source radius. */
if (*srcrad <= 0.) {
setmsg_("Light source must have positive radius; actual radius was #."
, (ftnlen)60);
errdp_("#", srcrad, (ftnlen)1);
sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* The light source must not intersect the outer bounding */
/* sphere of the ellipsoid. */
d__ = vnorm_(srcpos);
/* Computing MAX */
d__1 = max(*a,*b);
rmax = max(d__1,*c__);
/* Computing MIN */
d__1 = min(*a,*b);
rmin = min(d__1,*c__);
if (*srcrad + rmax >= d__) {
/* The light source is too close. */
setmsg_("Light source intersects outer bounding sphere of the ellips"
"oid. Light source radius = #; ellipsoid's longest axis = #;"
" sum = #; distance between centers = #.", (ftnlen)158);
errdp_("#", srcrad, (ftnlen)1);
errdp_("#", &rmax, (ftnlen)1);
d__1 = *srcrad + rmax;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &d__, (ftnlen)1);
sigerr_("SPICE(OBJECTSTOOCLOSE)", (ftnlen)22);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Find bounds on the angular size of the target as seen */
/* from the source. */
/* Computing MIN */
d__1 = rmax / d__;
minang = asin((min(d__1,1.)));
/* Computing MIN */
d__1 = rmin / d__;
maxang = asin((min(d__1,1.)));
/* Let the inverse of the ellipsoid-light source vector be the */
/* Z-axis of a frame we'll use to generate the terminator set. */
vminus_(srcpos, z__);
frame_(z__, x, y);
/* Create the rotation matrix required to convert vectors */
/* from the source-centered frame back to the target body-fixed */
/* frame. */
vequ_(x, trans);
vequ_(y, &trans[3]);
vequ_(z__, &trans[6]);
/* Find the maximum and minimum target radii. */
/* Computing MAX */
d__1 = max(*a,*b);
maxrad = max(d__1,*c__);
/* Computing MIN */
d__1 = min(*a,*b);
minrad = min(d__1,*c__);
if (umbral) {
/* Compute the angular offsets from the axis of rays tangent to */
/* both the source and the bounding spheres of the target, where */
/* the tangency points lie in a half-plane bounded by the line */
/* containing the origin and SRCPOS. (We'll call this line */
/* the "axis.") */
/* OUTANG corresponds to the target's outer bounding sphere; */
/* INANG to the inner bounding sphere. */
outang = asin((*srcrad - maxrad) / d__);
inang = asin((*srcrad - minrad) / d__);
} else {
/* Compute the angular offsets from the axis of rays tangent to */
/* both the source and the bounding spheres of the target, where */
/* the tangency points lie in opposite half-planes bounded by the */
/* axis (compare the case above). */
/* OUTANG corresponds to the target's outer bounding sphere; */
/* INANG to the inner bounding sphere. */
outang = asin((*srcrad + maxrad) / d__);
inang = asin((*srcrad + minrad) / d__);
}
/* Compute the angular delta we'll use for generating */
/* terminator points. */
delta = twopi_() / *npts;
/* Generate the terminator points. */
i__1 = *npts;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (i__ - 1) * delta;
/* Let SRCPT be the surface point on the source lying in */
/* the X-Y plane of the frame produced by FRAME */
/* and corresponding to the angle THETA. */
latrec_(srcrad, &theta, &c_b30, srcpt);
/* Now solve for the angle by which SRCPT must be rotated (toward */
/* +Z in the umbral case, away from +Z in the penumbral case) */
/* so that a plane tangent to the source at SRCPT is also tangent */
/* to the target. The rotation is bracketed by OUTANG on the low */
/* side and INANG on the high side in the umbral case; the */
/* bracketing values are reversed in the penumbral case. */
if (umbral) {
angle = outang;
} else {
angle = inang;
}
prvdif = twopi_();
prvang = angle + halfpi_();
nitr = 0;
for(;;) { /* while(complicated condition) */
d__2 = (d__1 = angle - prvang, abs(d__1));
if (!(nitr <= 10 && touchd_(&d__2) < prvdif))
break;
++nitr;
d__2 = (d__1 = angle - prvang, abs(d__1));
prvdif = touchd_(&d__2);
prvang = angle;
/* Find the closest point on the ellipsoid to the plane */
/* corresponding to "ANGLE". */
/* The tangent point on the source is obtained by rotating */
/* SRCPT by ANGLE towards +Z. The plane's normal vector is */
/* parallel to VTX in the source-centered frame. */
latrec_(srcrad, &theta, &angle, vtx);
vequ_(vtx, dir);
/* VTX and DIR are expressed in the source-centered frame. We */
/* must translate VTX to the target frame and rotate both */
/* vectors into that frame. */
mxv_(trans, vtx, vtemp);
vadd_(srcpos, vtemp, vtx);
mxv_(trans, dir, vtemp);
vequ_(vtemp, dir);
/* Create the plane defined by VTX and DIR. */
nvp2pl_(dir, vtx, plane);
/* Find the closest point on the ellipsoid to the plane. At */
/* the point we seek, the outward normal on the ellipsoid is */
/* parallel to the choice of plane normal that points away */
/* from the origin. We can always obtain this choice from */
/* PL2NVC. */
pl2nvc_(plane, dir, &plcons);
/* At the point */
/* E = (x, y, z) */
/* on the ellipsoid's surface, an outward normal */
/* is */
/* N = ( x/A**2, y/B**2, z/C**2 ) */
/* which is also */
/* lambda * ( DIR(1), DIR(2), DIR(3) ) */
/* Equating components in the normal vectors yields */
/* E = lambda * ( DIR(1)*A**2, DIR(2)*B**2, DIR(3)*C**2 ) */
/* Taking the inner product with the point E itself and */
/* applying the ellipsoid equation, we find */
/* lambda * <DIR, E> = < N, E > = 1 */
/* The first term above is */
/* lambda**2 * || ( A*DIR(1), B*DIR(2), C*DIR(3) ) ||**2 */
/* So the positive root lambda is */
/* 1 / || ( A*DIR(1), B*DIR(2), C*DIR(3) ) || */
/* Having lambda we can compute E. */
d__1 = *a * dir[0];
d__2 = *b * dir[1];
d__3 = *c__ * dir[2];
vpack_(&d__1, &d__2, &d__3, v);
lambda = 1. / vnorm_(v);
d__1 = *a * v[0];
d__2 = *b * v[1];
d__3 = *c__ * v[2];
vpack_(&d__1, &d__2, &d__3, e);
vscl_(&lambda, e, &trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3
&& 0 <= i__2 ? i__2 : s_rnge("trmpts", i__2, "zzedterm_",
(ftnlen)586)]);
/* Make a new estimate of the plane rotation required to touch */
/* the target. */
vsub_(&trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 && 0 <= i__2
? i__2 : s_rnge("trmpts", i__2, "zzedterm_", (ftnlen)592)]
, vtx, offset);
/* Let ANGERR be an estimate of the magnitude of angular error */
/* between the plane and the terminator. */
angerr = vsep_(dir, offset) - halfpi_();
/* Let S indicate the sign of the altitude error: where */
/* S is positive, the plane is above E. */
d__1 = vdot_(e, dir);
s = d_sign(&c_b35, &d__1);
if (umbral) {
/* If the plane is above the target, increase the */
/* rotation angle; otherwise decrease the angle. */
angle += s * angerr;
} else {
/* This is the penumbral case; decreasing the angle */
/* "lowers" the plane toward the target. */
angle -= s * angerr;
}
}
}
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
} /* zzedterm_ */
void npedln_c ( SpiceDouble a,
SpiceDouble b,
SpiceDouble c,
ConstSpiceDouble linept[3],
ConstSpiceDouble linedr[3],
SpiceDouble pnear[3],
SpiceDouble * dist )
/*
-Brief_I/O
Variable I/O Description
-------- --- --------------------------------------------------
a I Length of ellipsoid's semi-axis in the x direction
b I Length of ellipsoid's semi-axis in the y direction
c I Length of ellipsoid's semi-axis in the z direction
linept I Point on line
linedr I Direction vector of line
pnear O Nearest point on ellipsoid to line
dist O Distance of ellipsoid from line
-Detailed_Input
a,
b,
c are the lengths of the semi-axes of a triaxial
ellipsoid which is centered at the origin and
oriented so that its axes lie on the x-, y- and
z- coordinate axes. a, b, and c are the lengths of
the semi-axes that point in the x, y, and z
directions respectively.
linept
linedr are, respectively, a point and a direction vector
that define a line. The line is the set of vectors
linept + t * linedr
where t is any real number.
-Detailed_Output
pnear is the point on the ellipsoid that is closest to
the line, if the line doesn't intersect the
ellipsoid.
If the line intersects the ellipsoid, pnear will
be a point of intersection. If linept is outside
of the ellipsoid, pnear will be the closest point
of intersection. If linept is inside the
ellipsoid, pnear will not necessarily be the
closest point of intersection.
dist is the distance of the line from the ellipsoid.
This is the minimum distance between any point on
the line and any point on the ellipsoid.
If the line intersects the ellipsoid, dist is zero.
-Parameters
None.
-Exceptions
If this routine detects an error, the output arguments nearp and
dist are not modified.
1) If the length of any semi-axis of the ellipsoid is
non-positive, the error SPICE(INVALIDAXISLENGTH) is signaled.
2) If the line's direction vector is the zero vector, the error
SPICE(ZEROVECTOR) is signaled.
3) If the length of any semi-axis of the ellipsoid is zero after
the semi-axis lengths are scaled by the reciprocal of the
magnitude of the longest semi-axis and then squared, the error
SPICE(DEGENERATECASE) is signaled.
4) If the input ellipsoid is extremely flat or needle-shaped
and has its shortest axis close to perpendicular to the input
line, numerical problems could cause this routine's algorithm
to fail, in which case the error SPICE(DEGENERATECASE) is
signaled.
-Files
None.
-Particulars
For any ellipsoid and line, if the line does not intersect the
ellipsoid, there is a unique point on the ellipsoid that is
closest to the line. Therefore, the distance dist between
ellipsoid and line is well-defined. The unique line segment of
length dist that connects the line and ellipsoid is normal to
both of these objects at its endpoints.
If the line intersects the ellipsoid, the distance between the
line and ellipsoid is zero.
-Examples
1) We can find the distance between an instrument optic axis ray
and the surface of a body modelled as a tri-axial ellipsoid
using this routine. If the instrument position and pointing
unit vector in body-fixed coordinates are
linept = ( 1.0e6, 2.0e6, 3.0e6 )
and
linedr = ( -4.472091234e-1
-8.944182469e-1,
-4.472091234e-3 )
and the body semi-axes lengths are
a = 7.0e5
b = 7.0e5
c = 6.0e5,
then the call to npedln_c
npedln_c ( a, b, c, linept, linedr, pnear, &dist );
yields a value for pnear, the nearest point on the body to
the optic axis ray, of
( -.16333110792340931E+04,
-.32666222157820771E+04,
.59999183350006724E+06 )
and a value for dist, the distance to the ray, of
.23899679338299707E+06
(These results were obtained on a PC-Linux system under gcc.)
In some cases, it may not be clear that the closest point
on the line containing an instrument boresight ray is on
the boresight ray itself; the point may lie on the ray
having the same vertex as the boresight ray and pointing in
the opposite direction. To rule out this possibility, we
can make the following test:
/.
Find the difference vector between the closest point
on the ellipsoid to the line containing the boresight
ray and the boresight ray's vertex. Find the
angular separation between this difference vector
and the boresight ray. If the angular separation
does not exceed pi/2, we have the nominal geometry.
Otherwise, we have an error.
./
vsub_c ( pnear, linept, diff );
sep = vsep_c ( diff, linedr );
if ( sep <= halfpi_c() )
{
[ perform normal processing ]
}
else
{
[ handle error case ]
}
-Restrictions
None.
-Literature_References
None.
-Author_and_Institution
N.J. Bachman (JPL)
-Version
-CSPICE Version 1.1.0, 01-JUN-2010 (NJB)
Added touchd_ calls to tests for squared, scaled axis length
underflow. This forces rounding to zero in certain cases where
it otherwise might not occur due to use of extended registers.
-CSPICE Version 1.0.1, 06-DEC-2002 (NJB)
Outputs shown in header example have been corrected to
be consistent with those produced by this routine.
-CSPICE Version 1.0.0, 03-SEP-1999 (NJB)
-Index_Entries
distance between line and ellipsoid
distance between line of sight and body
nearest point on ellipsoid to line
-&
*/
{ /* Begin npedln_c */
/*
Local variables
*/
SpiceBoolean found [2];
SpiceBoolean ifound;
SpiceBoolean xfound;
SpiceDouble oppdir [3];
SpiceDouble mag;
SpiceDouble normal [3];
SpiceDouble prjpt [3];
SpiceDouble prjnpt [3];
SpiceDouble pt [2][3];
SpiceDouble scale;
SpiceDouble scla;
SpiceDouble scla2;
SpiceDouble sclb;
SpiceDouble sclb2;
SpiceDouble sclc;
SpiceDouble sclc2;
SpiceDouble sclpt [3];
SpiceDouble udir [3];
SpiceEllipse cand;
SpiceEllipse prjel;
SpiceInt i;
SpicePlane candpl;
SpicePlane prjpl;
/*
Static variables
*/
/*
Participate in error tracing.
*/
chkin_c ( "npedln_c" );
/*
The algorithm used in this routine has two parts. The first
part handles the case where the input line and ellipsoid
intersect. Our procedure is simple in that case; we just
call surfpt_c twice, passing it first one ray determined by the
input line, then a ray pointing in the opposite direction.
The second part of the algorithm handles the case where surfpt_c
doesn't find an intersection.
Finding the nearest point on the ellipsoid to the line, when the
two do not intersect, is a matter of following four steps:
1) Find the points on the ellipsoid where the surface normal
is normal to the line's direction. This set of points is
an ellipse centered at the origin. The point we seek MUST
lie on this `candidate' ellipse.
2) Project the candidate ellipse onto a plane that is normal
to the line's direction. This projection preserves
distance from the line; the nearest point to the line on
this new ellipse is the projection of the nearest point to
the line on the candidate ellipse, and these two points are
exactly the same distance from the line. If computed using
infinite-precision arithmetic, this projection would be
guaranteed to be non-degenerate as long as the input
ellipsoid were non-degenerate. This can be verified by
taking the inner product of the scaled normal to the candidate
ellipse plane and the line's unitized direction vector
(these vectors are called normal and udir in the code below);
the inner product is strictly greater than 1 if the ellipsoid
is non-degenerate.
3) The nearest point on the line to the projected ellipse will
be contained in the plane onto which the projection is done;
we find this point and then find the nearest point to it on
the projected ellipse. The distance between these two points
is the distance between the line and the ellipsoid.
4) Finally, we find the point on the candidate ellipse that was
projected to the nearest point to the line on the projected
ellipse that was found in step 3. This is the nearest point
on the ellipsoid to the line.
Glossary of Geometric Variables
a,
b,
c Input ellipsoid's semi-axis lengths.
point Point of intersection of line and ellipsoid
if the intersection is non-empty.
candpl Plane containing candidate ellipse.
normal Normal vector to the candidate plane candpl.
cand Candidate ellipse.
linept,
linedr, Point and direction vector on input line.
udir Unitized line direction vector.
prjpl Projection plane; the candidate ellipse is
projected onto this plane to yield prjel.
prjel Projection of the candidate ellipse cand onto
the projection plane prjel.
prjpt Projection of line point.
prjnpt Nearest point on projected ellipse to
projection of line point.
pnear Nearest point on ellipsoid to line.
*/
/*
We need a valid normal vector.
*/
unorm_c ( linedr, udir, &mag );
if ( mag == 0. )
{
setmsg_c( "Line direction vector is the zero vector. " );
sigerr_c( "SPICE(ZEROVECTOR)" );
chkout_c( "npedln_c" );
return;
}
if ( ( a <= 0. )
|| ( b <= 0. )
|| ( c <= 0. ) )
{
setmsg_c ( "Semi-axis lengths: a = #, b = #, c = #." );
errdp_c ( "#", a );
errdp_c ( "#", b );
errdp_c ( "#", c );
sigerr_c ( "SPICE(INVALIDAXISLENGTH)" );
chkout_c ( "npedln_c" );
return;
}
/*
Scale the semi-axes lengths for better numerical behavior.
If squaring any one of the scaled lengths causes it to
underflow to zero, we cannot continue the computation. Otherwise,
scale the viewing point too.
*/
scale = maxd_c ( 3, a, b, c );
scla = a / scale;
sclb = b / scale;
sclc = c / scale;
scla2 = scla*scla;
sclb2 = sclb*sclb;
sclc2 = sclc*sclc;
if ( ( (SpiceDouble)touchd_(&scla2) == 0. )
|| ( (SpiceDouble)touchd_(&sclb2) == 0. )
|| ( (SpiceDouble)touchd_(&sclc2) == 0. ) )
{
setmsg_c ( "Semi-axis too small: a = #, b = #, c = #. " );
errdp_c ( "#", a );
errdp_c ( "#", b );
errdp_c ( "#", c );
sigerr_c ( "SPICE(DEGENERATECASE)" );
chkout_c ( "npedln_c" );
return;
}
/*
Scale linept.
*/
sclpt[0] = linept[0] / scale;
sclpt[1] = linept[1] / scale;
sclpt[2] = linept[2] / scale;
/*
Hand off the intersection case to surfpt_c. surfpt_c determines
whether rays intersect a body, so we treat the line as a pair
of rays.
*/
vminus_c ( udir, oppdir );
surfpt_c ( sclpt, udir, scla, sclb, sclc, pt[0], &(found[0]) );
surfpt_c ( sclpt, oppdir, scla, sclb, sclc, pt[1], &(found[1]) );
for ( i = 0; i < 2; i++ )
{
if ( found[i] )
{
*dist = 0.0;
vequ_c ( pt[i], pnear );
vscl_c ( scale, pnear, pnear );
chkout_c ( "npedln_c" );
return;
}
}
/*
Getting here means the line doesn't intersect the ellipsoid.
Find the candidate ellipse CAND. NORMAL is a normal vector to
the plane containing the candidate ellipse. Mathematically the
ellipse must exist, since it's the intersection of an ellipsoid
centered at the origin and a plane containing the origin. Only
numerical problems can prevent the intersection from being found.
*/
normal[0] = udir[0] / scla2;
normal[1] = udir[1] / sclb2;
normal[2] = udir[2] / sclc2;
nvc2pl_c ( normal, 0., &candpl );
inedpl_c ( scla, sclb, sclc, &candpl, &cand, &xfound );
if ( !xfound )
{
setmsg_c ( "Candidate ellipse could not be found." );
sigerr_c ( "SPICE(DEGENERATECASE)" );
chkout_c ( "npedln_c" );
return;
}
/*
Project the candidate ellipse onto a plane orthogonal to the
line. We'll call the plane prjpl and the projected ellipse prjel.
*/
nvc2pl_c ( udir, 0., &prjpl );
pjelpl_c ( &cand, &prjpl, &prjel );
/*
Find the point on the line lying in the projection plane, and
then find the near point PRJNPT on the projected ellipse. Here
PRJPT is the point on the line lying in the projection plane.
The distance between PRJPT and PRJNPT is DIST.
*/
vprjp_c ( sclpt, &prjpl, prjpt );
npelpt_c ( prjpt, &prjel, prjnpt, dist );
/*
Find the near point pnear on the ellipsoid by taking the inverse
orthogonal projection of prjnpt; this is the point on the
candidate ellipse that projects to prjnpt. Note that the
output dist was computed in step 3 and needs only to be re-scaled.
The inverse projection of pnear ought to exist, but may not
be calculable due to numerical problems (this can only happen
when the input ellipsoid is extremely flat or needle-shaped).
*/
vprjpi_c ( prjnpt, &prjpl, &candpl, pnear, &ifound );
if ( !ifound )
{
setmsg_c ( "Inverse projection could not be found." );
sigerr_c ( "SPICE(DEGENERATECASE)" );
chkout_c ( "npedln_c" );
return;
}
/*
Undo the scaling.
*/
vscl_c ( scale, pnear, pnear );
*dist *= scale;
chkout_c ( "npedln_c" );
} /* End npedln_c */
