/* $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 CKR05 ( Read CK record from segment, type 05 ) */
/* Subroutine */ int ckr05_(integer *handle, doublereal *descr, doublereal *
sclkdp, doublereal *tol, logical *needav, doublereal *record, logical
*found)
{
/* Initialized data */
static integer lbeg = -1;
static integer lend = -1;
static integer lhand = 0;
static doublereal prevn = -1.;
static doublereal prevnn = -1.;
static doublereal prevs = -1.;
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer i_dnnt(doublereal *), s_rnge(char *, integer, char *, integer);
/* Local variables */
integer high;
doublereal rate;
integer last, type__, i__, j, n;
doublereal t;
integer begin;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafus_(doublereal *,
integer *, integer *, doublereal *, integer *);
integer nidir;
extern doublereal dpmax_(void);
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer npdir, nsrch;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer lsize, first, nints, rsize;
doublereal start;
extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
doublereal *);
doublereal dc[2];
integer ic[6];
extern logical failed_(void);
integer bufbas, dirbas;
doublereal hepoch;
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal lepoch;
integer npread, nsread, remain, pbegix, sbegix, timbas;
doublereal pbuffr[101];
extern integer lstled_(doublereal *, integer *, doublereal *);
doublereal sbuffr[103];
integer pendix, sendix, packsz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
integer maxwnd;
doublereal contrl[5];
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
doublereal nstart;
extern logical return_(void);
integer pgroup, sgroup, wndsiz, wstart, subtyp;
doublereal nnstrt;
extern logical odd_(integer *);
integer end, low;
/* $ Abstract */
/* Read a single CK data record from a segment of type 05 */
/* (MEX/Rosetta Attitude file interpolation). */
/* $ 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 */
/* $ Keywords */
/* POINTING */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to CK type 05. */
/* $ 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 */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */
/* -& */
/* CK type 5 subtype codes: */
/* Subtype 0: Hermite interpolation, 8-element packets. Quaternion */
/* and quaternion derivatives only, no angular velocity */
/* vector provided. Quaternion elements are listed */
/* first, followed by derivatives. Angular velocity is */
/* derived from the quaternions and quaternion */
/* derivatives. */
/* Subtype 1: Lagrange interpolation, 4-element packets. Quaternion */
/* only. Angular velocity is derived by differentiating */
/* the interpolating polynomials. */
/* Subtype 2: Hermite interpolation, 14-element packets. */
/* Quaternion and angular angular velocity vector, as */
/* well as derivatives of each, are provided. The */
/* quaternion comes first, then quaternion derivatives, */
/* then angular velocity and its derivatives. */
/* Subtype 3: Lagrange interpolation, 7-element packets. Quaternion */
/* and angular velocity vector provided. The quaternion */
/* comes first. */
/* Packet sizes associated with the various subtypes: */
/* End of file ck05.inc. */
/* $ Abstract */
/* Declarations of the CK data type specific and general CK low */
/* level routine parameters. */
/* $ 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.REQ */
/* $ Keywords */
/* CK */
/* $ Restrictions */
/* 1) If new CK types are added, the size of the record passed */
/* between CKRxx and CKExx must be registered as separate */
/* parameter. If this size will be greater than current value */
/* of the CKMRSZ parameter (which specifies the maximum record */
/* size for the record buffer used inside CKPFS) then it should */
/* be assigned to CKMRSZ as a new value. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* CK Required Reading. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 19-AUG-2002 (NJB) */
/* Updated to support CK type 5. */
/* - SPICELIB Version 1.0.0, 05-APR-1999 (BVS) */
/* -& */
/* Number of quaternion components and number of quaternion and */
/* angular rate components together. */
/* CK Type 1 parameters: */
/* CK1DTP CK data type 1 ID; */
/* CK1RSZ maximum size of a record passed between CKR01 */
/* and CKE01. */
/* CK Type 2 parameters: */
/* CK2DTP CK data type 2 ID; */
/* CK2RSZ maximum size of a record passed between CKR02 */
/* and CKE02. */
/* CK Type 3 parameters: */
/* CK3DTP CK data type 3 ID; */
/* CK3RSZ maximum size of a record passed between CKR03 */
/* and CKE03. */
/* CK Type 4 parameters: */
/* CK4DTP CK data type 4 ID; */
/* CK4PCD parameter defining integer to DP packing schema that */
/* is applied when seven number integer array containing */
/* polynomial degrees for quaternion and angular rate */
/* components packed into a single DP number stored in */
/* actual CK records in a file; the value of must not be */
/* changed or compatibility with existing type 4 CK files */
/* will be lost. */
/* CK4MXD maximum Chebychev polynomial degree allowed in type 4 */
/* records; the value of this parameter must never exceed */
/* value of the CK4PCD; */
/* CK4SFT number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 4 */
/* CK record that passed between routines CKR04 and CKE04; */
/* CK4RSZ maximum size of type 4 CK record passed between CKR04 */
/* and CKE04; CK4RSZ is computed as follows: */
/* CK4RSZ = ( CK4MXD + 1 ) * QAVSIZ + CK4SFT */
/* CK Type 5 parameters: */
/* CK5DTP CK data type 5 ID; */
/* CK5MXD maximum polynomial degree allowed in type 5 */
/* records. */
/* CK5MET number of additional DPs, which are not polynomial */
/* coefficients, located at the beginning of a type 5 */
/* CK record that passed between routines CKR05 and CKE05; */
/* CK5MXP maximum packet size for any subtype. Subtype 2 */
/* has the greatest packet size, since these packets */
/* contain a quaternion, its derivative, an angular */
/* velocity vector, and its derivative. See ck05.inc */
/* for a description of the subtypes. */
/* CK5RSZ maximum size of type 5 CK record passed between CKR05 */
/* and CKE05; CK5RSZ is computed as follows: */
/* CK5RSZ = ( CK5MXD + 1 ) * CK5MXP + CK5MET */
/* Maximum record size that can be handled by CKPFS. This value */
/* must be set to the maximum of all CKxRSZ parameters (currently */
/* CK4RSZ.) */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle. */
/* DESCR I Segment descriptor. */
/* SCLKDP I Pointing request time. */
/* TOL I Lookup tolerance. */
/* NEEDAV I Angular velocity flag. */
/* RECORD O Data record. */
/* FOUND O Flag indicating whether record was found. */
/* $ Detailed_Input */
/* HANDLE, */
/* DESCR are the file handle and segment descriptor for */
/* a CK segment of type 05. */
/* SCLKDP is an encoded spacecraft clock time indicating */
/* the epoch for which pointing is desired. */
/* TOL is a time tolerance, measured in the same units as */
/* encoded spacecraft clock. */
/* When SCLKDP falls within the bounds of one of the */
/* interpolation intervals then the tolerance has no */
/* effect because pointing will be returned at the */
/* request time. */
/* However, if the request time is not in one of the */
/* intervals, then the tolerance is used to determine */
/* if pointing at one of the interval endpoints should */
/* be returned. */
/* NEEDAV is true if angular velocity is requested. */
/* $ Detailed_Output */
/* RECORD is a set of data from the specified segment which, */
/* when evaluated at epoch SCLKDP, will give the */
/* attitude and angular velocity of some body, relative */
/* to the reference frame indicated by DESCR. */
/* The structure of the record is as follows: */
/* +----------------------+ */
/* | evaluation epoch | */
/* +----------------------+ */
/* | subtype code | */
/* +----------------------+ */
/* | number of packets (n)| */
/* +----------------------+ */
/* | nominal SCLK rate | */
/* +----------------------+ */
/* | packet 1 | */
/* +----------------------+ */
/* | packet 2 | */
/* +----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------+ */
/* | packet n | */
/* +----------------------+ */
/* | epochs 1--n | */
/* +----------------------+ */
/* The packet size is a function of the subtype code. */
/* All packets in a record have the same size. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* This routine follows the pattern established in the lower-numbered */
/* CK data type readers of not explicitly performing error */
/* diagnoses. Exceptions are listed below nonetheless. */
/* 1) If the input HANDLE does not designate a loaded CK file, the */
/* error will be diagnosed by routines called by this routine. */
/* 2) If the segment specified by DESCR is not of data type 05, */
/* the error 'SPICE(WRONGCKTYPE)' is signaled. */
/* 3) If the input SCLK value is not within the range specified */
/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */
/* is signaled. */
/* 4) If the window size is non-positive or greater than the */
/* maximum allowed value, the error SPICE(INVALIDVALUE) is */
/* signaled. */
/* 5) If the window size is not compatible with the segment */
/* subtype, the error SPICE(INVALIDVALUE) is signaled. */
/* 6) If the segment subtype is not recognized, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 7) If the tolerance is negative, the error SPICE(VALUEOUTOFRANGE) */
/* is signaled. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* See the CK Required Reading file for a description of the */
/* structure of a data type 05 segment. */
/* $ Examples */
/* The data returned by the CKRnn 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 CKRxx */
/* routines might be used to "dump" and check segment data for a */
/* particular epoch. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* C CALL CKBSS ( INST, SCLKDP, TOL, NEEDAV ) */
/* CALL CKSNS ( HANDLE, DESCR, SEGID, SFND ) */
/* IF ( .NOT. SFND ) THEN */
/* [Handle case of pointing not being found] */
/* END IF */
/* 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. 05 ) THEN */
/* CALL CKR05 ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV, */
/* . RECORD, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* [Handle case of pointing not being found] */
/* END IF */
/* [Look at the RECORD data] */
/* . */
/* . */
/* . */
/* END IF */
/* $ Restrictions */
/* 1) Correctness of inputs must be ensured by the caller of */
/* this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.0, 06-SEP-2002 (NJB) */
/* -& */
/* $ Index_Entries */
/* read record from type_5 ck segment */
/* -& */
/* $ Revisions */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Maximum polynomial degree: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKR05", (ftnlen)5);
/* No pointing found so far. */
*found = FALSE_;
/* Unpack the segment descriptor, and get the start and end addresses */
/* of the segment. */
dafus_(descr, &c__2, &c__6, dc, ic);
type__ = ic[2];
begin = ic[4];
end = ic[5];
/* Make sure that this really is a type 05 data segment. */
if (type__ != 5) {
setmsg_("You are attempting to locate type * data in a type 5 data s"
"egment.", (ftnlen)66);
errint_("*", &type__, (ftnlen)1);
sigerr_("SPICE(WRONGCKTYPE)", (ftnlen)18);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative but was actually *.", (ftnlen)
50);
errdp_("*", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the request time and tolerance against the bounds in */
/* the segment descriptor. */
if (*sclkdp + *tol < dc[0] || *sclkdp - *tol > dc[1]) {
/* The request time is too far outside the segment's coverage */
/* interval for any pointing to satisfy the request. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Set the request time to use for searching. */
t = brcktd_(sclkdp, dc, &dc[1]);
/* From this point onward, we assume the segment was constructed */
/* correctly. In particular, we assume: */
/* 1) The segment descriptor's time bounds are in order and are */
/* distinct. */
/* 2) The epochs in the segment are in strictly increasing */
/* order. */
/* 3) The interpolation interval start times in the segment are */
/* in strictly increasing order. */
/* 4) The degree of the interpolating polynomial specified by */
/* the segment is at least 1 and is no larger than MAXDEG. */
i__1 = end - 4;
dafgda_(handle, &i__1, &end, contrl);
/* Check the FAILED flag just in case HANDLE is not attached to */
/* any DAF file and the error action is not set to ABORT. We */
/* do this only after the first call to DAFGDA, as in CKR03. */
if (failed_()) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
rate = contrl[0];
subtyp = i_dnnt(&contrl[1]);
wndsiz = i_dnnt(&contrl[2]);
nints = i_dnnt(&contrl[3]);
n = i_dnnt(&contrl[4]);
/* Set the packet size, which is a function of the subtype. */
if (subtyp == 0) {
packsz = 8;
} else if (subtyp == 1) {
packsz = 4;
} else if (subtyp == 2) {
packsz = 14;
} else if (subtyp == 3) {
packsz = 7;
} else {
setmsg_("Unexpected CK type 5 subtype # found in type 5 segment.", (
ftnlen)55);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Check the window size. */
if (wndsiz <= 0) {
setmsg_("Window size in type 05 segment was #; must be positive.", (
ftnlen)55);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (subtyp == 0 || subtyp == 2) {
/* These are the Hermite subtypes. */
maxwnd = 8;
if (wndsiz > maxwnd) {
setmsg_("Window size in type 05 segment was #; max allowed value"
" is # for subtypes 0 and 2 (Hermite, 8 or 14-element pac"
"kets).", (ftnlen)117);
errint_("#", &wndsiz, (ftnlen)1);
errint_("#", &maxwnd, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (odd_(&wndsiz)) {
setmsg_("Window size in type 05 segment was #; must be even for "
"subtypes 0 and 2 (Hermite, 8 or 14-element packets).", (
ftnlen)107);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
} else if (subtyp == 1 || subtyp == 3) {
/* These are the Lagrange subtypes. */
maxwnd = 16;
if (wndsiz > maxwnd) {
setmsg_("Window size in type 05 segment was #; max allowed value"
" is # for subtypes 1 and 3 (Lagrange, 4 or 7-element pac"
"kets).", (ftnlen)117);
errint_("#", &wndsiz, (ftnlen)1);
errint_("#", &maxwnd, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
if (odd_(&wndsiz)) {
setmsg_("Window size in type 05 segment was #; must be even for "
"subtypes 1 and 3 (Lagrange, 4 or 7-element packets).", (
ftnlen)107);
errint_("#", &wndsiz, (ftnlen)1);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
} else {
setmsg_("This point should not be reached. Getting here may indicate"
" that the code needs to updated to handle the new subtype #",
(ftnlen)118);
errint_("#", &subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* We now need to select the pointing values to interpolate */
/* in order to satisfy the pointing request. The first step */
/* is to use the pointing directories (if any) to locate a set of */
/* epochs bracketing the request time. Note that the request */
/* time might not be bracketed: it could precede the first */
/* epoch or follow the last epoch. */
/* We'll use the variable PGROUP to refer to the set of epochs */
/* to search. The first group consists of the epochs prior to */
/* and including the first pointing directory entry. The last */
/* group consists of the epochs following the last pointing */
/* directory entry. Other groups consist of epochs following */
/* one pointing directory entry up to and including the next */
/* pointing directory entry. */
npdir = (n - 1) / 100;
dirbas = begin + n * packsz + n - 1;
if (npdir == 0) {
/* There's no mystery about which group of epochs to search. */
pgroup = 1;
} else {
/* There's at least one directory. Find the first directory */
/* whose time is greater than or equal to the request time, if */
/* there is such a directory. We'll search linearly through the */
/* directory entries, reading up to DIRSIZ of them at a time. */
/* Having found the correct set of directory entries, we'll */
/* perform a binary search within that set for the desired entry. */
bufbas = dirbas;
npread = min(npdir,100);
i__1 = bufbas + 1;
i__2 = bufbas + npread;
dafgda_(handle, &i__1, &i__2, pbuffr);
remain = npdir - npread;
while(pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)633)] < t && remain > 0) {
bufbas += npread;
npread = min(remain,100);
/* Note: NPREAD is always > 0 here. */
i__1 = bufbas + 1;
i__2 = bufbas + npread;
dafgda_(handle, &i__1, &i__2, pbuffr);
remain -= npread;
}
/* At this point, BUFBAS - DIRBAS is the number of directory */
/* entries preceding the one contained in PBUFFR(1). */
/* PGROUP is one more than the number of directories we've */
/* passed by. */
pgroup = bufbas - dirbas + lstltd_(&t, &npread, pbuffr) + 1;
}
/* PGROUP now indicates the set of epochs in which to search for the */
/* request epoch. The following cases can occur: */
/* PGROUP = 1 */
/* ========== */
/* NPDIR = 0 */
/* -------- */
/* The request time may precede the first time tag */
/* of the segment, exceed the last time tag, or lie */
/* in the closed interval bounded by these time tags. */
/* NPDIR >= 1 */
/* --------- */
/* The request time may precede the first time tag */
/* of the group but does not exceed the last epoch */
/* of the group. */
/* 1 < PGROUP <= NPDIR */
/* =================== */
/* The request time follows the last time of the */
/* previous group and is less than or equal to */
/* the pointing directory entry at index PGROUP. */
/* 1 < PGROUP = NPDIR + 1 */
/* ====================== */
/* The request time follows the last time of the */
/* last pointing directory entry. The request time */
/* may exceed the last time tag. */
/* Now we'll look up the time tags in the group of epochs */
/* we've identified. */
/* We'll use the variable names PBEGIX and PENDIX to refer to */
/* the indices, relative to the set of time tags, of the first */
/* and last time tags in the set we're going to look up. */
if (pgroup == 1) {
pbegix = 1;
pendix = min(n,100);
} else {
/* If the group index is greater than 1, we'll include the last */
/* time tag of the previous group in the set of time tags we look */
/* up. That way, the request time is strictly bracketed on the */
/* low side by the time tag set we look up. */
pbegix = (pgroup - 1) * 100;
/* Computing MIN */
i__1 = pbegix + 100;
pendix = min(i__1,n);
}
timbas = dirbas - n;
i__1 = timbas + pbegix;
i__2 = timbas + pendix;
dafgda_(handle, &i__1, &i__2, pbuffr);
npread = pendix - pbegix + 1;
/* At this point, we'll deal with the cases where T lies outside */
/* of the range of epochs we've buffered. */
if (t < pbuffr[0]) {
/* This can happen only if PGROUP = 1 and T precedes all epochs. */
/* If the input request time is too far from PBUFFR(1) on */
/* the low side, we're done. */
if (*sclkdp + *tol < pbuffr[0]) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Bracket T to move it within the range of buffered epochs. */
t = pbuffr[0];
} else if (t > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 :
s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)748)]) {
/* This can happen only if T follows all epochs. */
if (*sclkdp - *tol > pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("pbuffr", i__1, "ckr05_", (ftnlen)752)]) {
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Bracket T to move it within the range of buffered epochs. */
t = pbuffr[(i__1 = npread - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)762)];
}
/* At this point, */
/* | T - SCLKDP | <= TOL */
/* Also, one of the following is true: */
/* T is the first time of the segment */
/* T is the last time of the segment */
/* T equals SCLKDP */
/* Find two adjacent time tags bounding the request epoch. The */
/* request time cannot be greater than all of time tags in the */
/* group, and it cannot precede the first element of the group. */
i__ = lstltd_(&t, &npread, pbuffr);
/* The variables LOW and HIGH are the indices of a pair of time */
/* tags that bracket the request time. Remember that NPREAD could */
/* be equal to 1, in which case we would have LOW = HIGH. */
if (i__ == 0) {
/* This can happen only if PGROUP = 1 and T = PBUFFR(1). */
low = 1;
lepoch = pbuffr[0];
if (n == 1) {
high = 1;
} else {
high = 2;
}
hepoch = pbuffr[(i__1 = high - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)805)];
} else {
low = pbegix + i__ - 1;
lepoch = pbuffr[(i__1 = i__ - 1) < 101 && 0 <= i__1 ? i__1 : s_rnge(
"pbuffr", i__1, "ckr05_", (ftnlen)810)];
high = low + 1;
hepoch = pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbu"
"ffr", i__1, "ckr05_", (ftnlen)813)];
}
/* We now need to find the interpolation interval containing */
/* T, if any. We may be able to use the interpolation */
/* interval found on the previous call to this routine. If */
/* this is the first call or if the previous interval is not */
/* applicable, we'll search for the interval. */
/* First check if the request time falls in the same interval as */
/* it did last time. We need to make sure that we are dealing */
/* with the same segment as well as the same time range. */
/* PREVS is the start time of the interval that satisfied */
/* the previous request for pointing. */
/* PREVN is the start time of the interval that followed */
/* the interval specified above. */
/* PREVNN is the start time of the interval that followed */
/* the interval starting at PREVN. */
/* LHAND is the handle of the file that PREVS and PREVN */
/* were found in. */
/* LBEG, are the beginning and ending addresses of the */
/* LEND segment in the file LHAND that PREVS and PREVN */
/* were found in. */
if (*handle == lhand && begin == lbeg && end == lend && t >= prevs && t <
prevn) {
start = prevs;
nstart = prevn;
nnstrt = prevnn;
} else {
/* Search for the interpolation interval. */
nidir = (nints - 1) / 100;
dirbas = end - 5 - nidir;
if (nidir == 0) {
/* There's no mystery about which group of epochs to search. */
sgroup = 1;
} else {
/* There's at least one directory. Find the first directory */
/* whose time is greater than or equal to the request time, if */
/* there is such a directory. We'll search linearly through */
/* the directory entries, reading up to DIRSIZ of them at a */
/* time. Having found the correct set of directory entries, */
/* we'll perform a binary search within that set for the */
/* desired entry. */
bufbas = dirbas;
nsread = min(nidir,100);
remain = nidir - nsread;
i__1 = bufbas + 1;
i__2 = bufbas + nsread;
dafgda_(handle, &i__1, &i__2, sbuffr);
while(sbuffr[(i__1 = nsread - 1) < 103 && 0 <= i__1 ? i__1 :
s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)885)] < t &&
remain > 0) {
bufbas += nsread;
nsread = min(remain,100);
remain -= nsread;
/* Note: NSREAD is always > 0 here. */
i__1 = bufbas + 1;
i__2 = bufbas + nsread;
dafgda_(handle, &i__1, &i__2, sbuffr);
}
/* At this point, BUFBAS - DIRBAS is the number of directory */
/* entries preceding the one contained in SBUFFR(1). */
/* SGROUP is one more than the number of directories we've */
/* passed by. */
sgroup = bufbas - dirbas + lstltd_(&t, &nsread, sbuffr) + 1;
}
/* SGROUP now indicates the set of interval start times in which */
/* to search for the request epoch. */
/* Now we'll look up the time tags in the group of epochs we've */
/* identified. */
/* We'll use the variable names SBEGIX and SENDIX to refer to the */
/* indices, relative to the set of start times, of the first and */
/* last start times in the set we're going to look up. */
if (sgroup == 1) {
sbegix = 1;
sendix = min(nints,102);
} else {
/* Look up the start times for the group of interest. Also */
/* buffer last start time from the previous group. Also, it */
/* turns out to be useful to pick up two extra start */
/* times---the first two start times of the next group---if */
/* they exist. */
sbegix = (sgroup - 1) * 100;
/* Computing MIN */
i__1 = sbegix + 102;
sendix = min(i__1,nints);
}
timbas = dirbas - nints;
i__1 = timbas + sbegix;
i__2 = timbas + sendix;
dafgda_(handle, &i__1, &i__2, sbuffr);
nsread = sendix - sbegix + 1;
/* Find the last interval start time less than or equal to the */
/* request time. We know T is greater than or equal to the */
/* first start time, so I will be > 0. */
nsrch = min(101,nsread);
i__ = lstled_(&t, &nsrch, sbuffr);
start = sbuffr[(i__1 = i__ - 1) < 103 && 0 <= i__1 ? i__1 : s_rnge(
"sbuffr", i__1, "ckr05_", (ftnlen)956)];
/* Let NSTART ("next start") be the start time that follows */
/* START, if START is not the last start time. If NSTART */
/* has a successor, let NNSTRT be that start time. */
if (i__ < nsread) {
nstart = sbuffr[(i__1 = i__) < 103 && 0 <= i__1 ? i__1 : s_rnge(
"sbuffr", i__1, "ckr05_", (ftnlen)965)];
if (i__ + 1 < nsread) {
nnstrt = sbuffr[(i__1 = i__ + 1) < 103 && 0 <= i__1 ? i__1 :
s_rnge("sbuffr", i__1, "ckr05_", (ftnlen)969)];
} else {
nnstrt = dpmax_();
}
} else {
nstart = dpmax_();
nnstrt = dpmax_();
}
}
/* If T does not lie within the interpolation interval starting */
/* at time START, we'll determine whether T is closer to this */
/* interval or the next. If the distance between T and the */
/* closer interval is less than or equal to TOL, we'll map T */
/* to the closer endpoint of the closer interval. Otherwise, */
/* we return without finding pointing. */
if (hepoch == nstart) {
/* The first time tag greater than or equal to T is the start */
/* time of the next interpolation interval. */
/* The request time lies between interpolation intervals. */
/* LEPOCH is the last time tag of the first interval; HEPOCH */
/* is the first time tag of the next interval. */
if ((d__1 = t - lepoch, abs(d__1)) <= (d__2 = hepoch - t, abs(d__2)))
{
/* T is closer to the first interval... */
if ((d__1 = t - lepoch, abs(d__1)) > *tol) {
/* ...But T is too far from the interval. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Map T to the right endpoint of the preceding interval. */
t = lepoch;
high = low;
hepoch = lepoch;
} else {
/* T is closer to the second interval... */
if ((d__1 = hepoch - t, abs(d__1)) > *tol) {
/* ...But T is too far from the interval. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Map T to the left endpoint of the next interval. */
t = hepoch;
low = high;
lepoch = hepoch;
/* Since we're going to be picking time tags from the next */
/* interval, we'll need to adjust START and NSTART. */
start = nstart;
nstart = nnstrt;
}
}
/* We now have */
/* LEPOCH < T < HEPOCH */
/* - - */
/* where LEPOCH and HEPOCH are the time tags at indices */
/* LOW and HIGH, respectively. */
/* Now select the set of packets used for interpolation. Note */
/* that the window size is known to be even. */
/* Unlike CK types 8, 9, 12, and 13, for type 05 we adjust */
/* the window size to keep the request time within the central */
/* interval of the window. */
/* The nominal bracketing epochs we've found are the (WNDSIZ/2)nd */
/* and (WNDSIZ/2 + 1)st of the interpolating set. If the request */
/* time is too close to one end of the interpolation interval, we */
/* reduce the window size, after which one endpoint of the window */
/* will coincide with an endpoint of the interpolation interval. */
/* We start out by looking up the set of time tags we'd use */
/* if there were no gaps in the coverage. We then trim our */
/* time tag set to ensure all tags are in the interpolation */
/* interval. It's possible that the interpolation window will */
/* collapse to a single point as a result of this last step. */
/* Let LSIZE be the size of the "left half" of the window: the */
/* size of the set of window epochs to the left of the request time. */
/* We want this size to be WNDSIZ/2, but if not enough states are */
/* available, the set ranges from index 1 to index LOW. */
/* Computing MIN */
i__1 = wndsiz / 2;
lsize = min(i__1,low);
/* RSIZE is defined analogously for the right half of the window. */
/* Computing MIN */
i__1 = wndsiz / 2, i__2 = n - high + 1;
rsize = min(i__1,i__2);
/* The window size is simply the sum of LSIZE and RSIZE. */
wndsiz = lsize + rsize;
/* FIRST and LAST are the endpoints of the range of indices of */
/* time tags (and packets) we'll collect in the output record. */
first = low - lsize + 1;
last = first + wndsiz - 1;
/* Buffer the epochs. */
wstart = begin + n * packsz + first - 1;
i__1 = wstart + wndsiz - 1;
dafgda_(handle, &wstart, &i__1, pbuffr);
/* Discard any epochs less than START or greater than or equal */
/* to NSTART. The set of epochs we want ranges from indices */
/* I+1 to J. This range is non-empty unless START and NSTART */
/* are both DPMAX(). */
i__ = lstltd_(&start, &wndsiz, pbuffr);
j = lstltd_(&nstart, &wndsiz, pbuffr);
if (i__ == j) {
/* Fuggedaboudit. */
chkout_("CKR05", (ftnlen)5);
return 0;
}
/* Update FIRST, LAST, and WNDSIZ. */
wndsiz = j - i__;
first += i__;
last = first + wndsiz - 1;
/* Put the subtype into the output record. The size of the group */
/* of packets is derived from the subtype, so we need not include */
/* the size. */
record[0] = t;
record[1] = (doublereal) subtyp;
record[2] = (doublereal) wndsiz;
record[3] = rate;
/* Read the packets. */
i__1 = begin + (first - 1) * packsz;
i__2 = begin + last * packsz - 1;
dafgda_(handle, &i__1, &i__2, &record[4]);
/* Finally, add the epochs to the output record. */
i__2 = j - i__;
moved_(&pbuffr[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 : s_rnge("pbuffr",
i__1, "ckr05_", (ftnlen)1158)], &i__2, &record[wndsiz * packsz +
4]);
/* Save the information about the interval and segment. */
lhand = *handle;
lbeg = begin;
lend = end;
prevs = start;
prevn = nstart;
prevnn = nnstrt;
/* Indicate pointing was found. */
*found = TRUE_;
chkout_("CKR05", (ftnlen)5);
return 0;
} /* ckr05_ */
/* $Procedure ZZGFRPWK ( Geometry finder report work done on a task ) */
/* Subroutine */ int zzgfrpwk_0_(int n__, integer *unit, doublereal *total,
doublereal *freq, integer *tcheck, char *begin, char *end, doublereal
*incr, ftnlen begin_len, ftnlen end_len)
{
/* Initialized data */
static integer calls = 0;
static integer stdout = 6;
static doublereal step = 0.;
static doublereal svincr = 0.;
static integer svunit = 6;
static integer check = 1;
static doublereal done = 0.;
static doublereal entire = 0.;
static char finish[13] = " ";
static logical first = TRUE_;
static integer ls = 1;
static doublereal lstsec = 0.;
static char start[55] = " "
" ";
/* System generated locals */
address a__1[5];
integer i__1[5];
doublereal d__1, d__2;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
/* Local variables */
doublereal tvec[6];
extern /* Subroutine */ int zzgfdsps_(integer *, char *, char *, integer *
, ftnlen, ftnlen), zzcputim_(doublereal *), chkin_(char *, ftnlen)
, dpfmt_(doublereal *, char *, char *, ftnlen, ftnlen), stdio_(
char *, integer *, ftnlen);
extern integer rtrim_(char *, ftnlen);
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal fractn;
char messge[78];
doublereal cursec;
char prcent[10];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
extern logical return_(void);
extern /* Subroutine */ int writln_(char *, integer *, ftnlen);
/* $ Abstract */
/* The entry points under this routine allows one to easily monitor */
/* the status of job in progress. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* UTILITY */
/* REPORT */
/* WORK */
/* $ Declarations */
/* $ Abstract */
/* SPICE private include file intended solely for the support of */
/* SPICE routines. Users should not include this routine in their */
/* source code due to the volatile nature of this file. */
/* This file contains private, global parameter declarations */
/* for the SPICELIB Geometry Finder (GF) subsystem. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* GEOMETRY */
/* ROOT */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */
/* -& */
/* The set of supported coordinate systems */
/* System Coordinates */
/* ---------- ----------- */
/* Rectangular X, Y, Z */
/* Latitudinal Radius, Longitude, Latitude */
/* Spherical Radius, Colatitude, Longitude */
/* RA/Dec Range, Right Ascension, Declination */
/* Cylindrical Radius, Longitude, Z */
/* Geodetic Longitude, Latitude, Altitude */
/* Planetographic Longitude, Latitude, Altitude */
/* Below we declare parameters for naming coordinate systems. */
/* User inputs naming coordinate systems must match these */
/* when compared using EQSTR. That is, user inputs must */
/* match after being left justified, converted to upper case, */
/* and having all embedded blanks removed. */
/* Below we declare names for coordinates. Again, user */
/* inputs naming coordinates must match these when */
/* compared using EQSTR. */
/* Note that the RA parameter value below matches */
/* 'RIGHT ASCENSION' */
/* when extra blanks are compressed out of the above value. */
/* Parameters specifying types of vector definitions */
/* used for GF coordinate searches: */
/* All string parameter values are left justified, upper */
/* case, with extra blanks compressed out. */
/* POSDEF indicates the vector is defined by the */
/* position of a target relative to an observer. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the sub-observer point on */
/* that body, for a given observer and target. */
/* SOBDEF indicates the vector points from the center */
/* of a target body to the surface intercept point on */
/* that body, for a given observer, ray, and target. */
/* Number of workspace windows used by ZZGFREL: */
/* Number of additional workspace windows used by ZZGFLONG: */
/* Index of "existence window" used by ZZGFCSLV: */
/* Progress report parameters: */
/* MXBEGM, */
/* MXENDM are, respectively, the maximum lengths of the progress */
/* report message prefix and suffix. */
/* Note: the sum of these lengths, plus the length of the */
/* "percent complete" substring, should not be long enough */
/* to cause wrap-around on any platform's terminal window. */
/* Total progress report message length upper bound: */
/* End of file zzgf.inc. */
/* $ Brief_I/O */
/* VARIABLE I/O Entry points */
/* -------- --- -------------------------------------------------- */
/* UNIT I-O ZZGFWKUN, ZZGFWKMO */
/* TOTAL I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */
/* FREQ I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */
/* TCHECK I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */
/* BEGIN I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */
/* END I-O ZZGFTSWK, ZZGFWKAD, ZZGFWKMO */
/* INCR I-O ZZGFWKIN, ZZGFWKMO */
/* $ Detailed_Input */
/* See the headers of the entry points. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* MXBEGM, */
/* MXENDM, */
/* MXMSG are, respectively, the maximum lengths of the progress */
/* message prefix, progress message suffix, and the */
/* complete message. */
/* $ Exceptions */
/* If this routine is called directly, the error SPICE(BOGUSENTRY) */
/* is signaled. */
/* See the entry points for descriptions of exceptions they detect. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The entry points under this routine are designed to allow one to */
/* easily build into his/her application a monitoring facility */
/* that reports how work on a particular task is proceeding. */
/* There are five entry points: ZZGFTSWK, ZZGFWKIN, ZZGFWKAD, */
/* ZZGFWKUN, and ZZGFWKMO. */
/* The first entry point ZZGFTSWK is used to initialize the reporter. */
/* It is used to tell the reporter "I have some work to do. This is */
/* how much, and this is how often I want you to report on the */
/* progress of the task." */
/* The second entry point ZZGFWKIN is used to tell the reporter "I've */
/* just finished some of the task I told you about with ZZGFTSWK. */
/* This is how much I've just done." (As in real life, the amount */
/* of work you've just done can be negative.) The reporter uses */
/* this information together with the information input in ZZGFTSWK */
/* to decide whether and how much work to report as finished. The */
/* reports will be sent to the current output device. */
/* The third entry point, ZZGFWKAD, adjusts the frequency with which */
/* work progress is reported. */
/* The fourth entry point ZZGFWKUN also is used for testing. It is */
/* used to send the output to the file connected to a specified */
/* logical unit. */
/* The fifth entry point ZZGFWKMO is used for testing. It returns */
/* the saved search parameters. */
/* A more detailed description of each entry point is provided in its */
/* associated header. */
/* $ Examples */
/* A typical use of ZZGFRPWK might be as follows. */
/* C */
/* C Compute how much work is to be done and put it in TOTAL */
/* C */
/* code */
/* computing */
/* how */
/* much */
/* work */
/* to */
/* do */
/* . */
/* . */
/* . */
/* TOTAL = <the amount of work to do> */
/* C */
/* C Tell the work reporter to report work completed every */
/* C 3 seconds. (The third argument in ZZGFTSWK is explained */
/* C in the header for ZZGFTSWK.) */
/* C */
/* FREQUENCY = 3.0D0 */
/* BEGIN = 'Current work status: ' */
/* END = 'completed. ' */
/* CALL ZZGFTSWK ( TOTAL, FREQUENCY, 1, BEGIN, END ) */
/* DO WHILE ( THERE_IS_MORE_WORK_TO_DO ) */
/* code that */
/* performs */
/* the work to */
/* be done */
/* AMOUNT = amount of work done in this loop pass */
/* CALL ZZGFWKIN ( AMOUNT ) */
/* END DO */
/* $ Restrictions */
/* You can use this routine to report progress on only one task at */
/* a time. The work reporter must be initialized using ZZGFTSWK */
/* before calling ZZGFWKIN. Failure to do this may lead to */
/* unexpected results. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.S. Elson (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* GF low-level progress report umbrella */
/* -& */
/* SPICELIB Functions */
/* Local variables */
/* Saved variables */
/* Initial values */
switch(n__) {
case 1: goto L_zzgftswk;
case 2: goto L_zzgfwkin;
case 3: goto L_zzgfwkad;
case 4: goto L_zzgfwkun;
case 5: goto L_zzgfwkmo;
}
chkin_("ZZGFRPWK", (ftnlen)8);
sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
chkout_("ZZGFRPWK", (ftnlen)8);
return 0;
/* $Procedure ZZGFTSWK ( Geometry finder total sum of work to be done. ) */
L_zzgftswk:
/* $ Abstract */
/* Initialize the work progress utility. This is required prior to */
/* use of the routine that performs the actual reporting. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* UTILITY */
/* REPORT */
/* WORK */
/* $ Declarations */
/* DOUBLE PRECISION TOTAL */
/* DOUBLE PRECISION FREQ */
/* INTEGER TCHECK */
/* CHARACTER*(*) BEGIN */
/* CHARACTER*(*) END */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TOTAL I A measure of the total amount of work to be done. */
/* FREQ I How often the work progress should be reported. */
/* TCHECK I How often to sample the system clock. */
/* BEGIN I First part of the output message. */
/* END I Last part of the output message. */
/* $ Detailed_Input */
/* UNIT is a logical unit connected to the output stream */
/* to which the progress report should be sent. */
/* Normally UNIT is set to the standard output unit, */
/* which can be obtained by calling the SPICELIB */
/* routine STDIO. Unit can be a logical unit connected */
/* to a file; this feature supports testing. */
/* TOTAL is a measure of the total amount of work to be done */
/* by the routine(s) that will be using this facility. */
/* It is expected (but not required) that TOTAL is a */
/* positive number. */
/* FREQ is the how often the work progress should be reported */
/* in seconds. If FREQ = 5 then a work progress report */
/* will be sent to the output device approximately every */
/* 5 seconds. Since writing to the output device takes */
/* time, the smaller FREQ is set, the greater the overhead */
/* taken up by the work reporter will be. ( A value of 2 */
/* or greater should not burden your application */
/* appreciably ) */
/* TCHECK is an integer used to the tell the reporter how often */
/* to sample the system clock. If TCHECK = 7, then on */
/* every seventh call to ZZGFWKIN, the system clock will */
/* be sampled to determine if FREQ seconds have elapsed */
/* since the last report time. Sampling the system clock */
/* takes time. Not a lot of time, but it does take time. */
/* If ZZGFWKIN is being called from a loop that does not */
/* take a lot of time for each pass, the sampling of */
/* the system clock can become a significant overhead */
/* cost in itself. On the VAX the sampling of the */
/* system clock used here takes about 37 double precision */
/* multiplies. If thousands of multiplies take place */
/* between calls to ZZGFWKIN, the sampling time is */
/* insignificant. On the other hand, if only a hundred or */
/* so multiplies occur between calls to ZZGFWKIN, the */
/* sampling of the system clock can become a significant */
/* fraction of your overhead. TCHECK allows you to */
/* tailor the work reporter to your application. */
/* If a non-positive value for TCHECK is entered, a value */
/* of 1 will be used instead of the input value. */
/* BEGIN Is the first part of the output message that will be */
/* constructed for shipment to the output device. This */
/* message will have the form: */
/* BEGIN // xx.x% // END */
/* where xx.x is the percentage of the job completed when */
/* the output message is sent to the output device. */
/* END is the second part of the output message that will be */
/* constructed and sent to the output device (see above). */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Standard SPICE error handling. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This entry point is used to initialize parameters that will */
/* be used by ZZGFWKIN. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* See the header for this module */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.S. Elson (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* GF low-level initialize progress report */
/* -& */
if (return_()) {
return 0;
}
chkin_("ZZGFTSWK", (ftnlen)8);
/* On the first pass, obtain the logical unit for */
/* standard output. */
if (first) {
stdio_("STDOUT", &stdout, (ftnlen)6);
/* The output unit is STDOUT unless the caller */
/* sets it to something else. */
svunit = stdout;
first = FALSE_;
}
/* Save the inputs and set the amount of work done to 0 */
entire = *total;
/* Computing MIN */
d__1 = 3600., d__2 = max(0.,*freq);
step = min(d__1,d__2);
check = max(1,*tcheck);
s_copy(start, begin, (ftnlen)55, begin_len);
s_copy(finish, end, (ftnlen)13, end_len);
done = 0.;
/* Set the timer. */
zzcputim_(tvec);
lstsec = tvec[3] * 3600. + tvec[4] * 60. + tvec[5];
/* Set the increment counter */
calls = 0;
/* Compose the output message. */
ls = rtrim_(start, (ftnlen)55);
/* Writing concatenation */
i__1[0] = ls, a__1[0] = start;
i__1[1] = 1, a__1[1] = " ";
i__1[2] = 7, a__1[2] = " 0.00%";
i__1[3] = 1, a__1[3] = " ";
i__1[4] = 13, a__1[4] = finish;
s_cat(messge, a__1, i__1, &c__5, (ftnlen)78);
/* Display a blank line, make sure we don't overwrite anything */
/* at the bottom of the screen. The display the message. */
if (svunit == stdout) {
zzgfdsps_(&c__1, messge, "A", &c__0, (ftnlen)78, (ftnlen)1);
} else {
/* Write the message without special carriage control. */
writln_(" ", &svunit, (ftnlen)1);
writln_(" ", &svunit, (ftnlen)1);
writln_(messge, &svunit, (ftnlen)78);
}
chkout_("ZZGFTSWK", (ftnlen)8);
return 0;
/* $Procedure ZZGFWKIN ( Geometry finder work finished increment ) */
L_zzgfwkin:
/* $ Abstract */
/* Let the work reporter know that an increment of work has just */
/* been completed. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* UTILITY */
/* REPORT */
/* WORK */
/* $ Declarations */
/* DOUBLE PRECISION INCR */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* INCR I An amount of work just completed. */
/* $ Detailed_Input */
/* INCR is some amount of work that has been completed since */
/* the last call to ZZGFWKIN. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Standard SPICE error handling. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This entry point is used to report work that has been done since */
/* initialization was performed using ZZGFTSWK or since the last */
/* call to ZZGFWKIN. The work reporter uses this information */
/* together with samples of the system clock to report how much of */
/* the total job has been completed. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* See the header for this module */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.S. Elson (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* ZZGF low-level progress report increment */
/* -& */
if (return_()) {
return 0;
}
chkin_("ZZGFWKIN", (ftnlen)8);
svincr = *incr;
done += *incr;
++calls;
if (entire == 0.) {
chkout_("ZZGFWKIN", (ftnlen)8);
return 0;
}
if (calls >= check) {
calls = 0;
zzcputim_(tvec);
cursec = tvec[3] * 3600. + tvec[4] * 60. + tvec[5];
if ((d__1 = cursec - lstsec, abs(d__1)) >= step) {
lstsec = cursec;
/* Report how much work has been done. */
d__1 = done / entire * 100.;
fractn = brcktd_(&d__1, &c_b19, &c_b20);
dpfmt_(&fractn, "xxx.xx", prcent, (ftnlen)6, (ftnlen)10);
*(unsigned char *)&prcent[6] = '%';
/* Writing concatenation */
i__1[0] = ls, a__1[0] = start;
i__1[1] = 1, a__1[1] = " ";
i__1[2] = 7, a__1[2] = prcent;
i__1[3] = 1, a__1[3] = " ";
i__1[4] = rtrim_(finish, (ftnlen)13), a__1[4] = finish;
s_cat(messge, a__1, i__1, &c__5, (ftnlen)78);
if (svunit == stdout) {
zzgfdsps_(&c__0, messge, "A", &c__0, (ftnlen)78, (ftnlen)1);
} else {
/* Write the message without special carriage control. */
writln_(messge, &svunit, (ftnlen)78);
}
}
}
chkout_("ZZGFWKIN", (ftnlen)8);
return 0;
/* $Procedure ZZGFWKAD ( Geometry finder work reporting adjustment ) */
L_zzgfwkad:
/* $ Abstract */
/* Adjust the frequency with which work progress is reported. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* UTILITY */
/* REPORT */
/* WORK */
/* $ Declarations */
/* DOUBLE PRECISION FREQ */
/* INTEGER TCHECK */
/* CHARACTER*(*) BEGIN */
/* CHARACTER*(*) END */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TOTAL I A measure of the total amount of work to be done. */
/* FREQ I How often the work progress should be reported. */
/* BEGIN I First part of the output message. */
/* END I Last part of the output message. */
/* $ Detailed_Input */
/* FREQ is the how often the work progress should be reported */
/* in seconds. If FREQ = 5 then a work progress report */
/* will be sent to the output device approximately every */
/* 5 seconds. Since writing to the output device takes */
/* time, the smaller FREQ is set, the greater the overhead */
/* taken up by the work reporter will be. ( A value of 2 */
/* or greater should not burden your application */
/* appreciably ) */
/* TCHECK is an integer used to the tell the reporter how often */
/* to sample the system clock. If TCHECK = 7, then on */
/* every seventh call to ZZGFWKIN, the system clock will */
/* be sampled to determine if FREQ seconds have elapsed */
/* since the last report time. Sampling the system clock */
/* takes time. Not a lot of time, but it does take time. */
/* If ZZGFWKIN is being called from a loop that does not */
/* take a lot of time for each pass, the sampling of */
/* the system clock can become a significant overhead */
/* cost in itself. On the VAX the sampling of the */
/* system clock used here takes about 37 double precision */
/* multiplies. If thousands of multiplies take place */
/* between calls to ZZGFWKIN, the sampling time is */
/* insignificant. On the other hand, if only a hundred or */
/* so multiplies occur between calls to ZZGFWKIN, the */
/* sampling of the system clock can become a significant */
/* fraction of your overhead. TCHECK allows you to */
/* tailor the work reporter to your application. */
/* If a non-positive value for TCHECK is entered, a value */
/* of 1 will be used instead of the input value. */
/* BEGIN Is the first part of the output message that will be */
/* constructed for shipment to the output device. This */
/* message will have the form: */
/* BEGIN // xx.x% // END */
/* where xx.x is the percentage of the job completed when */
/* the output message is sent to the output device. */
/* END is the second part of the output message that will be */
/* constructed and sent to the output device (see above). */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If TCHECK is less than 1, the value 1 is stored. */
/* 2) If FREQ is less than 0.1, the value 0.1 is stored. */
/* If FREQ is greater than 3600, the value 3600 is stored. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This entry point exists to modify the reporting frequency set */
/* up by an initial call to ZZGFTSWK. In this way one can override */
/* how often reporting of work increments is performed, without */
/* causing the screen to be modified (which happens if a new */
/* call to ZZGFTSWK is made.) */
/* It exists primarily as a back door to existing code */
/* that calls ZZGFTSWK in a rigid way. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* See the header for this module. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* L.S. Elson (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* GF low-level progress report adjust frequency */
/* -& */
/* Computing MIN */
d__1 = 3600., d__2 = max(0.,*freq);
step = min(d__1,d__2);
check = max(1,*tcheck);
s_copy(start, begin, (ftnlen)55, begin_len);
s_copy(finish, end, (ftnlen)13, end_len);
return 0;
/* $Procedure ZZGFWUN ( Geometry finder set work report output unit ) */
L_zzgfwkun:
/* $ Abstract */
/* Set the output unit for the progress report. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* UTILITY */
/* REPORT */
/* WORK */
/* $ Declarations */
/* INTEGER UNIT */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UNIT I Output logical unit. */
/* $ Detailed_Input */
/* UNIT Logical unit of a text file open for write access. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* The file designated by UNIT should be a text file opened by the */
/* calling application. */
/* $ Particulars */
/* This routine can be called before ZZGFTSWK to set the output */
/* logical unit to that of a text file. */
/* This entry point exists to support testing of the higher-level */
/* GF progress reporting routines */
/* GFREPI */
/* GFREPU */
/* GFREPF */
/* This routine enables TSPICE to send the output report to */
/* a specified file. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* GF low-level progress report output select unit */
/* -& */
/* On the first pass, obtain the logical unit for */
/* standard output. */
if (first) {
stdio_("STDOUT", &stdout, (ftnlen)6);
first = FALSE_;
}
svunit = *unit;
return 0;
/* $Procedure ZZGFWKMO ( Geometry finder work reporting monitor ) */
L_zzgfwkmo:
/* $ Abstract */
/* Return saved progress report parameters. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* GF */
/* $ Keywords */
/* UTILITY */
/* REPORT */
/* WORK */
/* $ Declarations */
/* INTEGER UNIT */
/* DOUBLE PRECISION TOTAL */
/* DOUBLE PRECISION FREQ */
/* INTEGER TCHECK */
/* CHARACTER*(*) BEGIN */
/* CHARACTER*(*) END */
/* DOUBLE PRECISION INCR */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UNIT O Output logical unit. */
/* TOTAL O A measure of the total amount of work to be done. */
/* FREQ O How often the work progress should be reported. */
/* TCHECK O Number of calls between system time check. */
/* BEGIN O First part of the output message. */
/* END O Last part of the output message. */
/* INCR O Last progress increment. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* UNIT, */
/* TOTAL, */
/* FREQ, */
/* TCHECK, */
/* BEGIN, */
/* END, */
/* INCR are the most recent values of these */
/* variables passed in via calls to ZZGFTSWK, */
/* ZZGFWKIN, or ZZGFWKAD. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This entry point exists to support testing of the higher-level */
/* GF progress reporting routines */
/* GFREPI */
/* GFREPU */
/* GFREPF */
/* This routine enables TSPICE to determine the values passed */
/* in to entry points of this package by those routines. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 17-FEB-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* GF low-level progress report monitor */
/* -& */
*unit = svunit;
*total = entire;
*freq = step;
*tcheck = check;
s_copy(begin, start, begin_len, (ftnlen)55);
s_copy(end, finish, end_len, (ftnlen)13);
*incr = svincr;
return 0;
} /* zzgfrpwk_ */
/* $Procedure ZZGFSOLVX ( Private --- GF, event finding routine ) */
/* Subroutine */ int zzgfsolvx_(U_fp udfuns, S_fp udfunb, S_fp udstep, S_fp
udrefn, logical *bail, L_fp udbail, logical *cstep, doublereal *step,
doublereal *start, doublereal *finish, doublereal *tol, logical *rpt,
S_fp udrepu, doublereal *result)
{
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int zzwninsd_(doublereal *, doublereal *, char *,
doublereal *, ftnlen);
logical s;
doublereal begin, t;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
integer nloop;
logical l1, l2, savst;
doublereal t1, t2;
logical state1;
extern logical failed_(void);
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *),
touchd_(doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
logical instat;
doublereal curtim, svdtim, timest;
logical curste;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
extern logical return_(void);
char contxt[256];
doublereal trnstn;
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* This routine is a root finding general purpose event location */
/* routine. Most of the HARD work has been delegated to other */
/* routines (In particular, how the dynamic step size is chosen). */
/* Sister routine to ZZGFSOLV. Copy any edits to ZZGFSOLV or */
/* ZZGFSOLVX to the sister routine. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* ROOT */
/* SEARCH */
/* WINDOWS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* UDFUNS I The routine that computes the scalar quantity of */
/* interest. */
/* UDFUNB I Name of the routine that compares the current state */
/* condition with-respect-to a constraint. */
/* UDSTEP I Name of the routine that computes a time step */
/* UDREFN I Name of the routine that computes a refined time. */
/* BAIL I Logical indicating program interrupt monitoring. */
/* UDBAIL I Name of a routine that signals a program interrupt. */
/* CSTEP I Logical indicating constant step size. */
/* STEP I Constant step size in seconds for finding geometric */
/* events. */
/* START I Beginning of the search interval. */
/* FINISH I End of the search interval. */
/* TOL I Maximum error in detection of state transitions. */
/* RPT I Progress reporter on ( .TRUE.) or off ( .FALSE. ) */
/* UDREPU I Function that updates the progress report. */
/* RESULT I-O SPICE window containing results. */
/* $ Detailed_Input */
/* UDFUNS the routine that returns the value of the scalar */
/* quantity of interest at time ET. The calling sequence */
/* for UDFUNS is: */
/* CALL UDFUNS ( ET, VALUE ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB at which to determine the scalar */
/* value. */
/* VALUE is the value of the scalar quantity */
/* at ET. */
/* UDFUNB the routine that determines if UDFUNS */
/* satisfies some constraint condition at epoch ET. */
/* The calling sequence: */
/* CALL UDFUNB ( UDFUNS, ET, BOOL ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB, at which to evaluate UDFUNS. */
/* BOOL a logical value indicating whether */
/* or not UDFUNS satisfies the constraint */
/* at ET (TRUE) or not (FALSE). */
/* UDSTEP the routine that computes a time step in an attempt to */
/* find a transition of the state of the specified */
/* coordinate. In the context of this routine's algorithm, */
/* a "state transition" occurs where the geometric state */
/* changes from being in the desired geometric condition */
/* event to not, or vice versa. */
/* This routine relies on UDSTEP returning step sizes */
/* small enough so that state transitions within the */
/* confinement window are not overlooked. There must */
/* never be two roots A and B separated by less than */
/* STEP, where STEP is the minimum step size returned by */
/* UDSTEP for any value of ET in the interval [A, B]. */
/* The calling sequence for UDSTEP is: */
/* CALL UDSTEP ( ET, STEP ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB, from which the algorithm is to */
/* search forward for a state transition. */
/* STEP is the output step size. STEP indicates */
/* how far to advance ET so that ET and */
/* ET+STEP may bracket a state transition and */
/* definitely do not bracket more than one */
/* state transition. Units are TDB seconds. */
/* If a constant step size is desired, the routine */
/* GFSTEP */
/* may be used. This is the default option. If using */
/* GFSTEP, the step size must be set by calling */
/* GFSSTP(STEP) */
/* prior to calling this routine. */
/* UDREFN the routine that computes a refinement in the times */
/* that bracket a transition point. In other words, once */
/* a pair of times have been detected such that the system */
/* is in different states at each of the two times, UDREFN */
/* selects an intermediate time which should be closer to */
/* the transition state than one of the two known times. */
/* The calling sequence for UDREFN is: */
/* CALL UDREFN ( T1, T2, S1, S2, T ) */
/* where the inputs are: */
/* T1 a time when the system is in state S1. */
/* T2 a time when the system is in state S2. T2 */
/* is assumed to be larger than T1. */
/* S1 a logical indicating the state of the system */
/* at time T1. */
/* S2 a logical indicating the state of the system */
/* at time T2. */
/* UDREFN may use or ignore the S1 and S2 values. */
/* The output is: */
/* T a time to check for a state transition */
/* between T1 and T2. */
/* If a simple bisection method is desired, the routine */
/* GFREFN may be used. This is the default option. */
/* BAIL is a logical indicating whether or not interrupt */
/* signaling is enabled. When `bail' is set to TRUE, */
/* the input function UDBAIL (see description below) */
/* is used to determine whether an interrupt has been */
/* issued. */
/* UDBAIL the routine that indicates whether an interrupt signal */
/* has been issued (for example, from the keyboard). */
/* UDBAIL has no arguments and returns a logical. */
/* The return value is .TRUE. if an interrupt has */
/* been issued; otherwise the value is .FALSE. */
/* ZZGFSOLVX uses UDBAIL only when BAIL (see above) is set */
/* to .TRUE., indicating that interrupt handling is */
/* enabled. When interrupt handling is enabled, ZZGFSOLVX */
/* and will call UDBAIL to determine whether to terminate */
/* processing and return immediately. */
/* If interrupt handing is not enabled, a logical */
/* function must still be passed as an input argument. */
/* The function */
/* GFBAIL */
/* may be used for this purpose. */
/* CSTEP is a logical indicating whether or not the step size */
/* used in searching is constant. If it is, the value */
/* STEP is used. Note that even if UDSTEP has the value */
/* GFSTEP, i.e. the public, constant step routine, CSTEP */
/* should still be .FALSE., in which case STEP is ignored. */
/* STEP is the step size to be used in the search. STEP must */
/* be short enough for a search using this step size */
/* to locate the time intervals where the geometric */
/* event function is monotone increasing or decreasing. */
/* However, STEP must not be *too* short, or the */
/* search will take an unreasonable amount of time. */
/* The choice of STEP affects the completeness but not */
/* the precision of solutions found by this routine; */
/* precision is controlled by the convergence */
/* the tolerance, TOL. */
/* STEP has units of TDB seconds. */
/* START is the beginning of the interval over which the state */
/* is to be detected. */
/* FINISH is the end of the interval over which the state is */
/* to be detected. */
/* TOL is a tolerance value used to determine convergence of */
/* root-finding operations. TOL is measured in seconds */
/* and is greater than zero. */
/* RPT is a logical variable which controls whether the */
/* progress reporter is enabled. When RPT is TRUE, */
/* progress reporting is enabled and the routine */
/* UDREPU (see description below) reports progress. */
/* UDREPU the routine that updates the progress report for a */
/* search. The calling sequence of UDREPU is */
/* UDREPU (IVBEG, IVEND, ET ) */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION IVBEG */
/* DOUBLE PRECISION IVEND */
/* where ET is an epoch belonging to the confinement */
/* window, IVBEG and IVEND are the start and stop times, */
/* respectively of the current confinement window */
/* interval. The ratio of the measure of the portion */
/* of CNFINE that precedes ET to the measure of CNFINE */
/* would be a logical candidate for the searches */
/* completion percentage; however the method of */
/* measurement is up to the user. */
/* If the user doesn't wish to provide a custom set of */
/* progress reporting functions, the routine */
/* GFREPU */
/* may be used. */
/* RESULT is an initialized SPICE window. RESULT may not be empty */
/* on entry and must be large enough to hold all of the */
/* intervals found by the search. */
/* $ Detailed_Output */
/* RESULT is a SPICE window containing the intersection of the */
/* results of the search and the contents of RESULT */
/* on entry. */
/* $ Parameters */
/* LBCELL is the SPICELIB cell lower bound. */
/* $ Exceptions */
/* 1) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) */
/* will signal. */
/* 2) If START +/- TOL is indistinguishable from START or */
/* FINISH +/- TOL is indistinguishable from FINISH, the */
/* error SPICE(INVALIDVALUE) will signal. */
/* 3) If START is greater than FINISH or SVDTIM is greater than */
/* CURTIM, SPICE(BADTIMECASE) will signal. */
/* 4) If the inner convergence loop fails to converge to TOL */
/* within MXLOOP iterations, the error SPICE(NOCONVERG) */
/* will signal. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. See the routine FURNSH and the SPK */
/* and KERNEL Required Reading for further information on loading */
/* (and unloading) kernels. */
/* $ Particulars */
/* This routine implements a strategy for searching for geometric */
/* state events important for planning solar system observations. */
/* The actual details of selecting time steps while searching for */
/* a state change as well as the scheme used for zeroing in on the */
/* actual time of transition are handled by lower level routines. */
/* By delegating the work of selecting search time steps and the */
/* process of refining a transition time estimate to lower level */
/* routines, the common work of the search can be isolated here. */
/* The routines that do the decision making, can be modified */
/* and made smarter as time permits. */
/* $ Examples */
/* See GFUDS and ZZGFRELX. */
/* $ Restrictions */
/* It is important that the user understand how the routines */
/* UDFUNB, UDSTEP and UDREFN are to be used and that the */
/* calling sequences match precisely with the descriptions given */
/* here. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* L. S. Elson (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 24-OCT-2010 (EDW) */
/* TOL error check now returns SPICE(INVALIDTOLERANCE) instead of */
/* previous return SPICE(VALUEOUTOFRANGE). */
/* - SPICELIB Version 1.1.0, 16-FEB-2010 (EDW) */
/* Modified version of ZZGFSOLV. */
/* - SPICELIB Version 1.0.0, 17-MAR-2009 (EDW)(LSE)(NJB) */
/* -& */
/* $ Index_Entries */
/* find times of an event */
/* -& */
/* SPICELIB functions. */
/* Local variables */
/* The maximum number of search loop iterations to execute. */
/* The default refinement method is bisection, a very slow */
/* method to convergence. Since 2**1000 ~ 10**301, */
/* 1000 loop iterations represents enough effort to assume */
/* either the search will not converge or that the refinement */
/* function operates slower than would bisection, in which */
/* case the user should use the default GFREFN function. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSOLVX", (ftnlen)9);
/* Check the convergence tolerance. */
if (*tol <= 0.) {
setmsg_("Tolerance must be positive but was #.", (ftnlen)37);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(INVALIDTOLERANCE)", (ftnlen)23);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Make sure that START is not greater than FINISH. Signal an */
/* error for START > FINISH. */
if (*start > *finish) {
setmsg_("Bad time interval result, START > FINISH.", (ftnlen)41);
sigerr_("SPICE(BADTIMECASE)", (ftnlen)18);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Make sure that TOL is not too small, i.e. that neither */
/* START + TOL nor START - TOL equals START. */
d__1 = *start - *tol;
d__2 = *start + *tol;
if (touchd_(&d__1) == *start || touchd_(&d__2) == *start) {
setmsg_("TOL has value #1. This value is too small to distinguish ST"
"ART - TOL or START + TOL from START, #2.", (ftnlen)99);
errdp_("#1", tol, (ftnlen)2);
errdp_("#2", start, (ftnlen)2);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* 5 */
/* Make sure that TOL is not too small, i.e. that neither */
/* FINISH + TOL nor FINISH - TOL equals FINISH. */
d__1 = *finish - *tol;
d__2 = *finish + *tol;
if (touchd_(&d__1) == *finish || touchd_(&d__2) == *finish) {
setmsg_("TOL has value #1. This value is too small to distinguish FI"
"NISH - TOL or FINISH + TOL from FINISH, #2.", (ftnlen)102);
errdp_("#1", tol, (ftnlen)2);
errdp_("#2", finish, (ftnlen)2);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* If active, update the progress reporter. */
if (*rpt) {
(*udrepu)(start, finish, start);
}
/* This algorithm determines those intervals when a given state */
/* is observed to occur within a specified search interval. */
/* Pairs of times are recorded. The first member of each pair */
/* denotes the time when the system changes to the state of */
/* interest. The second denotes a transition out of that state. */
/* If the system is in the state of interest at the beginning of */
/* the interval, the beginning of the time interval will be */
/* recorded. This may or may not be a transition point. */
/* Similarly if the system is in the state of interest at the end */
/* of the interval, the end of the interval will be recorded. */
/* Again, this may or may not be a transition point. */
/* Initially the current time is the beginning of the search */
/* interval. */
curtim = *start;
/* Determine if the state at the current time satisfies some */
/* constraint. This constraint may indicate only existence of */
/* a state. */
(*udfunb)((U_fp)udfuns, &curtim, &curste);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* If the system is in the state of interest, record the initial */
/* time of the search interval. */
if (curste) {
instat = TRUE_;
begin = curtim;
} else {
instat = FALSE_;
}
/* If the step size is constant, use the value supplied. */
if (*cstep) {
timest = *step;
}
/* Save the current time and state somewhere. */
svdtim = curtim;
savst = curste;
/* Once initializations have been performed keep working */
/* until the search interval has been exhausted. */
/* While time remains in the search interval. */
while(svdtim < *finish) {
/* Using the current window and internally stored */
/* information about the current state, select a new current */
/* time. */
if (! (*cstep)) {
(*udstep)(&curtim, ×t);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Add the time step to the current time. Make sure that the */
/* time does not move beyond the end of the search interval. */
/* Computing MIN */
d__1 = curtim + timest;
curtim = min(d__1,*finish);
/* Compute the state at time CURTIM. */
(*udfunb)((U_fp)udfuns, &curtim, &curste);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* While the state remains unchanged and the interval is not */
/* completely searched ... */
while(savst == curste && svdtim < *finish) {
/* First check for an interrupt signal if checking is enabled. */
if (*bail) {
if ((*udbail)()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Report the current time to the monitoring utility, if */
/* appropriate. */
if (*rpt) {
(*udrepu)(start, finish, &svdtim);
}
/* Save the current time and state somewhere. */
svdtim = curtim;
savst = curste;
/* Compute a new current time so that we will not step */
/* past the end of the interval. This time will be */
/* based on: */
/* 1. The kind of event we are looking for. */
/* 2. The objects and observer class. */
/* 3. Transition times already found. */
/* 4. A minimum time step allowed. */
if (! (*cstep)) {
(*udstep)(&curtim, ×t);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Computing MIN */
d__1 = curtim + timest;
curtim = min(d__1,*finish);
/* Compute the current state */
(*udfunb)((U_fp)udfuns, &curtim, &curste);
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Loop back to see if the state has changed. */
}
/* If we have detected a state change and not merely run out */
/* of the search interval... */
if (savst != curste) {
/* Call the previous state STATE1 */
/* Call the current state STATE2 */
/* Call the time at state STATE1, T1 */
/* Call the time at state STATE2, T2 */
/* Save the current time. */
state1 = savst;
t1 = svdtim;
t2 = curtim;
/* Make sure that T1 is not greater than T2. Signal an */
/* error for T1 > T2. */
if (t1 > t2) {
setmsg_("Bad time interval result, T1 > T2.", (ftnlen)34);
sigerr_("SPICE(BADTIMECASE)", (ftnlen)18);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
svdtim = curtim;
savst = curste;
/* T1 and T2 bracket the time of transition. Squeeze this */
/* interval down until it is less than some tolerance in */
/* length. Do it as described below... */
/* Loop while the difference between the times T1 and T2 */
/* exceeds a specified tolerance. */
nloop = 0;
for(;;) { /* while(complicated condition) */
d__1 = t2 - t1;
if (!(touchd_(&d__1) > *tol))
break;
++nloop;
/* This loop count error exists to catch pathologies */
/* in the refinement function. The default bisection */
/* refinement will converge before 1000 iterations if */
/* a convergence is numerically possible. Any other */
/* refinement function should require fewer iterations */
/* compared to bisection. If not, the user should */
/* probably use bisection. */
if (nloop >= 1000) {
setmsg_("Loop run exceeds maximum loop count. Unable to "
"converge to TOL value #1 within MXLOOP value #2 "
"iterations.", (ftnlen)106);
errdp_("#1", tol, (ftnlen)2);
errint_("#2", &c__1000, (ftnlen)2);
sigerr_("SPICE(NOCONVERG)", (ftnlen)16);
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
if (*bail) {
if ((*udbail)()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
}
/* Select a time T, between T1 and T2 (possibly based on the */
/* values of L1 and L2). */
(*udrefn)(&t1, &t2, &l1, &l2, &t);
/* Check for an error signal. The default refinement */
/* routine, GFREFN, does not include error checks. */
if (failed_()) {
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
}
/* Check whether T is between T1 and T2. If */
/* not then assume that we have gone as far as */
/* we can in refining our estimate of the transition */
/* point. Set T1 and T2 equal to T. */
t = brcktd_(&t, &t1, &t2);
if (t == t1) {
t2 = t;
} else if (t == t2) {
t1 = t;
} else {
/* Compute the state time T. If this state, S, */
/* equals STATE1, set T1 to T, otherwise set */
/* T2 to T. */
(*udfunb)((U_fp)udfuns, &t, &s);
if (s == state1) {
t1 = t;
} else {
t2 = t;
}
}
}
/* Let TRNSTN be the midpoint of [T1, T2]. Record this */
/* time as marking the transition from STATE1 to STATE2. */
d__1 = (t1 + t2) * .5;
trnstn = brcktd_(&d__1, &t1, &t2);
/* In state-of-interest or not? */
if (instat) {
/* We were in the state of interest, TRNSTN marks the */
/* point in time when the state changed to "not of */
/* interest" We need to record the interval from BEGIN to */
/* FINISH and note that we are no longer in the state of */
/* interest. */
/* Add an interval starting at BEGIN and ending at TRNSTN */
/* to the result window. */
s_copy(contxt, "Adding interval [BEGIN,TRNSTN] to RESULT. TR"
"NSTN represents time of passage out of the state-of-"
"interest.", (ftnlen)256, (ftnlen)105);
zzwninsd_(&begin, &trnstn, contxt, result, (ftnlen)256);
} else {
/* We were not in the state of interest. As a result */
/* TRNSTN marks the point where we are changing to */
/* the state of interest. Note that we have transitioned */
/* to the state of interest and record the time at */
/* which the transition occurred. */
begin = trnstn;
}
/* A transition occurred either from from in-state to */
/* out-of-state or the inverse. Reverse the value of the */
/* INSTAT flag to signify the transition event. */
instat = ! instat;
/* That's it for this detection of state change. */
}
/* Continue if there is more time in the search interval. */
}
/* Check if in-state at this time (FINISH). If so record the */
/* interval. */
if (instat) {
/* Add an interval starting at BEGIN and ending at FINISH to the */
/* window. */
s_copy(contxt, "Adding interval [BEGIN,FINISH] to RESULT. FINISH rep"
"resents end of the search interval.", (ftnlen)256, (ftnlen)87)
;
zzwninsd_(&begin, finish, contxt, result, (ftnlen)256);
}
/* If active, update the progress reporter before exiting this */
/* routine. */
if (*rpt) {
(*udrepu)(start, finish, finish);
}
/* Check-out then return. */
chkout_("ZZGFSOLVX", (ftnlen)9);
return 0;
} /* zzgfsolvx_ */
/* $Procedure INEDPL ( Intersection of ellipsoid and plane ) */
/* Subroutine */ int inedpl_(doublereal *a, doublereal *b, doublereal *c__,
doublereal *plane, doublereal *ellips, logical *found)
{
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double sqrt(doublereal);
/* Local variables */
doublereal dist, span1[3], span2[3];
integer i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal const__, point[3];
extern doublereal vnorm_(doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int cgv2el_(doublereal *, doublereal *,
doublereal *, doublereal *), pl2nvc_(doublereal *, doublereal *,
doublereal *), pl2psv_(doublereal *, doublereal *, doublereal *,
doublereal *), psv2pl_(doublereal *, doublereal *, doublereal *,
doublereal *);
doublereal dplane[4];
extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
doublereal maxrad, rcircl, center[3], normal[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *,
ftnlen);
doublereal invdst[3];
extern logical return_(void);
doublereal dstort[3], vec1[3], vec2[3];
/* $ Abstract */
/* Find the intersection of a triaxial ellipsoid and a plane. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* ELLIPSES */
/* PLANES */
/* $ Keywords */
/* ELLIPSE */
/* ELLIPSOID */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* A I Length of ellipsoid semi-axis lying on the x-axis. */
/* B I Length of ellipsoid semi-axis lying on the y-axis. */
/* C I Length of ellipsoid semi-axis lying on the z-axis. */
/* PLANE I Plane that intersects ellipsoid. */
/* ELLIPS O Intersection ellipse, when FOUND is .TRUE. */
/* FOUND O Flag indicating whether ellipse was found. */
/* $ Detailed_Input */
/* A, */
/* B, */
/* C are the lengths of the semi-axes of a triaxial */
/* ellipsoid. The ellipsoid is centered at the */
/* origin and oriented so that its axes lie on the */
/* x, y and z axes. A, B, and C are the lengths of */
/* the semi-axes that point in the x, y, and z */
/* directions respectively. */
/* PLANE is a SPICELIB plane. */
/* $ Detailed_Output */
/* ELLIPS is the SPICELIB ellipse formed by the intersection */
/* of the input plane and ellipsoid. ELLIPS will */
/* represent a single point if the ellipsoid and */
/* plane are tangent. */
/* If the intersection of the ellipsoid and plane is */
/* empty, ELLIPS is not modified. */
/* FOUND is .TRUE. if and only if the intersection of the */
/* ellipsoid and plane is non-empty. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If any of the lengths of the semi-axes of the input ellipsoid */
/* are non-positive, the error SPICE(DEGENERATECASE) is */
/* signaled. ELLIPS is not modified. FOUND is set to .FALSE. */
/* 2) If the input plane in invalid, in other words, if the input */
/* plane as the zero vector as its normal vector, the error */
/* SPICE(INVALIDPLANE) is signaled. ELLIPS is not modified. */
/* FOUND is set to .FALSE. */
/* 3) If the input plane and ellipsoid are very nearly tangent, */
/* roundoff error may cause this routine to give unreliable */
/* results. */
/* 4) If the input plane and ellipsoid are precisely tangent, the */
/* intersection is a single point. In this case, the output */
/* ellipse is degenerate, but FOUND will still have the value */
/* .TRUE. You must decide whether this output makes sense for */
/* your application. */
/* $ Files */
/* None. */
/* $ Particulars */
/* An ellipsoid and a plane can intersect in an ellipse, a single */
/* point, or the empty set. */
/* $ Examples */
/* 1) Suppose we wish to find the limb of a body, as observed from */
/* location LOC in body-fixed coordinates. The SPICELIB routine */
/* EDLIMB solves this problem. Here's how INEDPL is used in */
/* that solution. */
/* We assume LOC is outside of the body. The body is modelled as */
/* a triaxial ellipsoid with semi-axes of length A, B, and C. */
/* The notation */
/* < X, Y > */
/* indicates the inner product of the vectors X and Y. */
/* The limb lies on the plane defined by */
/* < X, N > = 1, */
/* where the vector N is defined as */
/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */
/* The assignments */
/* N(1) = LOC(1) / A**2 */
/* N(2) = LOC(2) / B**2 */
/* N(3) = LOC(3) / C**2 */
/* and the calls */
/* CALL NVC2PL ( N, 1.0D0, PLANE ) */
/* CALL INEDPL ( A, B, C, PLANE, LIMB, FOUND ) */
/* CALL EL2CGV ( LIMB, CENTER, SMAJOR, SMINOR ) */
/* will return the center and semi-axes of the limb. */
/* How do we know that < X, N > = 1 for all X on the limb? */
/* This is because all limb points X satisfy */
/* < LOC - X, SURFNM(X) > = 0, */
/* where SURFNM(X) is a surface normal at X. SURFNM(X) is */
/* parallel to the vector */
/* V = ( X(1) / A**2, X(2) / B**2, X(3) / C**2 ) */
/* so we have */
/* < LOC - X, V > = 0, */
/* < LOC, V > = < X, V > = 1 (from the original */
/* ellipsoid */
/* equation); */
/* and finally */
/* < X, N > = 1, */
/* where the vector N is defined as */
/* ( LOC(1) / A**2, LOC(2) / B**2, LOC(3) / C**2 ). */
/* 2) Suppose we wish to find the terminator of a body. We can */
/* make a fair approximation to the location of the terminator */
/* by finding the limb of the body as seen from the vertex of */
/* the umbra; then the problem is essentially the same as in */
/* example 1. Let VERTEX be this location. We make the */
/* assignments */
/* P(1) = VERTEX(1) / A**2 */
/* P(2) = VERTEX(2) / B**2 */
/* P(3) = VERTEX(3) / C**2 */
/* and then make the calls */
/* CALL NVC2PL ( P, 1.0D0, PLANE ) */
/* CALL INEDPL ( A, B, C, PLANE, TERM, FOUND ) */
/* The SPICELIB ellipse TERM represents the terminator of the */
/* body. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */
/* Bug fix: error detection for case of invalid input plane was */
/* added. */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */
/* Removed potential numerical precision problems that could be */
/* caused by using a REAL constant in a double precision */
/* computation. The value 1.0 was repaced with the value 1.0D0 in */
/* the following three lines: */
/* DSTORT(1) = 1.0 / A */
/* DSTORT(2) = 1.0 / B */
/* DSTORT(3) = 1.0 / C */
/* Also changed was a numeric constant from 1.D0 to the */
/* equivalent, but more aesthetically pleasing 1.0D0. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 02-NOV-1990 (NJB) */
/* -& */
/* $ Index_Entries */
/* intersection of ellipsoid and plane */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 16-NOV-2005 (NJB) */
/* Bug fix: error detection for case of invalid input plane was */
/* added. */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* - SPICELIB Version 1.1.0, 11-JUL-1995 (KRG) */
/* Removed potential numerical precision problems that could be */
/* caused by using a REAL constant in a double precision */
/* computation. The value 1.0 was repaced with the value 1.0D0 in */
/* the following three lines: */
/* DSTORT(1) = 1.0 / A */
/* DSTORT(2) = 1.0 / B */
/* DSTORT(3) = 1.0 / C */
/* Also changed was a numeric constant from 1.D0 to the */
/* equivalent, but more aesthetically pleasing 1.0D0. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("INEDPL", (ftnlen)6);
}
/* We don't want to worry about flat ellipsoids: */
if (*a <= 0. || *b <= 0. || *c__ <= 0.) {
*found = FALSE_;
setmsg_("Semi-axes: A = #, B = #, C = #.", (ftnlen)33);
errdp_("#", a, (ftnlen)1);
errdp_("#", b, (ftnlen)1);
errdp_("#", c__, (ftnlen)1);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* Check input plane for zero normal vector. */
pl2nvc_(plane, normal, &const__);
if (vzero_(normal)) {
setmsg_("Normal vector of the input PLANE is the zero vector.", (
ftnlen)52);
sigerr_("SPICE(INVALIDPLANE)", (ftnlen)19);
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* This algorithm is partitioned into a series of steps: */
/* 1) Identify a linear transformation that maps the input */
/* ellipsoid to the unit sphere. We'll call this mapping the */
/* `distortion' mapping. Apply the distortion mapping to both */
/* the input plane and ellipsoid. The image of the plane under */
/* this transformation will be a plane. */
/* 2) Find the intersection of the transformed plane and the unit */
/* sphere. */
/* 3) Apply the inverse of the distortion mapping to the */
/* intersection ellipse to find the undistorted intersection */
/* ellipse. */
/* Step 1: */
/* Find the image of the ellipsoid and plane under the distortion */
/* matrix. Since the image of the ellipsoid is the unit sphere, */
/* only the plane transformation requires any work. */
/* If the input plane is too far from the origin to possibly */
/* intersect the ellipsoid, return now. This can save us */
/* some numerical problems when we scale the plane and ellipsoid. */
/* The point returned by PL2PSV is the closest point in PLANE */
/* to the origin, so its norm gives the distance of the plane */
/* from the origin. */
pl2psv_(plane, point, span1, span2);
/* Computing MAX */
d__1 = abs(*a), d__2 = abs(*b), d__1 = max(d__1,d__2), d__2 = abs(*c__);
maxrad = max(d__1,d__2);
if (vnorm_(point) > maxrad) {
*found = FALSE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* The distortion matrix and its inverse are */
/* +- -+ +- -+ */
/* | 1/A 0 0 | | A 0 0 | */
/* | 0 1/B 0 |, | 0 B 0 |. */
/* | 0 0 1/C | | 0 0 C | */
/* +- -+ +- -+ */
/* We declare them with length three, since we are going to make */
/* use of the diagonal elements only. */
dstort[0] = 1. / *a;
dstort[1] = 1. / *b;
dstort[2] = 1. / *c__;
invdst[0] = *a;
invdst[1] = *b;
invdst[2] = *c__;
/* Apply the distortion mapping to the input plane. Applying */
/* the distortion mapping to a point and two spanning vectors that */
/* define the input plane yields a point and two spanning vectors */
/* that define the distorted plane. */
for (i__ = 1; i__ <= 3; ++i__) {
point[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("point", i__1,
"inedpl_", (ftnlen)449)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
449)] * point[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("point", i__3, "inedpl_", (ftnlen)449)];
span1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span1", i__1,
"inedpl_", (ftnlen)450)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
450)] * span1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("span1", i__3, "inedpl_", (ftnlen)450)];
span2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("span2", i__1,
"inedpl_", (ftnlen)451)] = dstort[(i__2 = i__ - 1) < 3 && 0
<= i__2 ? i__2 : s_rnge("dstort", i__2, "inedpl_", (ftnlen)
451)] * span2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 :
s_rnge("span2", i__3, "inedpl_", (ftnlen)451)];
}
psv2pl_(point, span1, span2, dplane);
/* Step 2: */
/* Find the intersection of the distorted plane and unit sphere. */
/* The intersection of the distorted plane and the unit sphere */
/* may be a circle, a point, or the empty set. The distance of the */
/* plane from the origin determines which type of intersection we */
/* have. If we represent the distorted plane by a unit normal */
/* vector and constant, the size of the constant gives us the */
/* distance of the plane from the origin. If the distance is greater */
/* than 1, the intersection of plane and unit sphere is empty. If */
/* the distance is equal to 1, we have the tangency case. */
/* The routine PL2PSV always gives us an output point that is the */
/* closest point to the origin in the input plane. This point is */
/* the center of the intersection circle. The spanning vectors */
/* returned by PL2PSV, after we scale them by the radius of the */
/* intersection circle, become an orthogonal pair of vectors that */
/* extend from the center of the circle to the circle itself. So, */
/* the center and these scaled vectors define the intersection */
/* circle. */
pl2psv_(dplane, center, vec1, vec2);
dist = vnorm_(center);
if (dist > 1.) {
*found = FALSE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
}
/* Scale the generating vectors by the radius of the intersection */
/* circle. */
/* Computing 2nd power */
d__2 = dist;
d__1 = 1. - d__2 * d__2;
rcircl = sqrt(brcktd_(&d__1, &c_b32, &c_b33));
vsclip_(&rcircl, vec1);
vsclip_(&rcircl, vec2);
/* Step 3: */
/* Apply the inverse distortion to the intersection circle to find */
/* the actual intersection ellipse. */
for (i__ = 1; i__ <= 3; ++i__) {
center[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("center",
i__1, "inedpl_", (ftnlen)511)] = invdst[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (
ftnlen)511)] * center[(i__3 = i__ - 1) < 3 && 0 <= i__3 ?
i__3 : s_rnge("center", i__3, "inedpl_", (ftnlen)511)];
vec1[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec1", i__1,
"inedpl_", (ftnlen)512)] = invdst[(i__2 = i__ - 1) < 3 && 0 <=
i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)512)]
* vec1[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
"vec1", i__3, "inedpl_", (ftnlen)512)];
vec2[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("vec2", i__1,
"inedpl_", (ftnlen)513)] = invdst[(i__2 = i__ - 1) < 3 && 0 <=
i__2 ? i__2 : s_rnge("invdst", i__2, "inedpl_", (ftnlen)513)]
* vec2[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
"vec2", i__3, "inedpl_", (ftnlen)513)];
}
/* Make an ellipse from the center and generating vectors. */
cgv2el_(center, vec1, vec2, ellips);
*found = TRUE_;
chkout_("INEDPL", (ftnlen)6);
return 0;
} /* inedpl_ */
