/* $Procedure DVSEP ( Derivative of separation angle ) */
doublereal dvsep_(doublereal *s1, doublereal *s2)
{
/* System generated locals */
doublereal ret_val;
/* Local variables */
logical safe;
extern doublereal vdot_(doublereal *, doublereal *);
doublereal numr;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal denom;
extern /* Subroutine */ int dvhat_(doublereal *, doublereal *);
extern doublereal dpmax_(void);
extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal
*);
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
doublereal u1[6], u2[6];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
doublereal pcross[3];
extern logical return_(void);
/* $ Abstract */
/* Calculate the time derivative of the separation angle between */
/* two input states, S1 and S2. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* GEOMETRY */
/* DERIVATIVES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* S1 I State vector of the first body. */
/* S2 I State vector of the second body. */
/* $ Detailed_Input */
/* S1 the state vector of the first target body as seen from */
/* the observer. */
/* S2 the state vector of the second target body as seen from */
/* the observer. */
/* An implicit assumption exists that both states lie in the same */
/* reference frame with the same observer for the same epoch. If this */
/* is not the case, the numerical result has no meaning. */
/* $ Detailed_Output */
/* The function returns the double precision value of the time */
/* derivative of the angular separation between S1 and S2. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) The error SPICE(NUMERICOVERFLOW) signals if the inputs S1, S2 */
/* define states with an angular separation rate ~ DPMAX(). */
/* 2) If called in RETURN mode, the return has value 0. */
/* 3) Linear dependent position components of S1 and S1 constitutes */
/* a non-error exception. The function returns 0 for this case. */
/* $ Files */
/* None. */
/* $ Particulars */
/* In this discussion, the notation */
/* < V1, V2 > */
/* indicates the dot product of vectors V1 and V2. The notation */
/* V1 x V2 */
/* indicates the cross product of vectors V1 and V2. */
/* To start out, note that we need consider only unit vectors, */
/* since the angular separation of any two non-zero vectors */
/* equals the angular separation of the corresponding unit vectors. */
/* Call these vectors U1 and U2; let their velocities be V1 and V2. */
/* For unit vectors having angular separation */
/* THETA */
/* the identity */
/* || U1 x U1 || = ||U1|| * ||U2|| * sin(THETA) (1) */
/* reduces to */
/* || U1 x U2 || = sin(THETA) (2) */
/* and the identity */
/* | < U1, U2 > | = || U1 || * || U2 || * cos(THETA) (3) */
/* reduces to */
/* | < U1, U2 > | = cos(THETA) (4) */
/* Since THETA is an angular separation, THETA is in the range */
/* 0 : Pi */
/* Then letting s be +1 if cos(THETA) > 0 and -1 if cos(THETA) < 0, */
/* we have for any value of THETA other than 0 or Pi */
/* 2 1/2 */
/* cos(THETA) = s * ( 1 - sin (THETA) ) (5) */
/* or */
/* 2 1/2 */
/* < U1, U2 > = s * ( 1 - sin (THETA) ) (6) */
/* At this point, for any value of THETA other than 0 or Pi, */
/* we can differentiate both sides with respect to time (T) */
/* to obtain */
/* 2 -1/2 */
/* < U1, V2 > + < V1, U2 > = s * (1/2)(1 - sin (THETA)) */
/* * (-2) sin(THETA)*cos(THETA) */
/* * d(THETA)/dT (7a) */
/* Using equation (5), and noting that s = 1/s, we can cancel */
/* the cosine terms on the right hand side */
/* -1 */
/* < U1, V2 > + < V1, U2 > = (1/2)(cos(THETA)) */
/* * (-2) sin(THETA)*cos(THETA) */
/* * d(THETA)/dT (7b) */
/* With (7b) reducing to */
/* < U1, V2 > + < V1, U2 > = - sin(THETA) * d(THETA)/dT (8) */
/* Using equation (2) and switching sides, we obtain */
/* || U1 x U2 || * d(THETA)/dT = - < U1, V2 > - < V1, U2 > (9) */
/* or, provided U1 and U2 are linearly independent, */
/* d(THETA)/dT = ( - < U1, V2 > - < V1, U2 > ) / ||U1 x U2|| (10) */
/* Note for times when U1 and U2 have angular separation 0 or Pi */
/* radians, the derivative of angular separation with respect to */
/* time doesn't exist. (Consider the graph of angular separation */
/* with respect to time; typically the graph is roughly v-shaped at */
/* the singular points.) */
/* $ Examples */
/* PROGRAM DVSEP_T */
/* IMPLICIT NONE */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION DSEPT */
/* DOUBLE PRECISION STATEE (6) */
/* DOUBLE PRECISION STATEM (6) */
/* INTEGER STRLEN */
/* PARAMETER ( STRLEN = 64 ) */
/* CHARACTER*(STRLEN) BEGSTR */
/* DOUBLE PRECISION DVSEP */
/* C */
/* C Load kernels. */
/* C */
/* CALL FURNSH ('standard.tm') */
/* C */
/* C An arbitrary time. */
/* C */
/* BEGSTR = 'JAN 1 2009' */
/* CALL STR2ET( BEGSTR, ET ) */
/* C */
/* C Calculate the state vectors sun to Moon, sun to earth at ET. */
/* C */
/* C */
/* CALL SPKEZR ( 'EARTH', ET, 'J2000', 'NONE', 'SUN', */
/* . STATEE, LT) */
/* CALL SPKEZR ( 'MOON', ET, 'J2000', 'NONE', 'SUN', */
/* . STATEM, LT) */
/* C */
/* C Calculate the time derivative of the angular separation of */
/* C the earth and Moon as seen from the sun at ET. */
/* C */
/* DSEPT = DVSEP( STATEE, STATEM ) */
/* WRITE(*,*) 'Time derivative of angular separation: ', DSEPT */
/* END */
/* The program compiled on OS X with g77 outputs (radians/sec): */
/* Time derivative of angular separation: 3.81211936E-09 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 15-MAR-2010 (EDW) */
/* Trivial header format clean-up. */
/* - SPICELIB Version 1.0.1, 31-MAR-2009 (EDW) */
/* -& */
/* $ Index_Entries */
/* time derivative of angular separation */
/* -& */
/* SPICELIB functions */
/* Local variables */
if (return_()) {
ret_val = 0.;
return ret_val;
}
chkin_("DVSEP", (ftnlen)5);
/* Compute the unit vectors and corresponding time derivatives */
/* for the input state vectors. */
dvhat_(s1, u1);
dvhat_(s2, u2);
/* Calculate the cross product vector of U1 and U2. As both vectors */
/* have magnitude one, the magnitude of the cross product equals */
/* sin(THETA), with THETA the angle between S1 and S2. */
vcrss_(u1, u2, pcross);
/* Now calculate the time derivate of the angular separation between */
/* S1 and S2. */
/* The routine needs to guard against both division by zero */
/* and numeric overflow. Before carrying out the division */
/* indicated by equation (10), the routine should verify that */
/* || U1 x U2 || > fudge factor * | numerator | / DPMAX() */
/* A fudge factor of 10.D0 should suffice. */
/* Note that the inequality is strict. */
/* Handle the parallel and anti-parallel cases. */
if (vzero_(pcross)) {
ret_val = 0.;
chkout_("DVSEP", (ftnlen)5);
return ret_val;
}
/* Now check for possible overflow. */
numr = vdot_(u1, &u2[3]) + vdot_(&u1[3], u2);
denom = vnorm_(pcross);
safe = denom > abs(numr) * 10. / dpmax_();
if (! safe) {
ret_val = 0.;
setmsg_("Numerical overflow event.", (ftnlen)25);
sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22);
chkout_("DVSEP", (ftnlen)5);
return ret_val;
}
ret_val = -numr / denom;
chkout_("DVSEP", (ftnlen)5);
return ret_val;
} /* dvsep_ */
/* $Procedure SPKE15 ( Evaluate a type 15 SPK data record) */
/* Subroutine */ int spke15_(doublereal *et, doublereal *recin, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), d_mod(doublereal *, doublereal *), d_sign(
doublereal *, doublereal *);
/* Local variables */
doublereal near__, dmdt;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer j2flg;
doublereal p, angle, dnode, z__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, speed, dperi, theta, manom;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
errdp_(char *, doublereal *, ftnlen), vcrss_(doublereal *,
doublereal *, doublereal *);
extern doublereal twopi_(void);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal oneme2, state0[6];
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal pa[3], gm, ta, dt;
extern doublereal pi_(void);
doublereal tp[3], pv[3], cosinc;
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen);
doublereal tmpsta[6], oj2;
extern logical return_(void);
doublereal ecc;
extern doublereal dpr_(void);
doublereal dot, rpl, k2pi;
/* $ Abstract */
/* Evaluates a single SPK data record from a segment of type 15 */
/* (Precessing Conic Propagation). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECIN I Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, specified as ephemeris seconds past */
/* J2000, at which a state vector is to be computed. */
/* RECIN is a data record which, when evaluated at epoch ET, */
/* will give the state (position and velocity) of some */
/* body, relative to some center, in some inertial */
/* reference frame. */
/* The structure of RECIN is: */
/* RECIN(1) epoch of periapsis */
/* in ephemeris seconds past J2000. */
/* RECIN(2)-RECIN(4) unit trajectory pole vector */
/* RECIN(5)-RECIN(7) unit periapsis vector */
/* RECIN(8) semi-latus rectum---p in the */
/* equation: */
/* r = p/(1 + ECC*COS(Nu)) */
/* RECIN(9) eccentricity */
/* RECIN(10) J2 processing flag describing */
/* what J2 corrections are to be */
/* applied when the orbit is */
/* propagated. */
/* All J2 corrections are applied */
/* if this flag has a value that */
/* is not 1,2 or 3. */
/* If the value of the flag is 3 */
/* no corrections are done. */
/* If the value of the flag is 1 */
/* no corrections are computed for */
/* the precession of the line */
/* of apsides. However, regression */
/* of the line of nodes is */
/* performed. */
/* If the value of the flag is 2 */
/* no corrections are done for */
/* the regression of the line of */
/* nodes. However, precession of the */
/* line of apsides is performed. */
/* Note that J2 effects are computed */
/* only if the orbit is elliptic and */
/* does not intersect the central */
/* body. */
/* RECIN(11)-RECIN(13) unit central body pole vector */
/* RECIN(14) central body GM */
/* RECIN(15) central body J2 */
/* RECIN(16) central body radius */
/* Units are radians, km, seconds */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECIN at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity is less than zero, the error */
/* 'SPICE(BADECCENTRICITY)' will be signalled. */
/* 2) If the semi-latus rectum is non-positive, the error */
/* 'SPICE(BADLATUSRECTUM)' is signalled. */
/* 3) If the pole vector, trajectory pole vector or periapsis vector */
/* has zero length, the error 'SPICE(BADVECTOR)' is signalled. */
/* 4) If the trajectory pole vector and the periapsis vector are */
/* not orthogonal, the error 'SPICE(BADINITSTATE)' is */
/* signalled. The test for orthogonality is very crude. The */
/* routine simply checks that the absolute value of the dot */
/* product of the unit vectors parallel to the trajectory pole */
/* and periapse vectors is less than 0.00001. This check is */
/* intended to catch blunders, not to enforce orthogonality to */
/* double precision tolerance. */
/* 5) If the mass of the central body is non-positive, the error */
/* 'SPICE(NONPOSITIVEMASS)' is signalled. */
/* 6) If the radius of the central body is negative, the error */
/* 'SPICE(BADRADIUS)' is signalled. */
/* $ Particulars */
/* This algorithm applies J2 corrections for precessing the */
/* node and argument of periapse for an object orbiting an */
/* oblate spheroid. */
/* Note the effects of J2 are incorporated only for elliptic */
/* orbits that do not intersect the central body. */
/* While the derivation of the effect of the various harmonics */
/* of gravitational field are beyond the scope of this header */
/* the effect of the J2 term of the gravity model are as follows */
/* The line of node precesses. Over one orbit average rate of */
/* precession, DNode/dNu, is given by */
/* 3 J2 */
/* dNode/dNu = - ----------------- DCOS( inc ) */
/* 2 (P/RPL)**2 */
/* (Since this is always less than zero for oblate spheroids, this */
/* should be called regression of nodes.) */
/* The line of apsides precesses. The average rate of precession */
/* DPeri/dNu is given by */
/* 3 J2 */
/* dPeri/dNu = ----------------- ( 5*DCOS ( inc ) - 1 ) */
/* 2 (P/RPL)**2 */
/* Details of these formulae are given in the Battin's book (see */
/* literature references below). */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR15 as shown here: */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECIN ) */
/* CALL SPKE15 ( ET, RECIN, STATE ) */
/* where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 15 data segment. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 15 ) THEN */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE15 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* S. Schlaifer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* [1] `Fundamentals of Celestial Mechanics', Second Edition 1989 */
/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */
/* Richmond Virginia; pp 345-347. */
/* [2] `Astronautical Guidance', by Richard H. Battin. 1964 */
/* McGraw-Hill Book Company, San Francisco. pp 199 */
/* $ Version */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* $ Index_Entries */
/* evaluate type_15 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKE15", (ftnlen)6);
/* Fetch the various entities from the input record, first the epoch. */
epoch = recin[0];
/* The trajectory pole vector. */
vequ_(&recin[1], tp);
/* The periapsis vector. */
vequ_(&recin[4], pa);
/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */
/* and eccentricity. */
p = recin[7];
ecc = recin[8];
/* J2 processing flag. */
j2flg = (integer) recin[9];
/* Central body pole vector. */
vequ_(&recin[10], pv);
/* The central mass, J2 and radius of the central body. */
gm = recin[13];
oj2 = recin[14];
rpl = recin[15];
/* Check all the inputs here for obvious failures. Yes, perhaps */
/* this is overkill. However, there is a lot more computation */
/* going on in this routine so that the small amount of overhead */
/* here should not be significant. */
if (p <= 0.) {
setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator"
" was non-positive. This value must be positive. The value s"
"upplied was #.", (ftnlen)133);
errdp_("#", &p, (ftnlen)1);
sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (ecc < 0.) {
setmsg_("The eccentricity supplied for a type 15 segment is negative"
". It must be non-negative. The value supplied to the type 1"
"5 evaluator was #. ", (ftnlen)138);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (gm <= 0.) {
setmsg_("The mass supplied for the central body of a type 15 segment"
" was non-positive. Masses must be positive. The value suppl"
"ied was #. ", (ftnlen)130);
errdp_("#", &gm, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(tp)) {
setmsg_("The trajectory pole vector supplied to SPKE15 had length ze"
"ro. The most likely cause of this problem is a corrupted SPK"
" (ephemeris) file. ", (ftnlen)138);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pa)) {
setmsg_("The periapse vector supplied to SPKE15 had length zero. The"
" most likely cause of this problem is a corrupted SPK (ephem"
"eris) file. ", (ftnlen)131);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pv)) {
setmsg_("The central pole vector supplied to SPKE15 had length zero."
" The most likely cause of this problem is a corrupted SPK (e"
"phemeris) file. ", (ftnlen)135);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (rpl < 0.) {
setmsg_("The central body radius was negative. It must be zero or po"
"sitive. The value supplied was #. ", (ftnlen)94);
errdp_("#", &rpl, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Convert TP, PV and PA to unit vectors. */
/* (It won't hurt to polish them up a bit here if they are already */
/* unit vectors.) */
vhatip_(pa);
vhatip_(tp);
vhatip_(pv);
/* One final check. Make sure the pole and periapse vectors are */
/* orthogonal. (We will use a very crude check but this should */
/* rule out any obvious errors.) */
dot = vdot_(pa, tp);
if (abs(dot) > 1e-5) {
angle = vsep_(pa, tp) * dpr_();
setmsg_("The periapsis and trajectory pole vectors are not orthogona"
"l. The anglebetween them is # degrees. ", (ftnlen)98);
errdp_("#", &angle, (ftnlen)1);
sigerr_("SPICE(BADINITSTATE)", (ftnlen)19);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Compute the distance and speed at periapse. */
near__ = p / (ecc + 1.);
speed = sqrt(gm / p) * (ecc + 1.);
/* Next get the position at periapse ... */
vscl_(&near__, pa, state0);
/* ... and the velocity at periapsis. */
vcrss_(tp, pa, &state0[3]);
vsclip_(&speed, &state0[3]);
/* Determine the elapsed time from periapse to the requested */
/* epoch and propagate the state at periapsis to the epoch of */
/* interest. */
/* Note that we are making use of the following fact. */
/* If R is a rotation, then the states obtained by */
/* the following blocks of code are mathematically the */
/* same. (In reality they may differ slightly due to */
/* roundoff.) */
/* Code block 1. */
/* CALL MXV ( R, STATE0, STATE0 ) */
/* CALL MXV ( R, STATE0(4), STATE0(4) ) */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* Code block 2. */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* CALL MXV ( R, STATE, STATE ) */
/* CALL MXV ( R, STATE(4), STATE(4) ) */
/* This allows us to first compute the propagation of our initial */
/* state and then if needed perform the precession of the line */
/* of nodes and apsides by simply precessing the resulting state. */
dt = *et - epoch;
prop2b_(&gm, state0, &dt, state);
/* If called for, handle precession needed due to the J2 term. Note */
/* that the motion of the lines of nodes and apsides is formulated */
/* in terms of the true anomaly. This means we need the accumulated */
/* true anomaly in order to properly transform the state. */
if (j2flg != 3 && oj2 != 0. && ecc < 1. && near__ > rpl) {
/* First compute the change in mean anomaly since periapsis. */
/* Computing 2nd power */
d__1 = ecc;
oneme2 = 1. - d__1 * d__1;
dmdt = oneme2 / p * sqrt(gm * oneme2 / p);
manom = dmdt * dt;
/* Next compute the angle THETA such that THETA is between */
/* -pi and pi and such than MANOM = THETA + K*2*pi for */
/* some integer K. */
d__1 = twopi_();
theta = d_mod(&manom, &d__1);
if (abs(theta) > pi_()) {
d__1 = twopi_();
theta -= d_sign(&d__1, &theta);
}
k2pi = manom - theta;
/* We can get the accumulated true anomaly from the propagated */
/* state theta and the accumulated mean anomaly prior to this */
/* orbit. */
ta = vsep_(pa, state);
ta = d_sign(&ta, &theta);
ta += k2pi;
/* Determine how far the line of nodes and periapsis have moved. */
cosinc = vdot_(pv, tp);
/* Computing 2nd power */
d__1 = rpl / p;
z__ = ta * 1.5 * oj2 * (d__1 * d__1);
dnode = -z__ * cosinc;
/* Computing 2nd power */
d__1 = cosinc;
dperi = z__ * (d__1 * d__1 * 2.5 - .5);
/* Precess the periapsis by rotating the state vector about the */
/* trajectory pole */
if (j2flg != 1) {
vrotv_(state, tp, &dperi, tmpsta);
vrotv_(&state[3], tp, &dperi, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* Regress the line of nodes by rotating the state */
/* about the pole of the central body. */
if (j2flg != 2) {
vrotv_(state, pv, &dnode, tmpsta);
vrotv_(&state[3], pv, &dnode, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* We could perform the rotations above in the other order, */
/* but we would also have to rotate the pole before precessing */
/* the line of apsides. */
}
/* That's all folks. Check out and return. */
chkout_("SPKE15", (ftnlen)6);
return 0;
} /* spke15_ */
/* $Procedure ZZHULLAX ( Pyramidal FOV convex hull to FOV axis ) */
/* Subroutine */ int zzhullax_(char *inst, integer *n, doublereal *bounds,
doublereal *axis, ftnlen inst_len)
{
/* System generated locals */
integer bounds_dim2, i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
doublereal xvec[3], yvec[3], zvec[3];
integer xidx;
extern doublereal vsep_(doublereal *, doublereal *);
integer next;
logical pass1;
integer i__, m;
doublereal r__, v[3], delta;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vlcom_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
integer minix, maxix;
doublereal trans[9] /* was [3][3] */;
extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal
*), vcrss_(doublereal *, doublereal *, doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal cp[3];
extern doublereal pi_(void);
logical ok;
extern doublereal halfpi_(void);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *), sigerr_(char *, ftnlen);
doublereal minlon;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal maxlon;
extern /* Subroutine */ int vhatip_(doublereal *), vsclip_(doublereal *,
doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
doublereal lat, sep, lon;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
doublereal ray1[3], ray2[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. */
/* Identify a face of the convex hull of an instrument's */
/* polygonal FOV, and use this face to generate an axis of the */
/* FOV. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK */
/* FRAMES */
/* GF */
/* IK */
/* KERNEL */
/* $ Keywords */
/* FOV */
/* GEOMETRY */
/* INSTRUMENT */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* MARGIN P Minimum complement of FOV cone angle. */
/* INST I Instrument name. */
/* N I Number of FOV boundary vectors. */
/* BOUNDS I FOV boundary vectors. */
/* AXIS O Instrument FOV axis vector. */
/* $ Detailed_Input */
/* INST is the name of an instrument with which the field of */
/* view (FOV) of interest is associated. This name is */
/* used only to generate long error messages. */
/* N is the number of boundary vectors in the array */
/* BOUNDS. */
/* BOUNDS is an array of N vectors emanating from a common */
/* vertex and defining the edges of a pyramidal region in */
/* three-dimensional space: this the region within the */
/* FOV of the instrument designated by INST. The Ith */
/* vector of BOUNDS resides in elements (1:3,I) of this */
/* array. */
/* The vectors contained in BOUNDS are called the */
/* "boundary vectors" of the FOV. */
/* The boundary vectors must satisfy the constraints: */
/* 1) The boundary vectors must be contained within */
/* a right circular cone of angular radius less */
/* than than (pi/2) - MARGIN radians; in other */
/* words, there must be a vector A such that all */
/* boundary vectors have angular separation from */
/* A of less than (pi/2)-MARGIN radians. */
/* 2) There must be a pair of vectors U, V in BOUNDS */
/* such that all other boundary vectors lie in */
/* the same half space bounded by the plane */
/* containing U and V. Furthermore, all other */
/* boundary vectors must have orthogonal */
/* projections onto a plane normal to this plane */
/* such that the projections have angular */
/* separation of at least 2*MARGIN radians from */
/* the plane spanned by U and V. */
/* Given the first constraint above, there is plane PL */
/* such that each of the set of rays extending the */
/* boundary vectors intersects PL. (In fact, there is an */
/* infinite set of such planes.) The boundary vectors */
/* must be ordered so that the set of line segments */
/* connecting the intercept on PL of the ray extending */
/* the Ith vector to that of the (I+1)st, with the Nth */
/* intercept connected to the first, form a polygon (the */
/* "FOV polygon") constituting the intersection of the */
/* FOV pyramid with PL. This polygon may wrap in either */
/* the positive or negative sense about a ray emanating */
/* from the FOV vertex and passing through the plane */
/* region bounded by the FOV polygon. */
/* The FOV polygon need not be convex; it may be */
/* self-intersecting as well. */
/* No pair of consecutive vectors in BOUNDS may be */
/* linearly dependent. */
/* The boundary vectors need not have unit length. */
/* $ Detailed_Output */
/* AXIS is a unit vector normal to a plane containing the */
/* FOV polygon. All boundary vectors have angular */
/* separation from AXIS of not more than */
/* ( pi/2 ) - MARGIN */
/* radians. */
/* This routine signals an error if it cannot find */
/* a satisfactory value of AXIS. */
/* $ Parameters */
/* MARGIN is a small positive number used to constrain the */
/* orientation of the boundary vectors. See the two */
/* constraints described in the Detailed_Input section */
/* above for specifics. */
/* $ Exceptions */
/* 1) In the input vector count N is not at least 3, the error */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If any pair of consecutive boundary vectors has cross */
/* product zero, the error SPICE(DEGENERATECASE) is signaled. */
/* For this test, the first vector is considered the successor */
/* of the Nth. */
/* 3) If this routine can't find a face of the convex hull of */
/* the set of boundary vectors such that this face satisfies */
/* constraint (2) of the Detailed_Input section above, the */
/* error SPICE(FACENOTFOUND) is signaled. */
/* 4) If any boundary vectors have longitude too close to 0 */
/* or too close to pi radians in the face frame (see discussion */
/* of the search algorithm's steps 3 and 4 in Particulars */
/* below), the respective errors SPICE(NOTSUPPORTED) or */
/* SPICE(FOVTOOWIDE) are signaled. */
/* 5) If any boundary vectors have angular separation of more than */
/* (pi/2)-MARGIN radians from the candidate FOV axis, the */
/* error SPICE(FOVTOOWIDE) is signaled. */
/* $ Files */
/* The boundary vectors input to this routine are typically */
/* obtained from an IK file. */
/* $ Particulars */
/* Normally implementation is not discussed in SPICE headers, but we */
/* make an exception here because this routine's implementation and */
/* specification are deeply intertwined. */
/* This routine produces an "axis" for a polygonal FOV using the */
/* following approach: */
/* 1) Test pairs of consecutive FOV boundary vectors to see */
/* whether there's a pair such that the plane region bounded */
/* by these vectors is */
/* a) part of the convex hull of the set of boundary vectors */
/* b) such that all other boundary vectors have angular */
/* separation of at least MARGIN from the plane */
/* containing these vectors */
/* This search has O(N**2) run time dependency on N. */
/* If this test produces a candidate face of the convex hull, */
/* proceed to step 3. */
/* 2) If step (1) fails, repeat the search for a candidate */
/* convex hull face, but this time search over every pair of */
/* distinct boundary vectors. */
/* This search has O(N**3) run time dependency on N. */
/* If this search fails, signal an error. */
/* 3) Produce a set of basis vectors for a reference frame, */
/* which we'll call the "face frame," using as the +X axis */
/* the angle bisector of the vectors bounding the candidate */
/* face, the +Y axis the inward normal vector to this face, */
/* and the +Z axis completing a right-handed basis. */
/* 4) Transform each boundary vector, other than the two vectors */
/* defining the selected convex hull face, to the face frame */
/* and compute the vector's longitude in that frame. Find the */
/* maximum and minimum longitudes of the vectors in the face */
/* frame. */
/* If any vector's longitude is less than 2*MARGIN or greater */
/* than pi - 2*MARGIN radians, signal an error. */
/* 5) Let DELTA be the difference between pi and the maximum */
/* longitude found in step (4). Rotate the +Y axis (which */
/* points in the inward normal direction relative to the */
/* selected face) by -DELTA/2 radians about the +Z axis of */
/* the face frame. This rotation aligns the +Y axis with the */
/* central longitude of the set of boundary vectors. The */
/* resulting vector is our candidate FOV axis. */
/* 6) Check the angular separation of the candidate FOV axis */
/* against each boundary vector. If any vector has angular */
/* separation of more than (pi/2)-MARGIN radians from the */
/* axis, signal an error. */
/* Note that there are reasonable FOVs that cannot be handled by the */
/* algorithm described here. For example, any FOV whose cross */
/* section is a regular convex polygon can be made unusable by */
/* adding boundary vectors aligned with the angle bisectors of each */
/* face of the pyramid defined by the FOV's boundary vectors. The */
/* resulting set of boundary vectors has no face in its convex hull */
/* such that all other boundary vectors have positive angular */
/* separation from that face. */
/* Because of this limitation, this algorithm should be used only */
/* after a simple FOV axis-finding approach, such as using as the */
/* FOV axis the average of the boundary vectors, has been tried */
/* unsuccessfully. */
/* Note that it's easy to construct FOVs where the average of the */
/* boundary vectors doesn't yield a viable axis: a FOV of angular */
/* width nearly equal to pi radians, with a sufficiently large */
/* number of boundary vectors on one side and few boundary vectors */
/* on the other, is one such example. This routine can find an */
/* axis for many such intractable FOVs---that's why this routine */
/* should be called after the simple approach fails. */
/* $ Examples */
/* See SPICELIB private routine ZZFOVAXI. */
/* $ Restrictions */
/* 1) This is a SPICE private routine. User applications should not */
/* call this routine. */
/* 2) There are "reasonable" polygonal FOVs that cannot be handled */
/* by this routine. See the discussion in Particulars above. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB 1.0.0, 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* Create axis vector for polygonal FOV */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Parameter adjustments */
bounds_dim2 = *n;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZHULLAX", (ftnlen)8);
/* Nothing found yet. */
found = FALSE_;
xidx = 0;
/* We must have at least 3 boundary vectors. */
if (*n < 3) {
setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb"
"er supplied for # was #.", (ftnlen)83);
errch_("#", inst, (ftnlen)1, inst_len);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Find an exterior face of the pyramid defined by the */
/* input boundary vectors. Since most polygonal FOVs will have */
/* an exterior face bounded by two consecutive rays, we'll */
/* try pairs of consecutive rays first. If this fails, we'll */
/* try each pair of rays. */
i__ = 1;
while(i__ <= *n && ! found) {
/* Set the index of the next ray. When we get to the */
/* last boundary vector, the next ray is the first. */
if (i__ == *n) {
next = 1;
} else {
next = i__ + 1;
}
/* Find the cross product of the first ray with the */
/* second. Depending on the ordering of the boundary */
/* vectors, this could be an inward or outward normal, */
/* in the case the current face is exterior. */
vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ?
i__1 : s_rnge("bounds", i__1, "zzhullax_", (ftnlen)408)], &
bounds[(i__2 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)408)], cp);
/* We insist on consecutive boundary vectors being */
/* linearly independent. */
if (vzero_(cp)) {
setmsg_("Polygonal FOV must have linearly independent consecutiv"
"e boundary but vectors at indices # and # have cross pro"
"duct equal to the zero vector. Instrument is #.", (ftnlen)
158);
errint_("#", &i__, (ftnlen)1);
errint_("#", &next, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* See whether the other boundary vectors have angular */
/* separation of at least MARGIN from the plane containing */
/* the current face. */
pass1 = TRUE_;
ok = TRUE_;
m = 1;
while(m <= *n && ok) {
/* Find the angular separation of CP and the Mth vector if the */
/* latter is not an edge of the current face. */
if (m != i__ && m != next) {
sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) < bounds_dim2 * 3
&& 0 <= i__1 ? i__1 : s_rnge("bounds", i__1, "zzhull"
"ax_", (ftnlen)446)]);
if (pass1) {
/* Adjust CP if necessary so that it points */
/* toward the interior of the pyramid. */
if (sep > halfpi_()) {
/* Invert the cross product vector and adjust SEP */
/* accordingly. Within this "M" loop, all other */
/* angular separations will be computed using the new */
/* value of CP. */
vsclip_(&c_b20, cp);
sep = pi_() - sep;
}
pass1 = FALSE_;
}
ok = sep < halfpi_() - 1e-12;
}
if (ok) {
/* Consider the next boundary vector. */
++m;
}
}
/* We've tested each boundary vector against the current face, or */
/* else the loop terminated early because a vector with */
/* insufficient angular separation from the plane containing the */
/* face was found. */
if (ok) {
/* The current face is exterior. It's bounded by rays I and */
/* NEXT. */
xidx = i__;
found = TRUE_;
} else {
/* Look at the next face of the pyramid. */
++i__;
}
}
/* If we didn't find an exterior face, we'll have to look at each */
/* face bounded by a pair of rays, even if those rays are not */
/* adjacent. (This can be a very slow process is N is large.) */
if (! found) {
i__ = 1;
while(i__ <= *n && ! found) {
/* Consider all ray pairs (I,NEXT) where NEXT > I. */
next = i__ + 1;
while(next <= *n && ! found) {
/* Find the cross product of the first ray with the second. */
/* If the current face is exterior, CP could be an inward */
/* or outward normal, depending on the ordering of the */
/* boundary vectors. */
vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__1 ? i__1 : s_rnge("bounds", i__1, "zzhullax_", (
ftnlen)530)], &bounds[(i__2 = next * 3 - 3) <
bounds_dim2 * 3 && 0 <= i__2 ? i__2 : s_rnge("bounds",
i__2, "zzhullax_", (ftnlen)530)], cp);
/* It's allowable for non-consecutive boundary vectors to */
/* be linearly dependent, but if we have such a pair, */
/* it doesn't define an exterior face. */
if (! vzero_(cp)) {
/* The rays having direction vectors indexed I and NEXT */
/* define a semi-infinite sector of a plane that might */
/* be of interest. */
/* Check whether all of the boundary vectors that are */
/* not edges of the current face have angular separation */
/* of at least MARGIN from the plane containing the */
/* current face. */
pass1 = TRUE_;
ok = TRUE_;
m = 1;
while(m <= *n && ok) {
/* Find the angular separation of CP and the Mth */
/* vector if the latter is not an edge of the current */
/* face. */
if (m != i__ && m != next) {
sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) <
bounds_dim2 * 3 && 0 <= i__1 ? i__1 :
s_rnge("bounds", i__1, "zzhullax_", (
ftnlen)560)]);
if (pass1) {
/* Adjust CP if necessary so that it points */
/* toward the interior of the pyramid. */
if (sep > halfpi_()) {
/* Invert the cross product vector and */
/* adjust SEP accordingly. Within this "M" */
/* loop, all other angular separations will */
/* be computed using the new value of CP. */
vsclip_(&c_b20, cp);
sep = pi_() - sep;
}
pass1 = FALSE_;
}
ok = sep < halfpi_() - 1e-12;
}
if (ok) {
/* Consider the next boundary vector. */
++m;
}
}
/* We've tested each boundary vector against the current */
/* face, or else the loop terminated early because a */
/* vector with insufficient angular separation from the */
/* plane containing the face was found. */
if (ok) {
/* The current face is exterior. It's bounded by rays */
/* I and NEXT. */
xidx = i__;
found = TRUE_;
}
/* End of angular separation test block. */
}
/* End of non-zero cross product block. */
if (! found) {
/* Look at the face bounded by the rays */
/* at indices I and NEXT+1. */
++next;
}
}
/* End of NEXT loop. */
if (! found) {
/* Look at the face bounded by the pairs of rays */
/* including the ray at index I+1. */
++i__;
}
}
/* End of I loop. */
}
/* End of search for exterior face using each pair of rays. */
/* If we still haven't found an exterior face, we can't continue. */
if (! found) {
setmsg_("Unable to find face of convex hull of FOV of instrument #.",
(ftnlen)58);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FACENOTFOUND)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Arrival at this point means that the rays at indices */
/* XIDX and NEXT define a plane such that all boundary */
/* vectors lie in a half-space bounded by that plane. */
/* We're now going to define a set of orthonormal basis vectors: */
/* +X points along the angle bisector of the bounding vectors */
/* of the exterior face. */
/* +Y points along CP. */
/* +Z is the cross product of +X and +Y. */
/* We'll call the reference frame having these basis vectors */
/* the "face frame." */
vhat_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1 :
s_rnge("bounds", i__1, "zzhullax_", (ftnlen)683)], ray1);
vhat_(&bounds[(i__1 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1
: s_rnge("bounds", i__1, "zzhullax_", (ftnlen)684)], ray2);
vlcom_(&c_b36, ray1, &c_b36, ray2, xvec);
vhatip_(xvec);
vhat_(cp, yvec);
ucrss_(xvec, yvec, zvec);
/* Create a transformation matrix to map the input boundary */
/* vectors into the face frame. */
for (i__ = 1; i__ <= 3; ++i__) {
trans[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)698)] = xvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("xvec", i__2, "zzhullax_", (
ftnlen)698)];
trans[(i__1 = i__ * 3 - 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)699)] = yvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("yvec", i__2, "zzhullax_", (
ftnlen)699)];
trans[(i__1 = i__ * 3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)700)] = zvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("zvec", i__2, "zzhullax_", (
ftnlen)700)];
}
/* Now we're going to compute the longitude of each boundary in the */
/* face frame. The vectors with indices XIDX and NEXT are excluded. */
/* We expect all longitudes to be between MARGIN and pi - MARGIN. */
minlon = pi_();
maxlon = 0.;
minix = 1;
maxix = 1;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (i__ != xidx && i__ != next) {
/* The current vector is not a boundary of our edge, */
/* so find its longitude. */
mxv_(trans, &bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (
ftnlen)720)], v);
reclat_(v, &r__, &lon, &lat);
/* Update the longitude bounds. */
if (lon < minlon) {
minix = i__;
minlon = lon;
}
if (lon > maxlon) {
maxix = i__;
maxlon = lon;
}
}
}
/* If the longitude bounds are not as expected, don't try */
/* to continue. */
if (minlon < 2e-12) {
setmsg_("Minimum boundary vector longitude in exterior face frame is"
" # radians. Minimum occurs at index #. This FOV does not con"
"form to the requirements of this routine. Instrument is #.", (
ftnlen)177);
errdp_("#", &minlon, (ftnlen)1);
errint_("#", &minix, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
} else if (maxlon > pi_() - 2e-12) {
setmsg_("Maximum boundary vector longitude in exterior face frame is"
" # radians. Maximum occurs at index #. This FOV does not con"
"form to the requirements of this routine. Instrument is #.", (
ftnlen)177);
errdp_("#", &maxlon, (ftnlen)1);
errint_("#", &maxix, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Let delta represent the amount we can rotate the exterior */
/* face clockwise about +Z without contacting another boundary */
/* vector. */
delta = pi_() - maxlon;
/* Rotate +Y by -DELTA/2 about +Z. The result is our candidate */
/* FOV axis. Make the axis vector unit length. */
d__1 = -delta / 2;
vrotv_(yvec, zvec, &d__1, axis);
vhatip_(axis);
/* If we have a viable result, ALL boundary vectors have */
/* angular separation less than HALFPI-MARGIN from AXIS. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
sep = vsep_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)794)
], axis);
if (sep > halfpi_() - 1e-12) {
setmsg_("Boundary vector at index # has angular separation of # "
"radians from candidate FOV axis. This FOV does not confo"
"rm to the requirements of this routine. Instrument is #.",
(ftnlen)167);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sep, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
}
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
} /* zzhullax_ */
/* $Procedure ZZSTELAB ( Private --- stellar aberration correction ) */
/* Subroutine */ int zzstelab_(logical *xmit, doublereal *accobs, doublereal *
vobs, doublereal *starg, doublereal *scorr, doublereal *dscorr)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal);
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal dphi, rhat[3];
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
doublereal term1[3], term2[3], term3[3], c__, lcacc[3];
integer i__;
doublereal s;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal saoff[6] /* was [3][2] */, drhat[3];
extern /* Subroutine */ int dvhat_(doublereal *, doublereal *);
doublereal ptarg[3], evobs[3], srhat[6], vphat[3], vtarg[3];
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *), vperp_(doublereal *, doublereal *,
doublereal *);
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *), cleard_(integer *, doublereal *);
doublereal vp[3];
extern doublereal clight_(void);
doublereal dptmag, ptgmag, eptarg[3], dvphat[3], lcvobs[3];
extern /* Subroutine */ int qderiv_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *), sigerr_(char *, ftnlen), chkout_(
char *, ftnlen), setmsg_(char *, ftnlen);
doublereal svphat[6];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
doublereal sgn, dvp[3], svp[6];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Return the state (position and velocity) of a target body */
/* relative to an observing body, optionally corrected for light */
/* time (planetary aberration) and stellar aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* XMIT I Reception/transmission flag. */
/* ACCOBS I Observer acceleration relative to SSB. */
/* VOBS I Observer velocity relative to to SSB. */
/* STARG I State of target relative to observer. */
/* SCORR O Stellar aberration correction for position. */
/* DSCORR O Stellar aberration correction for velocity. */
/* $ Detailed_Input */
/* XMIT is a logical flag which is set to .TRUE. for the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at an observation epoch ET */
/* and arrive at the target's location at the light-time */
/* corrected epoch ET+LT, where LT is the one-way light */
/* time between observer and target; XMIT is set to */
/* .FALSE. for "reception" case in which photons depart */
/* from the target's location at the light-time */
/* corrected epoch ET-LT and *arrive* at the observer's */
/* location at ET. */
/* Note that the observation epoch is not used in this */
/* routine. */
/* XMIT must be consistent with any light time */
/* corrections used for the input state STARG: if that */
/* state has been corrected for "reception" light time; */
/* XMIT must be .FALSE.; otherwise XMIT must be .TRUE. */
/* ACCOBS is the geometric acceleration of the observer */
/* relative to the solar system barycenter. Units are */
/* km/sec**2. ACCOBS must be expressed relative to */
/* an inertial reference frame. */
/* VOBS is the geometric velocity of the observer relative to */
/* the solar system barycenter. VOBS must be expressed */
/* relative to the same inertial reference frame as */
/* ACCOBS. Units are km/sec. */
/* STARG is the Cartesian state of the target relative to the */
/* observer. Normally STARG has been corrected for */
/* one-way light time, but this is not required. STARG */
/* must be expressed relative to the same inertial */
/* reference frame as ACCOBS. Components are */
/* (x, y, z, dx, dy, dz). Units are km and km/sec. */
/* $ Detailed_Output */
/* SCORR is the stellar aberration correction for the position */
/* component of STARG. Adding SCORR to this position */
/* vector produces the input observer-target position, */
/* corrected for stellar aberration. */
/* The reference frame of SCORR is the common frame */
/* relative to which the inputs ACCOBS, VOBS, and STARG */
/* are expressed. Units are km. */
/* DSCORR is the stellar aberration correction for the velocity */
/* component of STARG. Adding DSCORR to this velocity */
/* vector produces the input observer-target velocity, */
/* corrected for stellar aberration. */
/* The reference frame of DSCORR is the common frame */
/* relative to which the inputs ACCOBS, VOBS, and STARG */
/* are expressed. Units are km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If attempt to divide by zero occurs, the error */
/* SPICE(DIVIDEBYZERO) will be signaled. This case may occur */
/* due to uninitialized inputs. */
/* 2) Loss of precision will occur for geometric cases in which */
/* VOBS is nearly parallel to the position component of STARG. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine computes a Newtonian estimate of the stellar */
/* aberration correction of an input state. Normally the input state */
/* has already been corrected for one-way light time. */
/* Since stellar aberration corrections are typically "small" */
/* relative to the magnitude of the input observer-target position */
/* and velocity, this routine avoids loss of precision by returning */
/* the corrections themselves rather than the corrected state */
/* vector. This allows the caller to manipulate (for example, */
/* interpolate) the corrections with greater accuracy. */
/* $ Examples */
/* See SPICELIB routine SPKACS. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 15-APR-2014 (NJB) */
/* Added RETURN test and discovery check-in. */
/* Check for division by zero was added. This */
/* case might occur due to uninitialized inputs. */
/* - SPICELIB Version 1.0.1, 12-FEB-2009 (NJB) */
/* Minor updates were made to the inline documentation. */
/* - SPICELIB Version 1.0.0, 17-JAN-2008 (NJB) */
/* -& */
/* Note for the maintenance programmer */
/* =================================== */
/* The source code of the test utility T_ZZSTLABN must be */
/* kept in sync with the source code of this routine. That */
/* routine uses a value of SEPLIM that forces the numeric */
/* branch of the velocity computation to be taken in all */
/* cases. See the documentation of that routine for details. */
/* SPICELIB functions */
/* Local parameters */
/* Let PHI be the (non-negative) rotation angle of the stellar */
/* aberration correction; then SEPLIM is a limit on how close PHI */
/* may be to zero radians while stellar aberration velocity is */
/* computed analytically. When sin(PHI) is less than SEPLIM, the */
/* velocity must be computed numerically. */
/* Let TDELTA be the time interval, measured in seconds, */
/* used for numerical differentiation of the stellar */
/* aberration correction, when this is necessary. */
/* Local variables */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
/* In the discussion below, the dot product of vectors X and Y */
/* is denoted by */
/* <X,Y> */
/* The speed of light is denoted by the lower case letter "c." BTW, */
/* variable names used here are case-sensitive: upper case "C" */
/* represents a different quantity which is unrelated to the speed */
/* of light. */
/* Variable names ending in "HAT" denote unit vectors. Variable */
/* names starting with "D" denote derivatives with respect to time. */
/* We'll compute the correction SCORR and its derivative with */
/* respect to time DSCORR for the reception case. In the */
/* transmission case, we perform the same computation with the */
/* negatives of the observer velocity and acceleration. */
/* In the code below, we'll store the position and velocity portions */
/* of the input observer-target state STARG in the variables PTARG */
/* and VTARG, respectively. */
/* Let VP be the component of VOBS orthogonal to PTARG. VP */
/* is defined as */
/* VOBS - < VOBS, RHAT > RHAT (1) */
/* where RHAT is the unit vector */
/* PTARG/||PTARG|| */
/* Then */
/* ||VP||/c (2) */
/* is the magnitude of */
/* s = sin( phi ) (3) */
/* where phi is the stellar aberration correction angle. We'll */
/* need the derivative with respect to time of (2). */
/* Differentiating (1) with respect to time yields the */
/* velocity DVP, where, letting */
/* DRHAT = d(RHAT) / dt */
/* VPHAT = VP / ||VP|| */
/* DVPMAG = d( ||VP|| ) / dt */
/* we have */
/* DVP = d(VP)/dt */
/* = ACCOBS - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */
/* + <VOBS,RHAT> * DRHAT ) (4) */
/* and */
/* DVPMAG = < DVP, VPHAT > (5) */
/* Now we can find the derivative with respect to time of */
/* the stellar aberration angle phi: */
/* ds/dt = d(sin(phi))/dt = d(phi)/dt * cos(phi) (6) */
/* Using (2) and (5), we have for positive phi, */
/* ds/dt = (1/c)*DVPMAG = (1/c)*<DVP, VPHAT> (7) */
/* Then for positive phi */
/* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> (8) */
/* Equation (8) is well-defined as along as VP is non-zero: */
/* if VP is the zero vector, VPHAT is undefined. We'll treat */
/* the singular and near-singular cases separately. */
/* The aberration correction itself is a rotation by angle phi */
/* from RHAT towards VP, so the corrected vector is */
/* ( sin(phi)*VPHAT + cos(phi)*RHAT ) * ||PTARG|| */
/* and we can express the offset of the corrected vector from */
/* PTARG, which is the output SCORR, as */
/* SCORR = */
/* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| (9) */
/* Let DPTMAG be defined as */
/* DPTMAG = d ( ||PTARG|| ) / dt (10) */
/* Then the derivative with respect to time of SCORR is */
/* DSCORR = */
/* ( sin(phi)*DVPHAT */
/* + cos(phi)*d(phi)/dt * VPHAT */
/* + (cos(phi) - 1) * DRHAT */
/* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */
/* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG (11) */
/* Computations begin here: */
/* Split STARG into position and velocity components. Compute */
/* RHAT */
/* DRHAT */
/* VP */
/* DPTMAG */
if (*xmit) {
vminus_(vobs, lcvobs);
vminus_(accobs, lcacc);
} else {
vequ_(vobs, lcvobs);
vequ_(accobs, lcacc);
}
vequ_(starg, ptarg);
vequ_(&starg[3], vtarg);
dvhat_(starg, srhat);
vequ_(srhat, rhat);
vequ_(&srhat[3], drhat);
vperp_(lcvobs, rhat, vp);
dptmag = vdot_(vtarg, rhat);
/* Compute sin(phi) and cos(phi), which we'll call S and C */
/* respectively. Note that phi is always close to zero for */
/* realistic inputs (for which ||VOBS|| << CLIGHT), so the */
/* cosine term is positive. */
s = vnorm_(vp) / clight_();
/* Computing MAX */
d__1 = 0., d__2 = 1 - s * s;
c__ = sqrt((max(d__1,d__2)));
if (c__ == 0.) {
/* C will be used as a divisor later (in the computation */
/* of DPHI), so we'll put a stop to the problem here. */
chkin_("ZZSTELAB", (ftnlen)8);
setmsg_("Cosine of the aberration angle is 0; this cannot occur for "
"realistic observer velocities. This case can arise due to un"
"initialized inputs. This cosine value is used as a divisor i"
"n a later computation, so it must not be equal to zero.", (
ftnlen)234);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("ZZSTELAB", (ftnlen)8);
return 0;
}
/* Compute the unit vector VPHAT and the stellar */
/* aberration correction. We avoid relying on */
/* VHAT's exception handling for the zero vector. */
if (vzero_(vp)) {
cleard_(&c__3, vphat);
} else {
vhat_(vp, vphat);
}
/* Now we can use equation (9) to obtain the stellar */
/* aberration correction SCORR: */
/* SCORR = */
/* ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * ||PTARG|| */
ptgmag = vnorm_(ptarg);
d__1 = ptgmag * s;
d__2 = ptgmag * (c__ - 1.);
vlcom_(&d__1, vphat, &d__2, rhat, scorr);
/* Now we use S as an estimate of PHI to decide if we're */
/* going to differentiate the stellar aberration correction */
/* analytically or numerically. */
/* Note that S is non-negative by construction, so we don't */
/* need to use the absolute value of S here. */
if (s >= 1e-6) {
/* This is the analytic case. */
/* Compute DVP---the derivative of VP with respect to time. */
/* Recall equation (4): */
/* DVP = d(VP)/dt */
/* = ACCOBS - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */
/* + <VOBS,RHAT> * DRHAT ) */
d__1 = -vdot_(lcvobs, drhat) - vdot_(lcacc, rhat);
d__2 = -vdot_(lcvobs, rhat);
vlcom3_(&c_b7, lcacc, &d__1, rhat, &d__2, drhat, dvp);
vhat_(vp, vphat);
/* Now we can compute DVPHAT, the derivative of VPHAT: */
vequ_(vp, svp);
vequ_(dvp, &svp[3]);
dvhat_(svp, svphat);
vequ_(&svphat[3], dvphat);
/* Compute the DPHI, the time derivative of PHI, using equation 8: */
/* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> */
dphi = 1. / (c__ * clight_()) * vdot_(dvp, vphat);
/* At long last we've assembled all of the "ingredients" required */
/* to compute DSCORR: */
/* DSCORR = */
/* ( sin(phi)*DVPHAT */
/* + cos(phi)*d(phi)/dt * VPHAT */
/* + (cos(phi) - 1) * DRHAT */
/* + ( -sin(phi)*d(phi)/dt ) * RHAT ) * ||PTARG|| */
/* + ( sin(phi)*VPHAT + (cos(phi)-1)*RHAT ) * DPTMAG */
d__1 = c__ * dphi;
vlcom_(&s, dvphat, &d__1, vphat, term1);
d__1 = c__ - 1.;
d__2 = -s * dphi;
vlcom_(&d__1, drhat, &d__2, rhat, term2);
vadd_(term1, term2, term3);
d__1 = dptmag * s;
d__2 = dptmag * (c__ - 1.);
vlcom3_(&ptgmag, term3, &d__1, vphat, &d__2, rhat, dscorr);
} else {
/* This is the numeric case. We're going to differentiate */
/* the stellar aberration correction offset vector using */
/* a quadratic estimate. */
for (i__ = 1; i__ <= 2; ++i__) {
/* Set the sign of the time offset. */
if (i__ == 1) {
sgn = -1.;
} else {
sgn = 1.;
}
/* Estimate the observer's velocity relative to the */
/* solar system barycenter at the current epoch. We use */
/* the local copies of the input velocity and acceleration */
/* to make a linear estimate. */
d__1 = sgn * 1.;
vlcom_(&c_b7, lcvobs, &d__1, lcacc, evobs);
/* Estimate the observer-target vector. We use the */
/* observer-target state velocity to make a linear estimate. */
d__1 = sgn * 1.;
vlcom_(&c_b7, starg, &d__1, &starg[3], eptarg);
/* Let RHAT be the unit observer-target position. */
/* Compute the component of the observer's velocity */
/* that is perpendicular to the target position; call */
/* this vector VP. Also compute the unit vector in */
/* the direction of VP. */
vhat_(eptarg, rhat);
vperp_(evobs, rhat, vp);
if (vzero_(vp)) {
cleard_(&c__3, vphat);
} else {
vhat_(vp, vphat);
}
/* Compute the sine and cosine of the correction */
/* angle. */
s = vnorm_(vp) / clight_();
/* Computing MAX */
d__1 = 0., d__2 = 1 - s * s;
c__ = sqrt((max(d__1,d__2)));
/* Compute the vector offset of the correction. */
ptgmag = vnorm_(eptarg);
d__1 = ptgmag * s;
d__2 = ptgmag * (c__ - 1.);
vlcom_(&d__1, vphat, &d__2, rhat, &saoff[(i__1 = i__ * 3 - 3) < 6
&& 0 <= i__1 ? i__1 : s_rnge("saoff", i__1, "zzstelab_", (
ftnlen)597)]);
}
/* Now compute the derivative. */
qderiv_(&c__3, saoff, &saoff[3], &c_b7, dscorr);
}
/* At this point the correction offset SCORR and its derivative */
/* with respect to time DSCORR are both set. */
return 0;
} /* zzstelab_ */
/* $Procedure ZZFOVAXI ( Generate an axis vector for polygonal FOV ) */
/* Subroutine */ int zzfovaxi_(char *inst, integer *n, doublereal *bounds,
doublereal *axis, ftnlen inst_len)
{
/* System generated locals */
integer bounds_dim2, i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal uvec[3];
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
extern doublereal vsep_(doublereal *, doublereal *);
integer next;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), zzhullax_(
char *, integer *, doublereal *, doublereal *, ftnlen);
integer i__;
doublereal v[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal limit;
extern /* Subroutine */ int vcrss_(doublereal *, doublereal *, doublereal
*);
extern logical vzero_(doublereal *);
doublereal cp[3];
extern logical failed_(void);
logical ok;
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern doublereal halfpi_(void);
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen);
extern logical return_(void);
doublereal sep;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Generate an axis of an instrument's polygonal FOV such that all */
/* of the FOV's boundary vectors have angular separation of strictly */
/* less than pi/2 radians from this axis. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK */
/* FRAMES */
/* GF */
/* IK */
/* KERNEL */
/* $ Keywords */
/* FOV */
/* GEOMETRY */
/* INSTRUMENT */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* MARGIN P Minimum complement of FOV cone angle. */
/* INST I Instrument name. */
/* N I Number of FOV boundary vectors. */
/* BOUNDS I FOV boundary vectors. */
/* AXIS O Instrument FOV axis vector. */
/* $ Detailed_Input */
/* INST is the name of an instrument with which the field of */
/* view (FOV) of interest is associated. This name is */
/* used only to generate long error messages. */
/* N is the number of boundary vectors in the array */
/* BOUNDS. */
/* BOUNDS is an array of N vectors emanating from a common */
/* vertex and defining the edges of a pyramidal region in */
/* three-dimensional space: this the region within the */
/* FOV of the instrument designated by INST. The Ith */
/* vector of BOUNDS resides in elements (1:3,I) of this */
/* array. */
/* The vectors contained in BOUNDS are called the */
/* "boundary vectors" of the FOV. */
/* The boundary vectors must satisfy the constraints: */
/* 1) The boundary vectors must be contained within */
/* a right circular cone of angular radius less */
/* than than (pi/2) - MARGIN radians; in other */
/* words, there must be a vector A such that all */
/* boundary vectors have angular separation from */
/* A of less than (pi/2)-MARGIN radians. */
/* 2) There must be a pair of vectors U, V in BOUNDS */
/* such that all other boundary vectors lie in */
/* the same half space bounded by the plane */
/* containing U and V. Furthermore, all other */
/* boundary vectors must have orthogonal */
/* projections onto a plane normal to this plane */
/* such that the projections have angular */
/* separation of at least 2*MARGIN radians from */
/* the plane spanned by U and V. */
/* Given the first constraint above, there is plane PL */
/* such that each of the set of rays extending the */
/* boundary vectors intersects PL. (In fact, there is an */
/* infinite set of such planes.) The boundary vectors */
/* must be ordered so that the set of line segments */
/* connecting the intercept on PL of the ray extending */
/* the Ith vector to that of the (I+1)st, with the Nth */
/* intercept connected to the first, form a polygon (the */
/* "FOV polygon") constituting the intersection of the */
/* FOV pyramid with PL. This polygon may wrap in either */
/* the positive or negative sense about a ray emanating */
/* from the FOV vertex and passing through the plane */
/* region bounded by the FOV polygon. */
/* The FOV polygon need not be convex; it may be */
/* self-intersecting as well. */
/* No pair of consecutive vectors in BOUNDS may be */
/* linearly dependent. */
/* The boundary vectors need not have unit length. */
/* $ Detailed_Output */
/* AXIS is a unit vector normal to a plane containing the */
/* FOV polygon. All boundary vectors have angular */
/* separation from AXIS of not more than */
/* ( pi/2 ) - MARGIN */
/* radians. */
/* This routine signals an error if it cannot find */
/* a satisfactory value of AXIS. */
/* $ Parameters */
/* MARGIN is a small positive number used to constrain the */
/* orientation of the boundary vectors. See the two */
/* constraints described in the Detailed_Input section */
/* above for specifics. */
/* $ Exceptions */
/* 1) In the input vector count N is not at least 3, the error */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If any pair of consecutive boundary vectors has cross */
/* product zero, the error SPICE(DEGENERATECASE) is signaled. */
/* For this test, the first vector is considered the successor */
/* of the Nth. */
/* 3) If this routine can't find a face of the convex hull of */
/* the set of boundary vectors such that this face satisfies */
/* constraint (2) of the Detailed_Input section above, the */
/* error SPICE(FACENOTFOUND) is signaled. */
/* 4) If any boundary vectors have longitude too close to 0 */
/* or too close to pi radians in the face frame (see discussion */
/* of the search algorithm's steps 3 and 4 in Particulars */
/* below), the respective errors SPICE(NOTSUPPORTED) or */
/* SPICE(FOVTOOWIDE) are signaled. */
/* 5) If any boundary vectors have angular separation of more than */
/* (pi/2)-MARGIN radians from the candidate FOV axis, the */
/* error SPICE(FOVTOOWIDE) is signaled. */
/* $ Files */
/* The boundary vectors input to this routine are typically */
/* obtained from an IK file. */
/* $ Particulars */
/* Normally implementation is not discussed in SPICE headers, but we */
/* make an exception here because this routine's implementation and */
/* specification are deeply intertwined. */
/* This routine first computes the average of the unitized input */
/* boundary vectors; if this vector satisfies the angular separation */
/* constraint (1) in Detailed_Input, a unit length copy of this */
/* vector is returned as the FOV axis. */
/* If the procedure above fails, an algorithm based on selection */
/* of a suitable face of the boundary vector's convex hull is tried. */
/* See the routine ZZHULLAX for details. */
/* If the second approach fails, an error is signaled. */
/* Note that it's easy to construct FOVs where the average of the */
/* boundary vectors doesn't yield a viable axis: a FOV of angular */
/* width nearly equal to pi radians, with a sufficiently large */
/* number of boundary vectors on one side and few boundary vectors */
/* on the other, is one such example. This routine can find an */
/* axis for many such intractable FOVs---that's why ZZHULLAX */
/* is called after the simple approach fails. */
/* $ Examples */
/* See SPICELIB private routine ZZGFFVIN. */
/* $ Restrictions */
/* 1) This is a SPICE private routine. User applications should not */
/* call this routine. */
/* 2) There may "reasonable" polygonal FOVs that cannot be handled */
/* by this routine. See the discussions in Detailed_Input, */
/* Exceptions, and Particulars above for restrictions on the */
/* input set of FOV boundary vectors. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 05-MAR-2009 (NJB) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Parameter adjustments */
bounds_dim2 = *n;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZFOVAXI", (ftnlen)8);
/* We must have at least 3 boundary vectors. */
if (*n < 3) {
setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb"
"er supplied for # was #.", (ftnlen)83);
errch_("#", inst, (ftnlen)1, inst_len);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
}
/* Check for linearly dependent consecutive boundary vectors. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Set the index of the next ray. When we get to the */
/* last boundary vector, the next ray is the first. */
if (i__ == *n) {
next = 1;
} else {
next = i__ + 1;
}
/* Find the cross product of the first ray with the */
/* second. Depending on the ordering of the boundary */
/* vectors, this could be an inward or outward normal, */
/* in the case the current face is is exterior. */
vcrss_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzfovaxi_", (ftnlen)313)], &
bounds[(i__3 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__3 ?
i__3 : s_rnge("bounds", i__3, "zzfovaxi_", (ftnlen)313)], cp);
/* We insist on consecutive boundary vectors being */
/* linearly independent. */
if (vzero_(cp)) {
setmsg_("Polygonal FOV must have linearly independent consecutiv"
"e boundary but vectors at indices # and # have cross pro"
"duct equal to the zero vector. Instrument is #.", (ftnlen)
158);
errint_("#", &i__, (ftnlen)1);
errint_("#", &next, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
}
}
/* First try the average of the FOV unit boundary vectors as */
/* a candidate axis. In many cases, this simple approach */
/* does the trick. */
cleard_(&c__3, axis);
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
vhat_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzfovaxi_", (ftnlen)346)],
uvec);
vadd_(uvec, axis, v);
vequ_(v, axis);
}
d__1 = 1. / *n;
vsclip_(&d__1, axis);
/* If each boundary vector has sufficiently small */
/* angular separation from AXIS, we're done. */
limit = halfpi_() - 1e-12;
ok = TRUE_;
i__ = 1;
while(i__ <= *n && ok) {
sep = vsep_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__1 ? i__1 : s_rnge("bounds", i__1, "zzfovaxi_", (ftnlen)365)
], axis);
if (sep > limit) {
ok = FALSE_;
} else {
++i__;
}
}
if (! ok) {
/* See whether we can find an axis using a */
/* method based on finding a face of the convex */
/* hull of the FOV. ZZHULLAX signals an error */
/* if it doesn't succeed. */
zzhullax_(inst, n, bounds, axis, inst_len);
if (failed_()) {
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
}
}
/* At this point AXIS is valid. Make the axis vector unit length. */
vhatip_(axis);
chkout_("ZZFOVAXI", (ftnlen)8);
return 0;
} /* zzfovaxi_ */
/* $Procedure INEDPL ( Intersection of ellipsoid and plane ) */
/* Subroutine */ int inedpl_(doublereal *a, doublereal *b, doublereal *c__,
doublereal *plane, doublereal *ellips, logical *found)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double sqrt(doublereal);
/* Local variables */
doublereal dist, span1[3], span2[3];
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal const__, point[3];
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int cgv2el_(doublereal *, doublereal *,
doublereal *, doublereal *), pl2nvc_(doublereal *, doublereal *,
doublereal *), pl2psv_(doublereal *, doublereal *, doublereal *,
doublereal *), psv2pl_(doublereal *, doublereal *, doublereal *,
doublereal *);
doublereal dplane[4];
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal maxrad, rcircl, center[3], normal[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *,
ftnlen);
doublereal invdst[3];
extern logical return_(void);
doublereal dstort[3], vec1[3], vec2[3];
/* $ Abstract */
/* Find the intersection of a triaxial ellipsoid and a plane. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* ELLIPSES */
/* PLANES */
/* $ Keywords */
/* ELLIPSE */
/* ELLIPSOID */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* A I Length of ellipsoid semi-axis lying on the x-axis. */
/* B I Length of ellipsoid semi-axis lying on the y-axis. */
/* C I Length of ellipsoid semi-axis lying on the z-axis. */
/* PLANE I Plane that intersects ellipsoid. */
/* ELLIPS O Intersection ellipse, when FOUND is .TRUE. */
/* FOUND O Flag indicating whether ellipse was found. */
/* $ Detailed_Input */
/* A, */
/* B, */
/* C are the lengths of the semi-axes of a triaxial */
/* ellipsoid. The ellipsoid is centered at the */
/* origin and oriented so that its axes lie on the */
/* x, y and z axes. A, B, and C are the lengths of */
/* the semi-axes that point in the x, y, and z */
/* directions respectively. */
/* PLANE is a SPICELIB plane. */
/* $ Detailed_Output */
/* ELLIPS is the SPICELIB ellipse formed by the intersection */
/* of the input plane and ellipsoid. ELLIPS will */
/* represent a single point if the ellipsoid and */
/* plane are tangent. */
/* If the intersection of the ellipsoid and plane is */
/* empty, ELLIPS is not modified. */
/* FOUND is .TRUE. if and only if the intersection of the */
/* ellipsoid and plane is non-empty. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If any of the lengths of the semi-axes of the input ellipsoid */
/* are non-positive, the error SPICE(DEGENERATECASE) is */
/* signaled. ELLIPS is not modified. FOUND is set to .FALSE. */
/* 2) If the input plane in invalid, in other words, if the input */
/* plane as the zero vector as its normal vector, the error */
/* SPICE(INVALIDPLANE) is signaled. ELLIPS is not modified. */
/* FOUND is set to .FALSE. */
/* 3) If the input plane and ellipsoid are very nearly tangent, */
/* roundoff error may cause this routine to give unreliable */
/* results. */
/* 4) If the input plane and ellipsoid are precisely tangent, the */
/* intersection is a single point. In this case, the output */
/* ellipse is degenerate, but FOUND will still have the value */
/* .TRUE. You must decide whether this output makes sense for */
/* your application. */
/* $ Files */
/* None. */
/* $ Particulars */
/* An ellipsoid and a plane can intersect in an ellipse, a single */
/* point, or the empty set. */
/* $ Examples */
/* 1) Suppose we wish to find the limb of a body, as observed from */
/* location LOC in body-fixed coordinates. The SPICELIB routine */
/* EDLIMB solves this problem. Here's how INEDPL is used in */
/* that solution. */
/* We assume LOC is outside of the body. The body is modelled as */
/* a triaxial ellipsoid with semi-axes of length A, B, and C. */
/* The notation */
/* < X, Y > */
/* indicates the inner product of the vectors X and Y. */
/* The limb lies on the plane defined by */
/* < X, N > = 1, */
/* where the vector N is defined as */
/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */
/* The assignments */
/* N(1) = LOC(1) / A**2 */
/* N(2) = LOC(2) / B**2 */
/* N(3) = LOC(3) / C**2 */
/* and the calls */
/* CALL NVC2PL ( N, 1.0D0, PLANE ) */
/* CALL INEDPL ( A, B, C, PLANE, LIMB, FOUND ) */
/* CALL EL2CGV ( LIMB, CENTER, SMAJOR, SMINOR ) */
/* will return the center and semi-axes of the limb. */
/* How do we know that < X, N > = 1 for all X on the limb? */
/* This is because all limb points X satisfy */
/* < LOC - X, SURFNM(X) > = 0, */
/* where SURFNM(X) is a surface normal at X. SURFNM(X) is */
/* parallel to the vector */
/* V = ( X(1) / A**2, X(2) / B**2, X(3) / C**2 ) */
/* so we have */
/* < LOC - X, V > = 0, */
/* < LOC, V > = < X, V > = 1 (from the original */
/* ellipsoid */
/* equation); */
/* and finally */
/* < X, N > = 1, */
/* where the vector N is defined as */
/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */
/* 2) Suppose we wish to find the terminator of a body. We can */
/* make a fair approximation to the location of the terminator */
/* by finding the limb of the body as seen from the vertex of */
/* the umbra; then the problem is essentially the same as in */
/* example 1. Let VERTEX be this location. We make the */
/* assignments */
/* P(1) = VERTEX(1) / A**2 */
/* P(2) = VERTEX(2) / B**2 */
/* P(3) = VERTEX(3) / C**2 */
/* and then make the calls */
/* CALL NVC2PL ( P, 1.0D0, PLANE ) */
/* CALL INEDPL ( A, B, C, PLANE, TERM, FOUND ) */
/* The SPICELIB ellipse TERM represents the terminator of the */
/* body. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */
/* Bug fix: error detection for case of invalid input plane was */
/* added. */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */
/* Removed potential numerical precision problems that could be */
/* caused by using a REAL constant in a double precision */
/* computation. The value 1.0 was repaced with the value 1.0D0 in */
/* the following three lines: */
/* DSTORT(1) = 1.0 / A */
/* DSTORT(2) = 1.0 / B */
/* DSTORT(3) = 1.0 / C */
/* Also changed was a numeric constant from 1.D0 to the */
/* equivalent, but more aesthetically pleasing 1.0D0. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* intersection of ellipsoid and plane */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */
/* Bug fix: error detection for case of invalid input plane was */
/* added. */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */
/* Removed potential numerical precision problems that could be */
/* caused by using a REAL constant in a double precision */
/* computation. The value 1.0 was repaced with the value 1.0D0 in */
/* the following three lines: */
/* DSTORT(1) = 1.0 / A */
/* DSTORT(2) = 1.0 / B */
/* DSTORT(3) = 1.0 / C */
/* Also changed was a numeric constant from 1.D0 to the */
/* equivalent, but more aesthetically pleasing 1.0D0. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("INEDPL", (ftnlen)6);
}
/* We don't want to worry about flat ellipsoids: */
if (*a <= 0. || *b <= 0. || *c__ <= 0.) {
*found = FALSE_;
setmsg_("Semi-axes: A = #, B = #, C = #.", (ftnlen)33);
errdp_("#", a, (ftnlen)1);
errdp_("#", b, (ftnlen)1);
errdp_("#", c__, (ftnlen)1);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* Check input plane for zero normal vector. */
pl2nvc_(plane, normal, &const__);
if (vzero_(normal)) {
setmsg_("Normal vector of the input PLANE is the zero vector.", (
ftnlen)52);
sigerr_("SPICE(INVALIDPLANE)", (ftnlen)19);
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* This algorithm is partitioned into a series of steps: */
/* 1) Identify a linear transformation that maps the input */
/* ellipsoid to the unit sphere. We'll call this mapping the */
/* `distortion' mapping. Apply the distortion mapping to both */
/* the input plane and ellipsoid. The image of the plane under */
/* this transformation will be a plane. */
/* 2) Find the intersection of the transformed plane and the unit */
/* sphere. */
/* 3) Apply the inverse of the distortion mapping to the */
/* intersection ellipse to find the undistorted intersection */
/* ellipse. */
/* Step 1: */
/* Find the image of the ellipsoid and plane under the distortion */
/* matrix. Since the image of the ellipsoid is the unit sphere, */
/* only the plane transformation requires any work. */
/* If the input plane is too far from the origin to possibly */
/* intersect the ellipsoid, return now. This can save us */
/* some numerical problems when we scale the plane and ellipsoid. */
/* The point returned by PL2PSV is the closest point in PLANE */
/* to the origin, so its norm gives the distance of the plane */
/* from the origin. */
pl2psv_(plane, point, span1, span2);
/* Computing MAX */
d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__);
maxrad = max(d__1,d__2);
if (vnorm_(point) > maxrad) {
*found = FALSE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* The distortion matrix and its inverse are */
/* +- -+ +- -+ */
/* | 1/A 0 0 | | A 0 0 | */
/* | 0 1/B 0 |, | 0 B 0 |. */
/* | 0 0 1/C | | 0 0 C | */
/* +- -+ +- -+ */
/* We declare them with length three, since we are going to make */
/* use of the diagonal elements only. */
dstort[0] = 1. / *a;
dstort[1] = 1. / *b;
dstort[2] = 1. / *c__;
invdst[0] = *a;
invdst[1] = *b;
invdst[2] = *c__;
/* Apply the distortion mapping to the input plane. Applying */
/* the distortion mapping to a point and two spanning vectors that */
/* define the input plane yields a point and two spanning vectors */
/* that define the distorted plane. */
for (i__ = 1; i__ <= 3; ++i__) {
point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("point", i__1,
"inedpl_", (ftnlen)449)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
449)] * point[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("point", i__3, "inedpl_", (ftnlen)449)];
span1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span1", i__1,
"inedpl_", (ftnlen)450)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
450)] * span1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("span1", i__3, "inedpl_", (ftnlen)450)];
span2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span2", i__1,
"inedpl_", (ftnlen)451)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
451)] * span2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("span2", i__3, "inedpl_", (ftnlen)451)];
}
psv2pl_(point, span1, span2, dplane);
/* Step 2: */
/* Find the intersection of the distorted plane and unit sphere. */
/* The intersection of the distorted plane and the unit sphere */
/* may be a circle, a point, or the empty set. The distance of the */
/* plane from the origin determines which type of intersection we */
/* have. If we represent the distorted plane by a unit normal */
/* vector and constant, the size of the constant gives us the */
/* distance of the plane from the origin. If the distance is greater */
/* than 1, the intersection of plane and unit sphere is empty. If */
/* the distance is equal to 1, we have the tangency case. */
/* The routine PL2PSV always gives us an output point that is the */
/* closest point to the origin in the input plane. This point is */
/* the center of the intersection circle. The spanning vectors */
/* returned by PL2PSV, after we scale them by the radius of the */
/* intersection circle, become an orthogonal pair of vectors that */
/* extend from the center of the circle to the circle itself. So, */
/* the center and these scaled vectors define the intersection */
/* circle. */
pl2psv_(dplane, center, vec1, vec2);
dist = vnorm_(center);
if (dist > 1.) {
*found = FALSE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* Scale the generating vectors by the radius of the intersection */
/* circle. */
/* Computing 2nd power */
d__2 = dist;
d__1 = 1. - d__2 * d__2;
rcircl = sqrt(brcktd_(&d__1, &c_b32, &c_b33));
vsclip_(&rcircl, vec1);
vsclip_(&rcircl, vec2);
/* Step 3: */
/* Apply the inverse distortion to the intersection circle to find */
/* the actual intersection ellipse. */
for (i__ = 1; i__ <= 3; ++i__) {
center[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("center",
i__1, "inedpl_", (ftnlen)511)] = invdst[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (
ftnlen)511)] * center[(i__3 = i__ - 1) < 3 && 0 <= i__3 ?
i__3 : s_rnge("center", i__3, "inedpl_", (ftnlen)511)];
vec1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec1", i__1,
"inedpl_", (ftnlen)512)] = invdst[(i__2 = i__ - 1) < 3 && 0 <=
i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)512)]
* vec1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
"vec1", i__3, "inedpl_", (ftnlen)512)];
vec2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec2", i__1,
"inedpl_", (ftnlen)513)] = invdst[(i__2 = i__ - 1) < 3 && 0 <=
i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)513)]
* vec2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
"vec2", i__3, "inedpl_", (ftnlen)513)];
}
/* Make an ellipse from the center and generating vectors. */
cgv2el_(center, vec1, vec2, ellips);
*found = TRUE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
} /* inedpl_ */
/* $Procedure INRYPL ( Intersection of ray and plane ) */
/* Subroutine */ int inrypl_(doublereal *vertex, doublereal *dir, doublereal *
plane, integer *nxpts, doublereal *xpt)
{
/* System generated locals */
doublereal d__1, d__2;
/* Local variables */
doublereal udir[3];
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_(
doublereal *, doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern doublereal dpmax_(void);
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
doublereal const__, prjvn;
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int pl2nvc_(doublereal *, doublereal *,
doublereal *), cleard_(integer *, doublereal *);
doublereal mscale, prjdif, sclcon, toobig, normal[3], prjdir;
extern logical smsgnd_(doublereal *, doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *,
ftnlen);
extern logical return_(void);
doublereal sclvtx[3];
/* $ Abstract */
/* Find the intersection of a ray and a plane. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PLANES */
/* $ Keywords */
/* GEOMETRY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* VERTEX, */
/* DIR I Vertex and direction vector of ray. */
/* PLANE I A SPICELIB plane. */
/* NXPTS O Number of intersection points of ray and plane. */
/* XPT O Intersection point, if NXPTS = 1. */
/* $ Detailed_Input */
/* VERTEX, */
/* DIR are a point and direction vector that define a */
/* ray in three-dimensional space. */
/* PLANE is a SPICELIB plane. */
/* $ Detailed_Output */
/* NXPTS is the number of points of intersection of the */
/* input ray and plane. Values and meanings of */
/* NXPTS are: */
/* 0 No intersection. */
/* 1 One point of intersection. Note that */
/* this case may occur when the ray's */
/* vertex is in the plane. */
/* -1 An infinite number of points of */
/* intersection; the ray lies in the plane. */
/* XPT is the point of intersection of the input ray */
/* and plane, when there is exactly one point of */
/* intersection. Otherwise, XPT is the zero vector. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the ray's direction vector is the zero vector, the error */
/* SPICE(ZEROVECTOR) is signaled. NXPTS and XPT are not */
/* modified. */
/* 2) If the ray's vertex is further than DPMAX() / 3 from the */
/* origin, the error SPICE(VECTORTOOBIG) is signaled. NXPTS */
/* and XPT are not modified. */
/* 3) If the input plane is s further than DPMAX() / 3 from the */
/* origin, the error SPICE(VECTORTOOBIG) is signaled. NXPTS */
/* and XPT are not modified. */
/* 4) The input plane should be created by one of the SPICELIB */
/* routines */
/* NVC2PL */
/* NVP2PL */
/* PSV2PL */
/* Invalid input planes will cause unpredictable results. */
/* 5) In the interest of good numerical behavior, in the case */
/* where the ray's vertex is not in the plane, this routine */
/* considers that an intersection of the ray and plane occurs */
/* only if the distance between the ray's vertex and the */
/* intersection point is less than DPMAX() / 3. */
/* If VERTEX is not in the plane and this condition is not */
/* met, then NXPTS is set to 0 and XPT is set to the zero */
/* vector. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The intersection of a ray and plane in three-dimensional space */
/* can be a the empty set, a single point, or the ray itself. */
/* $ Examples */
/* 1) Find the camera projection of the center of an extended */
/* body. For simplicity, we assume: */
/* -- The camera has no distortion; the image of a point */
/* is determined by the intersection of the focal plane */
/* and the line determined by the point and the camera's */
/* focal point. */
/* -- The camera's pointing matrix (C-matrix) is available */
/* in a C-kernel. */
/* C */
/* C Load Leapseconds and SCLK kernels to support time */
/* C conversion. */
/* C */
/* CALL FURNSH ( 'LEAP.KER' ) */
/* CALL FURNSH ( 'SCLK.KER' ) */
/* C */
/* C Load an SPK file containing ephemeris data for */
/* C observer (a spacecraft, whose NAIF integer code */
/* C is SC) and target at the UTC epoch of observation. */
/* C */
/* CALL FURNSH ( 'SPK.BSP' ) */
/* C */
/* C Load a C-kernel containing camera pointing for */
/* C the UTC epoch of observation. */
/* C */
/* CALL FURNSH ( 'CK.BC' ) */
/* C */
/* C Find the ephemeris time (barycentric dynamical time) */
/* C and encoded spacecraft clock times corresponding to */
/* C the UTC epoch of observation. */
/* C */
/* CALL UTC2ET ( UTC, ET ) */
/* CALL SCE2C ( SC, ET, SCLKDP ) */
/* C */
/* C Encode the pointing lookup tolerance. */
/* C */
/* CALL SCTIKS ( SC, TOLCH, TOLDP ) */
/* C */
/* C Find the observer-target vector at the observation */
/* C epoch. In this example, we'll use a light-time */
/* C corrected state vector. */
/* C */
/* CALL SPKEZ ( TARGET, ET, 'J2000', 'LT', SC, */
/* . STATE, LT ) */
/* C */
/* C Look up camera pointing. */
/* C */
/* CALL CKGP ( CAMERA, SCLKDP, TOLDP, 'J2000', CMAT, */
/* . CLKOUT, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* [Handle this case...] */
/* END IF */
/* C */
/* C Negate the spacecraft-to-target body vector and */
/* C convert it to camera coordinates. */
/* C */
/* CALL VMINUS ( STATE, DIR ) */
/* CALL MXV ( CMAT, DIR, DIR ) */
/* C */
/* C If FL is the camera's focal length, the effective */
/* C focal point is */
/* C */
/* C FL * ( 0, 0, 1 ) */
/* C */
/* CALL VSCL ( FL, ZVEC, FOCUS ) */
/* C */
/* C The camera's focal plane contains the origin in */
/* C camera coordinates, and the z-vector is orthogonal */
/* C to the plane. Make a SPICELIB plane representing */
/* C the focal plane. */
/* C */
/* CALL NVC2PL ( ZVEC, 0.D0, FPLANE ) */
/* C */
/* C The image of the target body's center in the focal */
/* C plane is defined by the intersection with the focal */
/* C plane of the ray whose vertex is the focal point and */
/* C whose direction is DIR. */
/* C */
/* CALL INRYPL ( FOCUS, DIR, FPLANE, NXPTS, IMAGE ) */
/* IF ( NXPTS .EQ. 1 ) THEN */
/* C */
/* C The body center does project to the focal plane. */
/* C Check whether the image is actually in the */
/* C camera's field of view... */
/* C */
/* . */
/* . */
/* . */
/* ELSE */
/* C */
/* C The body center does not map to the focal plane. */
/* C Handle this case... */
/* C */
/* . */
/* . */
/* . */
/* END IF */
/* 2) Find the Saturn ring plane intercept of a spacecraft-mounted */
/* instrument's boresight vector. We want the find the point */
/* in the ring plane that will be observed by an instrument */
/* with a give boresight direction at a specified time. We */
/* must account for light time and stellar aberration in order */
/* to find this point. The intercept point will be expressed */
/* in Saturn body-fixed coordinates. */
/* In this example, we assume */
/* -- The ring plane is equatorial. */
/* -- Light travels in a straight line. */
/* -- The light time correction for the ring plane intercept */
/* can be obtained by performing three light-time */
/* correction iterations. If this assumption does not */
/* lead to a sufficiently accurate result, additional */
/* iterations can be performed. */
/* -- A Newtonian approximation of stellar aberration */
/* suffices. */
/* -- The boresight vector is given in J2000 coordinates. */
/* -- The observation epoch is ET ephemeris seconds past */
/* J2000. */
/* -- The boresight vector, spacecraft and planetary */
/* ephemerides, and ring plane orientation are all known */
/* with sufficient accuracy for the application. */
/* -- All necessary kernels are loaded by the caller of */
/* this example routine. */
/* SUBROUTINE RING_XPT ( SC, ET, BORVEC, SBFXPT, FOUND ) */
/* IMPLICIT NONE */
/* CHARACTER*(*) SC */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION BORVEC ( 3 ) */
/* DOUBLE PRECISION SBFXPT ( 3 ) */
/* LOGICAL FOUND */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION CLIGHT */
/* DOUBLE PRECISION VDIST */
/* C */
/* C Local parameters */
/* C */
/* INTEGER UBPL */
/* PARAMETER ( UBPL = 4 ) */
/* INTEGER SATURN */
/* PARAMETER ( SATURN = 699 ) */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION BORV2 ( 3 ) */
/* DOUBLE PRECISION CORVEC ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION PLANE ( UBPL ) */
/* DOUBLE PRECISION SATSSB ( 6 ) */
/* DOUBLE PRECISION SCPOS ( 3 ) */
/* DOUBLE PRECISION SCSSB ( 6 ) */
/* DOUBLE PRECISION STATE ( 6 ) */
/* DOUBLE PRECISION STCORR ( 3 ) */
/* DOUBLE PRECISION TAU */
/* DOUBLE PRECISION TPMI ( 3, 3 ) */
/* DOUBLE PRECISION XPT ( 3 ) */
/* DOUBLE PRECISION ZVEC ( 3 ) */
/* INTEGER I */
/* INTEGER NXPTS */
/* INTEGER SCID */
/* LOGICAL FND */
/* C */
/* C First step: account for stellar aberration. Since the */
/* C instrument pointing is given, we need to find the intercept */
/* C point such that, when the stellar aberration correction is */
/* C applied to the vector from the spacecraft to that point, */
/* C the resulting vector is parallel to BORVEC. An easy */
/* C solution is to apply the inverse of the normal stellar */
/* C aberration correction to BORVEC, and then solve the */
/* C intercept problem with this corrected boresight vector. */
/* C */
/* C Find the position of the observer relative */
/* C to the solar system barycenter at ET. */
/* C */
/* CALL BODN2C ( SC, SCID, FND ) */
/* IF ( .NOT. FND ) THEN */
/* CALL SETMSG ( 'ID code for body # was not found.' ) */
/* CALL ERRCH ( '#', SC ) */
/* CALL SIGERR ( 'SPICE(NOTRANSLATION' ) */
/* RETURN */
/* END IF */
/* CALL SPKSSB ( SCID, ET, 'J2000', SCSSB ) */
/* C */
/* C We now wish to find the vector CORVEC that, when */
/* C corrected for stellar aberration, yields BORVEC. */
/* C A good first approximation is obtained by applying */
/* C the stellar aberration correction for transmission */
/* C to BORVEC. */
/* C */
/* CALL STLABX ( BORVEC, SCSSB(4), CORVEC ) */
/* C */
/* C The inverse of the stellar aberration correction */
/* C applicable to CORVEC should be a very good estimate of */
/* C the correction we need to apply to BORVEC. Apply */
/* C this correction to BORVEC to obtain an improved estimate */
/* C of CORVEC. */
/* C */
/* CALL STELAB ( CORVEC, SCSSB(4), BORV2 ) */
/* CALL VSUB ( BORV2, CORVEC, STCORR ) */
/* CALL VSUB ( BORVEC, STCORR, CORVEC ) */
/* C */
/* C Because the ring plane intercept may be quite far from */
/* C Saturn's center, we cannot assume light time from the */
/* C intercept to the observer is well approximated by */
/* C light time from Saturn's center to the observer. */
/* C We compute the light time explicitly using an iterative */
/* C approach. */
/* C */
/* C We can however use the light time from Saturn's center to */
/* C the observer to obtain a first estimate of the actual light */
/* C time. */
/* C */
/* CALL SPKEZR ( 'SATURN', ET, 'J2000', 'LT', SC, */
/* . STATE, LT ) */
/* TAU = LT */
/* C */
/* C Find the ring plane intercept and calculate the */
/* C light time from it to the spacecraft. */
/* C Perform three iterations. */
/* C */
/* I = 1 */
/* FOUND = .TRUE. */
/* DO WHILE ( ( I .LE. 3 ) .AND. ( FOUND ) ) */
/* C */
/* C Find the position of Saturn relative */
/* C to the solar system barycenter at ET-TAU. */
/* C */
/* CALL SPKSSB ( SATURN, ET-TAU, 'J2000', SATSSB ) */
/* C */
/* C Find the Saturn-to-observer vector defined by these */
/* C two position vectors. */
/* C */
/* CALL VSUB ( SCSSB, SATSSB, SCPOS ) */
/* C */
/* C Look up Saturn's pole at ET-TAU; this is the third */
/* C column of the matrix that transforms Saturn body-fixed */
/* C coordinates to J2000 coordinates. */
/* C */
/* CALL PXFORM ( 'IAU_SATURN', 'J2000', ET-TAU, TPMI ) */
/* CALL MOVED ( TPMI(1,3), 3, ZVEC ) */
/* C */
/* C Make a SPICELIB plane representing the ring plane. */
/* C We're treating Saturn's center as the origin, so */
/* C the plane constant is 0. */
/* C */
/* CALL NVC2PL ( ZVEC, 0.D0, PLANE ) */
/* C */
/* C Find the intersection of the ring plane and the */
/* C ray having vertex SCPOS and direction vector */
/* C CORVEC. */
/* C */
/* CALL INRYPL ( SCPOS, CORVEC, PLANE, NXPTS, XPT ) */
/* C */
/* C If the number of intersection points is 1, */
/* C find the next light time estimate. */
/* C */
/* IF ( NXPTS .EQ. 1 ) THEN */
/* C */
/* C Find the light time (zero-order) from the */
/* C intercept point to the spacecraft. */
/* C */
/* TAU = VDIST ( SCPOS, XPT ) / CLIGHT() */
/* I = I + 1 */
/* ELSE */
/* FOUND = .FALSE. */
/* END IF */
/* END DO */
/* C */
/* C At this point, if FOUND is .TRUE., we iterated */
/* C 3 times, and XPT is our estimate of the */
/* C position of the ring plane intercept point */
/* C relative to Saturn in the J2000 frame. This is the */
/* C point observed by an instrument pointed in direction */
/* C BORVEC at ET at mounted on the spacecraft SC. */
/* C */
/* C If FOUND is .FALSE., the boresight ray does not */
/* C intersect the ring plane. */
/* C */
/* C As a final step, transform XPT to Saturn body-fixed */
/* C coordinates. */
/* C */
/* IF ( FOUND ) THEN */
/* CALL MTXV ( TPMI, XPT, SBFXPT ) */
/* END IF */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 07-FEB-2008 (BVS) */
/* Fixed a few typos in the header. */
/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL call. */
/* - SPICELIB Version 1.0.3, 12-DEC-2002 (NJB) */
/* Header fix: ring plane intercept algorithm was corrected. */
/* Now light time is computed accurately, and stellar aberration */
/* is accounted for. Example was turned into a complete */
/* subroutine. */
/* - SPICELIB Version 1.0.2, 09-MAR-1999 (NJB) */
/* Reference to SCE2T replaced by reference to SCE2C. An */
/* occurrence of ENDIF was replaced by END IF. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 01-APR-1991 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* intersection of ray and plane */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL call. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("INRYPL", (ftnlen)6);
}
/* We'll give the name TOOBIG to the bound DPMAX() / MARGIN. */
/* If we let VTXPRJ be the orthogonal projection of VERTEX onto */
/* PLANE, and let DIFF be the vector VTXPRJ - VERTEX, then */
/* we know that */
/* || DIFF || < 2 * TOOBIG */
/* Check the distance of the ray's vertex from the origin. */
toobig = dpmax_() / 3.;
if (vnorm_(vertex) >= toobig) {
setmsg_("Ray's vertex is too far from the origin.", (ftnlen)40);
sigerr_("SPICE(VECTORTOOBIG)", (ftnlen)19);
chkout_("INRYPL", (ftnlen)6);
return 0;
}
/* Check the distance of the plane from the origin. (The returned */
/* plane constant IS this distance.) */
pl2nvc_(plane, normal, &const__);
if (const__ >= toobig) {
setmsg_("Plane is too far from the origin.", (ftnlen)33);
sigerr_("SPICE(VECTORTOOBIG)", (ftnlen)19);
chkout_("INRYPL", (ftnlen)6);
return 0;
}
/* Check the ray's direction vector. */
vhat_(dir, udir);
if (vzero_(udir)) {
setmsg_("Ray's direction vector is the zero vector.", (ftnlen)42);
sigerr_("SPICE(ZEROVECTOR)", (ftnlen)17);
chkout_("INRYPL", (ftnlen)6);
return 0;
}
/* That takes care of the error cases. Now scale the input vertex */
/* and plane to improve numerical behavior. */
/* Computing MAX */
d__1 = const__, d__2 = vnorm_(vertex);
mscale = max(d__1,d__2);
if (mscale != 0.) {
d__1 = 1. / mscale;
vscl_(&d__1, vertex, sclvtx);
sclcon = const__ / mscale;
} else {
vequ_(vertex, sclvtx);
sclcon = const__;
}
if (mscale > 1.) {
toobig /= mscale;
}
/* Find the projection (coefficient) of the ray's vertex along the */
/* plane's normal direction. */
prjvn = vdot_(sclvtx, normal);
/* If this projection is the plane constant, the ray's vertex lies in */
/* the plane. We have one intersection or an infinite number of */
/* intersections. It all depends on whether the ray actually lies */
/* in the plane. */
/* The absolute value of PRJDIF is the distance of the ray's vertex */
/* from the plane. */
prjdif = sclcon - prjvn;
if (prjdif == 0.) {
/* XPT is the original, unscaled vertex. */
vequ_(vertex, xpt);
if (vdot_(normal, udir) == 0.) {
/* The ray's in the plane. */
*nxpts = -1;
} else {
*nxpts = 1;
}
chkout_("INRYPL", (ftnlen)6);
return 0;
}
/* Ok, the ray's vertex is not in the plane. The ray may still be */
/* parallel to or may point away from the plane. If the ray does */
/* point towards the plane, mathematicians would say that the */
/* ray does intersect the plane, but the computer may disagree. */
/* For this routine to find an intersection, both of the following */
/* conditions must be met: */
/* -- The ray must point toward the plane; this happens when */
/* PRJDIF has the same sign as < UDIR, NORMAL >. */
/* -- The vector difference XPT - SCLVTX must not overflow. */
/* Qualitatively, the case of interest looks something like the */
/* picture below: */
/* * SCLVTX */
/* |\ */
/* | \ <-- UDIR */
/* | \ */
/* length of this | \| */
/* segment is | -* */
/* | */
/* | PRJDIF | --> | ___________________________ */
/* |/ / */
/* | * / <-- PLANE */
/* /| XPT / */
/* / ^ / */
/* / | NORMAL / */
/* / | . / */
/* / |/| / */
/* / .---| / / */
/* / | |/ / */
/* / `---* / */
/* / Projection of SCLVTX onto the plane */
/* / / */
/* / / */
/* ---------------------------- */
/* Find the projection of the direction vector along the plane's */
/* normal vector. */
prjdir = vdot_(udir, normal);
/* We're done if the ray doesn't point toward the plane. PRJDIF */
/* has already been found to be non-zero at this point; PRJDIR is */
/* zero if the ray and plane are parallel. The SPICELIB routine */
/* SMSGND will return a value of .FALSE. if PRJDIR is zero. */
if (! smsgnd_(&prjdir, &prjdif)) {
/* The ray is parallel to or points away from the plane. */
*nxpts = 0;
cleard_(&c__3, xpt);
chkout_("INRYPL", (ftnlen)6);
return 0;
}
/* The difference XPT - SCLVTX is the hypotenuse of a right triangle */
/* formed by SCLVTX, XPT, and the orthogonal projection of SCLVTX */
/* onto the plane. We'll obtain the hypotenuse by scaling UDIR. */
/* We must make sure that this hypotenuse does not overflow. The */
/* scale factor has magnitude */
/* | PRJDIF | */
/* -------------- */
/* | PRJDIR | */
/* and UDIR is a unit vector, so as long as */
/* | PRJDIF | < | PRJDIR | * TOOBIG */
/* the hypotenuse is no longer than TOOBIG. The product can be */
/* computed safely since PRJDIR has magnitude 1 or less. */
if (abs(prjdif) >= abs(prjdir) * toobig) {
/* If the hypotenuse is too long, we say that no intersection */
/* exists. */
*nxpts = 0;
cleard_(&c__3, xpt);
chkout_("INRYPL", (ftnlen)6);
return 0;
}
/* We conclude that it's safe to compute XPT. Scale UDIR and add */
/* the result to SCLVTX. The addition is safe because both addends */
/* have magnitude no larger than TOOBIG. The vector thus obtained */
/* is the intersection point. */
*nxpts = 1;
scale = abs(prjdif) / abs(prjdir);
vlcom_(&c_b17, sclvtx, &scale, udir, xpt);
/* Re-scale XPT. This is safe, since TOOBIG has already been */
/* scaled to allow for any growth of XPT at this step. */
vsclip_(&mscale, xpt);
chkout_("INRYPL", (ftnlen)6);
return 0;
} /* inrypl_ */
/* $Procedure SPKW15 ( SPK, write a type 15 segment ) */
/* Subroutine */ int spkw15_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p,
doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm,
doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen
segid_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
doublereal mypa[3];
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
doublereal mytp[3];
integer i__;
doublereal angle;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
integer value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
integer *, doublereal *, char *, ftnlen), dafena_(void);
extern logical failed_(void);
doublereal record[16];
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen), spkpds_(integer *, integer *, char *, integer *,
doublereal *, doublereal *, doublereal *, ftnlen);
extern logical return_(void);
extern doublereal dpr_(void);
doublereal dot;
/* $ Abstract */
/* Write an SPK segment of type 15 given a type 15 data record. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I Body code for ephemeris object. */
/* CENTER I Body code for the center of motion of the body. */
/* FRAME I The reference frame of the states. */
/* FIRST I First valid time for which states can be computed. */
/* LAST I Last valid time for which states can be computed. */
/* SEGID I Segment identifier. */
/* EPOCH I Epoch of the periapse. */
/* TP I Trajectory pole vector. */
/* PA I Periapsis vector. */
/* P I Semi-latus rectum. */
/* ECC I Eccentricity. */
/* J2FLG I J2 processing flag. */
/* PV I Central body pole vector. */
/* GM I Central body GM. */
/* J2 I Central body J2. */
/* RADIUS I Equatorial radius of central body. */
/* $ Detailed_Input */
/* HANDLE is the file handle of an SPK file that has been */
/* opened for writing. */
/* BODY is the NAIF ID for the body whose states are */
/* to be recorded in an SPK file. */
/* CENTER is the NAIF ID for the center of motion associated */
/* with BODY. */
/* FRAME is the reference frame that states are referenced to, */
/* for example 'J2000'. */
/* FIRST are the bounds on the ephemeris times, expressed as */
/* LAST seconds past J2000. */
/* SEGID is the segment identifier. An SPK segment identifier */
/* may contain up to 40 characters. */
/* EPOCH is the epoch of the orbit elements at periapse */
/* in ephemeris seconds past J2000. */
/* TP is a vector parallel to the angular momentum vector */
/* of the orbit at epoch expressed relative to FRAME. A */
/* unit vector parallel to TP will be stored in the */
/* output segment. */
/* PA is a vector parallel to the position vector of the */
/* trajectory at periapsis of EPOCH expressed relative */
/* to FRAME. A unit vector parallel to PA will be */
/* stored in the output segment. */
/* P is the semi-latus rectum--- p in the equation: */
/* r = p/(1 + ECC*COS(Nu)) */
/* ECC is the eccentricity. */
/* J2FLG is the J2 processing flag describing what J2 */
/* corrections are to be applied when the orbit is */
/* propagated. */
/* All J2 corrections are applied if the value of J2FLG */
/* is not 1, 2 or 3. */
/* If the value of the flag is 3 no corrections are */
/* done. */
/* If the value of the flag is 1 no corrections are */
/* computed for the precession of the line of apsides. */
/* However, regression of the line of nodes is */
/* performed. */
/* If the value of the flag is 2 no corrections are */
/* done for the regression of the line of nodes. */
/* However, precession of the line of apsides is */
/* performed. */
/* Note that J2 effects are computed only if the orbit */
/* is elliptic and does not intersect the central body. */
/* PV is a vector parallel to the north pole vector of the */
/* central body expressed relative to FRAME. A unit */
/* vector parallel to PV will be stored in the output */
/* segment. */
/* GM is the central body GM. */
/* J2 is the central body J2 (dimensionless). */
/* RADIUS is the equatorial radius of the central body. */
/* Units are radians, km, seconds. */
/* $ Detailed_Output */
/* None. A type 15 segment is written to the file attached */
/* to HANDLE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity is less than zero, the error */
/* 'SPICE(BADECCENTRICITY)' will be signaled. */
/* 2) If the semi-latus rectum is 0, the error */
/* 'SPICE(BADLATUSRECTUM)' is signaled. */
/* 3) If the pole vector, trajectory pole vector or periapsis vector */
/* have zero length, the error 'SPICE(BADVECTOR)' is signaled. */
/* 4) If the trajectory pole vector and the periapsis vector are */
/* not orthogonal, the error 'SPICE(BADINITSTATE)' is signaled. */
/* The test for orthogonality is very crude. The routine simply */
/* checks that the dot product of the unit vectors parallel */
/* to the trajectory pole and periapse vectors is less than */
/* 0.00001. This check is intended to catch blunders, not to */
/* enforce orthogonality to double precision capacity. */
/* 5) If the mass of the central body is non-positive, the error */
/* 'SPICE(NONPOSITIVEMASS)' is signaled. */
/* 6) If the radius of the central body is negative, the error */
/* 'SPICE(BADRADIUS)' is signaled. */
/* 7) If the segment identifier has more than 40 non-blank characters */
/* the error 'SPICE(SEGIDTOOLONG)' is signaled. */
/* 8) If the segment identifier contains non-printing characters */
/* the error 'SPICE(NONPRINTABLECHARS)' is signaled. */
/* 9) If there are inconsistencies in the BODY, CENTER, FRAME or */
/* FIRST and LAST times, the problem will be diagnosed by */
/* a routine in the call tree of this routine. */
/* $ Files */
/* A new type 15 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 15 data segment to the open SPK */
/* file according to the format described in the type 15 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* This routine is provided to provide direct support for the MASL */
/* precessing orbit formulation. */
/* $ Examples */
/* Suppose that at time EPOCH you have the J2000 periapsis */
/* state of some object relative to some central body and would */
/* like to create a type 15 SPK segment to model the motion of */
/* the object using simple regression and precession of the */
/* line of nodes and apsides. The following code fragment */
/* illustrates how you can prepare such a segment. We shall */
/* assume that you have in hand the J2000 direction of the */
/* central body's pole vector, its GM, J2 and equatorial */
/* radius. In addition we assume that you have opened an SPK */
/* file for write access and that it is attached to HANDLE. */
/* (If your state is at an epoch other than periapse the */
/* fragment below will NOT produce a "correct" type 15 segment */
/* for modeling the motion of your object.) */
/* C */
/* C First we get the osculating elements. */
/* C */
/* CALL OSCELT ( STATE, EPOCH, GM, ELTS ) */
/* C */
/* C From these collect the eccentricity and semi-latus rectum. */
/* C */
/* ECC = ELTS ( 2 ) */
/* P = ELTS ( 1 ) * ( 1.0D0 + ECC ) */
/* C */
/* C Next get the trajectory pole vector and the */
/* C periapsis vector. */
/* C */
/* CALL UCRSS ( STATE(1), STATE(4), TP ) */
/* CALL VHAT ( STATE(1), PA ) */
/* C */
/* C Enable both J2 corrections. */
/* C */
/* J2FLG = 0.0D0 */
/* C */
/* C Now add the segment. */
/* C */
/* CALL SPKW15 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */
/* . SEGID, EPOCH, TP, PA, P, ECC, */
/* . J2FLG, PV, GM, J2, RADIUS ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 29-MAY-2012 (NJB) */
/* Input vectors that nominally have unit length */
/* are mapped to local copies that actually do */
/* have unit length. The applicable inputs are TP, PA, */
/* and PV. The Detailed Input header section was updated */
/* to reflect the change. */
/* Some typos in error messages were corrected. */
/* - SPICELIB Version 1.0.0, 28-NOV-1994 (WLT) */
/* -& */
/* $ Index_Entries */
/* Write a type 15 spk segment */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Segment descriptor size */
/* Segment identifier size */
/* SPK data type */
/* Range of printing characters */
/* Number of items in a segment */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW15", (ftnlen)6);
/* Fetch the various entities from the inputs and put them into */
/* the data record, first the epoch. */
record[0] = *epoch;
/* Convert TP and PA to unit vectors. */
vhat_(pa, mypa);
vhat_(tp, mytp);
/* The trajectory pole vector. */
vequ_(mytp, &record[1]);
/* The periapsis vector. */
vequ_(mypa, &record[4]);
/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */
/* and eccentricity. */
record[7] = *p;
record[8] = *ecc;
/* J2 processing flag. */
record[9] = *j2flg;
/* Central body pole vector. */
vhat_(pv, &record[10]);
/* The central mass, J2 and radius of the central body. */
record[13] = *gm;
record[14] = *j2;
record[15] = *radius;
/* Check all the inputs here for obvious failures. It's much */
/* better to check them now and quit than it is to get a bogus */
/* segment into an SPK file and diagnose it later. */
if (*p <= 0.) {
setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator"
" was non-positive. This value must be positive. The value s"
"upplied was #.", (ftnlen)133);
errdp_("#", p, (ftnlen)1);
sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21);
chkout_("SPKW15", (ftnlen)6);
return 0;
} else if (*ecc < 0.) {
setmsg_("The eccentricity supplied for a type 15 segment is negative"
". It must be non-negative. The value supplied to the type 1"
"5 evaluator was #. ", (ftnlen)138);
errdp_("#", ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKW15", (ftnlen)6);
return 0;
} else if (*gm <= 0.) {
setmsg_("The mass supplied for the central body of a type 15 segment"
" was non-positive. Masses must be positive. The value suppl"
"ied was #. ", (ftnlen)130);
errdp_("#", gm, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22);
chkout_("SPKW15", (ftnlen)6);
return 0;
} else if (vzero_(tp)) {
setmsg_("The trajectory pole vector supplied to SPKW15 had length ze"
"ro. The most likely cause of this problem is an uninitialize"
"d vector.", (ftnlen)128);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKW15", (ftnlen)6);
return 0;
} else if (vzero_(pa)) {
setmsg_("The periapse vector supplied to SPKW15 had length zero. The"
" most likely cause of this problem is an uninitialized vecto"
"r.", (ftnlen)121);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKW15", (ftnlen)6);
return 0;
} else if (vzero_(pv)) {
setmsg_("The central pole vector supplied to SPKW15 had length zero."
" The most likely cause of this problem is an uninitialized v"
"ector. ", (ftnlen)126);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKW15", (ftnlen)6);
return 0;
} else if (*radius < 0.) {
setmsg_("The central body radius was negative. It must be zero or po"
"sitive. The value supplied was #. ", (ftnlen)94);
errdp_("#", radius, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("SPKW15", (ftnlen)6);
return 0;
}
/* One final check. Make sure the pole and periapse vectors are */
/* orthogonal. (We will use a very crude check but this should */
/* rule out any obvious errors.) */
dot = vdot_(mypa, mytp);
if (abs(dot) > 1e-5) {
angle = vsep_(pa, tp) * dpr_();
setmsg_("The periapsis and trajectory pole vectors are not orthogona"
"l. The angle between them is # degrees. ", (ftnlen)99);
errdp_("#", &angle, (ftnlen)1);
sigerr_("SPICE(BADINITSTATE)", (ftnlen)19);
chkout_("SPKW15", (ftnlen)6);
return 0;
}
/* Make sure the segment identifier is not too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("SPKW15", (ftnlen)6);
return 0;
}
/* Make sure it has only printing characters. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
value = *(unsigned char *)&segid[i__ - 1];
if (value < 32 || value > 126) {
setmsg_("The segment identifier contains the nonprintable charac"
"ter having ascii code #.", (ftnlen)79);
errint_("#", &value, (ftnlen)1);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("SPKW15", (ftnlen)6);
return 0;
}
}
/* All of the obvious checks have been performed on the input */
/* record. Create the segment descriptor. (FIRST and LAST are */
/* checked by SPKPDS as well as consistency between BODY and CENTER). */
spkpds_(body, center, frame, &c__15, first, last, descr, frame_len);
if (failed_()) {
chkout_("SPKW15", (ftnlen)6);
return 0;
}
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW15", (ftnlen)6);
return 0;
}
dafada_(record, &c__16);
if (! failed_()) {
dafena_();
}
chkout_("SPKW15", (ftnlen)6);
return 0;
} /* spkw15_ */
