/* $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 ZZHULLAX ( Pyramidal FOV convex hull to FOV axis ) */
/* Subroutine */ int zzhullax_(char *inst, integer *n, doublereal *bounds,
doublereal *axis, ftnlen inst_len)
{
/* System generated locals */
integer bounds_dim2, i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
doublereal xvec[3], yvec[3], zvec[3];
integer xidx;
extern doublereal vsep_(doublereal *, doublereal *);
integer next;
logical pass1;
integer i__, m;
doublereal r__, v[3], delta;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vlcom_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
integer minix, maxix;
doublereal trans[9] /* was [3][3] */;
extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal
*), vcrss_(doublereal *, doublereal *, doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal cp[3];
extern doublereal pi_(void);
logical ok;
extern doublereal halfpi_(void);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *), sigerr_(char *, ftnlen);
doublereal minlon;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal maxlon;
extern /* Subroutine */ int vhatip_(doublereal *), vsclip_(doublereal *,
doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
doublereal lat, sep, lon;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
doublereal ray1[3], ray2[3];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Identify a face of the convex hull of an instrument's */
/* polygonal FOV, and use this face to generate an axis of the */
/* FOV. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK */
/* FRAMES */
/* GF */
/* IK */
/* KERNEL */
/* $ Keywords */
/* FOV */
/* GEOMETRY */
/* INSTRUMENT */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* MARGIN P Minimum complement of FOV cone angle. */
/* INST I Instrument name. */
/* N I Number of FOV boundary vectors. */
/* BOUNDS I FOV boundary vectors. */
/* AXIS O Instrument FOV axis vector. */
/* $ Detailed_Input */
/* INST is the name of an instrument with which the field of */
/* view (FOV) of interest is associated. This name is */
/* used only to generate long error messages. */
/* N is the number of boundary vectors in the array */
/* BOUNDS. */
/* BOUNDS is an array of N vectors emanating from a common */
/* vertex and defining the edges of a pyramidal region in */
/* three-dimensional space: this the region within the */
/* FOV of the instrument designated by INST. The Ith */
/* vector of BOUNDS resides in elements (1:3,I) of this */
/* array. */
/* The vectors contained in BOUNDS are called the */
/* "boundary vectors" of the FOV. */
/* The boundary vectors must satisfy the constraints: */
/* 1) The boundary vectors must be contained within */
/* a right circular cone of angular radius less */
/* than than (pi/2) - MARGIN radians; in other */
/* words, there must be a vector A such that all */
/* boundary vectors have angular separation from */
/* A of less than (pi/2)-MARGIN radians. */
/* 2) There must be a pair of vectors U, V in BOUNDS */
/* such that all other boundary vectors lie in */
/* the same half space bounded by the plane */
/* containing U and V. Furthermore, all other */
/* boundary vectors must have orthogonal */
/* projections onto a plane normal to this plane */
/* such that the projections have angular */
/* separation of at least 2*MARGIN radians from */
/* the plane spanned by U and V. */
/* Given the first constraint above, there is plane PL */
/* such that each of the set of rays extending the */
/* boundary vectors intersects PL. (In fact, there is an */
/* infinite set of such planes.) The boundary vectors */
/* must be ordered so that the set of line segments */
/* connecting the intercept on PL of the ray extending */
/* the Ith vector to that of the (I+1)st, with the Nth */
/* intercept connected to the first, form a polygon (the */
/* "FOV polygon") constituting the intersection of the */
/* FOV pyramid with PL. This polygon may wrap in either */
/* the positive or negative sense about a ray emanating */
/* from the FOV vertex and passing through the plane */
/* region bounded by the FOV polygon. */
/* The FOV polygon need not be convex; it may be */
/* self-intersecting as well. */
/* No pair of consecutive vectors in BOUNDS may be */
/* linearly dependent. */
/* The boundary vectors need not have unit length. */
/* $ Detailed_Output */
/* AXIS is a unit vector normal to a plane containing the */
/* FOV polygon. All boundary vectors have angular */
/* separation from AXIS of not more than */
/* ( pi/2 ) - MARGIN */
/* radians. */
/* This routine signals an error if it cannot find */
/* a satisfactory value of AXIS. */
/* $ Parameters */
/* MARGIN is a small positive number used to constrain the */
/* orientation of the boundary vectors. See the two */
/* constraints described in the Detailed_Input section */
/* above for specifics. */
/* $ Exceptions */
/* 1) In the input vector count N is not at least 3, the error */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If any pair of consecutive boundary vectors has cross */
/* product zero, the error SPICE(DEGENERATECASE) is signaled. */
/* For this test, the first vector is considered the successor */
/* of the Nth. */
/* 3) If this routine can't find a face of the convex hull of */
/* the set of boundary vectors such that this face satisfies */
/* constraint (2) of the Detailed_Input section above, the */
/* error SPICE(FACENOTFOUND) is signaled. */
/* 4) If any boundary vectors have longitude too close to 0 */
/* or too close to pi radians in the face frame (see discussion */
/* of the search algorithm's steps 3 and 4 in Particulars */
/* below), the respective errors SPICE(NOTSUPPORTED) or */
/* SPICE(FOVTOOWIDE) are signaled. */
/* 5) If any boundary vectors have angular separation of more than */
/* (pi/2)-MARGIN radians from the candidate FOV axis, the */
/* error SPICE(FOVTOOWIDE) is signaled. */
/* $ Files */
/* The boundary vectors input to this routine are typically */
/* obtained from an IK file. */
/* $ Particulars */
/* Normally implementation is not discussed in SPICE headers, but we */
/* make an exception here because this routine's implementation and */
/* specification are deeply intertwined. */
/* This routine produces an "axis" for a polygonal FOV using the */
/* following approach: */
/* 1) Test pairs of consecutive FOV boundary vectors to see */
/* whether there's a pair such that the plane region bounded */
/* by these vectors is */
/* a) part of the convex hull of the set of boundary vectors */
/* b) such that all other boundary vectors have angular */
/* separation of at least MARGIN from the plane */
/* containing these vectors */
/* This search has O(N**2) run time dependency on N. */
/* If this test produces a candidate face of the convex hull, */
/* proceed to step 3. */
/* 2) If step (1) fails, repeat the search for a candidate */
/* convex hull face, but this time search over every pair of */
/* distinct boundary vectors. */
/* This search has O(N**3) run time dependency on N. */
/* If this search fails, signal an error. */
/* 3) Produce a set of basis vectors for a reference frame, */
/* which we'll call the "face frame," using as the +X axis */
/* the angle bisector of the vectors bounding the candidate */
/* face, the +Y axis the inward normal vector to this face, */
/* and the +Z axis completing a right-handed basis. */
/* 4) Transform each boundary vector, other than the two vectors */
/* defining the selected convex hull face, to the face frame */
/* and compute the vector's longitude in that frame. Find the */
/* maximum and minimum longitudes of the vectors in the face */
/* frame. */
/* If any vector's longitude is less than 2*MARGIN or greater */
/* than pi - 2*MARGIN radians, signal an error. */
/* 5) Let DELTA be the difference between pi and the maximum */
/* longitude found in step (4). Rotate the +Y axis (which */
/* points in the inward normal direction relative to the */
/* selected face) by -DELTA/2 radians about the +Z axis of */
/* the face frame. This rotation aligns the +Y axis with the */
/* central longitude of the set of boundary vectors. The */
/* resulting vector is our candidate FOV axis. */
/* 6) Check the angular separation of the candidate FOV axis */
/* against each boundary vector. If any vector has angular */
/* separation of more than (pi/2)-MARGIN radians from the */
/* axis, signal an error. */
/* Note that there are reasonable FOVs that cannot be handled by the */
/* algorithm described here. For example, any FOV whose cross */
/* section is a regular convex polygon can be made unusable by */
/* adding boundary vectors aligned with the angle bisectors of each */
/* face of the pyramid defined by the FOV's boundary vectors. The */
/* resulting set of boundary vectors has no face in its convex hull */
/* such that all other boundary vectors have positive angular */
/* separation from that face. */
/* Because of this limitation, this algorithm should be used only */
/* after a simple FOV axis-finding approach, such as using as the */
/* FOV axis the average of the boundary vectors, has been tried */
/* unsuccessfully. */
/* Note that it's easy to construct FOVs where the average of the */
/* boundary vectors doesn't yield a viable axis: a FOV of angular */
/* width nearly equal to pi radians, with a sufficiently large */
/* number of boundary vectors on one side and few boundary vectors */
/* on the other, is one such example. This routine can find an */
/* axis for many such intractable FOVs---that's why this routine */
/* should be called after the simple approach fails. */
/* $ Examples */
/* See SPICELIB private routine ZZFOVAXI. */
/* $ Restrictions */
/* 1) This is a SPICE private routine. User applications should not */
/* call this routine. */
/* 2) There are "reasonable" polygonal FOVs that cannot be handled */
/* by this routine. See the discussion in Particulars above. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB 1.0.0, 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* Create axis vector for polygonal FOV */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Parameter adjustments */
bounds_dim2 = *n;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZHULLAX", (ftnlen)8);
/* Nothing found yet. */
found = FALSE_;
xidx = 0;
/* We must have at least 3 boundary vectors. */
if (*n < 3) {
setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb"
"er supplied for # was #.", (ftnlen)83);
errch_("#", inst, (ftnlen)1, inst_len);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Find an exterior face of the pyramid defined by the */
/* input boundary vectors. Since most polygonal FOVs will have */
/* an exterior face bounded by two consecutive rays, we'll */
/* try pairs of consecutive rays first. If this fails, we'll */
/* try each pair of rays. */
i__ = 1;
while(i__ <= *n && ! found) {
/* Set the index of the next ray. When we get to the */
/* last boundary vector, the next ray is the first. */
if (i__ == *n) {
next = 1;
} else {
next = i__ + 1;
}
/* Find the cross product of the first ray with the */
/* second. Depending on the ordering of the boundary */
/* vectors, this could be an inward or outward normal, */
/* in the case the current face is exterior. */
vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ?
i__1 : s_rnge("bounds", i__1, "zzhullax_", (ftnlen)408)], &
bounds[(i__2 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)408)], cp);
/* We insist on consecutive boundary vectors being */
/* linearly independent. */
if (vzero_(cp)) {
setmsg_("Polygonal FOV must have linearly independent consecutiv"
"e boundary but vectors at indices # and # have cross pro"
"duct equal to the zero vector. Instrument is #.", (ftnlen)
158);
errint_("#", &i__, (ftnlen)1);
errint_("#", &next, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* See whether the other boundary vectors have angular */
/* separation of at least MARGIN from the plane containing */
/* the current face. */
pass1 = TRUE_;
ok = TRUE_;
m = 1;
while(m <= *n && ok) {
/* Find the angular separation of CP and the Mth vector if the */
/* latter is not an edge of the current face. */
if (m != i__ && m != next) {
sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) < bounds_dim2 * 3
&& 0 <= i__1 ? i__1 : s_rnge("bounds", i__1, "zzhull"
"ax_", (ftnlen)446)]);
if (pass1) {
/* Adjust CP if necessary so that it points */
/* toward the interior of the pyramid. */
if (sep > halfpi_()) {
/* Invert the cross product vector and adjust SEP */
/* accordingly. Within this "M" loop, all other */
/* angular separations will be computed using the new */
/* value of CP. */
vsclip_(&c_b20, cp);
sep = pi_() - sep;
}
pass1 = FALSE_;
}
ok = sep < halfpi_() - 1e-12;
}
if (ok) {
/* Consider the next boundary vector. */
++m;
}
}
/* We've tested each boundary vector against the current face, or */
/* else the loop terminated early because a vector with */
/* insufficient angular separation from the plane containing the */
/* face was found. */
if (ok) {
/* The current face is exterior. It's bounded by rays I and */
/* NEXT. */
xidx = i__;
found = TRUE_;
} else {
/* Look at the next face of the pyramid. */
++i__;
}
}
/* If we didn't find an exterior face, we'll have to look at each */
/* face bounded by a pair of rays, even if those rays are not */
/* adjacent. (This can be a very slow process is N is large.) */
if (! found) {
i__ = 1;
while(i__ <= *n && ! found) {
/* Consider all ray pairs (I,NEXT) where NEXT > I. */
next = i__ + 1;
while(next <= *n && ! found) {
/* Find the cross product of the first ray with the second. */
/* If the current face is exterior, CP could be an inward */
/* or outward normal, depending on the ordering of the */
/* boundary vectors. */
vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__1 ? i__1 : s_rnge("bounds", i__1, "zzhullax_", (
ftnlen)530)], &bounds[(i__2 = next * 3 - 3) <
bounds_dim2 * 3 && 0 <= i__2 ? i__2 : s_rnge("bounds",
i__2, "zzhullax_", (ftnlen)530)], cp);
/* It's allowable for non-consecutive boundary vectors to */
/* be linearly dependent, but if we have such a pair, */
/* it doesn't define an exterior face. */
if (! vzero_(cp)) {
/* The rays having direction vectors indexed I and NEXT */
/* define a semi-infinite sector of a plane that might */
/* be of interest. */
/* Check whether all of the boundary vectors that are */
/* not edges of the current face have angular separation */
/* of at least MARGIN from the plane containing the */
/* current face. */
pass1 = TRUE_;
ok = TRUE_;
m = 1;
while(m <= *n && ok) {
/* Find the angular separation of CP and the Mth */
/* vector if the latter is not an edge of the current */
/* face. */
if (m != i__ && m != next) {
sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) <
bounds_dim2 * 3 && 0 <= i__1 ? i__1 :
s_rnge("bounds", i__1, "zzhullax_", (
ftnlen)560)]);
if (pass1) {
/* Adjust CP if necessary so that it points */
/* toward the interior of the pyramid. */
if (sep > halfpi_()) {
/* Invert the cross product vector and */
/* adjust SEP accordingly. Within this "M" */
/* loop, all other angular separations will */
/* be computed using the new value of CP. */
vsclip_(&c_b20, cp);
sep = pi_() - sep;
}
pass1 = FALSE_;
}
ok = sep < halfpi_() - 1e-12;
}
if (ok) {
/* Consider the next boundary vector. */
++m;
}
}
/* We've tested each boundary vector against the current */
/* face, or else the loop terminated early because a */
/* vector with insufficient angular separation from the */
/* plane containing the face was found. */
if (ok) {
/* The current face is exterior. It's bounded by rays */
/* I and NEXT. */
xidx = i__;
found = TRUE_;
}
/* End of angular separation test block. */
}
/* End of non-zero cross product block. */
if (! found) {
/* Look at the face bounded by the rays */
/* at indices I and NEXT+1. */
++next;
}
}
/* End of NEXT loop. */
if (! found) {
/* Look at the face bounded by the pairs of rays */
/* including the ray at index I+1. */
++i__;
}
}
/* End of I loop. */
}
/* End of search for exterior face using each pair of rays. */
/* If we still haven't found an exterior face, we can't continue. */
if (! found) {
setmsg_("Unable to find face of convex hull of FOV of instrument #.",
(ftnlen)58);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FACENOTFOUND)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Arrival at this point means that the rays at indices */
/* XIDX and NEXT define a plane such that all boundary */
/* vectors lie in a half-space bounded by that plane. */
/* We're now going to define a set of orthonormal basis vectors: */
/* +X points along the angle bisector of the bounding vectors */
/* of the exterior face. */
/* +Y points along CP. */
/* +Z is the cross product of +X and +Y. */
/* We'll call the reference frame having these basis vectors */
/* the "face frame." */
vhat_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1 :
s_rnge("bounds", i__1, "zzhullax_", (ftnlen)683)], ray1);
vhat_(&bounds[(i__1 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1
: s_rnge("bounds", i__1, "zzhullax_", (ftnlen)684)], ray2);
vlcom_(&c_b36, ray1, &c_b36, ray2, xvec);
vhatip_(xvec);
vhat_(cp, yvec);
ucrss_(xvec, yvec, zvec);
/* Create a transformation matrix to map the input boundary */
/* vectors into the face frame. */
for (i__ = 1; i__ <= 3; ++i__) {
trans[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)698)] = xvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("xvec", i__2, "zzhullax_", (
ftnlen)698)];
trans[(i__1 = i__ * 3 - 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)699)] = yvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("yvec", i__2, "zzhullax_", (
ftnlen)699)];
trans[(i__1 = i__ * 3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)700)] = zvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("zvec", i__2, "zzhullax_", (
ftnlen)700)];
}
/* Now we're going to compute the longitude of each boundary in the */
/* face frame. The vectors with indices XIDX and NEXT are excluded. */
/* We expect all longitudes to be between MARGIN and pi - MARGIN. */
minlon = pi_();
maxlon = 0.;
minix = 1;
maxix = 1;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (i__ != xidx && i__ != next) {
/* The current vector is not a boundary of our edge, */
/* so find its longitude. */
mxv_(trans, &bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (
ftnlen)720)], v);
reclat_(v, &r__, &lon, &lat);
/* Update the longitude bounds. */
if (lon < minlon) {
minix = i__;
minlon = lon;
}
if (lon > maxlon) {
maxix = i__;
maxlon = lon;
}
}
}
/* If the longitude bounds are not as expected, don't try */
/* to continue. */
if (minlon < 2e-12) {
setmsg_("Minimum boundary vector longitude in exterior face frame is"
" # radians. Minimum occurs at index #. This FOV does not con"
"form to the requirements of this routine. Instrument is #.", (
ftnlen)177);
errdp_("#", &minlon, (ftnlen)1);
errint_("#", &minix, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
} else if (maxlon > pi_() - 2e-12) {
setmsg_("Maximum boundary vector longitude in exterior face frame is"
" # radians. Maximum occurs at index #. This FOV does not con"
"form to the requirements of this routine. Instrument is #.", (
ftnlen)177);
errdp_("#", &maxlon, (ftnlen)1);
errint_("#", &maxix, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Let delta represent the amount we can rotate the exterior */
/* face clockwise about +Z without contacting another boundary */
/* vector. */
delta = pi_() - maxlon;
/* Rotate +Y by -DELTA/2 about +Z. The result is our candidate */
/* FOV axis. Make the axis vector unit length. */
d__1 = -delta / 2;
vrotv_(yvec, zvec, &d__1, axis);
vhatip_(axis);
/* If we have a viable result, ALL boundary vectors have */
/* angular separation less than HALFPI-MARGIN from AXIS. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
sep = vsep_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)794)
], axis);
if (sep > halfpi_() - 1e-12) {
setmsg_("Boundary vector at index # has angular separation of # "
"radians from candidate FOV axis. This FOV does not confo"
"rm to the requirements of this routine. Instrument is #.",
(ftnlen)167);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sep, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
}
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
} /* zzhullax_ */
/* $Procedure 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 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 CHBFIT ( Chebyshev fit ) */
/* Subroutine */ int chbfit_(D_fp func, doublereal *left, doublereal *right,
integer *n, doublereal *work, doublereal *coeffs)
{
/* Initialized data */
static logical pass1 = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double cos(doublereal);
/* Local variables */
static doublereal rtab[625] /* was [25][25] */, ttab[15625] /* was [25][
25][25] */;
integer i__, j, k;
doublereal x;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal midpt;
extern doublereal pi_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal radius;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
doublereal arg;
/* $ Abstract */
/* Return the Chebyshev coefficients for a Chebyshev expansion */
/* of a specified function. */
/* $ 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 */
/* INTERPOLATION */
/* MATH */
/* POLYNOMIAL */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* MAXSIZ P Maximum number of terms in expansion. */
/* FUNC I Function to be approximated. */
/* LEFT I Left endpoint of approximation interval. */
/* RIGHT I Right endpoint of approximation interval. */
/* N I Number of terms in Chebyshev expansion. */
/* WORK I Work space array of dimension N. */
/* COEFFS O Coefficients of Chebyshev expansion. */
/* $ Detailed_Input */
/* FUNC is the function to be approximated. FUNC must */
/* accept a single, double precision input argument */
/* and must return a double precision value. FUNC */
/* should be declared EXTERNAL in the caller of this */
/* routine. */
/* LEFT, */
/* RIGHT are, respectively, the left and right endpoints */
/* of the interval on which the input function is */
/* to be approximated. */
/* N is the number of terms in the desired Chebyshev */
/* expansion. The degree of the highest-order */
/* Chebyshev polynomial in the expansion is N-1. */
/* WORK is a work space array of dimension N. */
/* $ Detailed_Output */
/* COEFFS is an array containing the coefficients of */
/* the N-term Chebyshev expansion of the input */
/* function. */
/* Let */
/* T (x) = cos ( j arccos(x) ) */
/* j */
/* be the Chebyshev polynomial of degree j; then */
/* COEFFS are computed such that the expansion */
/* N */
/* ___ */
/* \ COEFFS(j) T (x) */
/* /__ j-1 */
/* j=1 */
/* is the Chebyshev expansion of F(Y) on the */
/* interval [-1,1], where */
/* F(Y) = FUNC(X) */
/* and */
/* X - (LEFT+RIGHT)/2 */
/* Y = --------------------- */
/* (LEFT-RIGHT) / 2 */
/* The coefficients computed by this routine are */
/* compatible with the SPICELIB routines CHBINT, */
/* CHBVAL, and CHBDER. */
/* See the $Particulars section for further details */
/* on the specification of this routine. */
/* $ Parameters */
/* MAXSIZ is the maximum number of terms in the Chebyshev */
/* expansion. This is the maximum allowed value of */
/* N. */
/* $ Exceptions */
/* 1) If N is less than 1, the error SPICE(INVALIDSIZE) is */
/* signaled. The function will return the value 0.D0. */
/* 2) If N is greater than MAXSIZ, the error SPICE(INVALIDSIZE) is */
/* signaled. The function will return the value 0.D0. */
/* 3) This routine does not attempt to ward off or diagnose */
/* arithmetic overflows. */
/* 4) If the endpoints LEFT and RIGHT are not in strictly */
/* increasing order, the error SPICE(INVALIDENDPTS) */
/* is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The coefficient set produced by this routine is described below: */
/* Let */
/* x , k = 1, ... , N */
/* k */
/* be the roots of the Chebyshev polynomial */
/* T (x) = cos ( N arccos(x) ) */
/* N */
/* These roots are */
/* cos ( (k-1/2)*PI/N ), k = 1, ..., N. */
/* For a function f(x) defined on the closed */
/* interval [-1,1], the N-term Chebyshev expansion */
/* is */
/* N */
/* ___ */
/* \ C T (x) */
/* /__ j j-1 */
/* j=1 */
/* where */
/* N */
/* ___ */
/* C = (2/N) \ f(x ) T (x ), j = 2, ...,N, */
/* j /__ k j-1 k */
/* k=1 */
/* N */
/* ___ */
/* C = (1/N) \ f(x ) */
/* 1 /__ k */
/* k=1 */
/* The definition of */
/* C */
/* 1 */
/* used differs from that used in reference [1]; */
/* our value is half theirs, and yields the simpler */
/* expression for the expansion of f(x) shown above. */
/* When the function f(x) to be approximated is */
/* defined on the interval [LEFT,RIGHT], the mapping */
/* x - (LEFT+RIGHT)/2 */
/* y(x) = --------------------- */
/* (LEFT-RIGHT) / 2 */
/* can be used to define a new function F such that */
/* F(y) = f(x). F has domain [-1,1] and hence admits */
/* a Chebyshev expansion. */
/* In this routine, the above mapping is used to */
/* transform the domain of the input function to the */
/* interval [-1,1]. */
/* $ Examples */
/* 1) Recover coefficients from a function whose Chebyshev */
/* expansion is known. Suppose */
/* f(x) = 1*T (x) + 2*T (x) + 3*T (x) + 4*T (x). */
/* 0 1 2 3 */
/* The following small program produces the Chebyshev */
/* coefficients of f: */
/* PROGRAM TSTCHB */
/* IMPLICIT NONE */
/* C */
/* C Test Chebyshev fitting for a simple function. */
/* C */
/* INTEGER NCOEFF */
/* PARAMETER ( NCOEFF = 4 ) */
/* DOUBLE PRECISION FUNC */
/* EXTERNAL FUNC */
/* DOUBLE PRECISION COEFFS ( NCOEFF ) */
/* DOUBLE PRECISION WORK ( NCOEFF ) */
/* INTEGER I */
/* CALL CHBFIT ( FUNC, -1.D0, 1.D0, */
/* . NCOEFF, WORK, COEFFS ) */
/* WRITE (*,*) 'Coefficients follow:' */
/* DO I = 1, NCOEFF */
/* WRITE (*,*) 'DEGREE: ', I-1, ' = ', COEFFS(I) */
/* END DO */
/* END */
/* DOUBLE PRECISION FUNCTION FUNC ( X ) */
/* IMPLICIT NONE */
/* C */
/* C Return */
/* C */
/* C f(x) = 1*T (x) + 2*T (x) + 3*T (x) + 4*T (x). */
/* C 0 1 2 3 */
/* C */
/* DOUBLE PRECISION X */
/* INTEGER NCOEFF */
/* PARAMETER ( NCOEFF = 4 ) */
/* DOUBLE PRECISION CP ( NCOEFF ) */
/* DOUBLE PRECISION X2S ( 2 ) */
/* INTEGER I */
/* DO I = 1, NCOEFF */
/* CP(I) = DBLE(I) */
/* END DO */
/* X2S(1) = 0.D0 */
/* X2S(2) = 1.D0 */
/* CALL CHBVAL ( CP, NCOEFF-1, X2S, X, FUNC ) */
/* END */
/* $ Restrictions */
/* 1) Maximum number of terms in the expansion is limited by the */
/* parameter MAXSIZ. */
/* $ Literature_References */
/* [1] "Numerical Recipes---The Art of Scientific Computing" by */
/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */
/* William T. Vetterling (see section 5.6). */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SUPPORT Version 2.0.0, 14-SEP-2007 (NJB) */
/* Now pre-computes Chebyvshev polynomial values. Maximum */
/* number of terms in the expansion is limited by the */
/* parameter MAXSIZ. */
/* - SUPPORT Version 1.0.0, 16-JUN-1996 (NJB) */
/* -& */
/* $ Index_Entries */
/* fit Chebyshev expansion to a function */
/* determine Chebyshev coefficients of a function */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Check in only if an error is detected. */
if (return_()) {
return 0;
}
/* Make sure the requested expansion order is not too large. */
if (*n > 25) {
chkin_("CHBFIT", (ftnlen)6);
setmsg_("The requested expansion order # exceeds the maximum support"
"ed order #.", (ftnlen)70);
errint_("#", n, (ftnlen)1);
errint_("#", &c__25, (ftnlen)1);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("CHBFIT", (ftnlen)6);
return 0;
}
/* No data, no interpolation. */
if (*n < 1) {
chkin_("CHBFIT", (ftnlen)6);
setmsg_("Array size must be positive; was #.", (ftnlen)35);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("CHBFIT", (ftnlen)6);
return 0;
}
/* Make sure the input interval is OK. */
if (*left >= *right) {
chkin_("CHBFIT", (ftnlen)6);
setmsg_("Left endpoint = #; right endpoint = #.", (ftnlen)38);
errdp_("#", left, (ftnlen)1);
errdp_("#", right, (ftnlen)1);
sigerr_("SPICE(INVALIDENDPTS)", (ftnlen)20);
chkout_("CHBFIT", (ftnlen)6);
return 0;
}
if (pass1) {
/* On the first pass, compute a table of roots of all */
/* Cheby polynomials from degree 1 to degree N. The Ith */
/* column of the table contains roots of the Ith polynomial. */
cleard_(&c__625, rtab);
for (i__ = 1; i__ <= 25; ++i__) {
i__1 = i__;
for (k = 1; k <= i__1; ++k) {
rtab[(i__2 = k + i__ * 25 - 26) < 625 && 0 <= i__2 ? i__2 :
s_rnge("rtab", i__2, "chbfit_", (ftnlen)439)] = cos(
pi_() * (k - .5) / i__);
}
}
/* Also compute a table of Chebyshev function values. For */
/* each expansion size J from 1 to N, we compute the values */
/* of */
/* T (x ) ... T ( x ) */
/* 0 1 0 J */
/* . */
/* . */
/* . */
/* T (x ) ... T ( x ) */
/* J-1 1 J-1 J */
/* where */
/* x */
/* K */
/* is the Kth root of */
/* T */
/* J */
/* In our 3-dimensional table, the (K,I,J) entry is the value */
/* of */
/* T ( x ) */
/* I-1 K */
/* where */
/* x */
/* K */
/* is the Kth root of */
/* T */
/* J */
cleard_(&c__15625, ttab);
for (j = 1; j <= 25; ++j) {
/* Compute Cheby values needed to implement an expansion */
/* of size J. */
i__1 = j;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute values of */
/* T */
/* I-1 */
/* on the roots of */
/* T */
/* J */
i__2 = j;
for (k = 1; k <= i__2; ++k) {
/* Evaluate */
/* T */
/* I-1 */
/* at the Kth root of */
/* T */
/* J */
arg = pi_() * (k - .5) / j;
ttab[(i__3 = k + (i__ + j * 25) * 25 - 651) < 15625 && 0
<= i__3 ? i__3 : s_rnge("ttab", i__3, "chbfit_", (
ftnlen)522)] = cos((i__ - 1) * arg);
}
}
}
pass1 = FALSE_;
}
/* Find the transformation parameters. */
midpt = (*right + *left) / 2.;
radius = (*right - *left) / 2.;
/* Compute the input function values at the transformed Chebyshev */
/* roots. */
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
x = radius * rtab[(i__2 = k + *n * 25 - 26) < 625 && 0 <= i__2 ? i__2
: s_rnge("rtab", i__2, "chbfit_", (ftnlen)550)] + midpt;
work[k - 1] = (*func)(&x);
}
/* Compute the coefficients. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
coeffs[j - 1] = 0.;
i__2 = *n;
for (k = 1; k <= i__2; ++k) {
coeffs[j - 1] = work[k - 1] * ttab[(i__3 = k + (j + *n * 25) * 25
- 651) < 15625 && 0 <= i__3 ? i__3 : s_rnge("ttab", i__3,
"chbfit_", (ftnlen)565)] + coeffs[j - 1];
}
coeffs[j - 1] = coeffs[j - 1] * 2. / *n;
}
/* Scale the zero-order coefficient to simplify the form of the */
/* Chebyshev expansion. */
coeffs[0] *= .5;
return 0;
} /* chbfit_ */
