/* $Procedure DPSPCE ( Propagate a two line element set for deep space ) */
/* Subroutine */ int dpspce_(doublereal *time, doublereal *geophs, doublereal
*elems, doublereal *state)
{
/* Initialized data */
static logical doinit = TRUE_;
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double pow_dd(doublereal *, doublereal *), cos(doublereal), sqrt(
doublereal), sin(doublereal), d_mod(doublereal *, doublereal *),
atan2(doublereal, doublereal);
/* Local variables */
static doublereal coef, eeta, aodp, delo, capu, uang, xmdf, xinc, xmam,
aynl, elsq, temp;
static logical cont;
static doublereal rdot, cosu, sinu, coef1, t2cof, temp1, temp2, temp3,
temp4, temp5, cos2u, temp6;
extern /* Subroutine */ int zzdpinit_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *);
static doublereal sin2u, a, e;
static integer i__;
static doublereal m[3], n[3], s, u[3], v[3], betal, scale, betao;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static doublereal epoch, ecose, aycof, esine, a3ovk2, tempa, tempe, bstar,
cosio, xincl, etasq, rfdot, sinio, a1, rdotk, c1, c2, cosuk, c4,
qoms24, sinuk, templ, x1m5th, x1mth2, x3thm1, x7thm1, psisq,
xinck, xlcof, xmdot, xnode, xnodp;
extern doublereal twopi_(void);
static doublereal s4;
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
static doublereal betao2, theta2, ae, xhdot1, ao, em, eo, qoms2t, pl,
omgadf, rk, qo, uk, so;
extern doublereal halfpi_(void);
static doublereal xl, xn, omegao;
extern /* Subroutine */ int latrec_(doublereal *, doublereal *,
doublereal *, doublereal *);
static doublereal perige, xnodcf, xnoddf, tsince, xnodek, omgdot, rfdotk,
xnodeo;
extern /* Subroutine */ int chkout_(char *, ftnlen);
static doublereal ck2, lstelm[10], ck4, cosepw, sinepw, xkmper, xnodot,
lstphs[8];
extern logical return_(void);
static doublereal pinvsq, xj2, xj3, xj4, eta, axn, xke, ayn, epw, tsi,
xll, xmo, xno, tsq, xlt, del1;
extern /* Subroutine */ int zzdpsec_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
static doublereal pio2;
extern /* Subroutine */ int zzdpper_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *);
static doublereal pix2;
/* $ Abstract */
/* This routine propagates NORAD two-line element data for */
/* earth orbiting deep space vehicles (a vehicle with an */
/* orbital period more than 225 minutes). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* EPHEMERIS */
/* TWO LINE ELEMENTS */
/* DEEP SPACE PROPAGATOR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TIME I Time for state evaluation in seconds past ephemeris */
/* epoch J2000. */
/* GEOPHS I The array of geophysical constants */
/* ELEMS I Array of orbit elements */
/* STATE O State vector at TIME */
/* $ Detailed_Input */
/* TIME is the epoch in seconds past ephemeris epoch J2000 */
/* to produced a state from the input elements. */
/* GEOPHS is a collection of 8 geophysical constants needed */
/* for computing a state. The order of these */
/* constants must be: */
/* GEOPHS(1) = J2 gravitational harmonic for earth */
/* GEOPHS(2) = J3 gravitational harmonic for earth */
/* GEOPHS(3) = J4 gravitational harmonic for earth */
/* These first three constants are dimensionless. */
/* GEOPHS(4) = KE: Square root of the GM for earth where */
/* GM is expressed in earth radii cubed per */
/* minutes squared. */
/* GEOPHS(5) = QO: Low altitude bound for atmospheric */
/* model in km. */
/* GEOPHS(6) = SO: High altitude bound for atmospheric */
/* model in km. */
/* GEOPHS(7) = RE: Equatorial radius of the earth in km. */
/* GEOPHS(8) = AE: Distance units/earth radius */
/* (normally 1) */
/* Below are currently recommended values for these */
/* items: */
/* J2 = 1.082616D-3 */
/* J3 = -2.53881D-6 */
/* J4 = -1.65597D-6 */
/* The next item is the square root of GM for the */
/* earth given in units of earth-radii**1.5/Minute */
/* KE = 7.43669161D-2 */
/* The next two items define the top and */
/* bottom of the atmospheric drag model */
/* used by the type 10 ephemeris type. */
/* Don't adjust these unless you understand */
/* the full implications of such changes. */
/* QO = 120.0D0 */
/* SO = 78.0D0 */
/* The ER value is the equatorial radius in km */
/* of the earth as used by NORAD. */
/* ER = 6378.135D0 */
/* The value of AE is the number of */
/* distance units per earth radii used by */
/* the NORAD state propagation software. */
/* The value is 1 unless you've got */
/* a very good understanding of the NORAD */
/* routine SGP4 and the affect of changing */
/* this value.. */
/* AE = 1.0D0 */
/* ELEMS is an array containing two-line element data */
/* as prescribed below. The elements XNDD6O and BSTAR */
/* must have been scaled by the proper exponent stored */
/* in the two line elements set. Moreover, the */
/* various items must be converted to the units shown */
/* here. */
/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */
/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */
/* ELEMS ( 3 ) = BSTAR */
/* ELEMS ( 4 ) = XINCL in radians */
/* ELEMS ( 5 ) = XNODEO in radians */
/* ELEMS ( 6 ) = EO */
/* ELEMS ( 7 ) = OMEGAO in radians */
/* ELEMS ( 8 ) = XMO in radians */
/* ELEMS ( 9 ) = XNO in radians/minute */
/* ELEMS ( 10 ) = EPOCH of the elements in seconds */
/* past ephemeris epoch J2000. */
/* $ Detailed_Output */
/* STATE A 6 vector containing the X, Y, Z, Vx, Vy, Vz */
/* coordinates in the inertial frame (double */
/* precision). */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This subroutine is an extensive rewrite of the SDP4 */
/* routine as described in the Spacetrack 3 report. All common */
/* blocks were removed and all variables are explicitly defined. */
/* The removal of common blocks causes the set of routines to */
/* execute slower than the original version of SDP4. However the */
/* stability improves especially as concerns memory and */
/* expanded internal documentation. */
/* Trivial or redundant variables have been eliminated. */
/* R removed, occurrence replaced with RK */
/* E6A renamed TOL */
/* THETA4 removed, relevant equation recast in Horner's form */
/* i.e. something like x^4 + x^2 -> x^2 ( x^2 + 1 ) */
/* U renamed UANG, U is now a euclidean 3 vector. */
/* Ux,Uy,Uz removed, replaced with 3-vector U */
/* Vx,Vy,Vz removed, replaced with 3-vector V */
/* OMEGAQ removed, usage replaced with OMEGAO */
/* OMGDT removed, same variable as OMGDOT, so all occurrences */
/* replaced with OMGDOT */
/* SSL,SSG replaced with the 5-vector SSX */
/* SSH,SSE */
/* SSI */
/* Three functions present in the original Spacetrack report, ACTAN, */
/* FMOD2P and THETAG, have been either replaced with an intrinsic */
/* FORTRAN function (ACTAN -> DATAN2, FMOD2P -> DMOD) or recoded */
/* using SPICELIB calls (THETAG). */
/* The code at the end of this subroutine which calculates */
/* orientation vectors, was replaced with a set of calls to */
/* SPICELIB vector routines. */
/* A direct comparison of output from the original Spacetrack 3 code */
/* and these NAIF routines for the same elements and time parameters */
/* will produce unacceptably different results. */
/* $ Examples */
/* C--- Load the geophysical constants kernel and the leapsecond */
/* kernel */
/* CALL FURNSH( '/Users/ewright/lib/geophysical.ker' ) */
/* CALL FURNSH( '/kernels/gen/lsk/naif0008.tls' ) */
/* C--- Define a vehicle element array, TDRS 4 Geosynch */
/* LINES( 1 ) = '1 19883U 89021B 97133.05943164 -.00000277 ' */
/* .// '00000-0 10000-3 0 3315' */
/* LINES( 2 ) = '2 19883 0.5548 86.7278 0001786 312.2904 ' */
/* .// '172.2391 1.00269108202415' */
/* C--- Identify the earliest first year for the elements */
/* FRSTYR = 1988 */
/* C--- Parse the elements to something SPICE can use */
/* CALL GETELM ( FRSTYR, LINES, EPOCH, ELEMS ) */
/* C--- Final time past epoch, 1400 mins (in seconds) */
/* TF = 1440.D0 * 60.D0 */
/* C--- Step size for elements output 360 mins (in seconds) */
/* DELT = 360.D0 * 60.D0 */
/* C--- Start time keyed off epoch */
/* TIME = EPOCH - 2.D0 * DELT */
/* DO WHILE ( DABS(TIME - EPOCH) .LE. DABS(TF) ) */
/* CALL DPSPCE ( TIME, GEOPHS, ELEMS, STATE ) */
/* WRITE(*, FMT ='(7F17.8)' ) (TIME-EPOCH)/60.D0, */
/* . (STATE(I),I=1,6) */
/* TIME = TIME + DELT */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* Hoots, Felix R., Ronald L. Roehrich (31 December 1988). "Models */
/* for Propagation of NORAD Element Sets". United States Department */
/* of Defense Spacetrack Report (3). */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 23-JAN-2013 (EDW) */
/* Corrected initialization block error. The ZZDPINIT call */
/* causes a side-effect required for each DPSPCE call. */
/* The ZZDPINIT call now occurs outside the initialization */
/* block. Note from designer, side-effects are bad. */
/* Added proper citation for Hoots paper. */
/* - SPICELIB Version 1.2.2, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 1.2.1, DEC-27-2000 (EDW) */
/* Corrected error in header documentation. Horner's Rule */
/* not Butcher's. */
/* - SPICELIB Version 1.2.0, MAR-24-1999 (EDW) */
/* Documentation expanded to include modifications made */
/* to private routines. Some english errors corrected. */
/* Alphabetized variable declaration lists. */
/* Temporary variable TEMP removed. OMGDOT argument added to */
/* ZZDPSEC call. */
/* - SPICELIB Version 1.1.0, OCT-05-1998 (WLT) */
/* Forced initialization section until we can figure out */
/* why it doesn't work on SUNs. */
/* - SPICELIB Version 1.0.1, MAR-11-1998 (EDW) */
/* Corrected error in header describing GEOPHS array. */
/* - SPICELIB Version 1.0.0, NOV-11-1998 (EDW) */
/* -& */
/* $ Index_Entries */
/* NORAD two line elements deep space evaluator */
/* -& */
/* Local variables */
/* Define parameters for convergence tolerance and the value for 2/3, */
/* 0 and 1. */
/* The geophysical Quantities */
/* Elements */
/* Other quantities */
/* SPICELIB routines */
/* Save everything. */
/* Set initialization flags */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DPSPCE", (ftnlen)6);
}
/* If this is the very first time into this routine, set these */
/* values. */
if (first) {
pix2 = twopi_();
pio2 = halfpi_();
first = FALSE_;
}
/* If initialization flag is FALSE, then this is not the first */
/* call to this routine. Check the stuff. */
if (! doinit) {
/* Check whether the current and last constants and elements */
/* match. If not, we need to reinitialize everything */
/* since the propagation is dependent on the value of these */
/* arrays. */
for (i__ = 1; i__ <= 8; ++i__) {
if (lstphs[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge(
"lstphs", i__1, "dpspce_", (ftnlen)547)] != geophs[(i__2 =
i__ - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("geophs", i__2,
"dpspce_", (ftnlen)547)]) {
doinit = TRUE_;
}
}
for (i__ = 1; i__ <= 10; ++i__) {
if (lstelm[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"lstelm", i__1, "dpspce_", (ftnlen)556)] != elems[(i__2 =
i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("elems", i__2,
"dpspce_", (ftnlen)556)]) {
doinit = TRUE_;
}
}
}
/* Initialization block. Always called on the initial entry and */
/* anytime the geophysical or elements array changes. */
if (doinit) {
doinit = FALSE_;
/* Retrieve the geophysical constants from the GEOPHS array */
xj2 = geophs[0];
xj3 = geophs[1];
xj4 = geophs[2];
xke = geophs[3];
qo = geophs[4];
so = geophs[5];
xkmper = geophs[6];
ae = geophs[7];
/* Save the geophysical constants for later comparison */
for (i__ = 1; i__ <= 8; ++i__) {
lstphs[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("lstphs",
i__1, "dpspce_", (ftnlen)590)] = geophs[(i__2 = i__ - 1)
< 8 && 0 <= i__2 ? i__2 : s_rnge("geophs", i__2, "dpspce_"
, (ftnlen)590)];
}
/* Unpack the elements array. */
bstar = elems[2];
xincl = elems[3];
xnodeo = elems[4];
eo = elems[5];
omegao = elems[6];
xmo = elems[7];
xno = elems[8];
epoch = elems[9];
/* Save the elements for later comparison */
for (i__ = 1; i__ <= 10; ++i__) {
lstelm[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lstelm"
, i__1, "dpspce_", (ftnlen)610)] = elems[(i__2 = i__ - 1)
< 10 && 0 <= i__2 ? i__2 : s_rnge("elems", i__2, "dpspce_"
, (ftnlen)610)];
}
/* Set common variables, the init flag and calculate the */
/* WGS-72 physical and geopotential constants */
/* CK2 = 0.5 * J2 * AE^2 */
/* CK4 = -0.375 * J4 * AE^4 */
/* These are values calculated only once and then saved for */
/* future access. */
/* Computing 2nd power */
d__1 = ae;
ck2 = xj2 * .5 * (d__1 * d__1);
/* Computing 4th power */
d__1 = ae, d__1 *= d__1;
ck4 = xj4 * -.375 * (d__1 * d__1);
/* Computing 4th power */
d__1 = (qo - so) * ae / xkmper, d__1 *= d__1;
qoms2t = d__1 * d__1;
s = ae * (so / xkmper + 1.);
/* Recover original mean motion (XNODP) and semimajor axis (AODP) */
/* from input elements */
d__1 = xke / xno;
a1 = pow_dd(&d__1, &c_b19);
cosio = cos(xincl);
/* Computing 2nd power */
d__1 = cosio;
theta2 = d__1 * d__1;
x3thm1 = theta2 * 3. - 1.;
/* Computing 2nd power */
d__1 = eo;
betao2 = 1. - d__1 * d__1;
betao = sqrt(betao2);
/* Computing 2nd power */
d__1 = a1;
del1 = ck2 * 1.5 * x3thm1 / (d__1 * d__1 * betao * betao2);
ao = a1 * (1. - del1 * (del1 * (del1 * 1.654320987654321 + 1.) +
.33333333333333331));
/* Computing 2nd power */
d__1 = ao;
delo = ck2 * 1.5 * x3thm1 / (d__1 * d__1 * betao * betao2);
xnodp = xno / (delo + 1.);
aodp = ao / (1. - delo);
/* For perigee below 156 km, the values of S and QOMS2T are */
/* altered */
s4 = s;
qoms24 = qoms2t;
perige = (aodp * (1. - eo) - ae) * xkmper;
if (perige < 156.) {
s4 = perige - 78.;
if (perige > 98.) {
/* Computing 4th power */
d__1 = (120. - s4) * ae / xkmper, d__1 *= d__1;
qoms24 = d__1 * d__1;
s4 = s4 / xkmper + ae;
} else {
s4 = 20.;
}
}
/* Computing 2nd power */
d__1 = aodp;
/* Computing 2nd power */
d__2 = betao2;
pinvsq = 1. / (d__1 * d__1 * (d__2 * d__2));
tsi = 1. / (aodp - s4);
eta = aodp * eo * tsi;
/* Computing 2nd power */
d__1 = eta;
etasq = d__1 * d__1;
eeta = eo * eta;
psisq = (d__1 = 1. - etasq, abs(d__1));
/* Computing 4th power */
d__1 = tsi, d__1 *= d__1;
coef = qoms24 * (d__1 * d__1);
coef1 = coef / pow_dd(&psisq, &c_b20);
c2 = coef1 * xnodp * (aodp * (etasq * 1.5 + 1. + eeta * (etasq + 4.))
+ ck2 * .75 * tsi / psisq * x3thm1 * (etasq * 3. * (etasq +
8.) + 8.));
c1 = bstar * c2;
sinio = sin(xincl);
/* Computing 3rd power */
d__1 = ae;
a3ovk2 = -xj3 / ck2 * (d__1 * (d__1 * d__1));
x1mth2 = 1. - theta2;
c4 = xnodp * 2. * coef1 * aodp * betao2 * (eta * (etasq * .5 + 2.) +
eo * (etasq * 2. + .5) - ck2 * 2. * tsi / (aodp * psisq) * (
x3thm1 * -3. * (1. - eeta * 2. + etasq * (1.5 - eeta * .5)) +
x1mth2 * .75 * (etasq * 2. - eeta * (etasq + 1.)) * cos(
omegao * 2.)));
temp1 = ck2 * 3. * pinvsq * xnodp;
temp2 = temp1 * ck2 * pinvsq;
temp3 = ck4 * 1.25 * pinvsq * pinvsq * xnodp;
xmdot = xnodp + temp1 * .5 * betao * x3thm1 + temp2 * .0625 * betao *
(theta2 * (theta2 * 137. - 78.) + 13.);
x1m5th = 1. - theta2 * 5.;
omgdot = temp1 * -.5 * x1m5th + temp2 * .0625 * (theta2 * (theta2 *
395. - 114.) + 7.) + temp3 * (theta2 * (theta2 * 49. - 36.) +
3.);
xhdot1 = -temp1 * cosio;
xnodot = xhdot1 + (temp2 * .5 * (4. - theta2 * 19.) + temp3 * 2. * (
3. - theta2 * 7.)) * cosio;
xnodcf = betao2 * 3.5 * xhdot1 * c1;
t2cof = c1 * 1.5;
xlcof = a3ovk2 * .125 * sinio * (cosio * 5. + 3.) / (cosio + 1.);
aycof = a3ovk2 * .25 * sinio;
x7thm1 = theta2 * 7. - 1.;
}
zzdpinit_(&aodp, &xmdot, &omgdot, &xnodot, &xnodp, elems);
/* Get the time since the EPOCH in minutes. */
tsince = (*time - epoch) / 60.;
/* Update for secular gravity and atmospheric drag */
xmdf = xmo + xmdot * tsince;
omgadf = omegao + omgdot * tsince;
xnoddf = xnodeo + xnodot * tsince;
tsq = tsince * tsince;
xnode = xnoddf + xnodcf * tsq;
tempa = 1. - c1 * tsince;
tempe = bstar * c4 * tsince;
templ = t2cof * tsq;
xn = xnodp;
/* Calculate the secular terms. */
zzdpsec_(&xmdf, &omgadf, &xnode, &em, &xinc, &xn, &tsince, elems, &omgdot)
;
d__1 = xke / xn;
/* Computing 2nd power */
d__2 = tempa;
a = pow_dd(&d__1, &c_b19) * (d__2 * d__2);
e = em - tempe;
xmam = xmdf + xnodp * templ;
/* Calculate the periodic terms. */
zzdpper_(&tsince, &e, &xinc, &omgadf, &xnode, &xmam);
xl = xmam + omgadf + xnode;
xn = xke / pow_dd(&a, &c_b22);
/* Long period periodics */
axn = e * cos(omgadf);
/* Computing 2nd power */
d__1 = e;
temp = 1. / (a * (1. - d__1 * d__1));
xll = temp * xlcof * axn;
aynl = temp * aycof;
xlt = xl + xll;
ayn = e * sin(omgadf) + aynl;
/* Solve Kepler's equation */
/* U = EPW - AXN * SIN(EPW) + AYN * COS(EPW) */
/* Where */
/* AYN = E * SIN(OMEGA) + AYNL */
/* AXN = E * COS(OMEGA) */
/* And */
/* AYNL = -0.50D0 * SINIO * AE * J3 / (J2 * A * (1.0D0 - E^2)) */
/* Get the mod division of CAPU with 2 Pi */
d__1 = xlt - xnode;
capu = d_mod(&d__1, &pix2);
if (capu < 0.) {
capu += pix2;
}
/* Set initial states for the Kepler solution */
epw = capu;
cont = TRUE_;
while(cont) {
temp2 = epw;
sinepw = sin(temp2);
cosepw = cos(temp2);
temp3 = axn * sinepw;
temp4 = ayn * cosepw;
temp5 = axn * cosepw;
temp6 = ayn * sinepw;
epw = (capu - temp4 + temp3 - temp2) / (1. - temp5 - temp6) + temp2;
/* Test for convergence against the defined tolerance */
if ((d__1 = epw - temp2, abs(d__1)) <= 1e-6) {
cont = FALSE_;
}
}
/* Short period preliminary quantities */
ecose = temp5 + temp6;
esine = temp3 - temp4;
elsq = axn * axn + ayn * ayn;
temp = 1. - elsq;
pl = a * temp;
rk = a * (1. - ecose);
temp1 = 1. / rk;
rdot = xke * sqrt(a) * esine * temp1;
rfdot = xke * sqrt(pl) * temp1;
temp2 = a * temp1;
betal = sqrt(temp);
temp3 = 1. / (betal + 1.);
cosu = temp2 * (cosepw - axn + ayn * esine * temp3);
sinu = temp2 * (sinepw - ayn - axn * esine * temp3);
/* Compute the angle from the x-axis of the point ( COSU, SINU ) */
if (sinu != 0. || cosu != 0.) {
uang = atan2(sinu, cosu);
if (uang < 0.) {
uang += pix2;
}
} else {
uang = 0.;
}
sin2u = sinu * 2. * cosu;
cos2u = cosu * 2. * cosu - 1.;
temp1 = ck2 * (1. / pl);
temp2 = temp1 * (1. / pl);
/* Update for short periodics */
rk = rk * (1. - temp2 * 1.5 * betal * x3thm1) + temp1 * .5 * x1mth2 *
cos2u;
uk = uang - temp2 * .25 * x7thm1 * sin2u;
xnodek = xnode + temp2 * 1.5 * cosio * sin2u;
xinck = xinc + temp2 * 1.5 * cosio * sinio * cos2u;
rdotk = rdot - xn * temp1 * x1mth2 * sin2u;
rfdotk = rfdot + xn * temp1 * (x1mth2 * cos2u + x3thm1 * 1.5);
/* Orientation vectors are calculated by */
/* U = M sin(uk) + N cos(uk) */
/* V = M cos(uk) - N sin(uk) */
/* Where M and N are euclidean 3 vectors */
/* M = (-sin(xnodek)cos(xinck), cos(xnodek)cos(xinck), sin(xinck) ) */
/* N = ( cos(xnodek), sin(xnodek) , 0 ) */
sinuk = sin(uk);
cosuk = cos(uk);
/* Use LATREC to generate M and N. M is a latitude to rectangle */
/* conversion of a unit vector where PI/2 + XNODEK is the longitude */
d__1 = pio2 + xnodek;
latrec_(&c_b23, &d__1, &xinck, m);
latrec_(&c_b23, &xnodek, &c_b25, n);
/* Sum the components to obtain U and V */
vlcom_(&sinuk, m, &cosuk, n, u);
d__1 = -sinuk;
vlcom_(&cosuk, m, &d__1, n, v);
/* Determine the position and velocity then pack the STATE vector */
/* with value scaled to KM and KPS. */
/* R = RK U + 0 V */
/* V = RKDOT U + RK RFDOT V */
scale = xkmper / ae;
d__1 = rk * scale;
vlcom_(&d__1, u, &c_b25, v, state);
/* Now scale to KPS for the velocity component */
scale /= 60.;
d__1 = rdotk * scale;
d__2 = rfdotk * scale;
vlcom_(&d__1, u, &d__2, v, &state[3]);
/* All done now.... */
chkout_("DPSPCE", (ftnlen)6);
return 0;
} /* dpspce_ */
/* $Procedure BODMAT ( Return transformation matrix for a body ) */
/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm)
{
/* Initialized data */
static logical first = TRUE_;
static logical found = FALSE_;
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_dnnt(doublereal *);
double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *)
;
/* Local variables */
integer cent;
char item[32];
doublereal j2ref[9] /* was [3][3] */;
extern integer zzbodbry_(integer *);
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
doublereal d__;
integer i__, j;
doublereal dcoef[3], t, w;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
doublereal delta;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal theta;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, errdp_(char *, doublereal *, ftnlen);
doublereal costh[100];
extern doublereal vdotg_(doublereal *, doublereal *, integer *);
char dtype[1];
doublereal sinth[100], tsipm[36] /* was [6][6] */;
extern doublereal twopi_(void);
static integer j2code;
doublereal ac[100], dc[100];
integer na, nd;
doublereal ra, wc[100];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern logical bodfnd_(integer *, char *, ftnlen);
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern doublereal halfpi_(void);
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
integer nw;
doublereal conepc, conref;
extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *,
doublereal *, logical *);
integer ntheta;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char fixfrm[32], errmsg[1840];
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen), errint_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
irfrot_(integer *, integer *, doublereal *);
extern logical return_(void);
char timstr[35];
extern doublereal j2000_(void);
doublereal dec;
integer dim, ref;
doublereal phi;
extern doublereal rpd_(void), spd_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return the J2000 to body Equator and Prime Meridian coordinate */
/* transformation matrix for a specified body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PCK */
/* NAIF_IDS */
/* TIME */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ 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. */
/* Include File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation from Inertial to PM for BODY at ET. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* transformation is requested. Bodies are numbered */
/* according to the standard NAIF numbering scheme. */
/* ET is the epoch at which the transformation is */
/* requested. (This is typically the epoch of */
/* observation minus the one-way light time from */
/* the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is the transformation matrix from Inertial to body */
/* Equator and Prime Meridian. The X axis of the PM */
/* system is directed to the intersection of the */
/* equator and prime meridian. The Z axis points north. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If data required to define the body-fixed frame associated */
/* with BODY are not found in the binary PCK system or the kernel */
/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */
/* the case of IAU style body-fixed frames, the absence of */
/* prime meridian polynomial data (which are required) is used */
/* as an indicator of missing data. */
/* 2) If the test for exception (1) passes, but in fact requested */
/* data are not available in the kernel pool, the error will be */
/* signaled by routines in the call tree of this routine. */
/* 3) If the kernel pool does not contain all of the data required */
/* to define the number of nutation precession angles */
/* corresponding to the available nutation precession */
/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */
/* signaled. */
/* 4) If the reference frame REF is not recognized, a routine */
/* called by BODMAT will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 5) If the specified body code BODY is not recognized, the */
/* error is diagnosed by a routine called by BODMAT. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine is related to the more general routine TIPBOD */
/* which returns a matrix that transforms vectors from a */
/* specified inertial reference frame to body equator and */
/* prime meridian coordinates. TIPBOD accepts an input argument */
/* REF that allows the caller to specify an inertial reference */
/* frame. */
/* The transformation represented by BODMAT's output argument TIPM */
/* is defined as follows: */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If there exists high-precision binary PCK kernel information */
/* for the body at the requested time, these angles, W, DELTA */
/* and PHI are computed directly from that file. The most */
/* recently loaded binary PCK file has first priority followed */
/* by previously loaded binary PCK files in backward time order. */
/* If no binary PCK file has been loaded, the text P_constants */
/* kernel file is used. */
/* If there is only text PCK kernel information, it is */
/* expressed in terms of RA, DEC and W (same W as above), where */
/* RA = PHI - HALFPI() */
/* DEC = HALFPI() - DELTA */
/* RA, DEC, and W are defined as follows in the text PCK file: */
/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */
/* i i */
/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */
/* i i */
/* W = W0 + W1*d + W2*d*d + w sin theta */
/* i i */
/* where: */
/* d = days past J2000. */
/* T = Julian centuries past J2000. */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0 * THETA1*T are specific to each planet. */
/* i */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* In the following code fragment, BODMAT is used to rotate */
/* the position vector (POS) from a target body (BODY) to a */
/* spacecraft from inertial coordinates to body-fixed coordinates */
/* at a specific epoch (ET), in order to compute the planetocentric */
/* longitude (PCLONG) of the spacecraft. */
/* CALL BODMAT ( BODY, ET, TIPM ) */
/* CALL MXV ( TIPM, POS, POS ) */
/* CALL RECLAT ( POS, RADIUS, PCLONG, LAT ) */
/* To compute the equivalent planetographic longitude (PGLONG), */
/* it is necessary to know the direction of rotation of the target */
/* body, as shown below. */
/* CALL BODVCD ( BODY, 'PM', 3, DIM, VALUES ) */
/* IF ( VALUES(2) .GT. 0.D0 ) THEN */
/* PGLONG = PCLONG */
/* ELSE */
/* PGLONG = TWOPI() - PCLONG */
/* END IF */
/* Note that the items necessary to compute the transformation */
/* TIPM must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the NAIF_IDS required reading file for a complete */
/* list of the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 4.1.1, 01-FEB-2008 (NJB) */
/* The routine was updated to improve the error messages created */
/* when required PCK data are not found. Now in most cases the */
/* messages are created locally rather than by the kernel pool */
/* access routines. In particular missing binary PCK data will */
/* be indicated with a reasonable error message. */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Implementation changes were made to improve robustness */
/* of the code. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* Gets TSIPM matrix from PCKMAT (instead of Euler angles */
/* from PCKEUL.) */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* Ability to get Euler angles from binary PCK file added. */
/* This uses the new routine PCKEUL. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* fetch transformation matrix for a body */
/* transformation from j2000 position to bodyfixed */
/* transformation from j2000 to bodyfixed coordinates */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Calls to deprecated kernel pool access routine RTPOOL */
/* were replaced by calls to GDPOOL. */
/* Calls to BODVAR have been replaced with calls to */
/* ZZBODVCD. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* BODMAT now get the TSIPM matrix from PCKMAT, and */
/* unpacks TIPM from it. Also the calculated but unused */
/* variable LAMBDA was removed. */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* BODMAT now uses new software to check for the */
/* existence of binary PCK files, search the for */
/* data corresponding to the requested body and time, */
/* and return the appropriate Euler angles, using the */
/* new routine PCKEUL. Otherwise the code calculates */
/* the Euler angles from the P_constants kernel file. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* BODMAT now checks the kernel pool for presence of the */
/* variables */
/* BODY#_CONSTANTS_REF_FRAME */
/* and */
/* BODY#_CONSTANTS_JED_EPOCH */
/* where # is the NAIF integer code of the barycenter of a */
/* planetary system or of a body other than a planet or */
/* satellite. If either or both of these variables are */
/* present, the P_constants for BODY are presumed to be */
/* referenced to the specified inertial frame or epoch. */
/* If the epoch of the constants is not J2000, the input */
/* time ET is converted to seconds past the reference epoch. */
/* If the frame of the constants is not J2000, the rotation from */
/* the P_constants' frame to body-fixed coordinates is */
/* transformed to the rotation from J2000 coordinates to */
/* body-fixed coordinates. */
/* For efficiency reasons, this routine now duplicates much */
/* of the code of BODEUL so that it doesn't have to call BODEUL. */
/* In some cases, BODEUL must covert Euler angles to a matrix, */
/* rotate the matrix, and convert the result back to Euler */
/* angles. If this routine called BODEUL, then in such cases */
/* this routine would convert the transformed angles back to */
/* a matrix. That would be a bit much.... */
/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */
/* Examples section completed. Declaration of unused variable */
/* FOUND removed. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODMAT", (ftnlen)6);
}
/* Get the code for the J2000 frame, if we don't have it yet. */
if (first) {
irfnum_("J2000", &j2code, (ftnlen)5);
first = FALSE_;
}
/* Get Euler angles from high precision data file. */
pckmat_(body, et, &ref, tsipm, &found);
if (found) {
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 :
s_rnge("tipm", i__1, "bodmat_", (ftnlen)485)] = tsipm[
(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("tsipm", i__2, "bodmat_", (ftnlen)485)];
}
}
} else {
/* The data for the frame of interest are not available in a */
/* loaded binary PCK file. This is not an error: the data may be */
/* present in the kernel pool. */
/* Conduct a non-error-signaling check for the presence of a */
/* kernel variable that is required to implement an IAU style */
/* body-fixed reference frame. If the data aren't available, we */
/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */
/* we want to issue the error signal locally, with a better error */
/* message. */
s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1);
if (! found) {
/* Now we do have an error. */
/* We don't have the data we'll need to produced the requested */
/* state transformation matrix. In order to create an error */
/* message understandable to the user, find, if possible, the */
/* name of the reference frame associated with the input body. */
/* Note that the body is really identified by a PCK frame class */
/* ID code, though most of the documentation just calls it a */
/* body ID code. */
ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32);
etcal_(et, timstr, (ftnlen)35);
s_copy(errmsg, "PCK data required to compute the orientation of "
"the # # for epoch # TDB were not found. If these data we"
"re to be provided by a binary PCK file, then it is possi"
"ble that the PCK file does not have coverage for the spe"
"cified body-fixed frame at the time of interest. If the "
"data were to be provided by a text PCK file, then possib"
"ly the file does not contain data for the specified body"
"-fixed frame. In either case it is possible that a requi"
"red PCK file was not loaded at all.", (ftnlen)1840, (
ftnlen)475);
/* Fill in the variable data in the error message. */
if (found) {
/* The frame system knows the name of the body-fixed frame. */
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16);
errch_("#", fixfrm, (ftnlen)1, (ftnlen)32);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
} else {
/* The frame system doesn't know the name of the */
/* body-fixed frame, most likely due to a missing */
/* frame kernel. */
suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840);
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame associated with the ID code", (
ftnlen)1, (ftnlen)44);
errint_("#", body, (ftnlen)1);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
errch_("#", "Also, a frame kernel defining the body-fixed fr"
"ame associated with body # may need to be loaded.", (
ftnlen)1, (ftnlen)96);
errint_("#", body, (ftnlen)1);
}
sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Find the body code used to label the reference frame and epoch */
/* specifiers for the orientation constants for BODY. */
/* For planetary systems, the reference frame and epoch for the */
/* orientation constants is associated with the system */
/* barycenter, not with individual bodies in the system. For any */
/* other bodies, (the Sun or asteroids, for example) the body's */
/* own code is used as the label. */
refid = zzbodbry_(body);
/* Look up the epoch of the constants. The epoch is specified */
/* as a Julian ephemeris date. The epoch defaults to J2000. */
s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32);
if (found) {
/* The reference epoch is returned as a JED. Convert to */
/* ephemeris seconds past J2000. Then convert the input ET to */
/* seconds past the reference epoch. */
conepc = spd_() * (conepc - j2000_());
epoch = *et - conepc;
} else {
epoch = *et;
}
/* Look up the reference frame of the constants. The reference */
/* frame is specified by a code recognized by CHGIRF. The */
/* default frame is J2000, symbolized by the code J2CODE. */
s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32);
if (found) {
ref = i_dnnt(&conref);
} else {
ref = j2code;
}
/* Whatever the body, it has quadratic time polynomials for */
/* the RA and Dec of the pole, and for the rotation of the */
/* Prime Meridian. */
s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7);
cleard_(&c__3, rcoef);
bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32);
s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8);
cleard_(&c__3, dcoef);
bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32);
s_copy(item, "PM", (ftnlen)32, (ftnlen)2);
cleard_(&c__3, wcoef);
bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32);
/* There may be additional nutation and libration (THETA) terms. */
ntheta = 0;
na = 0;
nd = 0;
nw = 0;
s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15);
if (bodfnd_(&refid, item, (ftnlen)32)) {
bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32);
ntheta /= 2;
}
s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32);
}
s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32);
}
s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32);
}
/* Computing MAX */
i__1 = max(na,nd);
if (max(i__1,nw) > ntheta) {
setmsg_("Insufficient number of nutation/precession angles for b"
"ody * at time #.", (ftnlen)71);
errint_("*", body, (ftnlen)1);
errdp_("#", et, (ftnlen)1);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Evaluate the time polynomials at EPOCH. */
d__ = epoch / spd_();
t = d__ / 36525.;
ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]);
dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]);
w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]);
/* Add nutation and libration as appropriate. */
i__1 = ntheta;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 :
s_rnge("tcoef", i__2, "bodmat_", (ftnlen)700)] + t *
tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 :
s_rnge("tcoef", i__3, "bodmat_", (ftnlen)700)]) * rpd_();
sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth",
i__2, "bodmat_", (ftnlen)702)] = sin(theta);
costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh",
i__2, "bodmat_", (ftnlen)703)] = cos(theta);
}
ra += vdotg_(ac, sinth, &na);
dec += vdotg_(dc, costh, &nd);
w += vdotg_(wc, sinth, &nw);
/* Convert from degrees to radians and mod by two pi. */
ra *= rpd_();
dec *= rpd_();
w *= rpd_();
d__1 = twopi_();
ra = d_mod(&ra, &d__1);
d__1 = twopi_();
dec = d_mod(&dec, &d__1);
d__1 = twopi_();
w = d_mod(&w, &d__1);
/* Convert to Euler angles. */
phi = ra + halfpi_();
delta = halfpi_() - dec;
/* Produce the rotation matrix defined by the Euler angles. */
eul2m_(&w, &delta, &phi, &c__3, &c__1, &c__3, tipm);
}
/* Convert TIPM to the J2000-to-bodyfixed rotation, if is is not */
/* already referenced to J2000. */
if (ref != j2code) {
/* Find the transformation from the J2000 frame to the frame */
/* designated by REF. Form the transformation from `REF' */
/* coordinates to body-fixed coordinates. Compose the */
/* transformations to obtain the J2000-to-body-fixed */
/* transformation. */
irfrot_(&j2code, &ref, j2ref);
mxm_(tipm, j2ref, tmpmat);
moved_(tmpmat, &c__9, tipm);
}
/* TIPM now gives the transformation from J2000 to */
/* body-fixed coordinates at epoch ET seconds past J2000, */
/* regardless of the epoch and frame of the orientation constants */
/* for the specified body. */
chkout_("BODMAT", (ftnlen)6);
return 0;
} /* bodmat_ */
/* $Procedure RECRAD ( Rectangular coordinates to RA and DEC ) */
/* Subroutine */ int recrad_(doublereal *rectan, doublereal *range,
doublereal *ra, doublereal *dec)
{
extern doublereal twopi_(void);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *);
/* $ Abstract */
/* Convert rectangular coordinates to range, right ascension, */
/* and declination. */
/* $ 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 */
/* CONVERSION, COORDINATES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* RECTAN I Rectangular coordinates of a point. */
/* RANGE O Distance of the point from the origin. */
/* RA O Right ascension in radians. */
/* DEC O Declination in radians. */
/* $ Detailed_Input */
/* RECTAN The rectangular coordinates of a point. */
/* $ Detailed_Output */
/* RANGE is the distance of the point from the origin. */
/* The units associated with RANGE are those */
/* associated with the input RECTAN. */
/* RA is the right ascension of RECTAN. This is the angular */
/* distance measured toward the east from the prime */
/* meridian to the meridian containing the input point. */
/* The direction of increasing right ascension is from */
/* the +X axis towards the +Y axis. */
/* RA is output in radians. The range of RA is [0, 2*pi]. */
/* DEC is the declination of RECTAN. This is the angle from */
/* the XY plane of the ray from the origin through the */
/* point. */
/* DEC is output in radians. The range of DEC is */
/* [-pi/2, pi/2]. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If the X and Y components of RECTAN are both zero, the */
/* right ascension is set to zero. */
/* 2) If RECTAN is the zero vector, right ascension and declination */
/* are both set to zero. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine returns the range, right ascension, and declination */
/* of a point specified in rectangular coordinates. */
/* The output is defined by a distance from a central reference */
/* point, an angle from a reference meridian, and an angle above */
/* the equator of a sphere centered at the central reference */
/* point. */
/* $ Examples */
/* The following code fragment converts right ascension and */
/* declination from the B1950 reference frame to the J2000 frame. */
/* C */
/* C Convert RA and DEC to a 3-vector expressed in */
/* C the B1950 frame. */
/* C */
/* CALL RADREC ( 1.D0, RA, DEC, V1950 ) */
/* C */
/* C We use the SPICELIB routine PXFORM to obtain the */
/* C transformation matrix for converting vectors between */
/* C the B1950 and J2000 reference frames. Since */
/* C both frames are inertial, the input time value we */
/* C supply to PXFORM is arbitrary. We choose zero */
/* C seconds past the J2000 epoch. */
/* C */
/* CALL PXFORM ( 'B1950', 'J2000', 0.D0, MTRANS ) */
/* C */
/* C Transform the vector to the J2000 frame. */
/* C */
/* CALL MXV ( MTRANS, V1950, V2000 ) */
/* C */
/* C Find the RA and DEC of the J2000-relative vector. */
/* C */
/* CALL RECRAD ( V2000, R, RA, DEC ) */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.2, 30-JUL-2003 (NJB) (CHA) */
/* Various header changes were made to improve clarity. Some */
/* minor header corrections were made. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (HAN) */
/* -& */
/* $ Index_Entries */
/* rectangular coordinates to ra and dec */
/* rectangular to right_ascension and declination */
/* -& */
/* SPICELIB functions */
/* Call the subroutine RECLAT to convert the rectangular coordinates */
/* into latitudinal coordinates. In RECLAT, the longitude ( which */
/* is returned to this subroutine as RA ) ranges from - pi to pi */
/* radians. Because the right ascension ranges from zero to */
/* two pi radians, whenever RA is negative two pi must be added to */
/* it. */
reclat_(rectan, range, ra, dec);
if (*ra < 0.) {
*ra += twopi_();
}
return 0;
} /* recrad_ */
/* $Procedure ET2LST ( ET to Local Solar Time ) */
/* Subroutine */ int et2lst_(doublereal *et, integer *body, doublereal *
long__, char *type__, integer *hr, integer *mn, integer *sc, char *
time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len)
{
/* System generated locals */
address a__1[5], a__2[7];
integer i__1[5], i__2[7];
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
/* Local variables */
doublereal rate, slat, mins;
char h__[2], m[2];
integer n;
doublereal q;
char s[2];
doublereal angle;
char frame[32];
doublereal range;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), dpfmt_(
doublereal *, char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal state[6], slong;
extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
, integer *, doublereal *, doublereal *, ftnlen, ftnlen);
doublereal hours;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
extern doublereal twopi_(void);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
extern doublereal pi_(void);
char bodnam[36];
doublereal lt;
integer frcode;
extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical
*, ftnlen);
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *), rmaind_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal secnds;
extern /* Subroutine */ int pgrrec_(char *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, ftnlen);
char bpmkwd[32];
integer hrampm;
doublereal tmpang;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char amorpm[4];
doublereal tmpsec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
doublereal mylong, spoint[3];
extern logical return_(void);
char kwtype[1];
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
char mytype[32];
doublereal lat;
/* $ Abstract */
/* Given an ephemeris epoch ET, compute the local solar time for */
/* an object on the surface of a body at a specified longitude. */
/* $ 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 */
/* TIME */
/* $ Keywords */
/* TIME */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ET I Epoch in seconds past J2000 epoch */
/* BODY I ID-code of the body of interest */
/* LONG I Longitude of surface point (RADIANS) */
/* TYPE I Type of longitude 'PLANETOCENTRIC', etc. */
/* HR O Local hour on a "24 hour" clock */
/* MN O Minutes past the hour */
/* SC O Seconds past the minute */
/* TIME O String giving local time on 24 hour clock */
/* AMPM O String giving time on A.M./ P.M. scale */
/* $ Detailed_Input */
/* ET is the epoch expressed in TDB seconds past */
/* the J2000 epoch at which a local time is desired. */
/* BODY is the NAIF ID-code of a body on which local */
/* time is to be measured. */
/* LONG is the longitude (either planetocentric or */
/* planetographic) in radians of the site on the */
/* surface of body for which local time should be */
/* computed. */
/* TYPE is the form of longitude supplied by the variable */
/* LONG. Allowed values are 'PLANETOCENTRIC' and */
/* 'PLANETOGRAPHIC'. Note the case of the letters */
/* in TYPE is insignificant. Both 'PLANETOCENTRIC' */
/* and 'planetocentric' are recognized. */
/* $ Detailed_Output */
/* HR is the local "hour" of the site specified at the */
/* epoch ET. Note that an "hour" of local time does not */
/* have the same duration as an hour measured by */
/* conventional clocks. It is simply a representation */
/* of an angle. See the "Particulars" section for a more */
/* complete discussion of the meaning of local time. */
/* MN is the number of "minutes" past the hour of the */
/* local time of the site at the epoch ET. Again note */
/* that a "local minute" is not the same as a minute */
/* you would measure with conventional clocks. */
/* SC is the number of "seconds" past the minute of the */
/* local time of the site at the epoch ET. Again note */
/* that a "local second" is not the same as a second */
/* you would measure with conventional clocks. */
/* TIME is a string expressing the local time */
/* on a "24 hour" local clock. */
/* AMPM is a string expressing the local time on a "12 hour" */
/* local clock together with the traditional AM/PM */
/* label to indicate whether the sun has crossed */
/* the local zenith meridian. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) This routine defines local solar time for any point on the */
/* surface of the Sun to be 12:00:00 noon. */
/* 2) If the TYPE of the coordinates is not recognized, the */
/* error 'SPICE(UNKNOWNSYSTEM)' will be signaled. */
/* 3) If the body-fixed frame to associate with BODY cannot be */
/* determined, the error 'SPICE(CANTFINDFRAME)' is signaled. */
/* 4) If insufficient data is available to compute the */
/* location of the sun in body-fixed coordinates, the */
/* error will be diagnosed by a routine called by this one. */
/* 5) If the BODY#_PM keyword required to determine the body */
/* rotation sense is not found in the POOL or if it is found but */
/* is not a numeric keyword with at least two elements, the error */
/* 'SPICE(CANTGETROTATIONTYPE)' is signaled. */
/* $ Files */
/* Suitable SPK and PCK files must be loaded prior to calling this */
/* routine so that the body-fixed position of the sun relative to */
/* BODY can be computed. The PCK files must contain the standard */
/* BODY#_PM keyword need by this routine to determine the body */
/* rotation sense. */
/* When the input longitude is planetographic, the default */
/* interpretation of this value can be overridden using the optional */
/* kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* which is normally defined via loading a text kernel. */
/* $ Particulars */
/* This routine returns the local solar time at a user */
/* specified location on a user specified body. */
/* Let SUNLNG be the planetocentric longitude (in degrees) of */
/* the sun as viewed from the center of the body of interest. */
/* Let SITLNG be the planetocentric longitude (in degrees) of */
/* the site for which local time is desired. */
/* We define local time to be 12 + (SITLNG - SUNLNG)/15 */
/* (where appropriate care is taken to map ( SITLNG - SUNLNG ) */
/* into the range from -180 to 180). */
/* Using this definition, we see that from the point of view */
/* of this routine, local solar time is simply a measure of angles */
/* between meridians on the surface of a body. Consequently, */
/* this routine is not appropriate for computing "local times" */
/* in the sense of Pacific Standard Time. For computing times */
/* relative to standard time zones on earth, see the routines */
/* TIMOUT and STR2ET. */
/* Regarding planetographic longitude */
/* ---------------------------------- */
/* In the planetographic coordinate system, longitude is defined */
/* using the spin sense of the body. Longitude is positive to the */
/* west if the spin is prograde and positive to the east if the spin */
/* is retrograde. The spin sense is given by the sign of the first */
/* degree term of the time-dependent polynomial for the body's prime */
/* meridian Euler angle "W": the spin is retrograde if this term is */
/* negative and prograde otherwise. For the sun, planets, most */
/* natural satellites, and selected asteroids, the polynomial */
/* expression for W may be found in a SPICE PCK kernel. */
/* The earth, moon, and sun are exceptions: planetographic longitude */
/* is measured positive east for these bodies. */
/* If you wish to override the default sense of positive */
/* planetographic longitude for a particular body, you can do so by */
/* defining the kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* where <body ID> represents the NAIF ID code of the body. This */
/* variable may be assigned either of the values */
/* 'WEST' */
/* 'EAST' */
/* For example, you can have this routine treat the longitude */
/* of the earth as increasing to the west using the kernel */
/* variable assignment */
/* BODY399_PGR_POSITIVE_LON = 'WEST' */
/* Normally such assignments are made by placing them in a text */
/* kernel and loading that kernel via FURNSH. */
/* $ Examples */
/* The following code fragment illustrates how you */
/* could print the local time at a site on Mars with */
/* planetographic longitude 326.17 deg E at epoch ET. */
/* (This example assumes all required SPK and PCK files have */
/* been loaded). */
/* Convert the longitude to radians, set the type of the longitude */
/* and make up a mnemonic for Mars' ID-code. */
/* LONG = 326.17 * RPD() */
/* TYPE = 'PLANETOGRAPHIC' */
/* MARS = 499 */
/* CALL ET2LST ( ET, MARS, LONG, TYPE, HR, MN, SC, TIME, AMPM ) */
/* WRITE (*,*) 'The local time at Mars 326.17 degrees E ' */
/* WRITE (*,*) 'planetographic longitude is: ', AMPM */
/* $ Restrictions */
/* This routine relies on being able to determine the name */
/* of the body-fixed frame associated with BODY through the */
/* frames subsystem. If the BODY specified is NOT one of the */
/* nine planets or their satellites, you will need to load */
/* an appropriate frame definition kernel that contains */
/* the relationship between the body id and the body-fixed frame */
/* name. See the FRAMES required reading for more details */
/* on specifying this relationship. */
/* The routine determines the body rotation sense using the PCK */
/* keyword BODY#_PM. Therefore, you will need to a text PCK file */
/* defining the complete set of the standard PCK body rotation */
/* keywords for the body of interest. The text PCK file must be */
/* loaded independently of whether a binary PCK file providing */
/* rotation data for the same body is loaded or not. */
/* Although it is not currently the case for any of the Solar System */
/* bodies, it is possible that the retrograde rotation rate of a */
/* body would be slower than the orbital rate of the body rotation */
/* around the Sun. The routine does not account for such cases; for */
/* them it will compute incorrect the local time progressing */
/* backwards. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.2, 18-APR-2014 (BVS) */
/* Minor edits to long error messages. */
/* - SPICELIB Version 3.0.1, 09-SEP-2009 (EDW) */
/* Header edits: deleted a spurious C$ marker from the */
/* "Detailed_Output" section. The existence of the marker */
/* caused a failure in the HTML documentation creation script. */
/* Deleted the "Revisions" section as it contained several */
/* identical entries from the "Version" section. */
/* Corrected order of header sections. */
/* - SPICELIB Version 3.0.0, 28-OCT-2006 (BVS) */
/* Bug fix: incorrect computation of the local time for the */
/* bodies with the retrograde rotation causing the local time to */
/* flow backwards has been fixed. The local time for all types of */
/* bodies now progresses as expected -- midnight, increasing AM */
/* hours, noon, increasing PM hours, next midnight, and so on. */
/* - SPICELIB Version 2.0.0, 03-NOV-2005 (NJB) */
/* Bug fix: treatment of planetographic longitude has been */
/* updated to be consistent with the SPICE planetographic/ */
/* rectangular coordinate conversion routines. The effect of */
/* this change is that the default sense of positive longitude */
/* for the moon is now east; also, the default sense of positive */
/* planetographic longitude now may be overridden for any body */
/* (see Particulars above). */
/* Updated to remove non-standard use of duplicate arguments */
/* in RMAIND calls. */
/* - SPICELIB Version 1.1.0, 24-MAR-1998 (WLT) */
/* The integer variable SUN was never initialized in the */
/* previous version of the routine. Now it is set to */
/* the proper value of 10. */
/* - SPICELIB Version 1.0.0, 9-JUL-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Compute the local time for a point on a body. */
/* -& */
/* SPICELIB Functions */
/* Local parameters */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ET2LST", (ftnlen)6);
ljust_(type__, mytype, type_len, (ftnlen)32);
ucase_(mytype, mytype, (ftnlen)32, (ftnlen)32);
if (s_cmp(mytype, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) {
/* Find planetocentric longitude corresponding to the input */
/* longitude. We first represent in rectangular coordinates */
/* a surface point having zero latitude, zero altitude, and */
/* the input planetographic longitude. We then find the */
/* planetocentric longitude of this point. */
/* Since PGRREC accepts a body name, map the input code to */
/* a name, if possible. Otherwise, just convert the input code */
/* to a string. */
bodc2n_(body, bodnam, &found, (ftnlen)36);
if (! found) {
intstr_(body, bodnam, (ftnlen)36);
}
/* Convert planetographic coordinates to rectangular coordinates. */
/* All we care about here is longitude. Set the other inputs */
/* as follows: */
/* Latitude = 0 */
/* Altitude = 0 */
/* Equatorial radius = 1 */
/* Flattening factor = 0 */
pgrrec_(bodnam, long__, &c_b4, &c_b4, &c_b6, &c_b4, spoint, (ftnlen)
36);
/* The output MYLONG is planetocentric longitude. The other */
/* outputs are not used. Note that the variable RANGE appears */
/* later in another RECLAT call; it's not used after that. */
reclat_(spoint, &range, &mylong, &lat);
} else if (s_cmp(mytype, "PLANETOCENTRIC", (ftnlen)32, (ftnlen)14) == 0) {
mylong = *long__;
} else {
setmsg_("The coordinate system '#' is not a recognized system of lon"
"gitude. The recognized systems are 'PLANETOCENTRIC' and 'PL"
"ANETOGRAPHIC'. ", (ftnlen)134);
errch_("#", type__, (ftnlen)1, type_len);
sigerr_("SPICE(UNKNOWNSYSTEM)", (ftnlen)20);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
/* It's always noon on the surface of the sun. */
if (*body == 10) {
*hr = 12;
*mn = 0;
*sc = 0;
s_copy(time, "12:00:00", time_len, (ftnlen)8);
s_copy(ampm, "12:00:00 P.M.", ampm_len, (ftnlen)13);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
/* Get the body-fixed position of the sun. */
cidfrm_(body, &frcode, frame, &found, (ftnlen)32);
if (! found) {
setmsg_("The body-fixed frame associated with body # could not be de"
"termined. This information needs to be \"loaded\" via a fra"
"mes definition kernel. See frames.req for more details. ", (
ftnlen)174);
errint_("#", body, (ftnlen)1);
sigerr_("SPICE(CANTFINDFRAME)", (ftnlen)20);
chkout_("ET2LST", (ftnlen)6);
return 0;
}
spkez_(&c__10, et, frame, "LT+S", body, state, <, (ftnlen)32, (ftnlen)4)
;
reclat_(state, &range, &slong, &slat);
angle = mylong - slong;
/* Force the angle into the region from -PI to PI */
d__1 = twopi_();
rmaind_(&angle, &d__1, &q, &tmpang);
angle = tmpang;
if (angle > pi_()) {
angle -= twopi_();
}
/* Get the rotation sense of the body and invert the angle if the */
/* rotation sense is retrograde. Use the BODY#_PM PCK keyword to */
/* determine the sense of the body rotation. */
s_copy(bpmkwd, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(bpmkwd, "#", body, bpmkwd, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(bpmkwd, &found, &n, kwtype, (ftnlen)32, (ftnlen)1);
if (! found || *(unsigned char *)kwtype != 'N' || n < 2) {
setmsg_("The rotation type for the body # could not be determined be"
"cause the # keyword was either not found in the POOL or or i"
"t was not of the expected type and/or dimension. This keywor"
"d is usually provided via a planetary constants kernel. See "
"pck.req for more details. ", (ftnlen)265);
errint_("#", body, (ftnlen)1);
errch_("#", bpmkwd, (ftnlen)1, (ftnlen)32);
sigerr_("SPICE(CANTGETROTATIONTYPE)", (ftnlen)26);
chkout_("ET2LST", (ftnlen)6);
return 0;
} else {
/* If the rotation rate is negative, invert the angle. */
gdpool_(bpmkwd, &c__2, &c__1, &n, &rate, &found, (ftnlen)32);
if (rate < 0.) {
angle = -angle;
}
}
/* Convert the angle to "angle seconds" before or after local noon. */
secnds = angle * 86400. / twopi_();
secnds = brcktd_(&secnds, &c_b32, &c_b33);
/* Get the hour, and minutes components of the local time. */
rmaind_(&secnds, &c_b34, &hours, &tmpsec);
rmaind_(&tmpsec, &c_b35, &mins, &secnds);
/* Construct the integer components of the local time. */
*hr = (integer) hours + 12;
*mn = (integer) mins;
*sc = (integer) secnds;
/* Set the A.M./P.M. components of local time. */
if (*hr == 24) {
*hr = 0;
hrampm = 12;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr > 12) {
hrampm = *hr - 12;
s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr == 12) {
hrampm = 12;
s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
} else if (*hr == 0) {
hrampm = 12;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
} else {
hrampm = *hr;
s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
}
/* Now construct the two strings we need. */
hours = (doublereal) (*hr);
mins = (doublereal) (*mn);
secnds = (doublereal) (*sc);
dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
dpfmt_(&mins, "0x", m, (ftnlen)2, (ftnlen)2);
dpfmt_(&secnds, "0x", s, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
i__1[0] = 2, a__1[0] = h__;
i__1[1] = 1, a__1[1] = ":";
i__1[2] = 2, a__1[2] = m;
i__1[3] = 1, a__1[3] = ":";
i__1[4] = 2, a__1[4] = s;
s_cat(time, a__1, i__1, &c__5, time_len);
hours = (doublereal) hrampm;
dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
i__2[0] = 2, a__2[0] = h__;
i__2[1] = 1, a__2[1] = ":";
i__2[2] = 2, a__2[2] = m;
i__2[3] = 1, a__2[3] = ":";
i__2[4] = 2, a__2[4] = s;
i__2[5] = 1, a__2[5] = " ";
i__2[6] = 4, a__2[6] = amorpm;
s_cat(ampm, a__2, i__2, &c__7, ampm_len);
chkout_("ET2LST", (ftnlen)6);
return 0;
} /* et2lst_ */
/* $Procedure ZZEDTERM ( Ellipsoid terminator ) */
/* Subroutine */ int zzedterm_(char *type__, doublereal *a, doublereal *b,
doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer *
npts, doublereal *trmpts, ftnlen type_len)
{
/* System generated locals */
integer trmpts_dim2, i__1, i__2;
doublereal d__1, d__2, d__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
double asin(doublereal);
integer s_rnge(char *, integer, char *, integer);
double d_sign(doublereal *, doublereal *);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal rmin, rmax;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
integer nitr;
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *);
doublereal d__, e[3];
integer i__;
doublereal s, angle, v[3], x[3], delta, y[3], z__[3], inang;
extern /* Subroutine */ int chkin_(char *, ftnlen), frame_(doublereal *,
doublereal *, doublereal *);
doublereal plane[4];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
errch_(char *, char *, ftnlen, ftnlen), vpack_(doublereal *,
doublereal *, doublereal *, doublereal *);
doublereal theta;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal trans[9] /* was [3][3] */, srcpt[3], vtemp[3];
extern doublereal vnorm_(doublereal *), twopi_(void);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
pl2nvc_(doublereal *, doublereal *, doublereal *);
doublereal lambda;
extern /* Subroutine */ int nvp2pl_(doublereal *, doublereal *,
doublereal *);
extern doublereal halfpi_(void);
doublereal minang, minrad, maxang, maxrad;
extern /* Subroutine */ int latrec_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal angerr;
logical umbral;
extern doublereal touchd_(doublereal *);
doublereal offset[3], prvdif;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
doublereal outang, plcons, prvang;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
char loctyp[50];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
doublereal dir[3];
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
doublereal vtx[3];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Compute a set of points on the umbral or penumbral terminator of */
/* a specified ellipsoid, given a spherical light source. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* ELLIPSES */
/* $ Keywords */
/* BODY */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TYPE I Terminator type. */
/* A I Length of ellipsoid semi-axis lying on the x-axis. */
/* B I Length of ellipsoid semi-axis lying on the y-axis. */
/* C I Length of ellipsoid semi-axis lying on the z-axis. */
/* SRCRAD I Radius of light source. */
/* SRCPOS I Position of center of light source. */
/* NPTS I Number of points in terminator point set. */
/* TRMPTS O Terminator point set. */
/* $ Detailed_Input */
/* TYPE is a string indicating the type of terminator to */
/* compute: umbral or penumbral. The umbral */
/* terminator is the boundary of the portion of the */
/* ellipsoid surface in total shadow. The penumbral */
/* terminator is the boundary of the portion of the */
/* surface that is completely illuminated. Possible */
/* values of TYPE are */
/* 'UMBRAL' */
/* 'PENUMBRAL' */
/* Case and leading or trailing blanks in TYPE are */
/* not significant. */
/* A, */
/* B, */
/* C are the lengths of the semi-axes of a triaxial */
/* ellipsoid. The ellipsoid is centered at the */
/* origin and oriented so that its axes lie on the */
/* x, y and z axes. A, B, and C are the lengths of */
/* the semi-axes that point in the x, y, and z */
/* directions respectively. */
/* Length units associated with A, B, and C must */
/* match those associated with SRCRAD, SRCPOS, */
/* and the output TRMPTS. */
/* SRCRAD is the radius of the spherical light source. */
/* SRCPOS is the position of the center of the light source */
/* relative to the center of the ellipsoid. */
/* NPTS is the number of terminator points to compute. */
/* $ Detailed_Output */
/* TRMPTS is an array of points on the umbral or penumbral */
/* terminator of the ellipsoid, as specified by the */
/* input argument TYPE. The Ith point is contained */
/* in the array elements */
/* TRMPTS(J,I), J = 1, 2, 3 */
/* The terminator points are expressed in the */
/* body-fixed reference frame associated with the */
/* ellipsoid. Units are those associated with */
/* the input axis lengths. */
/* Each terminator point is the point of tangency of */
/* a plane that is also tangent to the light source. */
/* These associated points of tangency on the light */
/* source have uniform distribution in longitude when */
/* expressed in a cylindrical coordinate system whose */
/* Z-axis is SRCPOS. The magnitude of the separation */
/* in longitude between these tangency points on the */
/* light source is */
/* 2*Pi / NPTS */
/* If the target is spherical, the terminator points */
/* also are uniformly distributed in longitude in the */
/* cylindrical system described above. If the target */
/* is non-spherical, the longitude distribution of */
/* the points generally is not uniform. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the terminator type is not recognized, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 2) If the set size NPTS is not at least 1, the error */
/* SPICE(INVALIDSIZE) is signaled. */
/* 3) If any of the ellipsoid's semi-axis lengths is non-positive, */
/* the error SPICE(INVALIDAXISLENGTH) is signaled. */
/* 4) If the light source has non-positive radius, the error */
/* SPICE(INVALIDRADIUS) is signaled. */
/* 5) If the light source intersects the smallest sphere */
/* centered at the origin and containing the ellipsoid, the */
/* error SPICE(OBJECTSTOOCLOSE) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine models the boundaries of shadow regions on an */
/* ellipsoid "illuminated" by a spherical light source. Light rays */
/* are assumed to travel along straight lines; refraction is not */
/* modeled. */
/* Points on the ellipsoid at which the entire cap of the light */
/* source is visible are considered to be completely illuminated. */
/* Points on the ellipsoid at which some portion (or all) of the cap */
/* of the light source are blocked are considered to be in partial */
/* (or total) shadow. */
/* In this routine, we use the term "umbral terminator" to denote */
/* the curve ususally called the "terminator": this curve is the */
/* boundary of the portion of the surface that lies in total shadow. */
/* We use the term "penumbral terminator" to denote the boundary of */
/* the completely illuminated portion of the surface. */
/* In general, the terminator on an ellipsoid is a more complicated */
/* curve than the limb (which is always an ellipse). Aside from */
/* various special cases, the terminator does not lie in a plane. */
/* However, the condition for a point X on the ellipsoid to lie on */
/* the terminator is simple: a plane tangent to the ellipsoid at X */
/* must also be tangent to the light source. If this tangent plane */
/* does not intersect the vector from the center of the ellipsoid to */
/* the center of the light source, then X lies on the umbral */
/* terminator; otherwise X lies on the penumbral terminator. */
/* $ Examples */
/* See the SPICELIB routine EDTERM. */
/* $ Restrictions */
/* This is a private SPICELIB routine. User applications should not */
/* call this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-FEB-2007 (NJB) */
/* -& */
/* $ Index_Entries */
/* find terminator on ellipsoid */
/* find umbral terminator on ellipsoid */
/* find penumbral terminator on ellipsoid */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICELIB error handling. */
/* Parameter adjustments */
trmpts_dim2 = *npts;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZEDTERM", (ftnlen)8);
/* Check the terminator type. */
ljust_(type__, loctyp, type_len, (ftnlen)50);
ucase_(loctyp, loctyp, (ftnlen)50, (ftnlen)50);
if (s_cmp(loctyp, "UMBRAL", (ftnlen)50, (ftnlen)6) == 0) {
umbral = TRUE_;
} else if (s_cmp(loctyp, "PENUMBRAL", (ftnlen)50, (ftnlen)9) == 0) {
umbral = FALSE_;
} else {
setmsg_("Terminator type must be UMBRAL or PENUMBRAL but was actuall"
"y #.", (ftnlen)63);
errch_("#", type__, (ftnlen)1, type_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Check the terminator set dimension. */
if (*npts < 1) {
setmsg_("Set must contain at least one point; NPTS = #.", (ftnlen)47)
;
errint_("#", npts, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* The ellipsoid semi-axes must have positive length. */
if (*a <= 0. || *b <= 0. || *c__ <= 0.) {
setmsg_("Semi-axis lengths: A = #, B = #, C = #. ", (ftnlen)41);
errdp_("#", a, (ftnlen)1);
errdp_("#", b, (ftnlen)1);
errdp_("#", c__, (ftnlen)1);
sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Check the input light source radius. */
if (*srcrad <= 0.) {
setmsg_("Light source must have positive radius; actual radius was #."
, (ftnlen)60);
errdp_("#", srcrad, (ftnlen)1);
sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* The light source must not intersect the outer bounding */
/* sphere of the ellipsoid. */
d__ = vnorm_(srcpos);
/* Computing MAX */
d__1 = max(*a,*b);
rmax = max(d__1,*c__);
/* Computing MIN */
d__1 = min(*a,*b);
rmin = min(d__1,*c__);
if (*srcrad + rmax >= d__) {
/* The light source is too close. */
setmsg_("Light source intersects outer bounding sphere of the ellips"
"oid. Light source radius = #; ellipsoid's longest axis = #;"
" sum = #; distance between centers = #.", (ftnlen)158);
errdp_("#", srcrad, (ftnlen)1);
errdp_("#", &rmax, (ftnlen)1);
d__1 = *srcrad + rmax;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &d__, (ftnlen)1);
sigerr_("SPICE(OBJECTSTOOCLOSE)", (ftnlen)22);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Find bounds on the angular size of the target as seen */
/* from the source. */
/* Computing MIN */
d__1 = rmax / d__;
minang = asin((min(d__1,1.)));
/* Computing MIN */
d__1 = rmin / d__;
maxang = asin((min(d__1,1.)));
/* Let the inverse of the ellipsoid-light source vector be the */
/* Z-axis of a frame we'll use to generate the terminator set. */
vminus_(srcpos, z__);
frame_(z__, x, y);
/* Create the rotation matrix required to convert vectors */
/* from the source-centered frame back to the target body-fixed */
/* frame. */
vequ_(x, trans);
vequ_(y, &trans[3]);
vequ_(z__, &trans[6]);
/* Find the maximum and minimum target radii. */
/* Computing MAX */
d__1 = max(*a,*b);
maxrad = max(d__1,*c__);
/* Computing MIN */
d__1 = min(*a,*b);
minrad = min(d__1,*c__);
if (umbral) {
/* Compute the angular offsets from the axis of rays tangent to */
/* both the source and the bounding spheres of the target, where */
/* the tangency points lie in a half-plane bounded by the line */
/* containing the origin and SRCPOS. (We'll call this line */
/* the "axis.") */
/* OUTANG corresponds to the target's outer bounding sphere; */
/* INANG to the inner bounding sphere. */
outang = asin((*srcrad - maxrad) / d__);
inang = asin((*srcrad - minrad) / d__);
} else {
/* Compute the angular offsets from the axis of rays tangent to */
/* both the source and the bounding spheres of the target, where */
/* the tangency points lie in opposite half-planes bounded by the */
/* axis (compare the case above). */
/* OUTANG corresponds to the target's outer bounding sphere; */
/* INANG to the inner bounding sphere. */
outang = asin((*srcrad + maxrad) / d__);
inang = asin((*srcrad + minrad) / d__);
}
/* Compute the angular delta we'll use for generating */
/* terminator points. */
delta = twopi_() / *npts;
/* Generate the terminator points. */
i__1 = *npts;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (i__ - 1) * delta;
/* Let SRCPT be the surface point on the source lying in */
/* the X-Y plane of the frame produced by FRAME */
/* and corresponding to the angle THETA. */
latrec_(srcrad, &theta, &c_b30, srcpt);
/* Now solve for the angle by which SRCPT must be rotated (toward */
/* +Z in the umbral case, away from +Z in the penumbral case) */
/* so that a plane tangent to the source at SRCPT is also tangent */
/* to the target. The rotation is bracketed by OUTANG on the low */
/* side and INANG on the high side in the umbral case; the */
/* bracketing values are reversed in the penumbral case. */
if (umbral) {
angle = outang;
} else {
angle = inang;
}
prvdif = twopi_();
prvang = angle + halfpi_();
nitr = 0;
for(;;) { /* while(complicated condition) */
d__2 = (d__1 = angle - prvang, abs(d__1));
if (!(nitr <= 10 && touchd_(&d__2) < prvdif))
break;
++nitr;
d__2 = (d__1 = angle - prvang, abs(d__1));
prvdif = touchd_(&d__2);
prvang = angle;
/* Find the closest point on the ellipsoid to the plane */
/* corresponding to "ANGLE". */
/* The tangent point on the source is obtained by rotating */
/* SRCPT by ANGLE towards +Z. The plane's normal vector is */
/* parallel to VTX in the source-centered frame. */
latrec_(srcrad, &theta, &angle, vtx);
vequ_(vtx, dir);
/* VTX and DIR are expressed in the source-centered frame. We */
/* must translate VTX to the target frame and rotate both */
/* vectors into that frame. */
mxv_(trans, vtx, vtemp);
vadd_(srcpos, vtemp, vtx);
mxv_(trans, dir, vtemp);
vequ_(vtemp, dir);
/* Create the plane defined by VTX and DIR. */
nvp2pl_(dir, vtx, plane);
/* Find the closest point on the ellipsoid to the plane. At */
/* the point we seek, the outward normal on the ellipsoid is */
/* parallel to the choice of plane normal that points away */
/* from the origin. We can always obtain this choice from */
/* PL2NVC. */
pl2nvc_(plane, dir, &plcons);
/* At the point */
/* E = (x, y, z) */
/* on the ellipsoid's surface, an outward normal */
/* is */
/* N = ( x/A**2, y/B**2, z/C**2 ) */
/* which is also */
/* lambda * ( DIR(1), DIR(2), DIR(3) ) */
/* Equating components in the normal vectors yields */
/* E = lambda * ( DIR(1)*A**2, DIR(2)*B**2, DIR(3)*C**2 ) */
/* Taking the inner product with the point E itself and */
/* applying the ellipsoid equation, we find */
/* lambda * <DIR, E> = < N, E > = 1 */
/* The first term above is */
/* lambda**2 * || ( A*DIR(1), B*DIR(2), C*DIR(3) ) ||**2 */
/* So the positive root lambda is */
/* 1 / || ( A*DIR(1), B*DIR(2), C*DIR(3) ) || */
/* Having lambda we can compute E. */
d__1 = *a * dir[0];
d__2 = *b * dir[1];
d__3 = *c__ * dir[2];
vpack_(&d__1, &d__2, &d__3, v);
lambda = 1. / vnorm_(v);
d__1 = *a * v[0];
d__2 = *b * v[1];
d__3 = *c__ * v[2];
vpack_(&d__1, &d__2, &d__3, e);
vscl_(&lambda, e, &trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3
&& 0 <= i__2 ? i__2 : s_rnge("trmpts", i__2, "zzedterm_",
(ftnlen)586)]);
/* Make a new estimate of the plane rotation required to touch */
/* the target. */
vsub_(&trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 && 0 <= i__2
? i__2 : s_rnge("trmpts", i__2, "zzedterm_", (ftnlen)592)]
, vtx, offset);
/* Let ANGERR be an estimate of the magnitude of angular error */
/* between the plane and the terminator. */
angerr = vsep_(dir, offset) - halfpi_();
/* Let S indicate the sign of the altitude error: where */
/* S is positive, the plane is above E. */
d__1 = vdot_(e, dir);
s = d_sign(&c_b35, &d__1);
if (umbral) {
/* If the plane is above the target, increase the */
/* rotation angle; otherwise decrease the angle. */
angle += s * angerr;
} else {
/* This is the penumbral case; decreasing the angle */
/* "lowers" the plane toward the target. */
angle -= s * angerr;
}
}
}
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
} /* zzedterm_ */
/* $Procedure CONICS ( Determine state from conic elements ) */
/* Subroutine */ int conics_(doublereal *elts, doublereal *et, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal), sqrt(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal cnci, argp, snci, cosi, sini, cosn, sinn;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
doublereal cosw, sinw, n, v;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal lnode;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal m0;
extern doublereal twopi_(void);
doublereal t0;
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal dt, rp, mu, basisp[3], period, basisq[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal pstate[6], ainvrs;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
extern logical return_(void);
doublereal ecc, inc;
/* $ Abstract */
/* Determine the state (position, velocity) of an orbiting body */
/* from a set of elliptic, hyperbolic, or parabolic orbital */
/* elements. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CONIC */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ELTS I Conic elements. */
/* ET I Input time. */
/* STATE O State of orbiting body at ET. */
/* $ Detailed_Input */
/* ELTS are conic elements describing the orbit of a body */
/* around a primary. The elements are, in order: */
/* RP Perifocal distance. */
/* ECC Eccentricity. */
/* INC Inclination. */
/* LNODE Longitude of the ascending node. */
/* ARGP Argument of periapse. */
/* M0 Mean anomaly at epoch. */
/* T0 Epoch. */
/* MU Gravitational parameter. */
/* Units are km, rad, rad/sec, km**3/sec**2. The epoch */
/* is given in ephemeris seconds past J2000. The same */
/* elements are used to describe all three types */
/* (elliptic, hyperbolic, and parabolic) of conic orbit. */
/* ET is the time at which the state of the orbiting body */
/* is to be determined, in ephemeris seconds J2000. */
/* $ Detailed_Output */
/* STATE is the state (position and velocity) of the body at */
/* time ET. Components are x, y, z, dx/dt, dy/dt, dz/dt. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity supplied is less than 0, the error */
/* 'SPICE(BADECCENTRICITY)' is signalled. */
/* 2) If a non-positive periapse distance is supplied, the error */
/* 'SPICE(BADPERIAPSEVALUE)' is signalled. */
/* 3) If a non-positive value for the attracting mass is supplied, */
/* the error 'SPICE(BADGM)', is signalled. */
/* 4) Errors such as an out of bounds value for ET are diagnosed */
/* by routines called by this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* Let VINIT contain the initial state of a spacecraft relative to */
/* the center of a planet at epoch ET, and let GM be the gravitation */
/* parameter of the planet. The call */
/* CALL OSCELT ( VINIT, ET, GM, ELTS ) */
/* produces a set of osculating elements describing the nominal */
/* orbit that the spacecraft would follow in the absence of all */
/* other bodies in the solar system and non-gravitational forces */
/* on the spacecraft. */
/* Now let STATE contain the state of the same spacecraft at some */
/* other epoch, LATER. The difference between this state and the */
/* state predicted by the nominal orbit at the same epoch can be */
/* computed as follows. */
/* CALL CONICS ( ELTS, LATER, NOMINAL ) */
/* CALL VSUBG ( NOMINAL, STATE, 6, DIFF ) */
/* WRITE (*,*) 'Perturbation in x, dx/dt = ', DIFF(1), DIFF(4) */
/* WRITE (*,*) ' y, dy/dt = ', DIFF(2), DIFF(5) */
/* WRITE (*,*) ' z, dz/dt = ', DIFF(3), DIFF(6) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.0, 26-MAR-1998 (WLT) */
/* There was a coding error in the computation of the mean */
/* anomaly in the parabolic case. This problem has been */
/* corrected. */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* An error in the hyperbolic state generation was corrected. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* state from conic elements */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* These changes were prompted by the discovery that the old */
/* formulation had a severe bug for elliptic orbits and epochs */
/* prior to the epoch of the input elements, and by the discovery */
/* that the time of flight routines had problems with convergence. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* The original version of the routine had a bug in that */
/* it attempted to restrict the hyperbolic anomaly to */
/* the interval 0 to 2*PI. This has been fixed. */
/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */
/* Examples section completed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* The only real work required by this routine is the construction */
/* of a preliminary state vector from the input elements. Once this */
/* is in hand, we can simply let the routine PROP2B do the real */
/* work, free from the instabilities inherent in the classical */
/* elements formulation of two-body motion. */
/* To do this we shall construct a basis of vectors that lie in the */
/* plane of the orbit. The first vector P shall point towards the */
/* position of the orbiting body at periapse. The second */
/* vector Q shall point along the velocity vector of the body at */
/* periapse. */
/* The only other consideration is determining an epoch, TP, of */
/* this state and the delta time ET - TP. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CONICS", (ftnlen)6);
}
/* Unpack the element vector. */
rp = elts[0];
ecc = elts[1];
inc = elts[2];
lnode = elts[3];
argp = elts[4];
m0 = elts[5];
t0 = elts[6];
mu = elts[7];
/* Handle all of the exceptions first. */
if (ecc < 0.) {
setmsg_("The eccentricity supplied was negative. Only positive value"
"s are meaningful. The value was #", (ftnlen)93);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (rp <= 0.) {
setmsg_("The value of periapse range supplied was non-positive. Onl"
"y positive values are allowed. The value supplied was #. ", (
ftnlen)117);
errdp_("#", &rp, (ftnlen)1);
sigerr_("SPICE(BADPERIAPSEVALUE)", (ftnlen)23);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (mu <= 0.) {
setmsg_("The value of GM supplied was non-positive. Only positive v"
"alues are allowed. The value supplied was #. ", (ftnlen)105);
errdp_("#", &mu, (ftnlen)1);
sigerr_("SPICE(BADGM)", (ftnlen)12);
chkout_("CONICS", (ftnlen)6);
return 0;
}
/* First construct the orthonormal basis vectors that span the orbit */
/* plane. */
cosi = cos(inc);
sini = sin(inc);
cosn = cos(lnode);
sinn = sin(lnode);
cosw = cos(argp);
sinw = sin(argp);
snci = sinn * cosi;
cnci = cosn * cosi;
basisp[0] = cosn * cosw - snci * sinw;
basisp[1] = sinn * cosw + cnci * sinw;
basisp[2] = sini * sinw;
basisq[0] = -cosn * sinw - snci * cosw;
basisq[1] = -sinn * sinw + cnci * cosw;
basisq[2] = sini * cosw;
/* Next construct the state at periapse. */
/* The position at periapse is just BASISP scaled by the distance */
/* at periapse. */
/* The velocity must be constructed so that we can get an orbit */
/* of this shape. Recall that the magnitude of the specific angular */
/* momentum vector is given by DSQRT ( MU*RP*(1+ECC) ) */
/* The velocity will be given by V * BASISQ. But we must have the */
/* magnitude of the cross product of position and velocity be */
/* equal to DSQRT ( MU*RP*(1+ECC) ). So we must have */
/* RP*V = DSQRT( MU*RP*(1+ECC) ) */
/* so that: */
v = sqrt(mu * (ecc + 1.) / rp);
vscl_(&rp, basisp, pstate);
vscl_(&v, basisq, &pstate[3]);
/* Finally compute DT the elapsed time since the epoch of periapse. */
/* Ellipses first, since they are the most common. */
if (ecc < 1.) {
/* Recall that: */
/* N ( mean motion ) is given by DSQRT( MU / A**3 ). */
/* But since, A = RP / ( 1 - ECC ) ... */
ainvrs = (1. - ecc) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
period = twopi_() / n;
/* In general the mean anomaly is given by */
/* M = (T - TP) * N */
/* Where TP is the time of periapse passage. M0 is the mean */
/* anomaly at time T0 so that */
/* Thus */
/* M0 = ( T0 - TP ) * N */
/* So TP = T0-M0/N hence the time since periapse at time ET */
/* is given by ET - T0 + M0/N. Finally, since elliptic orbits are */
/* periodic, we can mod this value by the period of the orbit. */
d__1 = *et - t0 + m0 / n;
dt = d_mod(&d__1, &period);
/* Hyperbolas next. */
} else if (ecc > 1.) {
/* Again, recall that: */
/* N ( mean motion ) is given by DSQRT( MU / |A**3| ). */
/* But since, |A| = RP / ( ECC - 1 ) ... */
ainvrs = (ecc - 1.) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
dt = *et - t0 + m0 / n;
/* Finally, parabolas. */
} else {
n = sqrt(mu / (rp * 2.)) / rp;
dt = *et - t0 + m0 / n;
}
/* Now let PROP2B do the work of propagating the state. */
prop2b_(&mu, pstate, &dt, state);
chkout_("CONICS", (ftnlen)6);
return 0;
} /* conics_ */
/* $Procedure RECCYL ( Rectangular to cylindrical coordinates ) */
/* Subroutine */ int reccyl_(doublereal *rectan, doublereal *r__, doublereal *
long__, doublereal *z__)
{
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal), atan2(doublereal, doublereal);
/* Local variables */
doublereal x, y;
extern doublereal twopi_(void);
doublereal big;
/* $ Abstract */
/* Convert from rectangular to cylindrical coordinates. */
/* $ 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 */
/* CONVERSION, COORDINATES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ------------------------------------------------- */
/* RECTAN I Rectangular coordinates of a point. */
/* R O Distance of the point from Z axis. */
/* LONG O Angle (radians) of the point from XZ plane */
/* Z O Height of the point above XY plane. */
/* $ Detailed_Input */
/* RECTAN Rectangular coordinates of the point of interest. */
/* $ Detailed_Output */
/* R Distance of the point of interest from Z axis. */
/* LONG Cylindrical angle (in radians) of the point of */
/* interest from XZ plane. */
/* Z Height of the point above XY plane. */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* This routine transforms the coordinates of a point from */
/* rectangular to cylindrical coordinates. */
/* $ Examples */
/* Below are two tables. */
/* Listed in the first table (under X(1), X(2) and X(3) ) are a */
/* number of points whose rectangular coordinates coorindates are */
/* taken from the set {-1, 0, 1}. */
/* The result of the code fragment */
/* CALL RECCYL ( X, R, LONG, Z ) */
/* Use the SPICELIB routine CONVRT to convert the angular */
/* quantities to degrees */
/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */
/* are listed to 4 decimal places in the second parallel table under */
/* R (radius), LONG (longitude), and Z (same as rectangular Z */
/* coordinate). */
/* X(1) X(2) X(3) R LONG Z */
/* -------------------------- ------------------------- */
/* 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 */
/* 1.0000 0.0000 0.0000 1.0000 0.0000 0.0000 */
/* 0.0000 1.0000 0.0000 1.0000 90.0000 0.0000 */
/* 0.0000 0.0000 1.0000 0.0000 0.0000 1.0000 */
/* -1.0000 0.0000 0.0000 1.0000 180.0000 0.0000 */
/* 0.0000 -1.0000 0.0000 1.0000 270.0000 0.0000 */
/* 0.0000 0.0000 -1.0000 0.0000 0.0000 -1.0000 */
/* 1.0000 1.0000 0.0000 1.4142 45.0000 0.0000 */
/* 1.0000 0.0000 1.0000 1.0000 0.0000 1.0000 */
/* 0.0000 1.0000 1.0000 1.0000 90.0000 1.0000 */
/* 1.0000 1.0000 1.0000 1.4142 45.0000 1.0000 */
/* $ Restrictions */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.2, 22-AUG-2001 (EDW) */
/* Corrected ENDIF to END IF. Obsolete Revisions section */
/* deleted. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
/* -& */
/* $ Index_Entries */
/* rectangular to cylindrical coordinates */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Use temporary variables for computing R. */
/* Computing MAX */
d__1 = abs(rectan[0]), d__2 = abs(rectan[1]);
big = max(d__1,d__2);
/* Convert to cylindrical coordinates */
*z__ = rectan[2];
if (big == 0.) {
*r__ = 0.;
*long__ = 0.;
} else {
x = rectan[0] / big;
y = rectan[1] / big;
*r__ = big * sqrt(x * x + y * y);
*long__ = atan2(y, x);
}
if (*long__ < 0.) {
*long__ += twopi_();
}
return 0;
} /* reccyl_ */
/* $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 EQNCPV (Equinoctial Elements to position and velocity) */
/* Subroutine */ int eqncpv_(doublereal *et, doublereal *epoch, doublereal *
eqel, doublereal *rapol, doublereal *decpol, doublereal *state)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), sin(doublereal), cos(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal nfac, node, mldt, temp[3], a, b, h__, k, l, eecan, p, q, r__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal dlpdt, prate;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal xhold[6];
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
doublereal trans[9] /* was [3][3] */;
extern doublereal twopi_(void);
doublereal x1, y1;
extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
doublereal ca, cd, cf, di, cn, ra, sa, rb, sd, dt, sf, ml, dx, dy, vf[3],
vg[3], sn, nodedt;
extern doublereal kepleq_(doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
static doublereal pi2;
doublereal dx1, dy1;
extern logical return_(void);
doublereal ecc, can, dlp, san;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Compute the state (position and velocity of an object whose */
/* trajectory is described via equinoctial elements relative to some */
/* fixed plane (usually the equatorial plane of some planet). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ET I Epoch in seconds past J2000 to find state */
/* EPOCH I Epoch of elements in seconds past J2000 */
/* EQEL I Array of equinoctial elements */
/* RAPOL I Right Ascension of the pole of the reference plane */
/* DECPOL I Declination of the pole of the reference plane */
/* STATE O State of the object described by EQEL. */
/* $ Detailed_Input */
/* ET is the epoch (ephemeris time) at which the state */
/* of the target body is to be computed. ET is measured */
/* in seconds past the J2000 epoch. */
/* EPOCH is the epoch of the equinoctial elements in seconds */
/* past the J2000 epoch. */
/* EQEL is an array of 9 double precision numbers that */
/* are the equinoctial elements for some orbit expressed */
/* relative to the equatorial frame of the central body. */
/* (The z-axis of the equatorial frame is the direction */
/* of the pole of the central body relative to some */
/* inertial frame. The x-axis is given by the cross */
/* product of the Z-axis of the inertial frame */
/* with the direction of the pole of the central body. */
/* The Y-axis completes a right handed frame. */
/* (If the z-axis of the equatorial frame is aligned */
/* with the z-axis of the inertial frame, then the */
/* x-axis of the equatorial frame will be located at */
/* 90 degrees + RAPOL in the inertial frame.) */
/* The specific arrangement of the elements is spelled */
/* out below. The following terms are used in the */
/* discussion of elements of EQEL */
/* INC --- inclination of the orbit */
/* ARGP --- argument of periapse */
/* NODE --- longitude of the ascending node */
/* E --- eccentricity of the orbit */
/* EQEL(1) is the semi-major axis (A) of the orbit in km. */
/* EQEL(2) is the value of H at the specified epoch. */
/* ( E*SIN(ARGP+NODE) ). */
/* EQEL(3) is the value of K at the specified epoch */
/* ( E*COS(ARGP+NODE) ). */
/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */
/* the epoch of the elements measured in radians. */
/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */
/* the specified epoch. */
/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */
/* the specified epoch. */
/* EQEL(7) is the rate of the longitude of periapse */
/* (dARGP/dt + dNODE/dt ) at the epoch of */
/* the elements. This rate is assumed to hold */
/* for all time. The rate is measured in */
/* radians per second. */
/* EQEL(8) is the derivative of the mean longitude */
/* ( dM/dt + dARGP/dt + dNODE/dt ). This */
/* rate is assumed to be constant and is */
/* measured in radians/second. */
/* EQEL(9) is the rate of the longitude of the ascending */
/* node ( dNODE/dt). This rate is measured */
/* in radians per second. */
/* RAPOL Right Ascension of the pole of the reference plane */
/* with respect to some inertial frame (measured in */
/* radians). */
/* DECPOL Declination of the pole of the reference plane */
/* with respect to some inertial frame (measured in */
/* radians). */
/* $ Detailed_Output */
/* STATE State of the object described by EQEL relative to the */
/* inertial frame used to define RAPOL and DECPOL. Units */
/* are in km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity corresponding to the input elements is */
/* greater than 0.9, the error SPICE(ECCOUTOFRANGE) is signalled. */
/* 2) If the semi-major axis of the elements is non-positive, the */
/* error SPICE(BADSEMIAXIS) is signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine evaluates the input equinoctial elements for */
/* the specified epoch and return the corresponding state. */
/* This routine was adapted from a routine provided by */
/* Bob Jacobson of the Planetary Dynamics Group of */
/* the Navigation and Flight Mechanics Section at JPL. */
/* $ Examples */
/* Suppose you have classical elements and rates of */
/* change of the ascending node and argument of periapse */
/* for some satellite of the earth. */
/* By transforming the classical elements */
/* this routine can be used to compute the state of the */
/* object at an arbitrary epoch. The code below illustrates */
/* how you might do this. */
/* The table below illustrates the meanings of the various */
/* variables used in the discussion below. */
/* Variable Meaning */
/* -------- ---------------------------------- */
/* A Semi-major axis in km */
/* ECC Eccentricity of orbit */
/* INC Inclination of orbit */
/* NODE Longitude of the ascending node at epoch */
/* OMEGA Argument of periapse at epoch */
/* M Mean anomaly at epoch */
/* DMDT Mean anomaly rate in radians/second */
/* DNODE Rate of change of longitude of ascending node */
/* in radians/second */
/* DARGP Rate of change of argument of periapse in */
/* radians/second */
/* EPOCH is the epoch of the elements in seconds past */
/* the J2000 epoch. */
/* EQEL(1) = A */
/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */
/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */
/* EQEL(4) = M + OMEGA + NODE */
/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */
/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */
/* EQEL(7) = DARGP */
/* EQEL(8) = DARGP + DMDT + DNODE */
/* EQEL(9) = DNODE */
/* We shall compute the state of the satellite in the */
/* pole and equator reference system. */
/* RAPOL = -HALFPI() */
/* DECPOL = HALFPI() */
/* Now compute the state at the desired epoch ET. */
/* CALL EQNCPV ( ET, EPOCH, EQEL, RAPOL, DECPOL, STATE ) */
/* $ Restrictions */
/* The equinoctial elements used by this routine are taken */
/* from "Tangent" formulation of equinoctial elements */
/* p = Tan(inclination/2) * Sin(R.A. of ascending node) */
/* q = Tan(inclination/2) * Cos(R.A. of ascending node) */
/* Other formulations use Sine instead of Tangent. We shall */
/* call these the "Sine" formulations. */
/* p = Sin(inclination/2) * Sin(R.A. of ascending node) */
/* q = Sin(inclination/2) * Cos(R.A. of ascending node) */
/* If you have equinoctial elements from this alternative */
/* formulation you should replace p and q by the */
/* expressions below. */
/* P = P / DSQRT ( 1.0D0 - P*P - Q*Q ) */
/* Q = Q / DSQRT ( 1.0D0 - P*P - Q*Q ) */
/* This will convert the Sine formulation to the Tangent formulation. */
/* $ Literature_References */
/* JPL Engineering Memorandum 314-513 "Optical Navigation Program */
/* Mathematical Models" by William M. Owen, Jr. and Robin M Vaughan */
/* August 9, 1991 */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* R.A. Jacobson (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */
/* Removed "C$" marker from text in the header. */
/* - SPICELIB Version 1.0.1, 31-JAN-2008 (BVS) */
/* Removed non-standard header section heading */
/* 'Declarations_of_external_functions'. */
/* - SPICELIB Version 1.0.0, 8-JAN-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Compute a state from equinoctial elements */
/* -& */
/* SPICELIB Functions. */
/* LOCAL VARIABLES */
/* Constants computed on first pass */
/* Standard SPICE exception handling code. */
if (return_()) {
return 0;
}
chkin_("EQNCPV", (ftnlen)6);
/* The first time through this routine we fetch the various */
/* constants we need for this routine. */
if (first) {
first = FALSE_;
pi2 = twopi_();
}
/* Take care of the various errors that can arise with the */
/* input elements. */
if (eqel[0] <= 0.) {
setmsg_("The semi-major axis supplied to EQNCPV was non-positive. Th"
"e value is required to be positive by this routine. The valu"
"e supplied was #. ", (ftnlen)137);
errdp_("#", eqel, (ftnlen)1);
sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18);
chkout_("EQNCPV", (ftnlen)6);
return 0;
}
ecc = sqrt(eqel[1] * eqel[1] + eqel[2] * eqel[2]);
if (ecc > .9) {
setmsg_("The routine EQNCPV can reliably evaluate states from equino"
"ctial elements if the eccentricity of the orbit associated w"
"ith the elements is less than 0.9. The eccentricity associa"
"ted with the elements supplies is #. The values of H and K "
"are: # and # respectively. ", (ftnlen)266);
errdp_("#", &ecc, (ftnlen)1);
errdp_("#", &eqel[1], (ftnlen)1);
errdp_("#", &eqel[2], (ftnlen)1);
sigerr_("SPICE(ECCOUTOFRANGE)", (ftnlen)20);
chkout_("EQNCPV", (ftnlen)6);
return 0;
}
/* Form the transformation from planetary equator to the inertial */
/* reference frame. */
sa = sin(*rapol);
ca = cos(*rapol);
sd = sin(*decpol);
cd = cos(*decpol);
trans[0] = -sa;
trans[3] = -ca * sd;
trans[6] = ca * cd;
trans[1] = ca;
trans[4] = -sa * sd;
trans[7] = sa * cd;
trans[2] = 0.;
trans[5] = cd;
trans[8] = sd;
/* Compute the offset of the input epoch (ET) from the */
/* epoch of the elements. */
dt = *et - *epoch;
/* Obtain the elements, rates, and other parameters. First get */
/* the semi-major axis. */
a = eqel[0];
/* Recall that H and K at the epoch of the elements are in */
/* EQEL(2) and EQEL(3) respectively. */
/* H_0 = E*Sin(ARGP_0 + NODE_0 ) */
/* K_0 = E*Cos(ARGP_0 + NODE_0 ) */
/* The values of H and K at the epoch of interest is */
/* H_dt = E*Sin(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */
/* K_dt = E*Cos(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */
/* But using the identities Sin(A+B) = Sin(A)Cos(B) + Sin(B)Cos(A) */
/* Cos(A+B) = Cos(A)Cos(B) - Sin(A)Sin(B) */
/* We can re-write the expression for H_dt and K_dt as */
/* H_dt = E*Sin(ARGP_0 + NODE_0 )Cos(dt*d(ARGP+NODE)/dt ) */
/* + E*Cos(ARGP_0 + NODE_0 )Sin(dt*d(ARGP+NODE)/dt ) */
/* = H_0 * Cos(dt*d(ARGP+NODE)/dt ) */
/* + K_0 * Sin(dt*d(ARGP+NODE)/dt ) */
/* and */
/* K_dt = E*Cos(ARGP_0 + NODE_0)Cos(dt*d(ARGP+NODE)/dt) */
/* - E*Sin(ARGP_0 + NODE_0)Sin(dt*d(ARGP+NODE)/dt) */
/* = K_0 * Cos(dt*d(ARGP+NODE)/dt) */
/* - H_0 * Sin(dt*d(ARGP+NODE)/dt) */
/* Thus we can easily compute H and K at the current epoch. */
/* Recall that the derivative of the longitude of periapse is */
/* in entry 7 of EQEL. */
dlpdt = eqel[6];
dlp = dt * dlpdt;
can = cos(dlp);
san = sin(dlp);
h__ = eqel[1] * can + eqel[2] * san;
k = eqel[2] * can - eqel[1] * san;
/* The mean longitude at epoch is in the 4th element of EQEL. */
l = eqel[3];
/* The values for P and Q at epoch are stored in entries 5 and 6 */
/* of the array EQEL. Recall that */
/* P_0 = TAN(INC/2)*SIN(NODE_0) */
/* Q_0 = TAN(INC/2)*COS(NODE_0) */
/* We need P and Q offset from the initial epoch by DT. */
/* P = TAN(INC/2)*SIN(NODE_0 + dt*dNODE/dt) */
/* Q = TAN(INC/2)*COS(NODE_0 + dt*dNODE/dt) */
/* Applying the same identities as we did before we have */
/* P = P_0 * Cos( dt*dNODE/dt ) + Q_0 * Sin( dt*dNODE/dt ) */
/* Q = Q_0 * Cos( dt*dNODE/dt ) - P_0 * Sin( dt*dNODE/dt ) */
nodedt = eqel[8];
node = dt * nodedt;
cn = cos(node);
sn = sin(node);
p = eqel[4] * cn + eqel[5] * sn;
q = eqel[5] * cn - eqel[4] * sn;
mldt = eqel[7];
/* We compute the rate of change of the argument of periapse */
/* by taking the difference between the rate of the longitude */
/* of periapse and the rate of the node. */
prate = dlpdt - nodedt;
/* Form Broucke's beta parameter */
b = sqrt(1. - h__ * h__ - k * k);
b = 1. / (b + 1.);
/* Construct the coordinate axes */
di = 1. / (p * p + 1. + q * q);
vf[0] = (1. - p * p + q * q) * di;
vf[1] = p * 2. * q * di;
vf[2] = p * -2. * di;
vg[0] = p * 2. * q * di;
vg[1] = (p * p + 1. - q * q) * di;
vg[2] = q * 2. * di;
/* Compute the mean longitude */
d__1 = mldt * dt;
ml = l + d_mod(&d__1, &pi2);
/* Obtain the eccentric longitude from Kepler's equation */
eecan = kepleq_(&ml, &h__, &k);
/* Trigonometric functions of the eccentric longitude */
sf = sin(eecan);
cf = cos(eecan);
/* Position in the orbit plane */
/* Computing 2nd power */
d__1 = h__;
x1 = a * ((1. - b * (d__1 * d__1)) * cf + (h__ * k * b * sf - k));
/* Computing 2nd power */
d__1 = k;
y1 = a * ((1. - b * (d__1 * d__1)) * sf + (h__ * k * b * cf - h__));
/* Radial distance and functions of the radial distance */
rb = h__ * sf + k * cf;
r__ = a * (1. - rb);
ra = mldt * a * a / r__;
/* Velocity in the orbit plane */
dx1 = ra * (-sf + h__ * b * rb);
dy1 = ra * (cf - k * b * rb);
/* Correction factor for periapsis rate */
nfac = 1. - dlpdt / mldt;
/* Include precession in velocity */
dx = nfac * dx1 - prate * y1;
dy = nfac * dy1 + prate * x1;
/* Form the planetary mean equator position vector */
vlcom_(&x1, vf, &y1, vg, xhold);
/* Form the planetary mean equator velocity vector */
temp[0] = -nodedt * xhold[1];
temp[1] = nodedt * xhold[0];
temp[2] = 0.;
vlcom3_(&c_b13, temp, &dx, vf, &dy, vg, &xhold[3]);
/* Transform to an inertial state vector */
mxv_(trans, xhold, state);
mxv_(trans, &xhold[3], &state[3]);
chkout_("EQNCPV", (ftnlen)6);
return 0;
} /* eqncpv_ */
/* $Procedure SPKE10 ( Evaluate SPK record, type 10 ) */
/* Subroutine */ int spke10_(doublereal *et, doublereal *record, doublereal *
state)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
static doublereal dwdt, mypi;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), mxvg_(
doublereal *, doublereal *, integer *, integer *, doublereal *);
static doublereal my2pi, w;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static doublereal denom, precm[36] /* was [6][6] */;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
static doublereal vcomp[3], numer, n0;
extern doublereal twopi_(void);
static doublereal s1[6], s2[6], t1, t2;
extern /* Subroutine */ int ev2lin_(doublereal *, doublereal *,
doublereal *, doublereal *);
extern doublereal pi_(void);
static doublereal dargdt;
extern /* Subroutine */ int dpspce_(doublereal *, doublereal *,
doublereal *, doublereal *);
static doublereal mnrate;
extern /* Subroutine */ int vlcomg_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *), chkout_(char *,
ftnlen);
static doublereal invprc[36] /* was [6][6] */;
static logical loworb;
static doublereal tmpsta[6];
extern /* Subroutine */ int zzteme_(doublereal *, doublereal *);
extern logical return_(void);
extern /* Subroutine */ int invstm_(doublereal *, doublereal *);
static doublereal arg;
/* $ Abstract */
/* Evaluate a single SPK data record from a segment of type 10 */
/* (NORAD two-line element sets.). */
/* $ 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. */
/* RECORD 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. */
/* RECORD 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 RECORD is: */
/* RECORD(1) */
/* . Geophysical Constants such as */
/* . GM, J2, J3, J4, etc. */
/* . */
/* RECORD(NGEOCN) */
/* RECORD(NGEOCN + 1) */
/* . */
/* . elements and epoch for the body */
/* . at epoch 1. */
/* . */
/* RECORD(NGEOCN + NELEMN ) */
/* RECORD(NGEOCN + NELEMN + 1) */
/* . */
/* . elements and epoch for the body */
/* . at epoch 2. */
/* . */
/* RECORD(NGEOCN + 2*NELEMN ) */
/* Epoch 1 and epoch 2 are the times in the segment that */
/* bracket ET. If ET is less than the first time in the */
/* segment then both epochs 1 and 2 are equal to the */
/* first time. And if ET is greater than the last time */
/* then, epochs 1 and 2 are set equal to this last time. */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECORD at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If there is a problem evaluating the two-line elements, */
/* the error will be diagnosed by EV2LIN. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine interpolates a state from the two reference sets */
/* of two-line element sets contained in RECORD. */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR10 as shown here: */
/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */
/* CALL SPKE10 ( ET, RECORD, STATE ) */
/* Where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 10 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. 10 ) THEN */
/* CALL SPKR10 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE10 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 01-JAN-2011 (EDW) */
/* Correction of state transformation calculation. Algorithm */
/* now computes state transformation as from TEME to J2000. */
/* The previous version of this routine calculated TETE to */
/* J2000. */
/* - SPICELIB Version 1.1.0, 01-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MTXV and VADD calls. */
/* - SPICELIB Version 1.0.0 18-JUL-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* evaluate type_10 spk segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* The following parameters give the location of the various */
/* geophysical parameters needed for the two line element */
/* sets. We need these only so that we can count how many there */
/* are (NGEOCN). */
/* KJ2 --- location of J2 */
/* KJ3 --- location of J3 */
/* KJ4 --- location if J4 */
/* KKE --- location of KE = sqrt(GM) in earth-radii**1.5/MIN */
/* KQO --- upper bound of atmospheric model in KM */
/* KSO --- lower bound of atmospheric model in KM */
/* KER --- earth equatorial radius in KM. */
/* KAE --- distance units/earth radius */
/* An enumeration of the various components of the */
/* a two-line element set. These are needed so that we */
/* can locate the epochs in the two sets and so that */
/* we can count the number of elements in a two-line */
/* element set. */
/* KNDT20 */
/* KNDD60 */
/* KBSTAR */
/* KINCL */
/* KNODE0 */
/* KECC */
/* KOMEGA */
/* KMO */
/* KNO */
/* KEPOCH */
/* The nutation in obliquity and longitude as well as their rates */
/* follow the elements. So we've got four angles/angle rates */
/* following the elements */
/* The locations of the epochs and the starts of the element */
/* sets are given below. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKE10", (ftnlen)6);
}
if (first) {
first = FALSE_;
mypi = pi_();
my2pi = twopi_();
}
/* Fetch the mean motion from the first set of two-line elements */
/* stored in the record. */
n0 = record[16];
mnrate = my2pi / 225.;
loworb = n0 >= mnrate;
/* Fetch the two epochs stored in the record. */
t1 = record[17];
t2 = record[31];
/* Evaluate the two states. Call them s_1(t) and s_2(t). */
/* Let the position and velocity components be: p_1, v_1, p_2, v_2. */
/* The final position is a weighted average. */
/* Let */
/* W(t) = 0.5 + 0.5*COS( PI*(t-t1)/(t2-t1) ) */
/* then */
/* p = W(t)*p_1(t) + (1 - W(t))*p_2(t) */
/* v = W(t)*v_1(t) + (1 - W(t))*v_2(t) + W'(t)*(p_1(t) - p_2(t)) */
/* If t1 = t2, the state is just s(t1). */
/* Note: there are a number of weighting schemes we could have */
/* used. This one has the nice property that */
/* The graph of W is symmetric about the point */
/* ( (t1+t2)/2, W( (t1+t2)/2 ) ) */
/* The range of W is from 1 to 0. The derivative of W is */
/* symmetric and zero at both t1 and t2. */
if (t1 != t2) {
if (loworb) {
ev2lin_(et, record, &record[8], s1);
ev2lin_(et, record, &record[22], s2);
} else {
dpspce_(et, record, &record[8], s1);
dpspce_(et, record, &record[22], s2);
}
/* Compute the weighting function that we'll need later */
/* when we combine states 1 and 2. */
numer = *et - t1;
denom = t2 - t1;
arg = numer * mypi / denom;
dargdt = mypi / denom;
w = cos(arg) * .5 + .5;
dwdt = sin(arg) * -.5 * dargdt;
/* Now compute the weighted average of the two states. */
d__1 = 1. - w;
vlcomg_(&c__6, &w, s1, &d__1, s2, state);
d__1 = -dwdt;
vlcom_(&dwdt, s1, &d__1, s2, vcomp);
vadd_(&state[3], vcomp, &tmpsta[3]);
vequ_(&tmpsta[3], &state[3]);
} else {
if (loworb) {
ev2lin_(et, record, &record[8], state);
} else {
dpspce_(et, record, &record[8], state);
}
}
/* Finally, convert the TEME state to J2000. First get */
/* the rotation from J2000 to TEME... */
zzteme_(et, precm);
/* ...now convert STATE to J2000. Invert the state transformation */
/* operator (important to correctly do this). */
invstm_(precm, invprc);
/* Map STATE to the corresponding expression in J2000. */
mxvg_(invprc, state, &c__6, &c__6, tmpsta);
moved_(tmpsta, &c__6, state);
chkout_("SPKE10", (ftnlen)6);
return 0;
} /* spke10_ */
/* $Procedure ZZWIND2D ( Find winding number of polygon about point ) */
integer zzwind2d_(integer *n, doublereal *vertcs, doublereal *point)
{
/* System generated locals */
integer vertcs_dim2, ret_val, i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), i_dnnt(doublereal *);
/* Local variables */
doublereal rvec[2];
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *);
extern doublereal vdotg_(doublereal *, doublereal *, integer *), vsepg_(
doublereal *, doublereal *, integer *);
extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal rperp[2], rnext[2];
extern doublereal twopi_(void);
doublereal atotal;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), 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. */
/* Find the winding number of a planar polygon about a specified */
/* point in 2-dimensional space. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PLANES */
/* $ Keywords */
/* GEOMETRY */
/* MATH */
/* PLANE */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* N I Number of vertices of polygon. */
/* VERTCS I Vertices of polygon. */
/* POINT I Point in PLANE. */
/* The function returns the winding number of the input polygon */
/* about the input point. */
/* $ Detailed_Input */
/* N, */
/* VERTCS are, respectively, the number vertices defining */
/* the polygon and the vertices themselves. Each */
/* pair of consecutive vectors in the array VERTCS */
/* defines an edge of the polygon. */
/* $ Detailed_Output */
/* The function returns the winding number of the input polygon */
/* about the input point. The winding number measures the "net" */
/* number of times the polygon wraps around POINT: this is */
/* the number of times the polygon wraps around POINT in the */
/* counterclockwise sense minus the number of times the polygon */
/* wraps around POINT in the clockwise sense. */
/* The possible values and meanings of the winding number are: */
/* ZZWIND2D > 0: The polygon winds about POINT a total */
/* of ZZWIND2D times in the counterclockwise */
/* direction. */
/* POINT is inside the polygon. */
/* ZZWIND2D < 0: The polygon winds about POINT a total */
/* of ZZWIND2D times in the clockwise */
/* direction. */
/* POINT is inside the polygon. */
/* ZZWIND2D = 0: The number of times the polygon wraps around */
/* POINT in the counterclockwise sense is equal */
/* to the number of times the polygon wraps around */
/* POINT in the clockwise sense. */
/* POINT is outside the polygon. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the number of boundary vectors N is not at least 3, */
/* or if the number exceeds MAXFOV, the error */
/* SPICE(INVALIDCOUNT) will be signaled. */
/* 2) The input point and vertices are expected to lie in */
/* the input plane. To avoid problems introduced by */
/* round-off errors, all of these vectors are projected */
/* orthogonally onto the plane before the winding number */
/* is computed. If the input point or vertices are "far" */
/* from the input plane, no error will be signaled. */
/* 3) If the input plane as a zero normal vector, the error */
/* SPICE(ZEROVECTOR) will be signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Find the winding number of a 2-D polygon about a specified */
/* point. */
/* This routine supports determination of whether an ellipsoidal */
/* body is in the field of view of a remote-sensing instrument */
/* with a field of view having polygonal cross section. */
/* The winding number is actually defined for closed, piecewise */
/* differentiable curves in the complex plane. If z(t), t in */
/* [0, 2*Pi], is a parameterization of such a curve, then if the */
/* symbol I is used to represent the integration operator, z0 is the */
/* complex point of interest, and w is the winding number, we have */
/* 1 */
/* w = ------- * I ( d ( log(z-z0) ) ) */
/* 2*Pi*i z(t) */
/* 1 */
/* = ------- * I ( ( 1 / (z-z0) ) dz ) */
/* 2*Pi*i z(t) */
/* Because of Cauchy's theorem, we can transform the problem, */
/* without loss of generality (leaving out *many* steps here), to */
/* one for which the curve has the simple form */
/* i n*(t-t0) */
/* z(t) = z0 + r e */
/* for some real values r, n, and t0. So */
/* 1 */
/* w = ------- * I ( 1 / (z-z0) ) */
/* 2*Pi*i z(t) */
/* 1 t=2*pi i n*(t-t0) i n*(t-t0) */
/* = ------- * I ( (1/r e ) * ( r i n e )dt ) */
/* 2*Pi*i t=0 */
/* 1 t=2*pi */
/* = ------- * I ( i n dt ) */
/* 2*Pi*i t=0 */
/* 1 */
/* = ------ * ( 2 * Pi * i * n ) */
/* 2*Pi*i */
/* = n */
/* Given the simplified form of z(t) we've chosen, it's now clear */
/* that n is the winding number. */
/* In the simple case of a polygonal curve, the integral can be */
/* computed for a corresponding polygon whose vertices have been */
/* scaled to have equal magnitude; the integral can be expressed as */
/* the telescoping sum */
/* N */
/* ___ */
/* \ */
/* / ( argument of vertex(i+1) - argument of vertex(i) ) */
/* --- */
/* i=1 */
/* where vertex N+1 is considered have length identical to that of */
/* vertex 1 and argument differing from that of vertex 1 by w*2*pi. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] `Calculus and Analytic Geometry', Thomas and Finney. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 08-JUL-2008 (NJB) */
/* -& */
/* $ Index_Entries */
/* find winding number of polygon about point */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Initialize the function return value. */
/* Parameter adjustments */
vertcs_dim2 = *n;
/* Function Body */
ret_val = 0;
if (return_()) {
return ret_val;
}
chkin_("ZZWIND2D", (ftnlen)8);
/* Check the number of sides of the polygon. */
if (*n < 3) {
setmsg_("Polygon must have at least 3 sides; N = #.", (ftnlen)42);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZWIND2D", (ftnlen)8);
return ret_val;
}
/* The total "wrap angle" starts at zero. */
atotal = 0.;
vsubg_(&vertcs[(i__1 = 0) < vertcs_dim2 << 1 ? i__1 : s_rnge("vertcs",
i__1, "zzwind2d_", (ftnlen)285)], point, &c__2, rvec);
i__1 = *n + 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (i__ <= *n) {
j = i__;
} else {
j = 1;
}
/* Find the angular separation of RVEC and the next vector */
/* RNEXT. */
vsubg_(&vertcs[(i__2 = (j << 1) - 2) < vertcs_dim2 << 1 && 0 <= i__2 ?
i__2 : s_rnge("vertcs", i__2, "zzwind2d_", (ftnlen)299)],
point, &c__2, rnext);
sep = vsepg_(rnext, rvec, &c__2);
/* Create a normal vector to RVEC by rotating RVEC pi/2 radians */
/* counterclockwise. We'll use this vector RPERP to determine */
/* whether the next point is reached by clockwise or */
/* counterclockwise rotation from RVEC. */
rperp[0] = -rvec[1];
rperp[1] = rvec[0];
if (vdotg_(rnext, rperp, &c__2) >= 0.) {
/* RNEXT is reached by counterclockwise rotation from */
/* RVEC. Note that in the case of zero rotation, the */
/* sign doesn't matter because the contribution is zero. */
atotal += sep;
} else {
atotal -= sep;
}
/* Update RVEC. */
moved_(rnext, &c__2, rvec);
}
/* The above sum is 2 * pi * <the number of times the polygon */
/* wraps around P>. Let ZZWIND2D be the wrap count. */
d__1 = atotal / twopi_();
ret_val = i_dnnt(&d__1);
chkout_("ZZWIND2D", (ftnlen)8);
return ret_val;
} /* zzwind2d_ */
