/* $Procedure DGEODR ( Derivative of geodetic w.r.t. rectangular ) */
/* Subroutine */ int dgeodr_(doublereal *x, doublereal *y, doublereal *z__,
doublereal *re, doublereal *f, doublereal *jacobi)
{
doublereal long__;
extern /* Subroutine */ int chkin_(char *, ftnlen), vpack_(doublereal *,
doublereal *, doublereal *, doublereal *), errdp_(char *,
doublereal *, ftnlen);
doublereal injacb[9] /* was [3][3] */;
extern /* Subroutine */ int recgeo_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), drdgeo_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal rectan[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int invort_(doublereal *, doublereal *);
doublereal lat, alt;
/* $ Abstract */
/* This routine computes the Jacobian of the transformation from */
/* rectangular to geodetic coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* COORDINATES */
/* DERIVATIVES */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* X I X-coordinate of point. */
/* Y I Y-coordinate of point. */
/* Z I Z-coordinate of point. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* JACOBI O Matrix of partial derivatives. */
/* $ Detailed_Input */
/* X, */
/* Y, */
/* Z are the rectangular coordinates of the point at */
/* which the Jacobian of the map from rectangular */
/* to geodetic coordinates is desired. */
/* RE Equatorial radius of the reference spheroid. */
/* F Flattening coefficient = (RE-RP) / RE, where RP is */
/* the polar radius of the spheroid. (More importantly */
/* RP = RE*(1-F).) */
/* $ Detailed_Output */
/* JACOBI is the matrix of partial derivatives of the conversion */
/* between rectangular and geodetic coordinates. It */
/* has the form */
/* .- -. */
/* | DLONG/DX DLONG/DY DLONG/DZ | */
/* | DLAT/DX DLAT/DY DLAT/DZ | */
/* | DALT/DX DALT/DY DALT/DZ | */
/* `- -' */
/* evaluated at the input values of X, Y, and Z. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input point is on the z-axis (X and Y = 0), the */
/* Jacobian is undefined. The error SPICE(POINTONZAXIS) */
/* will be signaled. */
/* 2) If the flattening coefficient is greater than or equal to */
/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* 3) If the equatorial radius is not positive, the error */
/* SPICE(BADRADIUS) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* When performing vector calculations with velocities it is */
/* usually most convenient to work in rectangular coordinates. */
/* However, once the vector manipulations have been performed, */
/* it is often desirable to convert the rectangular representations */
/* into geodetic coordinates to gain insights about phenomena */
/* in this coordinate frame. */
/* To transform rectangular velocities to derivatives of coordinates */
/* in a geodetic system, one uses the Jacobian of the transformation */
/* between the two systems. */
/* Given a state in rectangular coordinates */
/* ( x, y, z, dx, dy, dz ) */
/* the velocity in geodetic coordinates is given by the matrix */
/* equation: */
/* t | t */
/* (dlon, dlat, dalt) = JACOBI| * (dx, dy, dz) */
/* |(x,y,z) */
/* This routine computes the matrix */
/* | */
/* JACOBI| */
/* |(x, y, z) */
/* $ Examples */
/* Suppose one is given the bodyfixed rectangular state of an object */
/* (x(t), y(t), z(t), dx(t), dy(t), dz(t)) as a function of time t. */
/* To find the derivatives of the coordinates of the object in */
/* bodyfixed geodetic coordinates, one simply multiplies the */
/* Jacobian of the transformation from rectangular to geodetic */
/* coordinates (evaluated at x(t), y(t), z(t)) by the rectangular */
/* velocity vector of the object at time t. */
/* In code this looks like: */
/* C */
/* C Load the rectangular velocity vector vector RECV. */
/* C */
/* RECV(1) = DX_DT ( T ) */
/* RECV(2) = DY_DT ( T ) */
/* RECV(3) = DZ_DT ( T ) */
/* C */
/* C Determine the Jacobian of the transformation from */
/* C rectangular to geodetic coordinates at the rectangular */
/* C coordinates at time T. */
/* C */
/* CALL DGEODR ( X(T), Y(T), Z(T), RE, F, JACOBI ) */
/* C */
/* C Multiply the Jacobian on the right by the rectangular */
/* C velocity to obtain the geodetic coordinate derivatives */
/* C GEOV. */
/* C */
/* CALL MXV ( JACOBI, RECV, GEOV ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-JUL-2001 (WLT) */
/* -& */
/* $ Index_Entries */
/* Jacobian of geodetic w.r.t. rectangular coordinates */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DGEODR", (ftnlen)6);
}
/* If the flattening coefficient is greater than one, the polar */
/* radius computed below is negative. If it's equal to one, the */
/* polar radius is zero. Either case is a problem, so signal an */
/* error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was *.", (ftnlen)29);
errdp_("*", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DGEODR", (ftnlen)6);
return 0;
}
if (*re <= 0.) {
setmsg_("Equatorial Radius <= 0.0D0. RE = *", (ftnlen)34);
errdp_("*", re, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("DGEODR", (ftnlen)6);
return 0;
}
/* There is a singularity of the Jacobian for points on the z-axis. */
if (*x == 0. && *y == 0.) {
setmsg_("The Jacobian of the transformation from rectangular to geod"
"etic coordinates is not defined for points on the z-axis.", (
ftnlen)116);
sigerr_("SPICE(POINTONZAXIS)", (ftnlen)19);
chkout_("DGEODR", (ftnlen)6);
return 0;
}
/* We will get the Jacobian of rectangular to geodetic by */
/* implicit differentiation. */
/* First move the X,Y and Z coordinates into a vector. */
vpack_(x, y, z__, rectan);
/* Convert from rectangular to geodetic coordinates. */
recgeo_(rectan, re, f, &long__, &lat, &alt);
/* Get the Jacobian of the transformation from geodetic to */
/* rectangular coordinates at LONG, LAT, ALT. */
drdgeo_(&long__, &lat, &alt, re, f, injacb);
/* Now invert INJACB to get the Jacobian of the transformation */
/* from rectangular to geodetic coordinates. */
invort_(injacb, jacobi);
chkout_("DGEODR", (ftnlen)6);
return 0;
} /* dgeodr_ */
/* $Procedure RECGEO ( Rectangular to geodetic ) */
/* Subroutine */ int recgeo_(doublereal *rectan, doublereal *re, doublereal *
f, doublereal *long__, doublereal *lat, doublereal *alt)
{
doublereal base[3], a, b, c__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen), reclat_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal radius, normal[3];
extern /* Subroutine */ int nearpt_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen),
surfnm_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
extern logical return_(void);
/* $ Abstract */
/* Convert from rectangular coordinates to geodetic coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CONVERSION, COORDINATES */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* RECTAN I Rectangular coordinates of a point. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* LONG O Geodetic longitude of the point (radians). */
/* LAT O Geodetic latitude of the point (radians). */
/* ALT O Altitude of the point above reference spheroid. */
/* $ Detailed_Input */
/* RECTAN The rectangular coordinates of a point. */
/* RE Equatorial radius of a reference spheroid. This */
/* spheroid is a volume of revolution: its horizontal */
/* cross sections are circular. The shape of the */
/* spheroid is defined by an equatorial radius RE and */
/* a polar radius RP. */
/* F Flattening coefficient = (RE-RP) / RE, where RP is */
/* the polar radius of the spheroid. */
/* $ Detailed_Output */
/* LONG Geodetic longitude of the input point. This is the */
/* angle between the prime meridian and the meridian */
/* containing RECTAN. The direction of increasing */
/* longitude is from the +X axis towards the +Y axis. */
/* LONG is output in radians. The range of LONG is */
/* [-pi, pi]. */
/* LAT Geodetic latitude of the input point. For a point P */
/* on the reference spheroid, this is the angle between */
/* the XY plane and the outward normal vector at P. */
/* For a point P not on the reference spheroid, the */
/* geodetic latitude is that of the closest point to P on */
/* the spheroid. */
/* LAT is output in radians. The range of LAT is */
/* [-pi/2, pi/2]. */
/* ALT Altitude of point above the reference spheroid. */
/* The units associated with ALT are those associated */
/* with the input RECTAN. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the equatorial radius is non-positive, the error */
/* SPICE(VALUEOUTOFRANGE) is signaled. */
/* 2) If the flattening coefficient is greater than or equal to */
/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* 3) For points inside the reference ellipsoid, the nearest */
/* point on the ellipsoid to RECTAN may not be unique, so */
/* latitude may not be well-defined. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Given the body-fixed rectangular coordinates of a point, and the */
/* constants describing the reference spheroid, this routine */
/* returns the geodetic coordinates of the point. The body-fixed */
/* rectangular frame is that having the x-axis pass through the */
/* 0 degree latitude 0 degree longitude point. The y-axis passes */
/* through the 0 degree latitude 90 degree longitude. The z-axis */
/* passes through the 90 degree latitude point. For some bodies */
/* this coordinate system may not be a right-handed coordinate */
/* system. */
/* $ Examples */
/* This routine can be used to convert body fixed rectangular */
/* coordinates (such as the Satellite Tracking and Data Network */
/* of 1973) to geodetic coordinates such as those used by the */
/* United States Geological Survey topographic maps. */
/* The code would look something like this */
/* C */
/* C Shift the STDN-73 coordinates to line up with the center */
/* C of the Clark66 reference system. */
/* C */
/* CALL VSUB ( STDNX, OFFSET, X ) */
/* C */
/* C Using the equatorial radius of the Clark66 spheroid */
/* C (CLARKR = 6378.2064 km) and the Clark 66 flattening */
/* C factor (CLARKF = 1.0D0 / 294.9787D0 ) convert to */
/* C geodetic coordinates of the North American Datum of 1927. */
/* C */
/* CALL RECGEO ( X, CLARKR, CLARKF, LONG, LAT, ALT ) */
/* Below are two tables. */
/* Listed in the first table (under X(1), X(2) and X(3)) are a */
/* number of points whose rectangular coordinates are */
/* taken from the set {-1, 0, 1}. */
/* The results of the code fragment */
/* CALL RECGEO ( X, CLARKR, CLARKF, LONG, LAT, ALT ) */
/* Use the SPICELIB routine CONVRT to convert the angular */
/* quantities to degrees */
/* CALL CONVRT ( LAT, 'RADIANS', 'DEGREES', LAT ) */
/* CALL CONVRT ( LONG, 'RADIANS', 'DEGREES', LONG ) */
/* are listed to 4 decimal places in the second parallel table under */
/* LONG (longitude), LAT (latitude), and ALT (altitude). */
/* X(1) X(2) X(3) LONG LAT ALT */
/* -------------------------- ---------------------------- */
/* 0.0000 0.0000 0.0000 0.0000 90.0000 -6356.5838 */
/* 1.0000 0.0000 0.0000 0.0000 0.0000 -6377.2063 */
/* 0.0000 1.0000 0.0000 90.0000 0.0000 -6377.2063 */
/* 0.0000 0.0000 1.0000 0.0000 90.0000 -6355.5838 */
/* -1.0000 0.0000 0.0000 180.0000 0.0000 -6377.2063 */
/* 0.0000 -1.0000 0.0000 -90.0000 0.0000 -6377.2063 */
/* 0.0000 0.0000 -1.0000 0.0000 -90.0000 -6355.5838 */
/* 1.0000 1.0000 0.0000 45.0000 0.0000 -6376.7921 */
/* 1.0000 0.0000 1.0000 0.0000 88.7070 -6355.5725 */
/* 0.0000 1.0000 1.0000 90.0000 88.7070 -6355.5725 */
/* 1.0000 1.0000 1.0000 45.0000 88.1713 -6355.5612 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* See FUNDAMENTALS OF ASTRODYNAMICS, Bate, Mueller, White */
/* published by Dover for a description of geodetic coordinates. */
/* $ Author_and_Institution */
/* C.H. Acton (JPL) */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.3, 02-JUL-2007 (NJB) */
/* In Examples section of header, description of right-hand */
/* table was updated to use correct names of columns. Term */
/* "bodyfixed" is now hyphenated. */
/* - SPICELIB Version 1.0.2, 30-JUL-2003 (NJB) (CHA) */
/* Various header changes were made to improve clarity. Some */
/* minor header corrections were made. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
/* -& */
/* $ Index_Entries */
/* rectangular to geodetic */
/* -& */
/* $ Revisions */
/* - Beta Version 3.0.1, 9-JUN-1989 (HAN) */
/* Error handling was added to detect and equatorial radius */
/* whose value is less than or equal to zero. */
/* - Beta Version 2.0.0, 21-DEC-1988 (HAN) */
/* Error handling to detect invalid flattening coefficients */
/* was added. Because the flattening coefficient is used to */
/* compute the length of an axis, it must be checked so that */
/* the length is greater than zero. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("RECGEO", (ftnlen)6);
}
/* The equatorial radius must be positive. If not, signal an error */
/* and check out. */
if (*re <= 0.) {
setmsg_("Equatorial radius was *.", (ftnlen)24);
errdp_("*", re, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("RECGEO", (ftnlen)6);
return 0;
}
/* If the flattening coefficient is greater than one, the length */
/* of the 'C' axis computed below is negative. If it's equal to one, */
/* the length of the axis is zero. Either case is a problem, so */
/* signal an error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was *.", (ftnlen)29);
errdp_("*", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("RECGEO", (ftnlen)6);
return 0;
}
/* Determine the lengths of the axes of the reference ellipsoid. */
a = *re;
b = *re;
c__ = *re - *f * *re;
/* Find the point on the reference spheroid closes to the input point */
nearpt_(rectan, &a, &b, &c__, base, alt);
/* From this closest point determine the surface normal */
surfnm_(&a, &b, &c__, base, normal);
/* Using the surface normal, determine the latitude and longitude */
/* of the input point. */
reclat_(normal, &radius, long__, lat);
chkout_("RECGEO", (ftnlen)6);
return 0;
} /* recgeo_ */
/* $Procedure LGRIND (Lagrange polynomial interpolation with derivative) */
/* Subroutine */ int lgrind_(integer *n, doublereal *xvals, doublereal *yvals,
doublereal *work, doublereal *x, doublereal *p, doublereal *dp)
{
/* System generated locals */
integer xvals_dim1, yvals_dim1, work_dim1, work_offset, i__1, i__2, i__3,
i__4, i__5, i__6, i__7;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal denom;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal c1, c2;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Evaluate a Lagrange interpolating polynomial for a specified */
/* set of coordinate pairs, at a specified abcissisa value. */
/* Return the value of both polynomial and derivative. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* INTERPOLATION */
/* POLYNOMIAL */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* N I Number of points defining the polynomial. */
/* XVALS I Abscissa values. */
/* YVALS I Ordinate values. */
/* WORK I-O Work space array. */
/* X I Point at which to interpolate the polynomial. */
/* P O Polynomial value at X. */
/* DP O Polynomial derivative at X. */
/* $ Detailed_Input */
/* N is the number of points defining the polynomial. */
/* The arrays XVALS and YVALS contain N elements. */
/* XVALS, */
/* YVALS are arrays of abscissa and ordinate values that */
/* together define N ordered pairs. The set of points */
/* ( XVALS(I), YVALS(I) ) */
/* define the Lagrange polynomial used for */
/* interpolation. The elements of XVALS must be */
/* distinct and in increasing order. */
/* WORK is an N x 2 work space array, where N is the same */
/* dimension as that of XVALS and YVALS. It is used */
/* by this routine as a scratch area to hold */
/* intermediate results. WORK is permitted to */
/* coincide with YVALS. */
/* X is the abscissa value at which the interpolating */
/* polynomial is to be evaluated. */
/* $ Detailed_Output */
/* P is the value at X of the unique polynomial of */
/* degree N-1 that fits the points in the plane */
/* defined by XVALS and YVALS. */
/* DP is the derivative at X of the interpolating */
/* polynomial described above. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If any two elements of the array XVALS are equal the error */
/* SPICE(DIVIDEBYZERO) will be signaled. */
/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */
/* signaled. */
/* 3) This routine does not attempt to ward off or diagnose */
/* arithmetic overflows. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Given a set of N distinct abscissa values and corresponding */
/* ordinate values, there is a unique polynomial of degree N-1, often */
/* called the `Lagrange polynomial', that fits the graph defined by */
/* these values. The Lagrange polynomial can be used to interpolate */
/* the value of a function at a specified point, given a discrete */
/* set of values of the function. */
/* Users of this routine must choose the number of points to use */
/* in their interpolation method. The authors of Reference [1] have */
/* this to say on the topic: */
/* Unless there is solid evidence that the interpolating function */
/* is close in form to the true function f, it is a good idea to */
/* be cautious about high-order interpolation. We */
/* enthusiastically endorse interpolations with 3 or 4 points, we */
/* are perhaps tolerant of 5 or 6; but we rarely go higher than */
/* that unless there is quite rigorous monitoring of estimated */
/* errors. */
/* The same authors offer this warning on the use of the */
/* interpolating function for extrapolation: */
/* ...the dangers of extrapolation cannot be overemphasized: */
/* An interpolating function, which is perforce an extrapolating */
/* function, will typically go berserk when the argument x is */
/* outside the range of tabulated values by more than the typical */
/* spacing of tabulated points. */
/* $ Examples */
/* 1) Fit a cubic polynomial through the points */
/* ( -1, -2 ) */
/* ( 0, -7 ) */
/* ( 1, -8 ) */
/* ( 3, 26 ) */
/* and evaluate this polynomial at x = 2. */
/* PROGRAM TEST_LGRIND */
/* DOUBLE PRECISION P */
/* DOUBLE PRECISION DP */
/* DOUBLE PRECISION XVALS (4) */
/* DOUBLE PRECISION YVALS (4) */
/* DOUBLE PRECISION WORK (4,2) */
/* INTEGER N */
/* N = 4 */
/* XVALS(1) = -1 */
/* XVALS(2) = 0 */
/* XVALS(3) = 1 */
/* XVALS(4) = 3 */
/* YVALS(1) = -2 */
/* YVALS(2) = -7 */
/* YVALS(3) = -8 */
/* YVALS(4) = 26 */
/* CALL LGRIND ( N, XVALS, YVALS, WORK, 2.D0, P, DP ) */
/* WRITE (*,*) 'P, DP = ', P, DP */
/* END */
/* The returned value of P should be 1.D0, since the */
/* unique cubic polynomial that fits these points is */
/* 3 2 */
/* f(x) = x + 2x - 4x - 7 */
/* The returned value of DP should be 1.6D1, since the */
/* derivative of f(x) is */
/* ' 2 */
/* f (x) = 3x + 4x - 4 */
/* We also could have invoked LGRIND with the reference */
/* CALL LGRIND ( N, XVALS, YVALS, YVALS, 2.D0, P, DP ) */
/* if we wished to; in this case YVALS would have been */
/* modified on output. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] "Numerical Recipes---The Art of Scientific Computing" by */
/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */
/* William T. Vetterling (see sections 3.0 and 3.1). */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-AUG-2002 (NJB) */
/* -& */
/* $ Index_Entries */
/* interpolate function using Lagrange polynomial */
/* Lagrange interpolation */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Check in only if an error is detected. */
/* Parameter adjustments */
work_dim1 = *n;
work_offset = work_dim1 + 1;
yvals_dim1 = *n;
xvals_dim1 = *n;
/* Function Body */
if (return_()) {
return 0;
}
/* No data, no interpolation. */
if (*n < 1) {
chkin_("LGRIND", (ftnlen)6);
setmsg_("Array size must be positive; was #.", (ftnlen)35);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("LGRIND", (ftnlen)6);
return 0;
}
/* We're going to compute the value of our interpolating polynomial */
/* at X by taking advantage of a recursion relation between */
/* Lagrange polynomials of order n+1 and order n. The method works */
/* as follows: */
/* Define */
/* P (x) */
/* i(i+1)...(i+j) */
/* to be the unique Lagrange polynomial that interpolates our */
/* input function at the abscissa values */
/* x , x , ... x . */
/* i i+1 i+j */
/* Then we have the recursion relation */
/* P (x) = */
/* i(i+1)...(i+j) */
/* x - x */
/* i */
/* ----------- * P (x) */
/* x - x (i+1)...(i+j) */
/* i i+j */
/* x - x */
/* i+j */
/* + ----------- * P (x) */
/* x - x i(i+1)...(i+j-1) */
/* i i+j */
/* Repeated application of this relation allows us to build */
/* successive columns, in left-to-right order, of the */
/* triangular table */
/* P (x) */
/* 1 */
/* P (x) */
/* 12 */
/* P (x) P (x) */
/* 2 123 */
/* P (x) */
/* 23 . */
/* P (x) */
/* . 234 . */
/* . */
/* . . . */
/* . */
/* . . P (x) */
/* . . 12...N */
/* . */
/* . */
/* . */
/* P (x) */
/* (N-2)(N-1)N */
/* P (x) */
/* (N-1)N */
/* P (x) */
/* N */
/* and after N-1 steps arrive at our desired result, */
/* P (x). */
/* 12...N */
/* The computation is easier to do than to describe. */
/* We'll use the scratch array WORK to contain the current column of */
/* our interpolation table. To start out with, WORK(I) will contain */
/* P (x). */
/* I */
/* For columns 2...N of the table, we'll also carry along the */
/* derivative at X of each interpolating polynomial. This will */
/* allow us to find the derivative of the Lagrange polynomial */
/* at X. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
work[(i__2 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 <=
i__2 ? i__2 : s_rnge("work", i__2, "lgrind_", (ftnlen)374)] =
yvals[(i__3 = i__ - 1) < yvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("yvals", i__3, "lgrind_", (ftnlen)374)];
work[(i__2 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 << 1 &&
0 <= i__2 ? i__2 : s_rnge("work", i__2, "lgrind_", (ftnlen)
375)] = 0.;
}
/* Compute columns 2 through N of the table. Note that DENOM must */
/* be non-zero, or else a divide-by-zero error will occur. */
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
i__2 = *n - j;
for (i__ = 1; i__ <= i__2; ++i__) {
denom = xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("xvals", i__3, "lgrind_", (ftnlen)387)] - xvals[(
i__4 = i__ + j - 1) < xvals_dim1 && 0 <= i__4 ? i__4 :
s_rnge("xvals", i__4, "lgrind_", (ftnlen)387)];
if (denom == 0.) {
chkin_("LGRIND", (ftnlen)6);
setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23);
errint_("#", &i__, (ftnlen)1);
i__3 = i__ + j;
errint_("#", &i__3, (ftnlen)1);
errdp_("#", &xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 <= i__3
? i__3 : s_rnge("xvals", i__3, "lgrind_", (ftnlen)395)
], (ftnlen)1);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("LGRIND", (ftnlen)6);
return 0;
}
c1 = *x - xvals[(i__3 = i__ + j - 1) < xvals_dim1 && 0 <= i__3 ?
i__3 : s_rnge("xvals", i__3, "lgrind_", (ftnlen)402)];
c2 = xvals[(i__3 = i__ - 1) < xvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("xvals", i__3, "lgrind_", (ftnlen)403)] - *x;
/* Use the chain rule to compute the derivatives. Do this */
/* before computing the function value, because the latter */
/* computation will overwrite the first column of WORK. */
work[(i__3 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 <<
1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "lgrind_", (
ftnlen)410)] = (c1 * work[(i__4 = i__ + (work_dim1 << 1)
- work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 :
s_rnge("work", i__4, "lgrind_", (ftnlen)410)] + c2 * work[
(i__5 = i__ + 1 + (work_dim1 << 1) - work_offset) <
work_dim1 << 1 && 0 <= i__5 ? i__5 : s_rnge("work", i__5,
"lgrind_", (ftnlen)410)] + (work[(i__6 = i__ + work_dim1
- work_offset) < work_dim1 << 1 && 0 <= i__6 ? i__6 :
s_rnge("work", i__6, "lgrind_", (ftnlen)410)] - work[(
i__7 = i__ + 1 + work_dim1 - work_offset) < work_dim1 <<
1 && 0 <= i__7 ? i__7 : s_rnge("work", i__7, "lgrind_", (
ftnlen)410)])) / denom;
/* Compute the Ith entry in the Jth column. */
work[(i__3 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0
<= i__3 ? i__3 : s_rnge("work", i__3, "lgrind_", (ftnlen)
416)] = (c1 * work[(i__4 = i__ + work_dim1 - work_offset)
< work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge("work",
i__4, "lgrind_", (ftnlen)416)] + c2 * work[(i__5 = i__ +
1 + work_dim1 - work_offset) < work_dim1 << 1 && 0 <=
i__5 ? i__5 : s_rnge("work", i__5, "lgrind_", (ftnlen)416)
]) / denom;
}
}
/* Our results are sitting in WORK(1,1) and WORK(1,2) at this point. */
*p = work[(i__1 = work_dim1 + 1 - work_offset) < work_dim1 << 1 && 0 <=
i__1 ? i__1 : s_rnge("work", i__1, "lgrind_", (ftnlen)425)];
*dp = work[(i__1 = (work_dim1 << 1) + 1 - work_offset) < work_dim1 << 1 &&
0 <= i__1 ? i__1 : s_rnge("work", i__1, "lgrind_", (ftnlen)426)];
return 0;
} /* lgrind_ */
/* $Procedure KPSOLV ( Solve Keplers Equation --- Vector Form ) */
doublereal kpsolv_(doublereal *evec)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4;
doublereal ret_val, d__1, d__2, d__3, d__4;
/* Builtin functions */
double sqrt(doublereal);
integer i_dnnt(doublereal *);
double cos(doublereal), sin(doublereal);
/* Local variables */
doublereal cosx, sinx, h__;
integer i__;
doublereal k, x;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
integer maxit;
doublereal y0, xl, xm, xu, yx;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
doublereal ecc, ecc2, yxm, ypx;
/* $ Abstract */
/* This routine solves the equation X = < EVEC, U(X) > where */
/* U(X) is the unit vector [ Cos(X), SIN(X) ] and < , > denotes */
/* the two-dimensional dot product. */
/* $ 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 */
/* ROOTS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* EVEC I A 2-vector whose magnitude is less than 1. */
/* The function returns the solution to X = < EVEC, U(X) > */
/* $ Detailed_Input */
/* EVEC is any two dimensional vector whose magnitude is */
/* less than 1. */
/* $ Detailed_Output */
/* The function returns the value X such that the equation */
/* X = EVEC(1)COS(X) + EVEC(2)SIN(X). */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the magnitude of EVEC is greater than or equal to 1 */
/* the error SPICE(EVECOUTOFRANGE) is signalled. */
/* $ Particulars */
/* This routine uses bisection and Newton's method to find */
/* the root of the equation */
/* X = EVEC(1)COS(X) + EVEC(2)SIN(X). */
/* This equation is just a "vector form" of Kepler's equation. */
/* $ Examples */
/* Suppose you need to solve the equation */
/* M = E - e SIN(E) [ 1 ] */
/* for E. If we let X = E - M the equation is transformed to */
/* 0 = X - e SIN( X + M ) */
/* = X - e SIN( M ) COS(X) - e COS(M) SIN ( X ) */
/* Thus if we solve the equation */
/* X = e SIN(M) COS(X) + e COS(M) SIN(X) */
/* we can find the value of X we can compute E. */
/* The code fragment below illustrates how this routine can */
/* be used to solve equation [1]. */
/* EVEC(1) = ECC * DSIN(M) */
/* EVEC(2) = ECC * DCOS(M) */
/* E = M + KPSOLV( EVEC ) */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.1.0, 26-AUG-1997 (WLT) */
/* KPSOLV is now given an initial value of zero so that */
/* if an error condition is detected, KPSOLV will have */
/* a return value. */
/* - SPICELIB Version 1.0.0, 03-JAN-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Solve the vector form of the Kepler equation */
/* -& */
/* MXNEWT is the number of iterations we will perform */
/* in the Newtons method for finding the solution to */
/* the vector form of Kepler's equation. It has been */
/* empirically determined that 5 iterations is always */
/* sufficient on computers have 64 bit double precision */
/* numbers. */
/* We give the function an initial value, just in case */
/* we exit without solving Kepler's equation. */
ret_val = 0.;
h__ = evec[0];
k = evec[1];
ecc2 = h__ * h__ + k * k;
if (ecc2 >= 1.) {
chkin_("KPSOLV", (ftnlen)6);
setmsg_("The magnitude of the vector EVEC = ( #, # ) must be less th"
"an 1. However, the magnitude of this vector is #.", (ftnlen)
109);
errdp_("#", &h__, (ftnlen)1);
errdp_("#", &k, (ftnlen)1);
d__1 = sqrt(ecc2);
errdp_("#", &d__1, (ftnlen)1);
sigerr_("SPICE(EVECOUTOFRANGE)", (ftnlen)21);
chkout_("KPSOLV", (ftnlen)6);
return ret_val;
}
/* We first approximate the equation 0 = X - H * COS(X) - K * SIN(X) */
/* using bisection. If we let Y(X) = X - H * COS(X) - K * SIN(X) */
/* Y( ECC) = ECC - <EVEC,U(X)> = ECC - ECC*COS(ANGLE_X) > 0 */
/* Y(-ECC) = -ECC - <EVEC,U(X)> = -ECC - ECC*COS(ANGLE_X) < 0 */
/* where ANGLE_X is the angle between U(X) and EVEC. Thus -ECC */
/* and ECC necessarily bracket the root of the equation Y(X) = 0. */
/* Also note that Y'(X) = 1 - < EVEC, V(X) > where V(X) is the */
/* unit vector given by U'(X). Thus Y is an increasing function */
/* over the interval from -ECC to ECC. */
/* The mid point of ECC and -ECC is 0 and Y(0) = -H. Thus */
/* we can do the first bisection step without doing */
/* much in the way of computations. */
y0 = -h__;
xm = 0.;
ecc = sqrt(ecc2);
if (y0 > 0.) {
xu = 0.;
xl = -ecc;
} else if (y0 < 0.) {
xu = ecc;
xl = 0.;
} else {
ret_val = 0.;
return ret_val;
}
/* Iterate until we are assured of being in a region where */
/* Newton's method will converge quickly. The formula */
/* below was empirically determined to give good results. */
/* Computing MIN */
/* Computing MAX */
d__1 = 1. / (1. - ecc);
i__3 = 1, i__4 = i_dnnt(&d__1);
i__1 = 32, i__2 = max(i__3,i__4);
maxit = min(i__1,i__2);
i__1 = maxit;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Compute the next midpoint. We bracket XM by XL and XU just in */
/* case some kind of strange rounding occurs in the computation */
/* of the midpoint. */
/* Computing MAX */
/* Computing MIN */
d__3 = xu, d__4 = (xl + xu) * .5;
d__1 = xl, d__2 = min(d__3,d__4);
xm = max(d__1,d__2);
/* Compute Y at the midpoint of XU and XL */
yxm = xm - h__ * cos(xm) - k * sin(xm);
/* Determine the new upper and lower bounds. */
if (yxm > 0.) {
xu = xm;
} else {
xl = xm;
}
}
/* We've bisected into a region where we can now get rapid */
/* convergence using Newton's method. */
x = xm;
for (i__ = 1; i__ <= 5; ++i__) {
cosx = cos(x);
sinx = sin(x);
/* Compute Y and Y' at X. Use these to get the next */
/* iteration for X. */
/* For those of you who might be wondering, "Why not put */
/* in a check for YX .EQ. 0 and return early if we get */
/* an exact solution?" Here's why. An empirical check */
/* of those cases where you can actually escape from the */
/* Do-loop showed that the test YX .EQ. 0 is true */
/* only about once in every 10000 case of random inputs */
/* of EVEC. Thus on average the check is a waste of */
/* time and we don't bother with it. */
yx = x - h__ * cosx - k * sinx;
ypx = h__ * sinx + 1. - k * cosx;
x -= yx / ypx;
}
ret_val = x;
return ret_val;
} /* kpsolv_ */
/* $Procedure XFMSTA ( Transform state between coordinate systems) */
/* Subroutine */ int xfmsta_(doublereal *istate, char *icosys, char *ocosys,
char *body, doublereal *ostate, ftnlen icosys_len, ftnlen ocosys_len,
ftnlen body_len)
{
/* Initialized data */
static char cosys[40*6] = "RECTANGULAR "
"CYLINDRICAL " "LATITUDINAL "
" " "SPHERICAL "
"GEODETIC " "PLANETOGRAPHIC "
" ";
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal);
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *,
logical *, char *, integer *, logical *, ftnlen, ftnlen);
doublereal ivel[3], ipos[3];
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer isys, osys;
doublereal f;
extern /* Subroutine */ int zzctruin_(integer *);
integer i__, j;
doublereal radii[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), vpack_(doublereal *, doublereal *, doublereal *,
doublereal *);
extern doublereal dpmax_(void);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vequg_(
doublereal *, integer *, doublereal *);
doublereal sqtmp;
char isysu[40], osysu[40];
static logical svfnd1;
static integer svctr1[2];
extern logical failed_(void);
doublereal jacobi[9] /* was [3][3] */;
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen), georec_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), drdgeo_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *), recgeo_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), dgeodr_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *);
integer bodyid;
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
static integer svbdid;
extern /* Subroutine */ int latrec_(doublereal *, doublereal *,
doublereal *, doublereal *), drdlat_(doublereal *, doublereal *,
doublereal *, doublereal *), cylrec_(doublereal *, doublereal *,
doublereal *, doublereal *), drdcyl_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal toobig;
extern /* Subroutine */ int sphrec_(doublereal *, doublereal *,
doublereal *, doublereal *), drdsph_(doublereal *, doublereal *,
doublereal *, doublereal *), pgrrec_(char *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, ftnlen), drdpgr_(char *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, ftnlen),
reccyl_(doublereal *, doublereal *, doublereal *, doublereal *),
reclat_(doublereal *, doublereal *, doublereal *, doublereal *),
sigerr_(char *, ftnlen), recsph_(doublereal *, doublereal *,
doublereal *, doublereal *), chkout_(char *, ftnlen), recpgr_(
char *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, ftnlen), dcyldr_(doublereal *,
doublereal *, doublereal *, doublereal *), dlatdr_(doublereal *,
doublereal *, doublereal *, doublereal *), ljucrs_(integer *,
char *, char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), dsphdr_(
doublereal *, doublereal *, doublereal *, doublereal *);
static char svbody[36];
extern /* Subroutine */ int dpgrdr_(char *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, ftnlen);
extern logical return_(void);
integer dim;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Transform a state between coordinate systems. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CONVERSION */
/* COORDINATE */
/* EPHEMERIS */
/* STATE */
/* $ Declarations */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- ------------------------------------------------- */
/* ISTATE I Input state. */
/* ICOSYS I Current (input) coordinate system. */
/* OCOSYS I Desired (output) coordinate system. */
/* BODY I Name or NAIF ID of body with which */
/* coordinates are associated (if applicable). */
/* OSTATE O Converted output state. */
/* $ Detailed_Input */
/* ISTATE is a state vector in the input (ICOSYS) coordinate */
/* system representing position and velocity. */
/* All angular measurements must be in radians. */
/* Note: body radii values taken from the kernel */
/* pool are used when converting to or from geodetic or */
/* planetographic coordinates. It is the user's */
/* responsibility to verify the distance inputs are in */
/* the same units as the radii in the kernel pool, */
/* typically kilometers. */
/* ICOSYS is the name of the coordinate system that the input */
/* state vector (ISTATE) is currently in. */
/* ICOSYS may be any of the following: */
/* 'RECTANGULAR' */
/* 'CYLINDRICAL' */
/* 'LATITUDINAL' */
/* 'SPHERICAL' */
/* 'GEODETIC' */
/* 'PLANETOGRAPHIC' */
/* Leading spaces, trailing spaces, and letter case */
/* are ignored. For example, ' cyLindRical ' would be */
/* accepted. */
/* OCOSYS is the name of the coordinate system that the state */
/* should be converted to. */
/* Please see the description of ICOSYS for details. */
/* BODY is the name or NAIF ID of the body associated with the */
/* planetographic or geodetic coordinate system. */
/* If neither of the coordinate system choices are */
/* geodetic or planetographic, BODY may be an empty */
/* string (' '). */
/* Examples of accepted body names or IDs are: */
/* 'Earth' */
/* '399' */
/* Leading spaces, trailing spaces, and letter case are */
/* ignored. */
/* $ Detailed_Output */
/* OSTATE is the state vector that has been converted to the */
/* output coordinate system (OCOSYS). */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If either the input or output coordinate system is not */
/* recognized, the error SPICE(COORDSYSNOTREC) is signaled. */
/* 2) If the input body name cannot be converted to a NAIF ID */
/* (applies to geodetic and planetographic coordinate */
/* systems), the error 'SPICE(IDCODENOTFOUND)' is signaled. */
/* 3) If the input state ISTATE is not valid, meaning the position */
/* but not the velocity is along the z-axis, the error */
/* 'SPICE(INVALIDSTATE)' is signaled. */
/* Note: If both the input position and velocity are along */
/* the z-axis and the output coordinate system is not */
/* rectangular, the velocity can still be calculated even */
/* though the Jacobian is undefined. This case will not */
/* signal an error. An example of the input position and */
/* velocity along the z-axis is below. */
/* Term Value */
/* ----- ------ */
/* x 0 */
/* y 0 */
/* z z */
/* dx/dt 0 */
/* dy/dt 0 */
/* dz/dt dz_dt */
/* 4) If either the input or output coordinate system is */
/* geodetic or planetographic and at least one of the body's */
/* radii is less than or equal to zero, the error */
/* SPICE(INVALIDRADIUS) will be signaled. */
/* 5) If either the input or output coordinate system is */
/* geodetic or planetographic and the difference of the */
/* equatorial and polar radii divided by the equatorial radius */
/* would produce numeric overflow, the error */
/* 'SPICE(INVALIDRADIUS)' will be signaled. */
/* 6) If the product of the Jacobian and velocity components */
/* may lead to numeric overflow, the error */
/* 'SPICE(NUMERICOVERFLOW)' is signaled. */
/* $ Files */
/* SPK, PCK, CK, and FK kernels may be required. */
/* If the input or output coordinate systems are either geodetic or */
/* planetographic, a PCK providing the radii of the body */
/* name BODY must be loaded via FURNSH. */
/* Kernel data are normally loaded once per program run, NOT every */
/* time this routine is called. */
/* $ Particulars */
/* Input Order */
/* ------------------------------------------- */
/* The input and output states will be structured by the */
/* following descriptions. */
/* For rectangular coordinates, the state vector is the following */
/* in which X, Y, and Z are the rectangular position components and */
/* DX, DY, and DZ are the time derivatives of each position */
/* component. */
/* ISTATE = ( X, Y, Z, DX, DY, DZ ) */
/* For cylindrical coordinates, the state vector is the following */
/* in which R is the radius, LONG is the longitudes, Z is the */
/* height, and DR, DLONG, and DZ are the time derivatives of each */
/* position component. */
/* ISTATE = ( R, LONG, Z, DR, DLONG, DZ ) */
/* For latitudinal coordinates, the state vector is the following */
/* in which R is the radius, LONG is the longitude, LAT is the */
/* latitude, and DR, DLONG, and DLAT are the time derivatives of */
/* each position component. */
/* ISTATE = ( R, LONG, LAT, DR, DLONG, DLAT ) */
/* For spherical coordinates, the state vector is the following in */
/* which R is the radius, COLAT is the colatitude, LONG is the */
/* longitude, and DR, DCOLAT, and DLONG are the time derivatives of */
/* each position component. */
/* ISTATE = ( R, COLAT, LONG, DR, DCOLAT, DLONG ) */
/* For geodetic coordinates, the state vector is the following in */
/* which LONG is the longitude, LAT is the latitude, ALT is the */
/* altitude, and DLONG, DLAT, and DALT are the time derivatives of */
/* each position component. */
/* ISTATE = ( LONG, LAT, ALT, DLONG, DLAT, DALT ) */
/* For planetographic coordinates, the state vector is the */
/* following in which LONG is the longitude, LAT is the latitude, */
/* ALT is the altitude, and DLONG, DLAT, and DALT are the time */
/* derivatives of each position component. */
/* ISTATE = ( LONG, LAT, ALT, DLONG, DLAT, DALT ) */
/* Input Boundaries */
/* ------------------------------------------- */
/* There are intervals the input angles must fall within if */
/* the input coordinate system is not rectangular. These */
/* intervals are provided below. */
/* Input variable Input meaning Input interval [rad] */
/* -------------- ------------- ------------------------ */
/* LONG Longitude 0 <= LONG < 2*pi */
/* LAT Latitude -pi/2 <= LAT <= pi/2 */
/* COLAT Colatitude 0 <= COLAT <= pi */
/* $ Examples */
/* The numerical results shown for these examples may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* 1) Find the apparent state of Phoebe as seen by CASSINI in the */
/* J2000 frame at 2004 Jun 11 19:32:00. Transform the state */
/* from rectangular to latitudinal coordinates. For verification, */
/* transform the state back from latitudinal to rectangular */
/* coordinates. */
/* Use the meta-kernel shown below to load the required SPICE */
/* kernels. */
/* KPL/MK */
/* File name: xfmsta_ex1.tm */
/* This meta-kernel is intended to support operation of SPICE */
/* example programs. The kernels shown here should not be */
/* assumed to contain adequate or correct versions of data */
/* required by SPICE-based user applications. */
/* In order for an application to use this meta-kernel, the */
/* kernels referenced here must be present in the user's */
/* current working directory. */
/* The names and contents of the kernels referenced */
/* by this meta-kernel are as follows: */
/* File name Contents */
/* --------- -------- */
/* cpck05Mar2004.tpc Planet orientation and */
/* radii */
/* naif0009.tls Leapseconds */
/* 020514_SE_SAT105.bsp Satellite ephemeris for */
/* Saturn */
/* 030201AP_SK_SM546_T45.bsp CASSINI ephemeris */
/* 981005_PLTEPH-DE405S.bsp Planetary ephemeris */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'naif0009.tls' , */
/* '020514_SE_SAT105.bsp' , */
/* '030201AP_SK_SM546_T45.bsp' , */
/* '981005_PLTEPH-DE405S.bsp', */
/* 'cpck05Mar2004.tpc' ) */
/* End of meta-kernel */
/* Example code begins here. */
/* PROGRAM EX1_XFMSTA */
/* IMPLICIT NONE */
/* C */
/* C Local parameters */
/* C */
/* C METAKR is the meta-kernel's filename. */
/* C */
/* CHARACTER*(*) METAKR */
/* PARAMETER ( METAKR = 'xfmsta_ex1.tm' ) */
/* CHARACTER*(*) FORM */
/* PARAMETER ( FORM = '(F16.6, F16.6, F16.6)' ) */
/* C */
/* C Local variables */
/* C */
/* C STAREC is the state of Phoebe with respect to CASSINI in */
/* C rectangular coordinates. STALAT is the state rotated into */
/* C latitudinal coordinates. STREC2 is the state transformed */
/* C back into rectangular coordinates from latitudinal. */
/* C */
/* DOUBLE PRECISION STAREC (6) */
/* DOUBLE PRECISION STALAT (6) */
/* DOUBLE PRECISION STREC2 (6) */
/* C */
/* C ET is the ephemeris time (TDB) corresponding to the */
/* C observation. */
/* C */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LT */
/* INTEGER I */
/* C */
/* C The required kernels must be loaded. */
/* C */
/* CALL FURNSH ( METAKR ) */
/* C */
/* C Calculate the state at 2004 Jun 11 19:32:00 UTC. */
/* C */
/* CALL STR2ET ( '2004-JUN-11-19:32:00', ET ) */
/* C */
/* C Calculate the apparent state of Phoebe as seen by */
/* C CASSINI in the J2000 frame. */
/* C */
/* CALL SPKEZR ( 'PHOEBE', ET, 'IAU_PHOEBE', 'LT+S', */
/* . 'CASSINI', STAREC, LT ) */
/* C */
/* C Transform the state from rectangular to latitudinal. */
/* C Notice that since neither the input nor output */
/* C coordinate frames are 'geodetic' or 'planetographic', */
/* C the input for the body name is a blank string. */
/* C */
/* CALL XFMSTA ( STAREC, 'RECTANGULAR', 'LATITUDINAL', ' ', */
/* . STALAT ) */
/* C */
/* C Transform the state back to rectangular from latitudinal */
/* C for verification. This result should be very similar to */
/* C STAREC. */
/* C */
/* CALL XFMSTA ( STALAT, 'LATITUDINAL', 'RECTANGULAR',' ', */
/* . STREC2 ) */
/* C */
/* C Report the results. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Phoebe as seen by CASSINI - rectangular' */
/* WRITE (*,*) ' Position [km]:' */
/* WRITE (*,FORM) (STAREC(I), I = 1, 3) */
/* WRITE (*,*) ' Velocity [km/s]:' */
/* WRITE (*,FORM) (STAREC(I), I = 4, 6) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Phoebe as seen by CASSINI - latitudinal' */
/* WRITE (*,*) ' Position [km, rad, rad]:' */
/* WRITE (*,FORM) (STALAT(I), I = 1, 3) */
/* WRITE (*,*) ' Velocity [km/s, rad/s, rad/s]:' */
/* WRITE (*,FORM) (STALAT(I), I = 4, 6) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Verification: ' */
/* WRITE (*,*) 'Phoebe as seen by CASSINI - rectangular' */
/* WRITE (*,*) ' Position [km]:' */
/* WRITE (*,FORM) (STREC2(I), I = 1, 3) */
/* WRITE (*,*) ' Velocity [km/s]:' */
/* WRITE (*,FORM) (STREC2(I), I = 4, 6) */
/* END */
/* When this program was executed using gfortran on a PC Linux */
/* 64 bit environment, the output was: */
/* Phoebe as seen by CASSINI - rectangular */
/* Position [km]: */
/* -1982.639762 -934.530471 -166.562595 */
/* Velocity [km/s]: */
/* 3.970832 -3.812496 -2.371663 */
/* Phoebe as seen by CASSINI - latitudinal */
/* Position [km, rad, rad]: */
/* 2198.169858 -2.701121 -0.075846 */
/* Velocity [km/s, rad/s, rad/s]: */
/* -1.780939 0.002346 -0.001144 */
/* Verification: */
/* Phoebe as seen by CASSINI - rectangular */
/* Position [km]: */
/* -1982.639762 -934.530471 -166.562595 */
/* Velocity [km/s]: */
/* 3.970832 -3.812496 -2.371663 */
/* 2) Transform a given state from cylindrical to planetographic */
/* coordinates with respect to Earth. */
/* Use the meta-kernel shown below to load the required SPICE */
/* kernels. */
/* KPL/MK */
/* File name: xfmsta_ex2.tm */
/* This meta-kernel is intended to support operation of SPICE */
/* example programs. The kernels shown here should not be */
/* assumed to contain adequate or correct versions of data */
/* required by SPICE-based user applications. */
/* In order for an application to use this meta-kernel, the */
/* kernels referenced here must be present in the user's */
/* current working directory. */
/* The names and contents of the kernels referenced */
/* by this meta-kernel are as follows: */
/* File name Contents */
/* --------- -------- */
/* cpck05Mar2004.tpc Planet orientation and */
/* radii */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'cpck05Mar2004.tpc' ) */
/* \begintext */
/* End of meta-kernel */
/* Example code begins here. */
/* PROGRAM EX2_XFMSTA */
/* IMPLICIT NONE */
/* C */
/* C Local parameters */
/* C */
/* C METAKR is the meta-kernel's filename. */
/* C */
/* CHARACTER*(*) METAKR */
/* PARAMETER ( METAKR = 'xfmsta_ex2.tm' ) */
/* CHARACTER*(*) FORM */
/* PARAMETER ( FORM = '(F16.6, F16.6, F16.6)' ) */
/* C */
/* C Local variables */
/* C */
/* C STACYL is the state in cylindrical coordinates. */
/* C */
/* DOUBLE PRECISION STACYL (6) */
/* C */
/* C STAPLN is the state transformed into planetographic */
/* C coordinates. */
/* C */
/* DOUBLE PRECISION STAPLN (6) */
/* C */
/* C STCYL2 is the state transformed back into */
/* C cylindrical coordinates from planetographic. */
/* C */
/* DOUBLE PRECISION STCYL2 (6) */
/* INTEGER I */
/* DATA STACYL / 1.0D0, 0.5D0, 0.5D0, 0.2D0, 0.1D0, -0.2D0 / */
/* C */
/* C The required kernels must be loaded. */
/* C */
/* CALL FURNSH ( METAKR ) */
/* C */
/* C Transform the state from cylindrical to planetographic. */
/* C Note that since one of the coordinate systems is */
/* C planetographic, the body name must be input. */
/* C */
/* CALL XFMSTA ( STACYL, 'CYLINDRICAL', 'PLANETOGRAPHIC', */
/* . 'EARTH', STAPLN ) */
/* C */
/* C Transform the state back to cylindrical from */
/* C planetographic for verification. The result should be very */
/* C close to STACYL. */
/* C */
/* CALL XFMSTA ( STAPLN, 'PLANETOGRAPHIC', 'CYLINDRICAL', */
/* . 'EARTH', STCYL2 ) */
/* C */
/* C Report the results. */
/* C */
/* WRITE (*,*) 'Cylindrical state' */
/* WRITE (*,*) ' Position [km, rad, km]:' */
/* WRITE (*,FORM) (STACYL(I), I = 1, 3) */
/* WRITE (*,*) ' Velocity [km/s, rad/s, km/s]:' */
/* WRITE (*,FORM) (STACYL(I), I = 4, 6) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Planetographic state' */
/* WRITE (*,*) ' Position [rad, rad, km]:' */
/* WRITE (*,FORM) (STAPLN(I), I = 1, 3) */
/* WRITE (*,*) ' Velocity [rad/s, rad/s, km/s]:' */
/* WRITE (*,FORM) (STAPLN(I), I = 4, 6) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Verification: Cylindrical state' */
/* WRITE (*,*) ' Position [km, rad, km]:' */
/* WRITE (*,FORM) (STCYL2(I), I = 1, 3) */
/* WRITE (*,*) ' Velocity [km/s, rad/s, km/s]:' */
/* WRITE (*,FORM) (STCYL2(I), I = 4, 6) */
/* END */
/* When this program was executed using gfortran on a PC Linux */
/* 64 bit environment, the output was: */
/* Cylindrical state */
/* Position [km, rad, km]: */
/* 1.000000 0.500000 0.500000 */
/* Velocity [km/s, rad/s, km/s]: */
/* 0.200000 0.100000 -0.200000 */
/* Planetographic state */
/* Position [rad, rad, km]: */
/* 0.500000 1.547727 -6356.238467 */
/* Velocity [rad/s, rad/s, km/s]: */
/* 0.100000 -0.004721 -0.195333 */
/* Verification: Cylindrical state */
/* Position [km, rad, km]: */
/* 1.000000 0.500000 0.500000 */
/* Velocity [km/s, rad/s, km/s]: */
/* 0.200000 0.100000 -0.200000 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* S.C. Krening (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 22-APR-2014 (SCK)(BVS) */
/* -& */
/* $ Index_Entries */
/* state transformation between coordinate systems */
/* convert state */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Potentially large numbers produced by transforming the */
/* velocity using the Jacobian must not exceed DPMAX()/MARGIN: */
/* The size of each coordinate system name must not exceed */
/* CHSIZ characters. */
/* NCOSYS is the number of coordinate systems supported by */
/* this routine. */
/* The following integer parameters represent the coordinate */
/* systems supported by this routine. */
/* Saved body name length. */
/* Local variables */
/* COSYS is the array of supported coordinate system names. */
/* ISYSU and OSYSU are the input and output coordinate systems */
/* from the user that are made insensitive to case or leading and */
/* trailing spaces. */
/* IPOS and IVEL are the input position and velocity translated */
/* into rectangular. */
/* For transformations including either geodetic or planetographic */
/* coordinate systems, RADII is an array of the radii values */
/* associated with the input body. These values will be loaded */
/* from the kernel pool. */
/* JACOBI is the Jacobian matrix that converts the velocity */
/* coordinates between systems. */
/* The flattening coefficient, F, is calculated when either */
/* geodetic or planetographic coordinate systems are included */
/* in the transformation. */
/* SQTMP and TOOBIG are used to check for possible numeric */
/* overflow situations. */
/* BODYID and DIM are only used when the input or output coordinate */
/* systems are geodetic or planetographic. The BODYID is the NAID ID */
/* associated with the input body name. DIM is used while retrieving */
/* the radii from the kernel pool. */
/* ISYS and OSYS are the integer codes corresponding to the */
/* input and output coordinate systems. I and J are iterators. */
/* Saved name/ID item declarations. */
/* Saved variables */
/* Saved name/ID items. */
/* Assign the names of the coordinate systems to a character */
/* array in which each coordinate system name is located at */
/* the index of the integer ID of the coordinate system. */
/* Initial values. */
/* There are three main sections of this routine: */
/* 1) Error handling and initialization. */
/* 2) Conversion of the input to rectangular coordinates. */
/* 3) Conversion from rectangular to the output coordinates. */
/* Error handling and initialization */
/* ---------------------------------------------------------------- */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("XFMSTA", (ftnlen)6);
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* Remove initial and trailing spaces. */
/* Convert the input coordinate systems to upper case. */
ljucrs_(&c__0, icosys, isysu, icosys_len, (ftnlen)40);
ljucrs_(&c__0, ocosys, osysu, ocosys_len, (ftnlen)40);
/* Check to see if the input and output coordinate systems */
/* provided by the user are acceptable. Store the integer */
/* code of the input and output coordinate systems into */
/* ISYS and OSYS. */
isys = isrchc_(isysu, &c__6, cosys, (ftnlen)40, (ftnlen)40);
osys = isrchc_(osysu, &c__6, cosys, (ftnlen)40, (ftnlen)40);
/* If the coordinate systems are not acceptable, an error is */
/* signaled. */
if (isys == 0 || osys == 0) {
if (isys == 0 && osys == 0) {
/* Both the input and the output coordinate systems were not */
/* recognized. */
setmsg_("Input coordinate system # and output coordinate system "
"# are not recognized.", (ftnlen)76);
errch_("#", icosys, (ftnlen)1, icosys_len);
errch_("#", ocosys, (ftnlen)1, ocosys_len);
sigerr_("SPICE(COORDSYSNOTREC)", (ftnlen)21);
chkout_("XFMSTA", (ftnlen)6);
return 0;
} else if (isys == 0) {
/* The input coordinate system was not recognized. */
setmsg_("Input coordinate system # was not recognized", (ftnlen)
44);
errch_("#", icosys, (ftnlen)1, icosys_len);
sigerr_("SPICE(COORDSYSNOTREC)", (ftnlen)21);
chkout_("XFMSTA", (ftnlen)6);
return 0;
} else {
/* The output coordinate system was not recognized. */
setmsg_("Output coordinate system # was not recognized", (ftnlen)
45);
errch_("#", ocosys, (ftnlen)1, ocosys_len);
sigerr_("SPICE(COORDSYSNOTREC)", (ftnlen)21);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
}
/* If the input and output coordinate systems are equal, set the */
/* output equal to the input since no conversion needs to take */
/* place. */
if (isys == osys) {
vequg_(istate, &c__6, ostate);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* If converting to or from either geodetic or planetographic, the */
/* NAIF ID must be found from the input body name BODY. If the */
/* body name does not have a valid NAIF ID code, an error is */
/* signaled. If the NAIF ID is valid, the radii of the body are */
/* located and the flattening coefficient is calculated. */
if (osys == 5 || osys == 6 || isys == 5 || isys == 6) {
/* Find the NAIF ID code */
zzbods2c_(svctr1, svbody, &svbdid, &svfnd1, body, &bodyid, &found, (
ftnlen)36, body_len);
/* If the body's name was found, find the body's radii and */
/* compute flattening coefficient. Otherwise, signal an error. */
if (found) {
bodvcd_(&bodyid, "RADII", &c__3, &dim, radii, (ftnlen)5);
if (failed_()) {
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* If either radius is less than or equal to zero, an error is */
/* signaled. */
if (radii[2] <= 0. || radii[0] <= 0.) {
setmsg_("At least one radii is less than or equal to zero. T"
"he equatorial radius has a value of # and the polar "
"radius has has a value of #.", (ftnlen)131);
errdp_("#", radii, (ftnlen)1);
errdp_("#", &radii[2], (ftnlen)1);
sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* If the difference of the equatorial and polar radii */
/* divided by the equatorial radius is greater than DPMAX, */
/* a numeric overflow may occur, so an error is signaled. */
if (sqrt((d__1 = radii[0] - radii[2], abs(d__1))) / sqrt((abs(
radii[0]))) >= sqrt(dpmax_())) {
setmsg_("The equatorial radius for # has a value of # and a "
"polar radius of #. The flattening coefficient cannot"
" be calculated due to numeric overflow.", (ftnlen)142)
;
errch_("#", body, (ftnlen)1, body_len);
errdp_("#", radii, (ftnlen)1);
errdp_("#", &radii[2], (ftnlen)1);
sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
f = (radii[0] - radii[2]) / radii[0];
} else {
setmsg_("The input body name # does not have a valid NAIF ID cod"
"e.", (ftnlen)57);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
}
/* Conversion of the input to rectangular coordinates */
/* ---------------------------------------------------------------- */
/* First, the position and velocity coordinates will be converted */
/* into rectangular coordinates. If the input system is not */
/* rectangular, then the velocity coordinates must be translated */
/* into rectangular using the Jacobian. If the input system is */
/* rectangular, then the input state must simply be saved into IPOS */
/* and IVEL. */
/* TOOBIG is used for preventing numerical overflow. The square */
/* roots of values are used to safely check if overflow will occur. */
toobig = sqrt(dpmax_() / 100.);
if (isys != 1) {
/* To rectangular... */
if (isys == 2) {
/* ... from cylindrical */
cylrec_(istate, &istate[1], &istate[2], ipos);
drdcyl_(istate, &istate[1], &istate[2], jacobi);
} else if (isys == 3) {
/* ... from latitudinal */
latrec_(istate, &istate[1], &istate[2], ipos);
drdlat_(istate, &istate[1], &istate[2], jacobi);
} else if (isys == 4) {
/* ... from spherical */
sphrec_(istate, &istate[1], &istate[2], ipos);
drdsph_(istate, &istate[1], &istate[2], jacobi);
} else if (isys == 5) {
/* ... from geodetic */
georec_(istate, &istate[1], &istate[2], radii, &f, ipos);
if (failed_()) {
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
drdgeo_(istate, &istate[1], &istate[2], radii, &f, jacobi);
} else if (isys == 6) {
/* ... from planetographic */
pgrrec_(body, istate, &istate[1], &istate[2], radii, &f, ipos,
body_len);
if (failed_()) {
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
drdpgr_(body, istate, &istate[1], &istate[2], radii, &f, jacobi,
body_len);
} else {
setmsg_("This error should never occur. This is an intermediate "
"step in which a non-rectangular input state should be tr"
"ansferred to rectangular. The input coordinate system i"
"s not recognized, yet was not caught by an earlier check."
, (ftnlen)224);
sigerr_("SPICE(BUG1)", (ftnlen)11);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* Some DRD* routines are not error free. Be safe and check */
/* FAILED to not use un-initialized JACOBI. */
if (failed_()) {
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* If the multiplication of the Jacobian and velocity can cause */
/* overflow, signal an error. */
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
sqtmp = sqrt((d__1 = jacobi[(i__1 = i__ + j * 3 - 4) < 9 && 0
<= i__1 ? i__1 : s_rnge("jacobi", i__1, "xfmsta_", (
ftnlen)1054)], abs(d__1))) * sqrt((d__2 = istate[(
i__2 = j + 2) < 6 && 0 <= i__2 ? i__2 : s_rnge("ista"
"te", i__2, "xfmsta_", (ftnlen)1054)], abs(d__2)));
if (sqtmp > toobig) {
setmsg_("The product of the Jacobian and velocity may ca"
"use numeric overflow.", (ftnlen)68);
sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
}
}
/* Transform the velocity into rectangular coordinates. */
mxv_(jacobi, &istate[3], ivel);
} else if (isys == 1) {
/* If the input coordinate system is rectangular, the input */
/* position does not need to be translated into rectangular. */
vequ_(istate, ipos);
vequ_(&istate[3], ivel);
} else {
setmsg_("This error should never occur. This is an ELSE statement. I"
"f the input coordinate system is not rectangular, the IF sho"
"uld be executed. If the input coordinate system is rectangul"
"ar, the ELSE IF should be executed.", (ftnlen)214);
sigerr_("SPICE(BUG2)", (ftnlen)11);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* Conversion from rectangular into the output coordinates */
/* ---------------------------------------------------------------- */
/* Convert to the output coordinate system. If the output */
/* coordinate system is not rectangular, four calculations must */
/* be made: */
/* 1) Verify the position and velocity are not along the z-axis. */
/* If the position and velocity are along the z-axis, the */
/* velocity can still be converted even though the */
/* Jacobian is not defined. If the position is along the */
/* z-axis but the velocity is not, the velocity cannot be */
/* converted to the output coordinate system. */
/* 2) Calculate the Jacobian from rectangular to the output */
/* coordinate system and verify the product of the Jacobian */
/* and velocity will not cause numeric overflow. */
/* 3) Transform the position to the output coordinate system. */
/* 4) Transform the velocity to the output coordinates using */
/* the Jacobian and the rectangular velocity IVEL. */
if (osys != 1) {
/* From rectangular for the case when the input position is along */
/* the z-axis ... */
if (abs(ipos[0]) + abs(ipos[1]) == 0.) {
if (abs(ivel[0]) + abs(ivel[1]) == 0.) {
/* If the velocity is along the z-axis, then the velocity */
/* can be computed in the output coordinate frame even */
/* though the Jacobian is not defined. */
if (osys == 2) {
/* ... to cylindrical */
vpack_(&c_b56, &c_b56, &ivel[2], &ostate[3]);
reccyl_(ipos, ostate, &ostate[1], &ostate[2]);
} else if (osys == 3) {
/* ... to latitudinal */
vpack_(&ivel[2], &c_b56, &c_b56, &ostate[3]);
reclat_(ipos, ostate, &ostate[1], &ostate[2]);
} else if (osys == 4) {
/* ... to spherical */
vpack_(&ivel[2], &c_b56, &c_b56, &ostate[3]);
recsph_(ipos, ostate, &ostate[1], &ostate[2]);
} else if (osys == 5) {
/* ... to geodetic */
vpack_(&c_b56, &c_b56, &ivel[2], &ostate[3]);
recgeo_(ipos, radii, &f, ostate, &ostate[1], &ostate[2]);
} else if (osys == 6) {
/* ... to planetographic */
vpack_(&c_b56, &c_b56, &ivel[2], &ostate[3]);
recpgr_(body, ipos, radii, &f, ostate, &ostate[1], &
ostate[2], body_len);
} else {
setmsg_("This error should never occur. This is an inter"
"mediate step in which a position and velocity al"
"ong the z-axis are converted to a non-rectangula"
"r coordinate system from rectangular. The output"
" coordinate system is not recognized, yet was no"
"t caught by an earlier check.", (ftnlen)268);
sigerr_("SPICE(BUG3)", (ftnlen)11);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* The output state has been calculated for the special */
/* case of the position and velocity existing along the */
/* z-axis. */
chkout_("XFMSTA", (ftnlen)6);
return 0;
} else {
/* The Jacobian is undefined and the velocity cannot be */
/* converted since it is not along the z-axis. */
/* Signal an error. */
setmsg_("Invalid input state: z axis.", (ftnlen)28);
sigerr_("SPICE(INVALIDSTATE)", (ftnlen)19);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
}
/* From rectangular for cases when the input position is not along */
/* the z-axis ... */
if (osys == 2) {
/* ... to cylindrical */
dcyldr_(ipos, &ipos[1], &ipos[2], jacobi);
reccyl_(ipos, ostate, &ostate[1], &ostate[2]);
} else if (osys == 3) {
/* ... to latitudinal */
dlatdr_(ipos, &ipos[1], &ipos[2], jacobi);
reclat_(ipos, ostate, &ostate[1], &ostate[2]);
} else if (osys == 4) {
/* ... to spherical */
dsphdr_(ipos, &ipos[1], &ipos[2], jacobi);
recsph_(ipos, ostate, &ostate[1], &ostate[2]);
} else if (osys == 5) {
/* ... to geodetic */
dgeodr_(ipos, &ipos[1], &ipos[2], radii, &f, jacobi);
recgeo_(ipos, radii, &f, ostate, &ostate[1], &ostate[2]);
} else if (osys == 6) {
/* ... to planetographic */
dpgrdr_(body, ipos, &ipos[1], &ipos[2], radii, &f, jacobi,
body_len);
recpgr_(body, ipos, radii, &f, ostate, &ostate[1], &ostate[2],
body_len);
} else {
setmsg_("This error should never occur. This is an intermediate "
"step in which a state is converted to a non-rectangular "
"coordinate system from rectangular. The output coordinat"
"e system is not recognized, yet was not caught by an ear"
"lier check.", (ftnlen)234);
sigerr_("SPICE(BUG4)", (ftnlen)11);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* Many D*DR and REC* routines are not error free. Be safe and */
/* check FAILED to not use un-initialized JACOBI. */
if (failed_()) {
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
/* If the multiplication of the Jacobian and velocity can cause */
/* overflow, signal an error. */
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
sqtmp = sqrt((d__1 = jacobi[(i__1 = i__ + j * 3 - 4) < 9 && 0
<= i__1 ? i__1 : s_rnge("jacobi", i__1, "xfmsta_", (
ftnlen)1314)], abs(d__1))) * sqrt((d__2 = ivel[(i__2 =
j - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("ivel", i__2,
"xfmsta_", (ftnlen)1314)], abs(d__2)));
if (sqtmp > toobig) {
setmsg_("The product of the Jacobian and velocity may ca"
"use numeric overflow.", (ftnlen)68);
sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
}
}
/* Calculate the velocity in the output coordinate system. */
mxv_(jacobi, ivel, &ostate[3]);
} else if (osys == 1) {
/* If the output coordinate system is rectangular, the position */
/* and velocity components of the output state are set equal to */
/* the rectangular IPOS and IVEL, respectively, because the */
/* components have already been converted to rectangular. */
vequ_(ipos, ostate);
vequ_(ivel, &ostate[3]);
} else {
setmsg_("This error should never occur. This is an ELSE statement. I"
"f the output coordinate system is not rectangular, the IF sh"
"ould be executed. If the output coordinate system is rectang"
"ular, the ELSE IF should be executed.", (ftnlen)216);
sigerr_("SPICE(BUG5)", (ftnlen)11);
chkout_("XFMSTA", (ftnlen)6);
return 0;
}
chkout_("XFMSTA", (ftnlen)6);
return 0;
} /* xfmsta_ */
/* $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 GFUDS ( GF, user defined scalar ) */
/* Subroutine */ int gfuds_(U_fp udfunc, U_fp udqdec, char *relate,
doublereal *refval, doublereal *adjust, doublereal *step, doublereal *
cnfine, integer *mw, integer *nw, doublereal *work, doublereal *
result, ftnlen relate_len)
{
/* System generated locals */
integer work_dim1, work_offset, i__1;
/* Local variables */
extern /* Subroutine */ int zzgfudlt_();
extern /* Subroutine */ int zzgfrelx_(U_fp, U_fp, U_fp, U_fp, U_fp, S_fp,
char *, doublereal *, doublereal *, doublereal *, doublereal *,
integer *, integer *, doublereal *, logical *, U_fp, U_fp, U_fp,
char *, char *, logical *, L_fp, doublereal *, ftnlen, ftnlen,
ftnlen), chkin_(char *, ftnlen), errdp_(char *, doublereal *,
ftnlen);
extern integer sized_(doublereal *);
extern logical gfbail_();
extern /* Subroutine */ int scardd_(integer *, doublereal *);
extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_(), gfrepu_(),
gfstep_();
char rptpre[1*2], rptsuf[1*2];
extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen), errint_(char *, integer *,
ftnlen), gfsstp_(doublereal *);
extern logical odd_(integer *);
doublereal tol;
extern /* Subroutine */ int zzgfref_(doublereal *);
/* $ Abstract */
/* Perform a GF search on a user defined scalar quantity. */
/* $ 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 */
/* SPK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* EVENT */
/* EPHEMERIS */
/* SEARCH */
/* WINDOW */
/* $ Declarations */
/* $ Abstract */
/* This file contains public, 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) */
/* L.E. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */
/* Added NWRR parameter. */
/* Added NWUDS parameter. */
/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */
/* -& */
/* Root finding parameters: */
/* CNVTOL is the default convergence tolerance used by the */
/* high-level GF search API routines. This tolerance is */
/* used to terminate searches for binary state transitions: */
/* when the time at which a transition occurs is bracketed */
/* by two times that differ by no more than CNVTOL, the */
/* transition time is considered to have been found. */
/* Units are TDB seconds. */
/* NWMAX is the maximum number of windows allowed for user-defined */
/* workspace array. */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */
/* Currently no more than twelve windows are required; the three */
/* extra windows are spares. */
/* Callers of GFEVNT can include this file and use the parameter */
/* NWMAX to declare the second dimension of the workspace array */
/* if necessary. */
/* Callers of GFIDST should declare their workspace window */
/* count using NWDIST. */
/* Callers of GFSEP should declare their workspace window */
/* count using NWSEP. */
/* Callers of GFRR should declare their workspace window */
/* count using NWRR. */
/* Callers of GFUDS should declare their workspace window */
/* count using NWUDS. */
/* ADDWIN is a parameter used to expand each interval of the search */
/* (confinement) window by a small amount at both ends in order to */
/* accommodate searches using equality constraints. The loaded */
/* kernel files must accommodate these expanded time intervals. */
/* FRMNLN is a string length for frame names. */
/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */
/* FOVTLN -- maximum length for FOV string. */
/* Specify the character strings that are allowed in the */
/* specification of field of view shapes. */
/* Character strings that are allowed in the */
/* specification of occultation types: */
/* Occultation target shape specifications: */
/* Specify the number of supported occultation types and occultation */
/* type string length: */
/* Instrument field-of-view (FOV) parameters */
/* Maximum number of FOV boundary vectors: */
/* FOV shape parameters: */
/* circle */
/* ellipse */
/* polygon */
/* rectangle */
/* End of file gf.inc. */
/* $ 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 Description */
/* -------- --- -------------------------------------------------- */
/* LBCELL P SPICE Cell lower bound. */
/* CNVTOL P Convergence tolerance. */
/* UDFUNC I Name of the routine that computes the scalar value */
/* of interest at some time. */
/* UDQDEC I Name of the routine that computes whether the */
/* current state is decreasing. */
/* RELATE I Operator that either looks for an extreme value */
/* (max, min, local, absolute) or compares the */
/* geometric quantity value and a number. */
/* REFVAL I Value used as reference for geometric quantity */
/* condition. */
/* ADJUST I Allowed variation for absolute extremal */
/* geometric conditions. */
/* STEP I Step size used for locating extrema and roots. */
/* CNFINE I SPICE window to which the search is confined. */
/* MW I Size of workspace windows. */
/* NW I Number of workspace windows. */
/* WORK I Array containing workspace windows. */
/* RESULT I-O SPICE window containing results. */
/* $ Detailed_Input */
/* UDFUNC the routine that returns the value of the scalar */
/* quantity of interest at time ET. The calling sequence */
/* for UDFUNC is: */
/* CALL UDFUNC ( 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. */
/* UDQDEC the name of the routine that determines if the scalar */
/* quantity calculated by UDFUNC is decreasing. */
/* The calling sequence: */
/* CALL UDQDEC ( UDFUNC, ET, ISDECR ) */
/* where: */
/* ET a double precision value representing */
/* ephemeris time, expressed as seconds past */
/* J2000 TDB, at which to determine the time */
/* derivative of UDFUNC. */
/* ISDECR a logical return indicating whether */
/* or not the scalar value returned by UDFUNC */
/* is decreasing. ISDECR returns true if the */
/* time derivative of UDFUNC at ET is */
/* negative. */
/* RELATE the scalar string comparison operator indicating */
/* the numeric constraint of interest. Values are: */
/* '>' value of scalar quantity greater than some */
/* reference (REFVAL). */
/* '=' value of scalar quantity equal to some */
/* reference (REFVAL). */
/* '<' value of scalar quantity less than some */
/* reference (REFVAL). */
/* 'ABSMAX' The scalar quantity is at an absolute */
/* maximum. */
/* 'ABSMIN' The scalar quantity is at an absolute */
/* minimum. */
/* 'LOCMAX' The scalar quantity is at a local */
/* maximum. */
/* 'LOCMIN' The scalar quantity is at a local */
/* minimum. */
/* The caller may indicate that the region of interest */
/* is the set of time intervals where the quantity is */
/* within a specified distance of an absolute extremum. */
/* The argument ADJUST (described below) is used to */
/* specified this distance. */
/* Local extrema are considered to exist only in the */
/* interiors of the intervals comprising the confinement */
/* window: a local extremum cannot exist at a boundary */
/* point of the confinement window. */
/* RELATE is insensitive to case, leading and */
/* trailing blanks. */
/* REFVAL is the reference value used to define an equality or */
/* inequality to satisfied by the scalar quantity. */
/* The units of REFVAL are those of the scalar quantity. */
/* ADJUST the amount by which the quantity is allowed to vary */
/* from an absolute extremum. */
/* If the search is for an absolute minimum is performed, */
/* the resulting window contains time intervals when the */
/* geometric quantity value has values between */
/* ABSMIN and ABSMIN + ADJUST. */
/* If the search is for an absolute maximum, the */
/* corresponding range is between ABSMAX - ADJUST and */
/* ABSMAX. */
/* ADJUST is not used for searches for local extrema, */
/* equality or inequality conditions and must have value */
/* zero for such searches. */
/* STEP the double precision time step size to use in */
/* the search. */
/* STEP must be short enough to for a search using this */
/* step size to locate the time intervals where the */
/* scalar quantity 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; the */
/* precision is controlled by the convergence tolerance. */
/* See the discussion of the parameter CNVTOL for */
/* details. */
/* STEP has units of TDB seconds. */
/* CNFINE is a SPICE window that confines the time period over */
/* which the specified search is conducted. CNFINE may */
/* consist of a single interval or a collection of */
/* intervals. */
/* In some cases the confinement window can be used to */
/* greatly reduce the time period that must be searched */
/* for the desired solution. See the Particulars section */
/* below for further discussion. */
/* See the Examples section below for a code example */
/* that shows how to create a confinement window. */
/* CNFINE must be initialized by the caller via the */
/* SPICELIB routine SSIZED. */
/* MW is a parameter specifying the length of the SPICE */
/* windows in the workspace array WORK (see description */
/* below) used by this routine. */
/* MW should be set to a number at least twice as large */
/* as the maximum number of intervals required by any */
/* workspace window. In many cases, it's not necessary to */
/* compute an accurate estimate of how many intervals are */
/* needed; rather, the user can pick a size considerably */
/* larger than what's really required. */
/* However, since excessively large arrays can prevent */
/* applications from compiling, linking, or running */
/* properly, sometimes MW must be set according to */
/* the actual workspace requirement. A rule of thumb */
/* for the number of intervals NINTVLS needed is */
/* NINTVLS = 2*N + ( M / STEP ) */
/* where */
/* N is the number of intervals in the confinement */
/* window */
/* M is the measure of the confinement window, in */
/* units of seconds */
/* STEP is the search step size in seconds */
/* MW should then be set to */
/* 2 * NINTVLS */
/* NW is a parameter specifying the number of SPICE windows */
/* in the workspace array WORK (see description below) */
/* used by this routine. (The reason this dimension is */
/* an input argument is that this allows run-time */
/* error checking to be performed.) */
/* NW must be at least as large as the parameter NWUDS. */
/* WORK is an array used to store workspace windows. This */
/* array should be declared by the caller as shown: */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NW ) */
/* WORK need not be initialized by the caller. */
/* RESULT a double precision SPICE window which will contain the */
/* search results. RESULT must be declared and initialized */
/* with sufficient size to capture the full set of time */
/* intervals within the search region on which the */
/* specified constraint is satisfied. */
/* RESULT must be initialized by the caller via the */
/* SPICELIB routine SSIZED. */
/* If RESULT is non-empty on input, its contents */
/* will be discarded before GFUDS conducts its search. */
/* $ Detailed_Output */
/* WORK the input workspace array, modified by this */
/* routine. */
/* RESULT is a SPICE window containing the time intervals within */
/* the confinement window, during which the specified */
/* condition on the scalar quantity is met. */
/* If the search is for local extrema, or for absolute */
/* extrema with ADJUST set to zero, then normally each */
/* interval of RESULT will be a singleton: the left and */
/* right endpoints of each interval will be identical. */
/* If no times within the confinement window satisfy the */
/* search, RESULT will be returned with a cardinality */
/* of zero. */
/* $ Parameters */
/* LBCELL the integer value defining the lower bound for */
/* SPICE Cell arrays (a SPICE window is a kind of cell). */
/* CNVTOL is the convergence tolerance used for finding */
/* endpoints of the intervals comprising the result */
/* window. CNVTOL is also used for finding intermediate */
/* results; in particular, CNVTOL is used for finding the */
/* windows on which the range rate is increasing */
/* or decreasing. CNVTOL is used to determine when binary */
/* searches for roots should terminate: when a root is */
/* bracketed within an interval of length CNVTOL; the */
/* root is considered to have been found. */
/* The accuracy, as opposed to precision, of roots found */
/* by this routine depends on the accuracy of the input */
/* data. In most cases, the accuracy of solutions will be */
/* inferior to their precision. */
/* See INCLUDE file gf.inc for declarations and descriptions of */
/* parameters used throughout the GF system. */
/* $ Exceptions */
/* 1) In order for this routine to produce correct results, */
/* the step size must be appropriate for the problem at hand. */
/* Step sizes that are too large may cause this routine to miss */
/* roots; step sizes that are too small may cause this routine */
/* to run unacceptably slowly and in some cases, find spurious */
/* roots. */
/* This routine does not diagnose invalid step sizes, except */
/* that if the step size is non-positive, the error */
/* SPICE(INVALIDSTEP) is signaled. */
/* 2) Due to numerical errors, in particular, */
/* - truncation error in time values */
/* - finite tolerance value */
/* - errors in computed geometric quantities */
/* it is *normal* for the condition of interest to not always be */
/* satisfied near the endpoints of the intervals comprising the */
/* RESULT window. One technique to handle such a situation, */
/* slightly contract RESULT using the window routine WNCOND. */
/* 3) If the workspace window size MW is less than 2 or not an even */
/* value, the error SPICE(INVALIDDIMENSION) will signal. If the */
/* size of the workspace is too small, an error is signaled by a */
/* routine in the call tree of this routine. */
/* 4) If the size of the SPICE window RESULT is less than 2 or */
/* not an even value, the error SPICE(INVALIDDIMENSION) will */
/* signal. If RESULT has insufficient capacity to contain the */
/* number of intervals on which the specified distance condition */
/* is met, the error will be diagnosed by a routine in the call */
/* tree of this routine. */
/* 5) If the window count NW is less than NWUDS, the error */
/* SPICE(INVALIDDIMENSION) will be signaled. */
/* 6) If an error (typically cell overflow) occurs during */
/* window arithmetic, the error will be diagnosed by a routine */
/* in the call tree of this routine. */
/* 7) If the relational operator RELATE is not recognized, an */
/* error is signaled by a routine in the call tree of this */
/* routine. */
/* 8) If ADJUST is negative, the error SPICE(VALUEOUTOFRANGE) will */
/* signal from a routine in the call tree of this routine. */
/* A non-zero value for ADJUST when RELATE has any value other */
/* than "ABSMIN" or "ABSMAX" causes the error SPICE(INVALIDVALUE) */
/* to signal from a routine in the call tree of this routine. */
/* 9) If required ephemerides or other kernel data are not */
/* available, an error is signaled by a routine in the call tree */
/* of this routine. */
/* $ Files */
/* Appropriate kernels must be loaded by the calling program before */
/* this routine is called. */
/* If the scalar function requires access to ephemeris data: */
/* - SPK data: ephemeris data for any body over the */
/* time period defined by the confinement window must be */
/* loaded. If aberration corrections are used, the states of */
/* target and observer relative to the solar system barycenter */
/* must be calculable from the available ephemeris data. */
/* Typically ephemeris data are made available by loading one */
/* or more SPK files via FURNSH. */
/* - If non-inertial reference frames are used, then PCK */
/* files, frame kernels, C-kernels, and SCLK kernels may be */
/* needed. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine determines a set of one or more time intervals */
/* within the confinement window when the scalar function */
/* satisfies a caller-specified constraint. The resulting set of */
/* intervals is returned as a SPICE window. */
/* UDQDEC Default Template */
/* ======================= */
/* The user must supply a routine to determine whether sign of the */
/* time derivative of UDFUNC is positive or negative at ET. For */
/* cases where UDFUNC is numerically well behaved, the user */
/* may find it convenient to use a routine based on the below */
/* template. UDDC determines the truth of the expression */
/* d (UDFUNC) */
/* -- < 0 */
/* dt */
/* using the library routine UDDF to numerically calculate the */
/* derivative of UDFUNC using a three-point estimation. */
/* Please see the Examples section for an example of GFDECR use. */
/* SUBROUTINE GFDECR ( UDFUNC, ET, ISDECR ) */
/* IMPLICIT NONE */
/* EXTERNAL UDFUNC */
/* EXTERNAL UDDF */
/* DOUBLE PRECISION ET */
/* LOGICAL ISDECR */
/* DOUBLE PRECISION DT */
/* DT = h, double precision interval size */
/* CALL UDDC ( UDFUNC, ET, DT, ISDECR ) */
/* END */
/* The Search Process */
/* ================== */
/* Regardless of the type of constraint selected by the caller, this */
/* routine starts the search for solutions by determining the time */
/* periods, within the confinement window, over which the specified */
/* scalar function is monotone increasing and monotone */
/* decreasing. Each of these time periods is represented by a SPICE */
/* window. Having found these windows, all of the quantity */
/* function's local extrema within the confinement window are known. */
/* Absolute extrema then can be found very easily. */
/* Within any interval of these "monotone" windows, there will be at */
/* most one solution of any equality constraint. Since the boundary */
/* of the solution set for any inequality constraint is the set */
/* of points where an equality constraint is met, the solutions of */
/* both equality and inequality constraints can be found easily */
/* once the monotone windows have been found. */
/* Step Size */
/* ========= */
/* The monotone windows (described above) are found using a two-step */
/* search process. Each interval of the confinement window is */
/* searched as follows: first, the input step size is used to */
/* determine the time separation at which the sign of the rate of */
/* change of quantity function will be sampled. Starting at */
/* the left endpoint of an interval, samples will be taken at each */
/* step. If a change of sign is found, a root has been bracketed; at */
/* that point, the time at which the time derivative of the quantity */
/* function is zero can be found by a refinement process, for */
/* example, using a binary search. */
/* Note that the optimal choice of step size depends on the lengths */
/* of the intervals over which the quantity function is monotone: */
/* the step size should be shorter than the shortest of these */
/* intervals (within the confinement window). */
/* The optimal step size is *not* necessarily related to the lengths */
/* of the intervals comprising the result window. For example, if */
/* the shortest monotone interval has length 10 days, and if the */
/* shortest result window interval has length 5 minutes, a step size */
/* of 9.9 days is still adequate to find all of the intervals in the */
/* result window. In situations like this, the technique of using */
/* monotone windows yields a dramatic efficiency improvement over a */
/* state-based search that simply tests at each step whether the */
/* specified constraint is satisfied. The latter type of search can */
/* miss solution intervals if the step size is shorter than the */
/* shortest solution interval. */
/* Having some knowledge of the relative geometry of the targets and */
/* observer can be a valuable aid in picking a reasonable step size. */
/* In general, the user can compensate for lack of such knowledge by */
/* picking a very short step size; the cost is increased computation */
/* time. */
/* Note that the step size is not related to the precision with which */
/* the endpoints of the intervals of the result window are computed. */
/* That precision level is controlled by the convergence tolerance. */
/* Convergence Tolerance */
/* ===================== */
/* Once a root has been bracketed, a refinement process is used to */
/* narrow down the time interval within which the root must lie. */
/* This refinement process terminates when the location of the root */
/* has been determined to within an error margin called the */
/* "convergence tolerance." */
/* The GF subsystem defines a parameter, CNVTOL (from gf.inc), as a */
/* default tolerance. This represents a "tight" tolerance value */
/* so that the tolerance doesn't become the limiting factor in the */
/* accuracy of solutions found by this routine. In general the */
/* accuracy of input data will be the limiting factor. */
/* Making the tolerance tighter than CNVTOL is unlikely to */
/* be useful, since the results are unlikely to be more accurate. */
/* Making the tolerance looser will speed up searches somewhat, */
/* since a few convergence steps will be omitted. However, in most */
/* cases, the step size is likely to have a much greater affect */
/* on processing time than would the convergence tolerance. */
/* The Confinement Window */
/* ====================== */
/* The simplest use of the confinement window is to specify a time */
/* interval within which a solution is sought. However, the */
/* confinement window can, in some cases, be used to make searches */
/* more efficient. Sometimes it's possible to do an efficient search */
/* to reduce the size of the time period over which a relatively */
/* slow search of interest must be performed. */
/* $ Examples */
/* The numerical results shown for these examples may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* Conduct a search on the range-rate of the vector from the Sun */
/* to the Moon. Define a function to calculate the value. */
/* Use the meta-kernel shown below to load the required SPICE */
/* kernels. */
/* KPL/MK */
/* File name: standard.tm */
/* This meta-kernel is intended to support operation of SPICE */
/* example programs. The kernels shown here should not be */
/* assumed to contain adequate or correct versions of data */
/* required by SPICE-based user applications. */
/* In order for an application to use this meta-kernel, the */
/* kernels referenced here must be present in the user's */
/* current working directory. */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'de414.bsp', */
/* 'pck00008.tpc', */
/* 'naif0009.tls' ) */
/* \begintext */
/* Code: */
/* PROGRAM GFUDS_T */
/* IMPLICIT NONE */
/* C */
/* C Include GF parameter declarations: */
/* C */
/* INCLUDE 'gf.inc' */
/* EXTERNAL GFQ */
/* EXTERNAL GFDECR */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION SPD */
/* DOUBLE PRECISION DVNORM */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* C */
/* C Use the parameter MAXWIN for both the result window size */
/* C and the workspace size. */
/* C */
/* INTEGER MAXWIN */
/* PARAMETER ( MAXWIN = 20000 ) */
/* C */
/* C Length of strings: */
/* C */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 26 ) */
/* INTEGER NLOOPS */
/* PARAMETER ( NLOOPS = 7 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(TIMLEN) RELATE (NLOOPS) */
/* DOUBLE PRECISION ADJUST */
/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */
/* DOUBLE PRECISION DRDT */
/* DOUBLE PRECISION ET0 */
/* DOUBLE PRECISION ET1 */
/* DOUBLE PRECISION FINISH */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION POS ( 6 ) */
/* DOUBLE PRECISION REFVAL */
/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */
/* DOUBLE PRECISION START */
/* DOUBLE PRECISION STEP */
/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWUDS ) */
/* INTEGER I */
/* INTEGER J */
/* DATA RELATE / '=', */
/* . '<', */
/* . '>', */
/* . 'LOCMIN', */
/* . 'ABSMIN', */
/* . 'LOCMAX', */
/* . 'ABSMAX' / */
/* C */
/* C Load kernels. */
/* C */
/* CALL FURNSH ( 'standard.tm' ) */
/* C */
/* C Initialize windows. */
/* C */
/* CALL SSIZED ( MAXWIN, RESULT ) */
/* CALL SSIZED ( 2, CNFINE ) */
/* CALL SCARDD ( 0, CNFINE ) */
/* C */
/* C Store the time bounds of our search interval in */
/* C the confinement window. */
/* C */
/* CALL STR2ET ( '2007 JAN 1', ET0 ) */
/* CALL STR2ET ( '2007 APR 1', ET1 ) */
/* CALL WNINSD ( ET0, ET1, CNFINE ) */
/* C */
/* C Search using a step size of 1 day (in units of seconds). */
/* C The reference value is .3365 km/s - a range rate value known */
/* C to exist during the confinement window. We're not using the */
/* C adjustment feature, so we set ADJUST to zero. */
/* C */
/* STEP = SPD() */
/* REFVAL = .3365D0 */
/* ADJUST = 0.D0 */
/* DO J=1, NLOOPS */
/* WRITE(*,*) 'Relation condition: ', RELATE(J) */
/* C */
/* C Perform the search. The SPICE window RESULT contains */
/* C the set of times when the condition is met. */
/* C */
/* CALL GFUDS ( GFQ, GFDECR, */
/* . RELATE(J), REFVAL, ADJUST, STEP, CNFINE, */
/* . MAXWIN, NWUDS, WORK, RESULT ) */
/* C */
/* C Display the results. */
/* C */
/* IF ( WNCARD(RESULT) .EQ. 0 ) THEN */
/* WRITE (*, '(A)') 'Result window is empty.' */
/* ELSE */
/* DO I = 1, WNCARD(RESULT) */
/* C */
/* C Fetch the endpoints of the Ith interval */
/* C of the result window. */
/* C */
/* CALL WNFETD ( RESULT, I, START, FINISH ) */
/* CALL SPKEZR ( 'MOON', START, 'J2000', 'NONE', */
/* . 'SUN', POS, LT ) */
/* DRDT = DVNORM(POS) */
/* CALL TIMOUT ( START, 'YYYY-MON-DD HR:MN:SC.###', */
/* . TIMSTR ) */
/* WRITE (*, '(A,F16.9)' ) 'Start time, drdt = '// */
/* . TIMSTR, DRDT */
/* CALL SPKEZR ( 'MOON', FINISH, 'J2000', 'NONE', */
/* . 'SUN', POS, LT ) */
/* DRDT = DVNORM(POS) */
/* CALL TIMOUT ( FINISH, 'YYYY-MON-DD HR:MN:SC.###', */
/* . TIMSTR ) */
/* WRITE (*, '(A,F16.9)' ) 'Stop time, drdt = '// */
/* . TIMSTR, DRDT */
/* END DO */
/* END IF */
/* WRITE(*,*) ' ' */
/* END DO */
/* END */
/* C-Procedure GFQ */
/* SUBROUTINE GFQ ( ET, VALUE ) */
/* IMPLICIT NONE */
/* C- Abstract */
/* C */
/* C User defined geometric quantity function. In this case, */
/* C the range from the sun to the Moon at TDB time ET. */
/* C */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION VALUE */
/* C */
/* C Local variables. */
/* C */
/* INTEGER TARG */
/* INTEGER OBS */
/* CHARACTER*(12) REF */
/* CHARACTER*(12) ABCORR */
/* DOUBLE PRECISION STATE ( 6 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION DVNORM */
/* C */
/* C Initialization. Retrieve the vector from the Sun to */
/* C the Moon in the J2000 frame, without aberration */
/* C correction. */
/* C */
/* TARG = 301 */
/* REF = 'J2000' */
/* ABCORR = 'NONE' */
/* OBS = 10 */
/* CALL SPKEZ ( TARG, ET, REF, ABCORR, OBS, STATE, LT ) */
/* C */
/* C Calculate the scalar range rate corresponding the */
/* C STATE vector. */
/* C */
/* VALUE = DVNORM( STATE ) */
/* END */
/* C-Procedure GFDECR */
/* SUBROUTINE GFDECR ( UDFUNC, ET, ISDECR ) */
/* IMPLICIT NONE */
/* C- Abstract */
/* C */
/* C User defined function to detect if the function derivative */
/* C is negative (the function is decreasing) at TDB time ET. */
/* C */
/* EXTERNAL UDFUNC */
/* EXTERNAL UDDF */
/* DOUBLE PRECISION ET */
/* LOGICAL ISDECR */
/* DOUBLE PRECISION DT */
/* DT = 1.D0 */
/* C */
/* C Determine if GFQ is decreasing at ET. */
/* C */
/* C UDDC - the default GF function to determine if */
/* C the derivative of the user defined */
/* C function is negative at ET. */
/* C */
/* C UDFUNC - the user defined scalar quantity function. */
/* C */
/* CALL UDDC ( UDFUNC, ET, DT, ISDECR ) */
/* END */
/* The program outputs: */
/* Relation condition: = */
/* Start time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */
/* Stop time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */
/* Start time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */
/* Stop time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */
/* Start time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */
/* Stop time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */
/* Start time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */
/* Stop time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */
/* Start time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */
/* Stop time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */
/* Start time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */
/* Stop time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */
/* Relation condition: < */
/* Start time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */
/* Stop time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */
/* Start time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */
/* Stop time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */
/* Start time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */
/* Stop time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */
/* Relation condition: > */
/* Start time, drdt = 2007-JAN-01 00:00:00.000 0.515522367 */
/* Stop time, drdt = 2007-JAN-02 00:35:19.574 0.336500000 */
/* Start time, drdt = 2007-JAN-19 22:04:54.899 0.336500000 */
/* Stop time, drdt = 2007-FEB-01 23:30:13.428 0.336500000 */
/* Start time, drdt = 2007-FEB-17 11:10:46.540 0.336500000 */
/* Stop time, drdt = 2007-MAR-04 15:50:19.929 0.336500000 */
/* Start time, drdt = 2007-MAR-18 09:59:05.959 0.336500000 */
/* Stop time, drdt = 2007-APR-01 00:00:00.000 0.793546222 */
/* Relation condition: LOCMIN */
/* Start time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */
/* Stop time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */
/* Start time, drdt = 2007-FEB-10 06:26:15.439 -0.575837623 */
/* Stop time, drdt = 2007-FEB-10 06:26:15.439 -0.575837623 */
/* Start time, drdt = 2007-MAR-12 03:28:36.404 -0.441800446 */
/* Stop time, drdt = 2007-MAR-12 03:28:36.404 -0.441800446 */
/* Relation condition: ABSMIN */
/* Start time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */
/* Stop time, drdt = 2007-JAN-11 07:03:58.988 -0.803382743 */
/* Relation condition: LOCMAX */
/* Start time, drdt = 2007-JAN-26 02:27:33.766 1.154648992 */
/* Stop time, drdt = 2007-JAN-26 02:27:33.766 1.154648992 */
/* Start time, drdt = 2007-FEB-24 09:35:07.816 1.347132236 */
/* Stop time, drdt = 2007-FEB-24 09:35:07.816 1.347132236 */
/* Start time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */
/* Stop time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */
/* Relation condition: ABSMAX */
/* Start time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */
/* Stop time, drdt = 2007-MAR-25 17:26:56.150 1.428141707 */
/* $ Restrictions */
/* 1) Any kernel files required by this routine must be loaded */
/* (normally via the SPICELIB routine FURNSH) before this routine */
/* is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 16-FEB-2010 (EDW) */
/* -& */
/* $ Index_Entries */
/* GF user defined scalar function search */
/* -& */
/* SPICELIB functions. */
/* Local variables. */
/* Dummy variables. */
/* Parameter adjustments */
work_dim1 = *mw + 6;
work_offset = work_dim1 - 5;
/* Function Body */
chkin_("GFUDS", (ftnlen)5);
/* Check the step size. */
if (*step <= 0.) {
setmsg_("Step size was #; step size must be positive.", (ftnlen)44);
errdp_("#", step, (ftnlen)1);
sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18);
chkout_("GFUDS", (ftnlen)5);
return 0;
}
/* Confirm minimum number of windows. */
if (*nw < 5) {
setmsg_("Workspace window count was #; count must be at least #.", (
ftnlen)55);
errint_("#", nw, (ftnlen)1);
errint_("#", &c__5, (ftnlen)1);
sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23);
chkout_("GFUDS", (ftnlen)5);
return 0;
}
/* Confirm minimum window sizes. */
if (*mw < 2 || odd_(mw)) {
setmsg_("Workspace window size was #; size must be at least 2 and an"
" even value.", (ftnlen)71);
errint_("#", mw, (ftnlen)1);
sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23);
chkout_("GFUDS", (ftnlen)5);
return 0;
}
/* Check the result window size. */
i__1 = sized_(result);
if (sized_(result) < 2 || odd_(&i__1)) {
setmsg_("Result window size was #; size must be at least 2 and an ev"
"en value.", (ftnlen)68);
i__1 = sized_(result);
errint_("#", &i__1, (ftnlen)1);
sigerr_("SPICE(INVALIDDIMENSION)", (ftnlen)23);
chkout_("GFUDS", (ftnlen)5);
return 0;
}
/* Set the step size. */
gfsstp_(step);
/* Set the reference value. */
zzgfref_(refval);
/* Use the default GF convergence tolerance. */
tol = 1e-6;
/* Initialize the RESULT window to empty. */
scardd_(&c__0, result);
/* Call ZZGFRELX to do the event detection work. */
zzgfrelx_((U_fp)gfstep_, (U_fp)gfrefn_, (U_fp)udqdec, (U_fp)zzgfudlt_, (
U_fp)udfunc, (S_fp)zzgfref_, relate, refval, &tol, adjust, cnfine,
mw, nw, work, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)
gfrepf_, rptpre, rptsuf, &c_false, (L_fp)gfbail_, result,
relate_len, (ftnlen)1, (ftnlen)1);
chkout_("GFUDS", (ftnlen)5);
return 0;
} /* gfuds_ */
/* $Procedure PCKW02 ( Write PCK segment, type 2 ) */
/* Subroutine */ int pckw02_(integer *handle, integer *body, char *frame,
doublereal *first, doublereal *last, char *segid, doublereal *intlen,
integer *n, integer *polydg, doublereal *cdata, doublereal *btime,
ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__, k;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), dafps_(integer *, integer *, doublereal *,
integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal ltime;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal rsize;
char etstr[40];
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
integer *, doublereal *, char *, ftnlen), dafena_(void);
extern logical failed_(void);
extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen,
ftnlen);
integer refcod, ninrec;
doublereal radius, numrec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
extern logical return_(void);
char netstr[40];
doublereal dcd[2];
integer icd[5];
doublereal mid;
/* $ Abstract */
/* Write a type 2 segment to a PCK binary file given */
/* the file handle, body, frame, time range covered by the */
/* segment, and the Chebyshev polynomial coefficeients. */
/* $ 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 */
/* NAIF_IDS */
/* SPC */
/* PCK */
/* $ Keywords */
/* PCK */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of binary PCK file open for writing. */
/* BODY I NAIF code for ephemeris object. */
/* FRAME I Reference frame name. */
/* FIRST I Start time of interval covered by segment. */
/* LAST I End time of interval covered by segment. */
/* SEGID I Segment identifier. */
/* INTLEN I Length of time covered by logical record. */
/* N I Number of logical records in segment. */
/* POLYDG I Chebyshev polynomial degree. */
/* CDATA I Array of Chebyshev coefficients. */
/* BTIME I Begin time of first logical record. */
/* $ Detailed_Input */
/* HANDLE is the DAF handle of an PCK file to which a type 2 */
/* segment is to be added. The PCK file must be open */
/* for writing. */
/* BODY is the NAIF integer code for an ephemeris object */
/* whose orientation is described by the segment to */
/* be created. */
/* FRAME is the NAIF name for a reference frame relative to */
/* which the orientation information for BODY is */
/* specified. */
/* FIRST, */
/* LAST are, respectively, the start and stop times of */
/* the time interval over which the segment defines */
/* the orientation of body. */
/* SEGID is the segment identifier. A PCK segment */
/* identifier may contain up to 40 characters. */
/* INTLEN Length of time, in seconds, covered by each set of */
/* Chebyshev polynomial coefficients (each logical */
/* record). Each set of Chebyshev coefficents must */
/* cover this fixed time interval, INTLEN. */
/* N is the number of sets of Chebyshev polynomial */
/* coefficents (number of logical records) */
/* to be stored in the segment. There is one set */
/* of Chebyshev coefficients for each time period. */
/* POLYDG Degree of each set of Chebyshev polynomials. */
/* CDATA Array containing all the sets of Chebyshev */
/* polynomial coefficients to be contained in the */
/* segment of the PCK file. The coefficients are */
/* stored in CDATA in order as follows: */
/* the (degree + 1) coefficients for the first */
/* Euler angle of the first logical record */
/* the coefficients for the second Euler angle */
/* the coefficients for the third Euler angle */
/* the coefficients for the first Euler angle for */
/* the second logical record, ... */
/* and so on. */
/* BTIME Begin time (seconds past J2000 TDB) of first set */
/* of Chebyshev polynomial coefficients (first */
/* logical record). */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the number of sets of coefficients is not positive */
/* 'SPICE(NUMCOEFFSNOTPOS)' is signalled. */
/* 2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */
/* is signalled. */
/* 3) If the integer code for the reference frame is not recognized, */
/* 'SPICE(INVALIDREFFRAME)' is signalled. */
/* 4) If segment stop time is not greater then the begin time, */
/* 'SPICE(BADDESCRTIMES)' is signalled. */
/* 5) If the time of the first record is not greater than */
/* or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */
/* is signalled. */
/* 6) If the end time of the last record is not greater than */
/* or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */
/* signalled. */
/* $ Files */
/* A new type 2 PCK segment is written to the PCK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an PCK type 2 data segment to the designated */
/* PCK file, according to the format described in the PCK Required */
/* Reading. */
/* Each segment can contain data for only one body and reference */
/* frame. The Chebyshev polynomial degree and length of time covered */
/* by each logical record are also fixed. However, an arbitrary */
/* number of logical records of Chebyshev polynomial coefficients can */
/* be written in each segment. Minimizing the number of segments in */
/* a PCK file will help optimize how the SPICE system accesses the */
/* file. */
/* $ Examples */
/* Suppose that you have sets of Chebyshev polynomial coefficients */
/* in an array CDATA pertaining to the position of the moon (NAIF ID */
/* = 301) in the J2000 reference frame, and want to put these into a */
/* type 2 segment in an existing PCK file. The following code could */
/* be used to add one new type 2 segment. To add multiple segments, */
/* put the call to PCKW02 in a loop. */
/* C */
/* C First open the PCK file and get a handle for it. */
/* C */
/* CALL DAFOPW ( PCKNAM, HANDLE ) */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_PCK_TYPE_2_SEGMENT' */
/* C */
/* C Write the segment. */
/* CALL PCKW02 ( HANDLE, 301, 'J2000', */
/* . FIRST, LAST, SEGID, INTLEN, */
/* . N, POLYDG, CDATA, BTIME) */
/* C */
/* C Close the file. */
/* C */
/* CALL DAFCLS ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */
/* The calling sequence was corrected so that REF is */
/* a character string and BTIME contains only the start */
/* time of the first record. Comments updated, and new */
/* routine CHCKID is called to check segment identifier. */
/* - SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */
/* -& */
/* $ Index_Entries */
/* write pck type_2 data segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */
/* The calling sequence was corrected so that REF is */
/* a character string and BTIME contains only the start */
/* time of the first record. Comments updated, and new */
/* routine CHCKID is called to check segment identifier. */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* DTYPE is the PCK data type. */
/* NS is the size of a packed PCK segment descriptor. */
/* ND is the number of double precision components in an PCK */
/* segment descriptor. PCK uses ND = 2. */
/* NI is the number of integer components in an PCK segment */
/* descriptor. PCK uses NI = 5. */
/* SIDLEN is the maximum number of characters allowed in an */
/* PCK segment identifier. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PCKW02", (ftnlen)6);
}
/* The number of sets of coefficients must be positive. */
if (*n <= 0) {
setmsg_("The number of sets of Euler anglecoefficients is not positi"
"ve. N = #", (ftnlen)68);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The interval length must be positive. */
if (*intlen <= 0.) {
setmsg_("The interval length is not positive.N = #", (ftnlen)41);
errdp_("#", intlen, (ftnlen)1);
sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
irfnum_(frame, &refcod, frame_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", frame, (ftnlen)1, frame_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The segment stop time must be greater than the begin time. */
if (*first > *last) {
setmsg_("The segment start time: # is greater than the segment end t"
"ime: #", (ftnlen)65);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(last, netstr, (ftnlen)40);
errch_("#", netstr, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The begin time of the first record must be less than or equal */
/* to the begin time of the segment. */
if (*first < *btime) {
setmsg_("The segment descriptor start time: # is less than the begin"
"ning time of the segment data: #", (ftnlen)91);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(btime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The end time of the final record must be greater than or */
/* equal to the end time of the segment. */
ltime = *btime + *n * *intlen;
if (*last > ltime) {
setmsg_("The segment descriptor end time: # is greater than the end "
"time of the segment data: #", (ftnlen)86);
etcal_(last, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(<ime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* Now check the validity of the segment identifier. */
chckid_("PCK segment identifier", &c__40, segid, (ftnlen)22, segid_len);
if (failed_()) {
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* Store the start and end times to be associated */
/* with this segment. */
dcd[0] = *first;
dcd[1] = *last;
/* Create the integer portion of the descriptor. */
icd[0] = *body;
icd[1] = refcod;
icd[2] = 2;
/* Pack the segment descriptor. */
dafps_(&c__2, &c__5, dcd, icd, descr);
/* Begin a new segment of PCK type 2 form: */
/* Record 1 */
/* Record 2 */
/* ... */
/* Record N */
/* INIT ( initial epoch of first record ) */
/* INTLEN ( length of interval covered by each record ) */
/* RSIZE ( number of data elements in each record ) */
/* N ( number of records in segment ) */
/* Each record will have the form: */
/* MID ( midpoint of time interval ) */
/* RADIUS ( radius of time interval ) */
/* X coefficients, Y coefficients, Z coefficients */
dafbna_(handle, descr, segid, segid_len);
/* Calculate the number of entries in a record. */
ninrec = (*polydg + 1) * 3;
/* Fill segment with N records of data. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Calculate the midpoint and radius of the time of each */
/* record, and put that at the beginning of each record. */
radius = *intlen / 2;
mid = *btime + radius + (i__ - 1) * *intlen;
dafada_(&mid, &c__1);
dafada_(&radius, &c__1);
/* Put one set of coefficients into the segment. */
k = (i__ - 1) * ninrec + 1;
dafada_(&cdata[k - 1], &ninrec);
}
/* Store the initial epoch of the first record. */
dafada_(btime, &c__1);
/* Store the length of interval covered by each record. */
dafada_(intlen, &c__1);
/* Store the size of each record (total number of array elements). */
rsize = (doublereal) (ninrec + 2);
dafada_(&rsize, &c__1);
/* Store the number of records contained in the segment. */
numrec = (doublereal) (*n);
dafada_(&numrec, &c__1);
/* End this segment. */
dafena_();
chkout_("PCKW02", (ftnlen)6);
return 0;
} /* pckw02_ */
/* $Procedure CONICS ( Determine state from conic elements ) */
/* Subroutine */ int conics_(doublereal *elts, doublereal *et, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal), sqrt(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal cnci, argp, snci, cosi, sini, cosn, sinn;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
doublereal cosw, sinw, n, v;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal lnode;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal m0;
extern doublereal twopi_(void);
doublereal t0;
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal dt, rp, mu, basisp[3], period, basisq[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal pstate[6], ainvrs;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
extern logical return_(void);
doublereal ecc, inc;
/* $ Abstract */
/* Determine the state (position, velocity) of an orbiting body */
/* from a set of elliptic, hyperbolic, or parabolic orbital */
/* elements. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CONIC */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ELTS I Conic elements. */
/* ET I Input time. */
/* STATE O State of orbiting body at ET. */
/* $ Detailed_Input */
/* ELTS are conic elements describing the orbit of a body */
/* around a primary. The elements are, in order: */
/* RP Perifocal distance. */
/* ECC Eccentricity. */
/* INC Inclination. */
/* LNODE Longitude of the ascending node. */
/* ARGP Argument of periapse. */
/* M0 Mean anomaly at epoch. */
/* T0 Epoch. */
/* MU Gravitational parameter. */
/* Units are km, rad, rad/sec, km**3/sec**2. The epoch */
/* is given in ephemeris seconds past J2000. The same */
/* elements are used to describe all three types */
/* (elliptic, hyperbolic, and parabolic) of conic orbit. */
/* ET is the time at which the state of the orbiting body */
/* is to be determined, in ephemeris seconds J2000. */
/* $ Detailed_Output */
/* STATE is the state (position and velocity) of the body at */
/* time ET. Components are x, y, z, dx/dt, dy/dt, dz/dt. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity supplied is less than 0, the error */
/* 'SPICE(BADECCENTRICITY)' is signalled. */
/* 2) If a non-positive periapse distance is supplied, the error */
/* 'SPICE(BADPERIAPSEVALUE)' is signalled. */
/* 3) If a non-positive value for the attracting mass is supplied, */
/* the error 'SPICE(BADGM)', is signalled. */
/* 4) Errors such as an out of bounds value for ET are diagnosed */
/* by routines called by this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* Let VINIT contain the initial state of a spacecraft relative to */
/* the center of a planet at epoch ET, and let GM be the gravitation */
/* parameter of the planet. The call */
/* CALL OSCELT ( VINIT, ET, GM, ELTS ) */
/* produces a set of osculating elements describing the nominal */
/* orbit that the spacecraft would follow in the absence of all */
/* other bodies in the solar system and non-gravitational forces */
/* on the spacecraft. */
/* Now let STATE contain the state of the same spacecraft at some */
/* other epoch, LATER. The difference between this state and the */
/* state predicted by the nominal orbit at the same epoch can be */
/* computed as follows. */
/* CALL CONICS ( ELTS, LATER, NOMINAL ) */
/* CALL VSUBG ( NOMINAL, STATE, 6, DIFF ) */
/* WRITE (*,*) 'Perturbation in x, dx/dt = ', DIFF(1), DIFF(4) */
/* WRITE (*,*) ' y, dy/dt = ', DIFF(2), DIFF(5) */
/* WRITE (*,*) ' z, dz/dt = ', DIFF(3), DIFF(6) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.0, 26-MAR-1998 (WLT) */
/* There was a coding error in the computation of the mean */
/* anomaly in the parabolic case. This problem has been */
/* corrected. */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* An error in the hyperbolic state generation was corrected. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* state from conic elements */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* These changes were prompted by the discovery that the old */
/* formulation had a severe bug for elliptic orbits and epochs */
/* prior to the epoch of the input elements, and by the discovery */
/* that the time of flight routines had problems with convergence. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* The original version of the routine had a bug in that */
/* it attempted to restrict the hyperbolic anomaly to */
/* the interval 0 to 2*PI. This has been fixed. */
/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */
/* Examples section completed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* The only real work required by this routine is the construction */
/* of a preliminary state vector from the input elements. Once this */
/* is in hand, we can simply let the routine PROP2B do the real */
/* work, free from the instabilities inherent in the classical */
/* elements formulation of two-body motion. */
/* To do this we shall construct a basis of vectors that lie in the */
/* plane of the orbit. The first vector P shall point towards the */
/* position of the orbiting body at periapse. The second */
/* vector Q shall point along the velocity vector of the body at */
/* periapse. */
/* The only other consideration is determining an epoch, TP, of */
/* this state and the delta time ET - TP. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CONICS", (ftnlen)6);
}
/* Unpack the element vector. */
rp = elts[0];
ecc = elts[1];
inc = elts[2];
lnode = elts[3];
argp = elts[4];
m0 = elts[5];
t0 = elts[6];
mu = elts[7];
/* Handle all of the exceptions first. */
if (ecc < 0.) {
setmsg_("The eccentricity supplied was negative. Only positive value"
"s are meaningful. The value was #", (ftnlen)93);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (rp <= 0.) {
setmsg_("The value of periapse range supplied was non-positive. Onl"
"y positive values are allowed. The value supplied was #. ", (
ftnlen)117);
errdp_("#", &rp, (ftnlen)1);
sigerr_("SPICE(BADPERIAPSEVALUE)", (ftnlen)23);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (mu <= 0.) {
setmsg_("The value of GM supplied was non-positive. Only positive v"
"alues are allowed. The value supplied was #. ", (ftnlen)105);
errdp_("#", &mu, (ftnlen)1);
sigerr_("SPICE(BADGM)", (ftnlen)12);
chkout_("CONICS", (ftnlen)6);
return 0;
}
/* First construct the orthonormal basis vectors that span the orbit */
/* plane. */
cosi = cos(inc);
sini = sin(inc);
cosn = cos(lnode);
sinn = sin(lnode);
cosw = cos(argp);
sinw = sin(argp);
snci = sinn * cosi;
cnci = cosn * cosi;
basisp[0] = cosn * cosw - snci * sinw;
basisp[1] = sinn * cosw + cnci * sinw;
basisp[2] = sini * sinw;
basisq[0] = -cosn * sinw - snci * cosw;
basisq[1] = -sinn * sinw + cnci * cosw;
basisq[2] = sini * cosw;
/* Next construct the state at periapse. */
/* The position at periapse is just BASISP scaled by the distance */
/* at periapse. */
/* The velocity must be constructed so that we can get an orbit */
/* of this shape. Recall that the magnitude of the specific angular */
/* momentum vector is given by DSQRT ( MU*RP*(1+ECC) ) */
/* The velocity will be given by V * BASISQ. But we must have the */
/* magnitude of the cross product of position and velocity be */
/* equal to DSQRT ( MU*RP*(1+ECC) ). So we must have */
/* RP*V = DSQRT( MU*RP*(1+ECC) ) */
/* so that: */
v = sqrt(mu * (ecc + 1.) / rp);
vscl_(&rp, basisp, pstate);
vscl_(&v, basisq, &pstate[3]);
/* Finally compute DT the elapsed time since the epoch of periapse. */
/* Ellipses first, since they are the most common. */
if (ecc < 1.) {
/* Recall that: */
/* N ( mean motion ) is given by DSQRT( MU / A**3 ). */
/* But since, A = RP / ( 1 - ECC ) ... */
ainvrs = (1. - ecc) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
period = twopi_() / n;
/* In general the mean anomaly is given by */
/* M = (T - TP) * N */
/* Where TP is the time of periapse passage. M0 is the mean */
/* anomaly at time T0 so that */
/* Thus */
/* M0 = ( T0 - TP ) * N */
/* So TP = T0-M0/N hence the time since periapse at time ET */
/* is given by ET - T0 + M0/N. Finally, since elliptic orbits are */
/* periodic, we can mod this value by the period of the orbit. */
d__1 = *et - t0 + m0 / n;
dt = d_mod(&d__1, &period);
/* Hyperbolas next. */
} else if (ecc > 1.) {
/* Again, recall that: */
/* N ( mean motion ) is given by DSQRT( MU / |A**3| ). */
/* But since, |A| = RP / ( ECC - 1 ) ... */
ainvrs = (ecc - 1.) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
dt = *et - t0 + m0 / n;
/* Finally, parabolas. */
} else {
n = sqrt(mu / (rp * 2.)) / rp;
dt = *et - t0 + m0 / n;
}
/* Now let PROP2B do the work of propagating the state. */
prop2b_(&mu, pstate, &dt, state);
chkout_("CONICS", (ftnlen)6);
return 0;
} /* conics_ */
/* $Procedure HRMINT ( Hermite polynomial interpolation ) */
/* Subroutine */ int hrmint_(integer *n, doublereal *xvals, doublereal *yvals,
doublereal *x, doublereal *work, doublereal *f, doublereal *df)
{
/* System generated locals */
integer xvals_dim1, yvals_dim1, work_dim1, work_offset, i__1, i__2, i__3,
i__4, i__5, i__6, i__7;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal temp;
integer this__, prev, next, i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal denom;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal c1, c2;
integer xi;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
integer xij;
/* $ Abstract */
/* Evaluate a Hermite interpolating polynomial at a specified */
/* abscissa value. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* INTERPOLATION */
/* POLYNOMIAL */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* N I Number of points defining the polynomial. */
/* XVALS I Abscissa values. */
/* YVALS I Ordinate and derivative values. */
/* X I Point at which to interpolate the polynomial. */
/* WORK I-O Work space array. */
/* F O Interpolated function value at X. */
/* DF O Interpolated function's derivative at X. */
/* $ Detailed_Input */
/* N is the number of points defining the polynomial. */
/* The arrays XVALS and YVALS contain N and 2*N */
/* elements respectively. */
/* XVALS is an array of length N containing abscissa values. */
/* YVALS is an array of length 2*N containing ordinate and */
/* derivative values for each point in the domain */
/* defined by FIRST, STEP, and N. The elements */
/* YVALS( 2*I - 1 ) */
/* YVALS( 2*I ) */
/* give the value and first derivative of the output */
/* polynomial at the abscissa value */
/* XVALS(I) */
/* where I ranges from 1 to N. */
/* WORK is a work space array. It is used by this routine */
/* as a scratch area to hold intermediate results. */
/* X is the abscissa value at which the interpolating */
/* polynomial and its derivative are to be evaluated. */
/* $ Detailed_Output */
/* F, */
/* DF are the value and derivative at X of the unique */
/* polynomial of degree 2N-1 that fits the points and */
/* derivatives defined by XVALS and YVALS. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If two input abscissas are equal, the error */
/* SPICE(DIVIDEBYZERO) will be signaled. */
/* 2) If N is less than 1, the error SPICE(INVALIDSIZE) is */
/* signaled. */
/* 3) This routine does not attempt to ward off or diagnose */
/* arithmetic overflows. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Users of this routine must choose the number of points to use */
/* in their interpolation method. The authors of Reference [1] have */
/* this to say on the topic: */
/* Unless there is solid evidence that the interpolating function */
/* is close in form to the true function f, it is a good idea to */
/* be cautious about high-order interpolation. We */
/* enthusiastically endorse interpolations with 3 or 4 points, we */
/* are perhaps tolerant of 5 or 6; but we rarely go higher than */
/* that unless there is quite rigorous monitoring of estimated */
/* errors. */
/* The same authors offer this warning on the use of the */
/* interpolating function for extrapolation: */
/* ...the dangers of extrapolation cannot be overemphasized: */
/* An interpolating function, which is perforce an extrapolating */
/* function, will typically go berserk when the argument x is */
/* outside the range of tabulated values by more than the typical */
/* spacing of tabulated points. */
/* $ Examples */
/* 1) Fit a 7th degree polynomial through the points ( x, y, y' ) */
/* ( -1, 6, 3 ) */
/* ( 0, 5, 0 ) */
/* ( 3, 2210, 5115 ) */
/* ( 5, 78180, 109395 ) */
/* and evaluate this polynomial at x = 2. */
/* PROGRAM TEST_HRMINT */
/* DOUBLE PRECISION ANSWER */
/* DOUBLE PRECISION DERIV */
/* DOUBLE PRECISION XVALS (4) */
/* DOUBLE PRECISION YVALS (8) */
/* DOUBLE PRECISION WORK (8,2) */
/* INTEGER N */
/* N = 4 */
/* XVALS(1) = -1.D0 */
/* XVALS(2) = 0.D0 */
/* XVALS(3) = 3.D0 */
/* XVALS(4) = 5.D0 */
/* YVALS(1) = 6.D0 */
/* YVALS(2) = 3.D0 */
/* YVALS(3) = 5.D0 */
/* YVALS(4) = 0.D0 */
/* YVALS(5) = 2210.D0 */
/* YVALS(6) = 5115.D0 */
/* YVALS(7) = 78180.D0 */
/* YVALS(8) = 109395.D0 */
/* CALL HRMINT ( N, XVALS, YVALS, 2.D0, WORK, ANSWER, DERIV ) */
/* WRITE (*,*) 'ANSWER = ', ANSWER */
/* WRITE (*,*) 'DERIV = ', DERIV */
/* END */
/* The returned value of ANSWER should be 141.D0, and the returned */
/* derivative value should be 456.D0, since the unique 7th degree */
/* polynomial that fits these constraints is */
/* 7 2 */
/* f(x) = x + 2x + 5 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] "Numerical Recipes---The Art of Scientific Computing" by */
/* William H. Press, Brian P. Flannery, Saul A. Teukolsky, */
/* William T. Vetterling (see sections 3.0 and 3.1). */
/* [2] "Elementary Numerical Analysis---An Algorithmic Approach" */
/* by S. D. Conte and Carl de Boor. See p. 64. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.1, 28-JAN-2014 (NJB) */
/* Fixed a few comment typos. */
/* - SPICELIB Version 1.2.0, 01-FEB-2002 (NJB) (EDW) */
/* Bug fix: declarations of local variables XI and XIJ */
/* were changed from DOUBLE PRECISION to INTEGER. */
/* Note: bug had no effect on behavior of this routine. */
/* - SPICELIB Version 1.1.0, 28-DEC-2001 (NJB) */
/* Blanks following final newline were truncated to */
/* suppress compilation warnings on the SGI-N32 platform. */
/* - SPICELIB Version 1.0.0, 01-MAR-2000 (NJB) */
/* -& */
/* $ Index_Entries */
/* interpolate function using Hermite polynomial */
/* Hermite interpolation */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Check in only if an error is detected. */
/* Parameter adjustments */
work_dim1 = *n << 1;
work_offset = work_dim1 + 1;
yvals_dim1 = *n << 1;
xvals_dim1 = *n;
/* Function Body */
if (return_()) {
return 0;
}
/* No data, no interpolation. */
if (*n < 1) {
chkin_("HRMINT", (ftnlen)6);
setmsg_("Array size must be positive; was #.", (ftnlen)35);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("HRMINT", (ftnlen)6);
return 0;
}
/* Copy the input array into WORK. After this, the first column */
/* of WORK represents the first column of our triangular */
/* interpolation table. */
i__1 = *n << 1;
for (i__ = 1; i__ <= i__1; ++i__) {
work[(i__2 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0 <=
i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)293)] =
yvals[(i__3 = i__ - 1) < yvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("yvals", i__3, "hrmint_", (ftnlen)293)];
}
/* Compute the second column of the interpolation table: this */
/* consists of the N-1 values obtained by evaluating the */
/* first-degree interpolants at X. We'll also evaluate the */
/* derivatives of these interpolants at X and save the results in */
/* the second column of WORK. Because the derivative computations */
/* depend on the function computations from the previous column in */
/* the interpolation table, and because the function interpolation */
/* overwrites the previous column of interpolated function values, */
/* we must evaluate the derivatives first. */
i__1 = *n - 1;
for (i__ = 1; i__ <= i__1; ++i__) {
c1 = xvals[(i__2 = i__) < xvals_dim1 && 0 <= i__2 ? i__2 : s_rnge(
"xvals", i__2, "hrmint_", (ftnlen)310)] - *x;
c2 = *x - xvals[(i__2 = i__ - 1) < xvals_dim1 && 0 <= i__2 ? i__2 :
s_rnge("xvals", i__2, "hrmint_", (ftnlen)311)];
denom = xvals[(i__2 = i__) < xvals_dim1 && 0 <= i__2 ? i__2 : s_rnge(
"xvals", i__2, "hrmint_", (ftnlen)312)] - xvals[(i__3 = i__ -
1) < xvals_dim1 && 0 <= i__3 ? i__3 : s_rnge("xvals", i__3,
"hrmint_", (ftnlen)312)];
if (denom == 0.) {
chkin_("HRMINT", (ftnlen)6);
setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23);
errint_("#", &i__, (ftnlen)1);
i__2 = i__ + 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &xvals[(i__2 = i__ - 1) < xvals_dim1 && 0 <= i__2 ?
i__2 : s_rnge("xvals", i__2, "hrmint_", (ftnlen)321)], (
ftnlen)1);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("HRMINT", (ftnlen)6);
return 0;
}
/* The second column of WORK contains interpolated derivative */
/* values. */
/* The odd-indexed interpolated derivatives are simply the input */
/* derivatives. */
prev = (i__ << 1) - 1;
this__ = prev + 1;
next = this__ + 1;
work[(i__2 = prev + (work_dim1 << 1) - work_offset) < work_dim1 << 1
&& 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)
339)] = work[(i__3 = this__ + work_dim1 - work_offset) <
work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3,
"hrmint_", (ftnlen)339)];
/* The even-indexed interpolated derivatives are the slopes of */
/* the linear interpolating polynomials for adjacent input */
/* abscissa/ordinate pairs. */
work[(i__2 = this__ + (work_dim1 << 1) - work_offset) < work_dim1 <<
1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (
ftnlen)346)] = (work[(i__3 = next + work_dim1 - work_offset) <
work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3,
"hrmint_", (ftnlen)346)] - work[(i__4 = prev + work_dim1 -
work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge(
"work", i__4, "hrmint_", (ftnlen)346)]) / denom;
/* The first column of WORK contains interpolated function values. */
/* The odd-indexed entries are the linear Taylor polynomials, */
/* for each input abscissa value, evaluated at X. */
temp = work[(i__2 = this__ + work_dim1 - work_offset) < work_dim1 <<
1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (
ftnlen)353)] * (*x - xvals[(i__3 = i__ - 1) < xvals_dim1 && 0
<= i__3 ? i__3 : s_rnge("xvals", i__3, "hrmint_", (ftnlen)353)
]) + work[(i__4 = prev + work_dim1 - work_offset) < work_dim1
<< 1 && 0 <= i__4 ? i__4 : s_rnge("work", i__4, "hrmint_", (
ftnlen)353)];
work[(i__2 = this__ + work_dim1 - work_offset) < work_dim1 << 1 && 0
<= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)356)]
= (c1 * work[(i__3 = prev + work_dim1 - work_offset) <
work_dim1 << 1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3,
"hrmint_", (ftnlen)356)] + c2 * work[(i__4 = next + work_dim1
- work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge(
"work", i__4, "hrmint_", (ftnlen)356)]) / denom;
work[(i__2 = prev + work_dim1 - work_offset) < work_dim1 << 1 && 0 <=
i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)359)] =
temp;
}
/* The last column entries were not computed by the preceding loop; */
/* compute them now. */
work[(i__1 = (*n << 1) - 1 + (work_dim1 << 1) - work_offset) < work_dim1
<< 1 && 0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (
ftnlen)367)] = work[(i__2 = (*n << 1) + work_dim1 - work_offset) <
work_dim1 << 1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmi"
"nt_", (ftnlen)367)];
work[(i__1 = (*n << 1) - 1 + work_dim1 - work_offset) < work_dim1 << 1 &&
0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (ftnlen)368)] =
work[(i__2 = (*n << 1) + work_dim1 - work_offset) < work_dim1 <<
1 && 0 <= i__2 ? i__2 : s_rnge("work", i__2, "hrmint_", (ftnlen)
368)] * (*x - xvals[(i__3 = *n - 1) < xvals_dim1 && 0 <= i__3 ?
i__3 : s_rnge("xvals", i__3, "hrmint_", (ftnlen)368)]) + work[(
i__4 = (*n << 1) - 1 + work_dim1 - work_offset) < work_dim1 << 1
&& 0 <= i__4 ? i__4 : s_rnge("work", i__4, "hrmint_", (ftnlen)368)
];
/* Compute columns 3 through 2*N of the table. */
i__1 = (*n << 1) - 1;
for (j = 2; j <= i__1; ++j) {
i__2 = (*n << 1) - j;
for (i__ = 1; i__ <= i__2; ++i__) {
/* In the theoretical construction of the interpolation table, */
/* there are 2*N abscissa values, since each input abcissa */
/* value occurs with multiplicity two. In this theoretical */
/* construction, the Jth column of the interpolation table */
/* contains results of evaluating interpolants that span J+1 */
/* consecutive abscissa values. The indices XI and XIJ below */
/* are used to pick the correct abscissa values out of the */
/* physical XVALS array, in which the abscissa values are not */
/* repeated. */
xi = (i__ + 1) / 2;
xij = (i__ + j + 1) / 2;
c1 = xvals[(i__3 = xij - 1) < xvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("xvals", i__3, "hrmint_", (ftnlen)391)] - *x;
c2 = *x - xvals[(i__3 = xi - 1) < xvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("xvals", i__3, "hrmint_", (ftnlen)392)];
denom = xvals[(i__3 = xij - 1) < xvals_dim1 && 0 <= i__3 ? i__3 :
s_rnge("xvals", i__3, "hrmint_", (ftnlen)394)] - xvals[(
i__4 = xi - 1) < xvals_dim1 && 0 <= i__4 ? i__4 : s_rnge(
"xvals", i__4, "hrmint_", (ftnlen)394)];
if (denom == 0.) {
chkin_("HRMINT", (ftnlen)6);
setmsg_("XVALS(#) = XVALS(#) = #", (ftnlen)23);
errint_("#", &xi, (ftnlen)1);
errint_("#", &xij, (ftnlen)1);
errdp_("#", &xvals[(i__3 = xi - 1) < xvals_dim1 && 0 <= i__3 ?
i__3 : s_rnge("xvals", i__3, "hrmint_", (ftnlen)402)]
, (ftnlen)1);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("HRMINT", (ftnlen)6);
return 0;
}
/* Compute the interpolated derivative at X for the Ith */
/* interpolant. This is the derivative with respect to X of */
/* the expression for the interpolated function value, which */
/* is the second expression below. This derivative computation */
/* is done first because it relies on the interpolated */
/* function values from the previous column of the */
/* interpolation table. */
/* The derivative expression here corresponds to equation */
/* 2.35 on page 64 in reference [2]. */
work[(i__3 = i__ + (work_dim1 << 1) - work_offset) < work_dim1 <<
1 && 0 <= i__3 ? i__3 : s_rnge("work", i__3, "hrmint_", (
ftnlen)421)] = (c1 * work[(i__4 = i__ + (work_dim1 << 1)
- work_offset) < work_dim1 << 1 && 0 <= i__4 ? i__4 :
s_rnge("work", i__4, "hrmint_", (ftnlen)421)] + c2 * work[
(i__5 = i__ + 1 + (work_dim1 << 1) - work_offset) <
work_dim1 << 1 && 0 <= i__5 ? i__5 : s_rnge("work", i__5,
"hrmint_", (ftnlen)421)] + (work[(i__6 = i__ + 1 +
work_dim1 - work_offset) < work_dim1 << 1 && 0 <= i__6 ?
i__6 : s_rnge("work", i__6, "hrmint_", (ftnlen)421)] -
work[(i__7 = i__ + work_dim1 - work_offset) < work_dim1 <<
1 && 0 <= i__7 ? i__7 : s_rnge("work", i__7, "hrmint_", (
ftnlen)421)])) / denom;
/* Compute the interpolated function value at X for the Ith */
/* interpolant. */
work[(i__3 = i__ + work_dim1 - work_offset) < work_dim1 << 1 && 0
<= i__3 ? i__3 : s_rnge("work", i__3, "hrmint_", (ftnlen)
428)] = (c1 * work[(i__4 = i__ + work_dim1 - work_offset)
< work_dim1 << 1 && 0 <= i__4 ? i__4 : s_rnge("work",
i__4, "hrmint_", (ftnlen)428)] + c2 * work[(i__5 = i__ +
1 + work_dim1 - work_offset) < work_dim1 << 1 && 0 <=
i__5 ? i__5 : s_rnge("work", i__5, "hrmint_", (ftnlen)428)
]) / denom;
}
}
/* Our interpolated function value is sitting in WORK(1,1) at this */
/* point. The interpolated derivative is located in WORK(1,2). */
*f = work[(i__1 = work_dim1 + 1 - work_offset) < work_dim1 << 1 && 0 <=
i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (ftnlen)438)];
*df = work[(i__1 = (work_dim1 << 1) + 1 - work_offset) < work_dim1 << 1 &&
0 <= i__1 ? i__1 : s_rnge("work", i__1, "hrmint_", (ftnlen)439)];
return 0;
} /* hrmint_ */
/* $Procedure ZZEDTERM ( Ellipsoid terminator ) */
/* Subroutine */ int zzedterm_(char *type__, doublereal *a, doublereal *b,
doublereal *c__, doublereal *srcrad, doublereal *srcpos, integer *
npts, doublereal *trmpts, ftnlen type_len)
{
/* System generated locals */
integer trmpts_dim2, i__1, i__2;
doublereal d__1, d__2, d__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
double asin(doublereal);
integer s_rnge(char *, integer, char *, integer);
double d_sign(doublereal *, doublereal *);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
doublereal rmin, rmax;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
integer nitr;
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *);
doublereal d__, e[3];
integer i__;
doublereal s, angle, v[3], x[3], delta, y[3], z__[3], inang;
extern /* Subroutine */ int chkin_(char *, ftnlen), frame_(doublereal *,
doublereal *, doublereal *);
doublereal plane[4];
extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
errch_(char *, char *, ftnlen, ftnlen), vpack_(doublereal *,
doublereal *, doublereal *, doublereal *);
doublereal theta;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal trans[9] /* was [3][3] */, srcpt[3], vtemp[3];
extern doublereal vnorm_(doublereal *), twopi_(void);
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
pl2nvc_(doublereal *, doublereal *, doublereal *);
doublereal lambda;
extern /* Subroutine */ int nvp2pl_(doublereal *, doublereal *,
doublereal *);
extern doublereal halfpi_(void);
doublereal minang, minrad, maxang, maxrad;
extern /* Subroutine */ int latrec_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal angerr;
logical umbral;
extern doublereal touchd_(doublereal *);
doublereal offset[3], prvdif;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
doublereal outang, plcons, prvang;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
char loctyp[50];
extern logical return_(void);
extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
doublereal dir[3];
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
doublereal vtx[3];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Compute a set of points on the umbral or penumbral terminator of */
/* a specified ellipsoid, given a spherical light source. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* ELLIPSES */
/* $ Keywords */
/* BODY */
/* GEOMETRY */
/* MATH */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TYPE I Terminator type. */
/* A I Length of ellipsoid semi-axis lying on the x-axis. */
/* B I Length of ellipsoid semi-axis lying on the y-axis. */
/* C I Length of ellipsoid semi-axis lying on the z-axis. */
/* SRCRAD I Radius of light source. */
/* SRCPOS I Position of center of light source. */
/* NPTS I Number of points in terminator point set. */
/* TRMPTS O Terminator point set. */
/* $ Detailed_Input */
/* TYPE is a string indicating the type of terminator to */
/* compute: umbral or penumbral. The umbral */
/* terminator is the boundary of the portion of the */
/* ellipsoid surface in total shadow. The penumbral */
/* terminator is the boundary of the portion of the */
/* surface that is completely illuminated. Possible */
/* values of TYPE are */
/* 'UMBRAL' */
/* 'PENUMBRAL' */
/* Case and leading or trailing blanks in TYPE are */
/* not significant. */
/* A, */
/* B, */
/* C are the lengths of the semi-axes of a triaxial */
/* ellipsoid. The ellipsoid is centered at the */
/* origin and oriented so that its axes lie on the */
/* x, y and z axes. A, B, and C are the lengths of */
/* the semi-axes that point in the x, y, and z */
/* directions respectively. */
/* Length units associated with A, B, and C must */
/* match those associated with SRCRAD, SRCPOS, */
/* and the output TRMPTS. */
/* SRCRAD is the radius of the spherical light source. */
/* SRCPOS is the position of the center of the light source */
/* relative to the center of the ellipsoid. */
/* NPTS is the number of terminator points to compute. */
/* $ Detailed_Output */
/* TRMPTS is an array of points on the umbral or penumbral */
/* terminator of the ellipsoid, as specified by the */
/* input argument TYPE. The Ith point is contained */
/* in the array elements */
/* TRMPTS(J,I), J = 1, 2, 3 */
/* The terminator points are expressed in the */
/* body-fixed reference frame associated with the */
/* ellipsoid. Units are those associated with */
/* the input axis lengths. */
/* Each terminator point is the point of tangency of */
/* a plane that is also tangent to the light source. */
/* These associated points of tangency on the light */
/* source have uniform distribution in longitude when */
/* expressed in a cylindrical coordinate system whose */
/* Z-axis is SRCPOS. The magnitude of the separation */
/* in longitude between these tangency points on the */
/* light source is */
/* 2*Pi / NPTS */
/* If the target is spherical, the terminator points */
/* also are uniformly distributed in longitude in the */
/* cylindrical system described above. If the target */
/* is non-spherical, the longitude distribution of */
/* the points generally is not uniform. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the terminator type is not recognized, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 2) If the set size NPTS is not at least 1, the error */
/* SPICE(INVALIDSIZE) is signaled. */
/* 3) If any of the ellipsoid's semi-axis lengths is non-positive, */
/* the error SPICE(INVALIDAXISLENGTH) is signaled. */
/* 4) If the light source has non-positive radius, the error */
/* SPICE(INVALIDRADIUS) is signaled. */
/* 5) If the light source intersects the smallest sphere */
/* centered at the origin and containing the ellipsoid, the */
/* error SPICE(OBJECTSTOOCLOSE) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine models the boundaries of shadow regions on an */
/* ellipsoid "illuminated" by a spherical light source. Light rays */
/* are assumed to travel along straight lines; refraction is not */
/* modeled. */
/* Points on the ellipsoid at which the entire cap of the light */
/* source is visible are considered to be completely illuminated. */
/* Points on the ellipsoid at which some portion (or all) of the cap */
/* of the light source are blocked are considered to be in partial */
/* (or total) shadow. */
/* In this routine, we use the term "umbral terminator" to denote */
/* the curve ususally called the "terminator": this curve is the */
/* boundary of the portion of the surface that lies in total shadow. */
/* We use the term "penumbral terminator" to denote the boundary of */
/* the completely illuminated portion of the surface. */
/* In general, the terminator on an ellipsoid is a more complicated */
/* curve than the limb (which is always an ellipse). Aside from */
/* various special cases, the terminator does not lie in a plane. */
/* However, the condition for a point X on the ellipsoid to lie on */
/* the terminator is simple: a plane tangent to the ellipsoid at X */
/* must also be tangent to the light source. If this tangent plane */
/* does not intersect the vector from the center of the ellipsoid to */
/* the center of the light source, then X lies on the umbral */
/* terminator; otherwise X lies on the penumbral terminator. */
/* $ Examples */
/* See the SPICELIB routine EDTERM. */
/* $ Restrictions */
/* This is a private SPICELIB routine. User applications should not */
/* call this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-FEB-2007 (NJB) */
/* -& */
/* $ Index_Entries */
/* find terminator on ellipsoid */
/* find umbral terminator on ellipsoid */
/* find penumbral terminator on ellipsoid */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICELIB error handling. */
/* Parameter adjustments */
trmpts_dim2 = *npts;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZEDTERM", (ftnlen)8);
/* Check the terminator type. */
ljust_(type__, loctyp, type_len, (ftnlen)50);
ucase_(loctyp, loctyp, (ftnlen)50, (ftnlen)50);
if (s_cmp(loctyp, "UMBRAL", (ftnlen)50, (ftnlen)6) == 0) {
umbral = TRUE_;
} else if (s_cmp(loctyp, "PENUMBRAL", (ftnlen)50, (ftnlen)9) == 0) {
umbral = FALSE_;
} else {
setmsg_("Terminator type must be UMBRAL or PENUMBRAL but was actuall"
"y #.", (ftnlen)63);
errch_("#", type__, (ftnlen)1, type_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Check the terminator set dimension. */
if (*npts < 1) {
setmsg_("Set must contain at least one point; NPTS = #.", (ftnlen)47)
;
errint_("#", npts, (ftnlen)1);
sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* The ellipsoid semi-axes must have positive length. */
if (*a <= 0. || *b <= 0. || *c__ <= 0.) {
setmsg_("Semi-axis lengths: A = #, B = #, C = #. ", (ftnlen)41);
errdp_("#", a, (ftnlen)1);
errdp_("#", b, (ftnlen)1);
errdp_("#", c__, (ftnlen)1);
sigerr_("SPICE(INVALIDAXISLENGTH)", (ftnlen)24);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Check the input light source radius. */
if (*srcrad <= 0.) {
setmsg_("Light source must have positive radius; actual radius was #."
, (ftnlen)60);
errdp_("#", srcrad, (ftnlen)1);
sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* The light source must not intersect the outer bounding */
/* sphere of the ellipsoid. */
d__ = vnorm_(srcpos);
/* Computing MAX */
d__1 = max(*a,*b);
rmax = max(d__1,*c__);
/* Computing MIN */
d__1 = min(*a,*b);
rmin = min(d__1,*c__);
if (*srcrad + rmax >= d__) {
/* The light source is too close. */
setmsg_("Light source intersects outer bounding sphere of the ellips"
"oid. Light source radius = #; ellipsoid's longest axis = #;"
" sum = #; distance between centers = #.", (ftnlen)158);
errdp_("#", srcrad, (ftnlen)1);
errdp_("#", &rmax, (ftnlen)1);
d__1 = *srcrad + rmax;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &d__, (ftnlen)1);
sigerr_("SPICE(OBJECTSTOOCLOSE)", (ftnlen)22);
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
}
/* Find bounds on the angular size of the target as seen */
/* from the source. */
/* Computing MIN */
d__1 = rmax / d__;
minang = asin((min(d__1,1.)));
/* Computing MIN */
d__1 = rmin / d__;
maxang = asin((min(d__1,1.)));
/* Let the inverse of the ellipsoid-light source vector be the */
/* Z-axis of a frame we'll use to generate the terminator set. */
vminus_(srcpos, z__);
frame_(z__, x, y);
/* Create the rotation matrix required to convert vectors */
/* from the source-centered frame back to the target body-fixed */
/* frame. */
vequ_(x, trans);
vequ_(y, &trans[3]);
vequ_(z__, &trans[6]);
/* Find the maximum and minimum target radii. */
/* Computing MAX */
d__1 = max(*a,*b);
maxrad = max(d__1,*c__);
/* Computing MIN */
d__1 = min(*a,*b);
minrad = min(d__1,*c__);
if (umbral) {
/* Compute the angular offsets from the axis of rays tangent to */
/* both the source and the bounding spheres of the target, where */
/* the tangency points lie in a half-plane bounded by the line */
/* containing the origin and SRCPOS. (We'll call this line */
/* the "axis.") */
/* OUTANG corresponds to the target's outer bounding sphere; */
/* INANG to the inner bounding sphere. */
outang = asin((*srcrad - maxrad) / d__);
inang = asin((*srcrad - minrad) / d__);
} else {
/* Compute the angular offsets from the axis of rays tangent to */
/* both the source and the bounding spheres of the target, where */
/* the tangency points lie in opposite half-planes bounded by the */
/* axis (compare the case above). */
/* OUTANG corresponds to the target's outer bounding sphere; */
/* INANG to the inner bounding sphere. */
outang = asin((*srcrad + maxrad) / d__);
inang = asin((*srcrad + minrad) / d__);
}
/* Compute the angular delta we'll use for generating */
/* terminator points. */
delta = twopi_() / *npts;
/* Generate the terminator points. */
i__1 = *npts;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (i__ - 1) * delta;
/* Let SRCPT be the surface point on the source lying in */
/* the X-Y plane of the frame produced by FRAME */
/* and corresponding to the angle THETA. */
latrec_(srcrad, &theta, &c_b30, srcpt);
/* Now solve for the angle by which SRCPT must be rotated (toward */
/* +Z in the umbral case, away from +Z in the penumbral case) */
/* so that a plane tangent to the source at SRCPT is also tangent */
/* to the target. The rotation is bracketed by OUTANG on the low */
/* side and INANG on the high side in the umbral case; the */
/* bracketing values are reversed in the penumbral case. */
if (umbral) {
angle = outang;
} else {
angle = inang;
}
prvdif = twopi_();
prvang = angle + halfpi_();
nitr = 0;
for(;;) { /* while(complicated condition) */
d__2 = (d__1 = angle - prvang, abs(d__1));
if (!(nitr <= 10 && touchd_(&d__2) < prvdif))
break;
++nitr;
d__2 = (d__1 = angle - prvang, abs(d__1));
prvdif = touchd_(&d__2);
prvang = angle;
/* Find the closest point on the ellipsoid to the plane */
/* corresponding to "ANGLE". */
/* The tangent point on the source is obtained by rotating */
/* SRCPT by ANGLE towards +Z. The plane's normal vector is */
/* parallel to VTX in the source-centered frame. */
latrec_(srcrad, &theta, &angle, vtx);
vequ_(vtx, dir);
/* VTX and DIR are expressed in the source-centered frame. We */
/* must translate VTX to the target frame and rotate both */
/* vectors into that frame. */
mxv_(trans, vtx, vtemp);
vadd_(srcpos, vtemp, vtx);
mxv_(trans, dir, vtemp);
vequ_(vtemp, dir);
/* Create the plane defined by VTX and DIR. */
nvp2pl_(dir, vtx, plane);
/* Find the closest point on the ellipsoid to the plane. At */
/* the point we seek, the outward normal on the ellipsoid is */
/* parallel to the choice of plane normal that points away */
/* from the origin. We can always obtain this choice from */
/* PL2NVC. */
pl2nvc_(plane, dir, &plcons);
/* At the point */
/* E = (x, y, z) */
/* on the ellipsoid's surface, an outward normal */
/* is */
/* N = ( x/A**2, y/B**2, z/C**2 ) */
/* which is also */
/* lambda * ( DIR(1), DIR(2), DIR(3) ) */
/* Equating components in the normal vectors yields */
/* E = lambda * ( DIR(1)*A**2, DIR(2)*B**2, DIR(3)*C**2 ) */
/* Taking the inner product with the point E itself and */
/* applying the ellipsoid equation, we find */
/* lambda * <DIR, E> = < N, E > = 1 */
/* The first term above is */
/* lambda**2 * || ( A*DIR(1), B*DIR(2), C*DIR(3) ) ||**2 */
/* So the positive root lambda is */
/* 1 / || ( A*DIR(1), B*DIR(2), C*DIR(3) ) || */
/* Having lambda we can compute E. */
d__1 = *a * dir[0];
d__2 = *b * dir[1];
d__3 = *c__ * dir[2];
vpack_(&d__1, &d__2, &d__3, v);
lambda = 1. / vnorm_(v);
d__1 = *a * v[0];
d__2 = *b * v[1];
d__3 = *c__ * v[2];
vpack_(&d__1, &d__2, &d__3, e);
vscl_(&lambda, e, &trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3
&& 0 <= i__2 ? i__2 : s_rnge("trmpts", i__2, "zzedterm_",
(ftnlen)586)]);
/* Make a new estimate of the plane rotation required to touch */
/* the target. */
vsub_(&trmpts[(i__2 = i__ * 3 - 3) < trmpts_dim2 * 3 && 0 <= i__2
? i__2 : s_rnge("trmpts", i__2, "zzedterm_", (ftnlen)592)]
, vtx, offset);
/* Let ANGERR be an estimate of the magnitude of angular error */
/* between the plane and the terminator. */
angerr = vsep_(dir, offset) - halfpi_();
/* Let S indicate the sign of the altitude error: where */
/* S is positive, the plane is above E. */
d__1 = vdot_(e, dir);
s = d_sign(&c_b35, &d__1);
if (umbral) {
/* If the plane is above the target, increase the */
/* rotation angle; otherwise decrease the angle. */
angle += s * angerr;
} else {
/* This is the penumbral case; decreasing the angle */
/* "lowers" the plane toward the target. */
angle -= s * angerr;
}
}
}
chkout_("ZZEDTERM", (ftnlen)8);
return 0;
} /* zzedterm_ */
/* $Procedure SPKE02 ( SPK, evaluate record, type 2 ) */
/* Subroutine */ int spke02_(doublereal *et, doublereal *record, doublereal *
xyzdot)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer degp, ncof, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
integer cofloc;
extern /* Subroutine */ int chbint_(doublereal *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen),
errint_(char *, integer *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Evaluate a single data record from an PCK or SPK segment of type */
/* 2 (Chebyshev Polynomials, 3 components). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* PCK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Evaluation epoch. */
/* RECORD I Data record. */
/* XYZDOT O Three function components and their derivatives. */
/* $ Detailed_Input */
/* ET is the epoch at which a state vector or Euler angle */
/* state is to be computed. The epoch is represented as */
/* seconds past J2000 TDB. */
/* RECORD is a data record which, when evaluated at epoch ET, */
/* will yield three function components and their */
/* derivatives with respect to time. The record */
/* structure for SPK type 2 data is: */
/* +--------------------------------------+ */
/* | record size (excluding this element) | */
/* +--------------------------------------+ */
/* | Coverage interval midpoint | */
/* +--------------------------------------+ */
/* | Coverage interval radius | */
/* +--------------------------------------+ */
/* | Coeffs for X position component | */
/* +--------------------------------------+ */
/* | Coeffs for Y position component | */
/* +--------------------------------------+ */
/* | Coeffs for Z position component | */
/* +--------------------------------------+ */
/* In the above record */
/* - Times are expressed as seconds past J2000 TDB. */
/* - Position components have units of km. */
/* See PCKE02 for a description of PCK type 2 records. */
/* RECORD must be declared by the caller with size large */
/* enough to accommodate the largest record that can be */
/* returned by this routine. See the INCLUDE file */
/* spkrec.inc for the correct record length. */
/* $ Detailed_Output */
/* XYZDOT is a 6-vector. In order, the components of XYZDOT are */
/* X, Y, Z, X', Y', and Z'. Units for state evaluations */
/* will be km and km/sec. Units for angles will be */
/* radians and radians/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input record contains an invalid coefficient count, */
/* the error SPICE(INVALIDCOUNT) will be signaled. */
/* 2) If the input record contains invalid domain transformation */
/* parameters, the error will be diagnosed by a routine in the */
/* call tree of this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* The exact format and structure of type 2 (Chebyshev polynomials, */
/* position only) segments are described in the SPK and PCK Required */
/* Reading files. */
/* A type 2 segment contains three sets of Chebyshev coefficients, */
/* one set each for components X, Y, and Z. SPKE02 calls the routine */
/* CHBINT for each set to evaluate the polynomial AND its first */
/* derivative (which it computes internally) at the input epoch, */
/* thereby arriving at the complete state. */
/* $ Examples */
/* The data returned by the 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. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 2 ) THEN */
/* CALL SPKR02 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE02 ( ET, RECORD, XYZDOT ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* NAIF Document 168.0, "S- and P- Kernel (SPK) Specification and */
/* User's Guide" */
/* $ Author_and_Institution */
/* R.E. Thurman (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 18-JAN-2014 (NJB) */
/* Added error checks for invalid coefficient counts */
/* and invalid interval radius. Changed error handling */
/* style to "discovery." Enhanced header documentation. */
/* - SPICELIB Version 1.0.4, 22-MAR-1994 (KSZ) */
/* Comments changed so this can be used as */
/* a generic Chebyshev evaluator, rather than just for */
/* SPK type 2 files. (KSZ) */
/* - SPICELIB Version 1.0.3, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.2, 23-AUG-1991 (HAN) */
/* SPK02 was removed from the Required_Reading section of the */
/* header. The information in the SPK02 Required Reading file */
/* is now part of the SPK Required Reading file. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (RET) */
/* -& */
/* $ Index_Entries */
/* evaluate type_2 spk segment */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
/* The first number in the record is the record size. Following it */
/* are two numbers that will be used later, then the three sets of */
/* coefficients. The number of coefficients for each variable can */
/* be determined from the record size, since there are the same */
/* number of coefficients for each variable. */
ncof = ((integer) record[0] - 2) / 3;
if (ncof < 1) {
chkin_("SPKE02", (ftnlen)6);
setmsg_("The input record's coefficient count NCOF should be positiv"
"e but was #.", (ftnlen)71);
errint_("#", &ncof, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKE02", (ftnlen)6);
return 0;
}
/* Check the radius of the domain interval. */
if (record[2] <= 0.) {
chkin_("SPKE02", (ftnlen)6);
setmsg_("Interval radius must be positive but was #.", (ftnlen)43);
errdp_("#", &record[2], (ftnlen)1);
sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
chkout_("SPKE02", (ftnlen)6);
return 0;
}
/* The degree of each polynomial is one less than the number of */
/* coefficients. */
degp = ncof - 1;
/* Call CHBINT once for each variable to evaluate the position */
/* and velocity values. */
for (i__ = 1; i__ <= 3; ++i__) {
/* The coefficients for each variable are located contiguously, */
/* following the first three words in the record. */
cofloc = ncof * (i__ - 1) + 4;
/* CHBINT needs as input the coefficients, the degree of the */
/* polynomial, the epoch, and also two variable transformation */
/* parameters, which are located, in our case, in the second and */
/* third slots of the record. */
/* Note that CHBINT is "error free." */
chbint_(&record[cofloc - 1], °p, &record[1], et, &xyzdot[(i__1 =
i__ - 1) < 6 && 0 <= i__1 ? i__1 : s_rnge("xyzdot", i__1,
"spke02_", (ftnlen)297)], &xyzdot[(i__2 = i__ + 2) < 6 && 0 <=
i__2 ? i__2 : s_rnge("xyzdot", i__2, "spke02_", (ftnlen)297)]
);
}
return 0;
} /* spke02_ */
/* $Procedure SPKE15 ( Evaluate a type 15 SPK data record) */
/* Subroutine */ int spke15_(doublereal *et, doublereal *recin, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), d_mod(doublereal *, doublereal *), d_sign(
doublereal *, doublereal *);
/* Local variables */
doublereal near__, dmdt;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer j2flg;
doublereal p, angle, dnode, z__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, speed, dperi, theta, manom;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
errdp_(char *, doublereal *, ftnlen), vcrss_(doublereal *,
doublereal *, doublereal *);
extern doublereal twopi_(void);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal oneme2, state0[6];
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal pa[3], gm, ta, dt;
extern doublereal pi_(void);
doublereal tp[3], pv[3], cosinc;
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen);
doublereal tmpsta[6], oj2;
extern logical return_(void);
doublereal ecc;
extern doublereal dpr_(void);
doublereal dot, rpl, k2pi;
/* $ Abstract */
/* Evaluates a single SPK data record from a segment of type 15 */
/* (Precessing Conic Propagation). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECIN I Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, specified as ephemeris seconds past */
/* J2000, at which a state vector is to be computed. */
/* RECIN is a data record which, when evaluated at epoch ET, */
/* will give the state (position and velocity) of some */
/* body, relative to some center, in some inertial */
/* reference frame. */
/* The structure of RECIN is: */
/* RECIN(1) epoch of periapsis */
/* in ephemeris seconds past J2000. */
/* RECIN(2)-RECIN(4) unit trajectory pole vector */
/* RECIN(5)-RECIN(7) unit periapsis vector */
/* RECIN(8) semi-latus rectum---p in the */
/* equation: */
/* r = p/(1 + ECC*COS(Nu)) */
/* RECIN(9) eccentricity */
/* RECIN(10) J2 processing flag describing */
/* what J2 corrections are to be */
/* applied when the orbit is */
/* propagated. */
/* All J2 corrections are applied */
/* if this flag has a value that */
/* is not 1,2 or 3. */
/* If the value of the flag is 3 */
/* no corrections are done. */
/* If the value of the flag is 1 */
/* no corrections are computed for */
/* the precession of the line */
/* of apsides. However, regression */
/* of the line of nodes is */
/* performed. */
/* If the value of the flag is 2 */
/* no corrections are done for */
/* the regression of the line of */
/* nodes. However, precession of the */
/* line of apsides is performed. */
/* Note that J2 effects are computed */
/* only if the orbit is elliptic and */
/* does not intersect the central */
/* body. */
/* RECIN(11)-RECIN(13) unit central body pole vector */
/* RECIN(14) central body GM */
/* RECIN(15) central body J2 */
/* RECIN(16) central body radius */
/* Units are radians, km, seconds */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECIN at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity is less than zero, the error */
/* 'SPICE(BADECCENTRICITY)' will be signalled. */
/* 2) If the semi-latus rectum is non-positive, the error */
/* 'SPICE(BADLATUSRECTUM)' is signalled. */
/* 3) If the pole vector, trajectory pole vector or periapsis vector */
/* has zero length, the error 'SPICE(BADVECTOR)' is signalled. */
/* 4) If the trajectory pole vector and the periapsis vector are */
/* not orthogonal, the error 'SPICE(BADINITSTATE)' is */
/* signalled. The test for orthogonality is very crude. The */
/* routine simply checks that the absolute value of the dot */
/* product of the unit vectors parallel to the trajectory pole */
/* and periapse vectors is less than 0.00001. This check is */
/* intended to catch blunders, not to enforce orthogonality to */
/* double precision tolerance. */
/* 5) If the mass of the central body is non-positive, the error */
/* 'SPICE(NONPOSITIVEMASS)' is signalled. */
/* 6) If the radius of the central body is negative, the error */
/* 'SPICE(BADRADIUS)' is signalled. */
/* $ Particulars */
/* This algorithm applies J2 corrections for precessing the */
/* node and argument of periapse for an object orbiting an */
/* oblate spheroid. */
/* Note the effects of J2 are incorporated only for elliptic */
/* orbits that do not intersect the central body. */
/* While the derivation of the effect of the various harmonics */
/* of gravitational field are beyond the scope of this header */
/* the effect of the J2 term of the gravity model are as follows */
/* The line of node precesses. Over one orbit average rate of */
/* precession, DNode/dNu, is given by */
/* 3 J2 */
/* dNode/dNu = - ----------------- DCOS( inc ) */
/* 2 (P/RPL)**2 */
/* (Since this is always less than zero for oblate spheroids, this */
/* should be called regression of nodes.) */
/* The line of apsides precesses. The average rate of precession */
/* DPeri/dNu is given by */
/* 3 J2 */
/* dPeri/dNu = ----------------- ( 5*DCOS ( inc ) - 1 ) */
/* 2 (P/RPL)**2 */
/* Details of these formulae are given in the Battin's book (see */
/* literature references below). */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR15 as shown here: */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECIN ) */
/* CALL SPKE15 ( ET, RECIN, STATE ) */
/* where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 15 data segment. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 15 ) THEN */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE15 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* S. Schlaifer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* [1] `Fundamentals of Celestial Mechanics', Second Edition 1989 */
/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */
/* Richmond Virginia; pp 345-347. */
/* [2] `Astronautical Guidance', by Richard H. Battin. 1964 */
/* McGraw-Hill Book Company, San Francisco. pp 199 */
/* $ Version */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* $ Index_Entries */
/* evaluate type_15 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKE15", (ftnlen)6);
/* Fetch the various entities from the input record, first the epoch. */
epoch = recin[0];
/* The trajectory pole vector. */
vequ_(&recin[1], tp);
/* The periapsis vector. */
vequ_(&recin[4], pa);
/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */
/* and eccentricity. */
p = recin[7];
ecc = recin[8];
/* J2 processing flag. */
j2flg = (integer) recin[9];
/* Central body pole vector. */
vequ_(&recin[10], pv);
/* The central mass, J2 and radius of the central body. */
gm = recin[13];
oj2 = recin[14];
rpl = recin[15];
/* Check all the inputs here for obvious failures. Yes, perhaps */
/* this is overkill. However, there is a lot more computation */
/* going on in this routine so that the small amount of overhead */
/* here should not be significant. */
if (p <= 0.) {
setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator"
" was non-positive. This value must be positive. The value s"
"upplied was #.", (ftnlen)133);
errdp_("#", &p, (ftnlen)1);
sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (ecc < 0.) {
setmsg_("The eccentricity supplied for a type 15 segment is negative"
". It must be non-negative. The value supplied to the type 1"
"5 evaluator was #. ", (ftnlen)138);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (gm <= 0.) {
setmsg_("The mass supplied for the central body of a type 15 segment"
" was non-positive. Masses must be positive. The value suppl"
"ied was #. ", (ftnlen)130);
errdp_("#", &gm, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(tp)) {
setmsg_("The trajectory pole vector supplied to SPKE15 had length ze"
"ro. The most likely cause of this problem is a corrupted SPK"
" (ephemeris) file. ", (ftnlen)138);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pa)) {
setmsg_("The periapse vector supplied to SPKE15 had length zero. The"
" most likely cause of this problem is a corrupted SPK (ephem"
"eris) file. ", (ftnlen)131);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pv)) {
setmsg_("The central pole vector supplied to SPKE15 had length zero."
" The most likely cause of this problem is a corrupted SPK (e"
"phemeris) file. ", (ftnlen)135);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (rpl < 0.) {
setmsg_("The central body radius was negative. It must be zero or po"
"sitive. The value supplied was #. ", (ftnlen)94);
errdp_("#", &rpl, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Convert TP, PV and PA to unit vectors. */
/* (It won't hurt to polish them up a bit here if they are already */
/* unit vectors.) */
vhatip_(pa);
vhatip_(tp);
vhatip_(pv);
/* One final check. Make sure the pole and periapse vectors are */
/* orthogonal. (We will use a very crude check but this should */
/* rule out any obvious errors.) */
dot = vdot_(pa, tp);
if (abs(dot) > 1e-5) {
angle = vsep_(pa, tp) * dpr_();
setmsg_("The periapsis and trajectory pole vectors are not orthogona"
"l. The anglebetween them is # degrees. ", (ftnlen)98);
errdp_("#", &angle, (ftnlen)1);
sigerr_("SPICE(BADINITSTATE)", (ftnlen)19);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Compute the distance and speed at periapse. */
near__ = p / (ecc + 1.);
speed = sqrt(gm / p) * (ecc + 1.);
/* Next get the position at periapse ... */
vscl_(&near__, pa, state0);
/* ... and the velocity at periapsis. */
vcrss_(tp, pa, &state0[3]);
vsclip_(&speed, &state0[3]);
/* Determine the elapsed time from periapse to the requested */
/* epoch and propagate the state at periapsis to the epoch of */
/* interest. */
/* Note that we are making use of the following fact. */
/* If R is a rotation, then the states obtained by */
/* the following blocks of code are mathematically the */
/* same. (In reality they may differ slightly due to */
/* roundoff.) */
/* Code block 1. */
/* CALL MXV ( R, STATE0, STATE0 ) */
/* CALL MXV ( R, STATE0(4), STATE0(4) ) */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* Code block 2. */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* CALL MXV ( R, STATE, STATE ) */
/* CALL MXV ( R, STATE(4), STATE(4) ) */
/* This allows us to first compute the propagation of our initial */
/* state and then if needed perform the precession of the line */
/* of nodes and apsides by simply precessing the resulting state. */
dt = *et - epoch;
prop2b_(&gm, state0, &dt, state);
/* If called for, handle precession needed due to the J2 term. Note */
/* that the motion of the lines of nodes and apsides is formulated */
/* in terms of the true anomaly. This means we need the accumulated */
/* true anomaly in order to properly transform the state. */
if (j2flg != 3 && oj2 != 0. && ecc < 1. && near__ > rpl) {
/* First compute the change in mean anomaly since periapsis. */
/* Computing 2nd power */
d__1 = ecc;
oneme2 = 1. - d__1 * d__1;
dmdt = oneme2 / p * sqrt(gm * oneme2 / p);
manom = dmdt * dt;
/* Next compute the angle THETA such that THETA is between */
/* -pi and pi and such than MANOM = THETA + K*2*pi for */
/* some integer K. */
d__1 = twopi_();
theta = d_mod(&manom, &d__1);
if (abs(theta) > pi_()) {
d__1 = twopi_();
theta -= d_sign(&d__1, &theta);
}
k2pi = manom - theta;
/* We can get the accumulated true anomaly from the propagated */
/* state theta and the accumulated mean anomaly prior to this */
/* orbit. */
ta = vsep_(pa, state);
ta = d_sign(&ta, &theta);
ta += k2pi;
/* Determine how far the line of nodes and periapsis have moved. */
cosinc = vdot_(pv, tp);
/* Computing 2nd power */
d__1 = rpl / p;
z__ = ta * 1.5 * oj2 * (d__1 * d__1);
dnode = -z__ * cosinc;
/* Computing 2nd power */
d__1 = cosinc;
dperi = z__ * (d__1 * d__1 * 2.5 - .5);
/* Precess the periapsis by rotating the state vector about the */
/* trajectory pole */
if (j2flg != 1) {
vrotv_(state, tp, &dperi, tmpsta);
vrotv_(&state[3], tp, &dperi, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* Regress the line of nodes by rotating the state */
/* about the pole of the central body. */
if (j2flg != 2) {
vrotv_(state, pv, &dnode, tmpsta);
vrotv_(&state[3], pv, &dnode, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* We could perform the rotations above in the other order, */
/* but we would also have to rotate the pole before precessing */
/* the line of apsides. */
}
/* That's all folks. Check out and return. */
chkout_("SPKE15", (ftnlen)6);
return 0;
} /* spke15_ */
/* $Procedure DRDGEO ( Derivative of rectangular w.r.t. geodetic ) */
/* Subroutine */ int drdgeo_(doublereal *long__, doublereal *lat, doublereal *
alt, doublereal *re, doublereal *f, doublereal *jacobi)
{
/* Builtin functions */
double cos(doublereal), sin(doublereal), sqrt(doublereal);
/* Local variables */
doublereal clat, flat, clon, slat, slon, flat2, g;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal g2, dgdlat;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* This routine computes the Jacobian of the transformation from */
/* geodetic to rectangular coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* COORDINATES */
/* DERIVATIVES */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* LONG I Geodetic longitude of point (radians). */
/* LAT I Geodetic latitude of point (radians). */
/* ALT I Altitude of point above the reference spheroid. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* JACOBI O Matrix of partial derivatives. */
/* $ Detailed_Input */
/* LONG Geodetic longitude of point (radians). */
/* LAT Geodetic latitude of point (radians). */
/* ALT Altitude of point above the reference spheroid. */
/* RE Equatorial radius of the reference spheroid. */
/* F Flattening coefficient = (RE-RP) / RE, where RP is */
/* the polar radius of the spheroid. (More importantly */
/* RP = RE*(1-F).) */
/* $ Detailed_Output */
/* JACOBI is the matrix of partial derivatives of the conversion */
/* between geodetic and rectangular coordinates. It */
/* has the form */
/* .- -. */
/* | DX/DLONG DX/DLAT DX/DALT | */
/* | DY/DLONG DY/DLAT DY/DALT | */
/* | DZ/DLONG DZ/DLAT DZ/DALT | */
/* `- -' */
/* evaluated at the input values of LONG, LAT and ALT. */
/* The formulae for computing X, Y, and Z from */
/* geodetic coordinates are given below. */
/* X = [ALT + RE/G(LAT,F)]*COS(LONG)*COS(LAT) */
/* Y = [ALT + RE/G(LAT,F)]*SIN(LONG)*COS(LAT) */
/* Z = [ALT + RE*(1-F)**2/G(LAT,F)]* SIN(LAT) */
/* where */
/* RE is the polar radius of the reference spheroid. */
/* F is the flattening factor (the polar radius is */
/* obtained by multiplying the equatorial radius by */
/* 1-F). */
/* G( LAT, F ) is given by */
/* sqrt ( cos(lat)**2 + (1-f)**2 * sin(lat)**2 ) */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the flattening coefficient is greater than or equal to */
/* one, the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* 2) If the equatorial radius is non-positive, the error */
/* SPICE(BADRADIUS) is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* It is often convenient to describe the motion of an object in */
/* the geodetic coordinate system. However, when performing */
/* vector computations its hard to beat rectangular coordinates. */
/* To transform states given with respect to geodetic coordinates */
/* to states with respect to rectangular coordinates, one makes use */
/* of the Jacobian of the transformation between the two systems. */
/* Given a state in geodetic coordinates */
/* ( long, lat, alt, dlong, dlat, dalt ) */
/* the velocity in rectangular coordinates is given by the matrix */
/* equation: */
/* t | t */
/* (dx, dy, dz) = JACOBI| * (dlong, dlat, dalt) */
/* |(long,lat,alt) */
/* This routine computes the matrix */
/* | */
/* JACOBI| */
/* |(long,lat,alt) */
/* $ Examples */
/* Suppose that one has a model that gives radius, longitude and */
/* latitude as a function of time (long(t), lat(t), alt(t) ) for */
/* which the derivatives ( dlong/dt, dlat/dt, dalt/dt ) are */
/* computable. */
/* To find the velocity of the object in bodyfixed rectangular */
/* coordinates, one simply multiplies the Jacobian of the */
/* transformation from geodetic to rectangular coordinates, */
/* evaluated at (long(t), lat(t), alt(t) ), by the vector of */
/* derivatives of the geodetic coordinates. */
/* In code this looks like: */
/* C */
/* C Load the derivatives of long, lat, and alt into the */
/* C geodetic velocity vector GEOV. */
/* C */
/* GEOV(1) = DLONG_DT ( T ) */
/* GEOV(2) = DLAT_DT ( T ) */
/* GEOV(3) = DALT_DT ( T ) */
/* C */
/* C Determine the Jacobian of the transformation from */
/* C geodetic to rectangular coordinates at the geodetic */
/* C coordinates of time T. */
/* C */
/* CALL DRDGEO ( LONG(T), LAT(T), ALT(T), RE, F, JACOBI ) */
/* C */
/* C Multiply the Jacobian on the right by the geodetic */
/* C velocity to obtain the rectangular velocity RECV. */
/* C */
/* CALL MXV ( JACOBI, GEOV, RECV ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-JUL-2001 (WLT) */
/* -& */
/* $ Index_Entries */
/* Jacobian of rectangular w.r.t. geodetic coordinates */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DRDGEO", (ftnlen)6);
}
/* If the flattening coefficient is greater than one, the polar */
/* radius computed below is negative. If it's equal to one, the */
/* polar radius is zero. Either case is a problem, so signal an */
/* error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was *.", (ftnlen)29);
errdp_("*", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDGEO", (ftnlen)6);
return 0;
}
if (*re <= 0.) {
setmsg_("Equatorial Radius <= 0.0D0. RE = *", (ftnlen)34);
errdp_("*", re, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("DRDGEO", (ftnlen)6);
return 0;
}
/* For the record, here is a derivation of the formulae for the */
/* values of x, y and z as a function of longitude, latitude and */
/* altitude. */
/* First, let's take the case where the longitude is 0. Moreover, */
/* lets assume that the length of the equatorial axis is a and */
/* that the polar axis is b: */
/* a = re */
/* b = re * (1-f) */
/* For any point on the spheroid where y is zero we know that there */
/* is a unique q in the range (-Pi, Pi] such that */
/* x = a cos(q) and z = b sin(q). */
/* The normal to the surface at such a point is given by */
/* cos(q) sin(q) */
/* ( ------- , ------- ) */
/* a b */
/* The unit vector in the same direction is */
/* b cos(q) a sin(q) */
/* ( -------------------------- , -------------------------- ) */
/* ______________________ ______________________ */
/* / 2 2 2 2 / 2 2 2 2 */
/* \/ b cos (q) + a sin (q) \/ b cos (q) + a sin (q) */
/* The first component of this term is by definition equal to the */
/* cosine of the geodetic latitude, thus */
/* ______________________ */
/* / 2 2 2 2 */
/* b cos(q) = cos(lat) \/ b cos (q) + a sin (q) */
/* This can be transformed to the equation */
/* ______________________________ */
/* / 2 2 2 2 */
/* b cos(q) = cos(lat) \/ ( b - a )cos (q) + a */
/* Squaring both sides and rearranging terms gives: */
/* 2 2 2 2 2 2 2 2 */
/* b cos (q) + cos (lat) ( a - b ) cos (q) = a cos (lat) */
/* Thus */
/* 2 2 */
/* 2 a cos (lat) */
/* cos (q) = -------------------------- */
/* 2 2 2 2 */
/* b sin (lat) + a cos (lat) */
/* cos (lat) */
/* = ------------------------------ */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (b/a) sin (lat) + cos (lat) */
/* cos (lat) */
/* = --------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* From this one can also conclude that */
/* (1-f) sin (lat) */
/* sin(q) = ---------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* Thus the point on the surface of the spheroid is given by */
/* re * cos (lat) */
/* x_0 = --------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* 2 */
/* re * (1-f) sin (lat) */
/* z_0 = ---------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* Thus given a point with the same latitude but a non-zero */
/* longitude, one can conclude that */
/* re * cos (long) *cos (lat) */
/* x_0 = --------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* re * sin (long) cos (lat) */
/* y_0 = --------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* 2 */
/* re * (1-f) sin (lat) */
/* z_0 = ---------------------------------- */
/* _____________________________ */
/* / 2 2 2 */
/* \/ (1-f) sin (lat) + cos (lat) */
/* The unit normal, n, at this point is simply */
/* ( cos(long)cos(lat), sin(long)cos(lat), sin(lat) ) */
/* Thus for a point at altitude alt, we simply add the vector */
/* alt*n */
/* to the vector ( x_0, y_0, z_0 ). Hence we have */
/* x = [ alt + re/g(lat,f) ] * cos(long) * cos(lat) */
/* y = [ alt + re/g(lat,f) ] * sin(long) * cos(lat) */
/* z = [ alt + re*(1-f)**2/g(lat,f) ] * sin(lat) */
/* We're going to need the sine and cosine of LAT and LONG many */
/* times. We'll just compute them once. */
clat = cos(*lat);
clon = cos(*long__);
slat = sin(*lat);
slon = sin(*long__);
/* Referring to the G given in the header we have... */
flat = 1. - *f;
flat2 = flat * flat;
g = sqrt(clat * clat + flat2 * slat * slat);
g2 = g * g;
dgdlat = (flat2 - 1.) * slat * clat / g;
/* Now simply take the partial derivatives of the x,y,z w.r.t. */
/* long,lat, alt. */
jacobi[0] = -(*alt + *re / g) * slon * clat;
jacobi[1] = (*alt + *re / g) * clon * clat;
jacobi[2] = 0.;
jacobi[3] = -(*re) * dgdlat / g2 * clon * clat - (*alt + *re / g) * clon *
slat;
jacobi[4] = -(*re) * dgdlat / g2 * slon * clat - (*alt + *re / g) * slon *
slat;
jacobi[5] = -flat2 * *re * dgdlat / g2 * slat + (*alt + flat2 * *re / g) *
clat;
jacobi[6] = clon * clat;
jacobi[7] = slon * clat;
jacobi[8] = slat;
chkout_("DRDGEO", (ftnlen)6);
return 0;
} /* drdgeo_ */
/* $Procedure SPKW17 ( SPK, write a type 17 segment ) */
/* Subroutine */ int spkw17_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
doublereal *epoch, doublereal *eqel, doublereal *rapol, doublereal *
decpol, ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
doublereal a, h__;
integer i__;
doublereal k;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_(
doublereal *, integer *), dafbna_(integer *, doublereal *, char *,
ftnlen), dafena_(void);
extern logical failed_(void);
doublereal record[12];
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen), spkpds_(integer *, integer *, char *, integer *,
doublereal *, doublereal *, doublereal *, ftnlen);
extern logical return_(void);
doublereal ecc;
/* $ Abstract */
/* Write an SPK segment of type 17 given a type 17 data record. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I Body code for ephemeris object. */
/* CENTER I Body code for the center of motion of the body. */
/* FRAME I The reference frame of the states. */
/* FIRST I First valid time for which states can be computed. */
/* LAST I Last valid time for which states can be computed. */
/* SEGID I Segment identifier. */
/* EPOCH I Epoch of elements in seconds past J2000 */
/* EQEL I Array of equinoctial elements */
/* RAPOL I Right Ascension of the pole of the reference plane */
/* DECPOL I Declination of the pole of the reference plane */
/* $ Detailed_Input */
/* HANDLE is the file handle of an SPK file that has been */
/* opened for writing. */
/* BODY is the NAIF ID for the body whose states are */
/* to be recorded in an SPK file. */
/* CENTER is the NAIF ID for the center of motion associated */
/* with BODY. */
/* FRAME is the reference frame that states are referenced to, */
/* for example 'J2000'. */
/* FIRST are the bounds on the ephemeris times, expressed as */
/* LAST seconds past J2000. */
/* SEGID is the segment identifier. An SPK segment identifier */
/* may contain up to 40 characters. */
/* EPOCH is the epoch of equinoctial elements in seconds */
/* past the J2000 epoch. */
/* EQEL is an array of 9 double precision numbers that */
/* are the equinoctial elements for some orbit relative */
/* to the equatorial frame of a central body. */
/* ( The z-axis of the equatorial frame is the direction */
/* of the pole of the central body relative to FRAME. */
/* The x-axis is given by the cross product of the */
/* Z-axis of FRAME with the direction of the pole of */
/* the central body. The Y-axis completes a right */
/* handed frame. ) */
/* The specific arrangement of the elements is spelled */
/* out below. The following terms are used in the */
/* discussion of elements of EQEL */
/* INC --- inclination of the orbit */
/* ARGP --- argument of periapse */
/* NODE --- longitude of the ascending node */
/* E --- eccentricity of the orbit */
/* EQEL(1) is the semi-major axis (A) of the orbit in km. */
/* EQEL(2) is the value of H at the specified epoch. */
/* ( E*SIN(ARGP+NODE) ). */
/* EQEL(3) is the value of K at the specified epoch */
/* ( E*COS(ARGP+NODE) ). */
/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */
/* the epoch of the elements measured in radians. */
/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */
/* the specified epoch. */
/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */
/* the specified epoch. */
/* EQEL(7) is the rate of the longitude of periapse */
/* (dARGP/dt + dNODE/dt ) at the epoch of */
/* the elements. This rate is assumed to hold */
/* for all time. The rate is measured in */
/* radians per second. */
/* EQEL(8) is the derivative of the mean longitude */
/* ( dM/dt + dARGP/dt + dNODE/dt ). This */
/* rate is assumed to be constant and is */
/* measured in radians/second. */
/* EQEL(9) is the rate of the longitude of the ascending */
/* node ( dNODE/dt). This rate is measured */
/* in radians per second. */
/* RAPOL Right Ascension of the pole of the reference plane */
/* relative to FRAME measured in radians. */
/* DECPOL Declination of the pole of the reference plane */
/* relative to FRAME measured in radians. */
/* $ Detailed_Output */
/* None. A type 17 segment is written to the file attached */
/* to HANDLE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the semi-major axis is less than or equal to zero, the error */
/* 'SPICE(BADSEMIAXIS)' is signalled. */
/* 2) If the eccentricity of the orbit corresponding to the values */
/* of H and K ( EQEL(2) and EQEL(3) ) is greater than 0.9 the */
/* error 'SPICE(ECCOUTOFRANGE)' is signalled. */
/* 3) If the segment identifier has more than 40 non-blank characters */
/* the error 'SPICE(SEGIDTOOLONG)' is signalled. */
/* 4) If the segment identifier contains non-printing characters */
/* the error 'SPICE(NONPRINTABLECHARS)' is signalled. */
/* 5) If there are inconsistencies in the BODY, CENTER, FRAME or */
/* FIRST and LAST times, the problem will be diagnosed by */
/* a routine in the call tree of this routine. */
/* $ Files */
/* A new type 17 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 17 data segment to the open SPK */
/* file according to the format described in the type 17 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* $ Examples */
/* Suppose that at time EPOCH you have the classical elements */
/* of some BODY relative to the equatorial frame of some central */
/* body CENTER. These can be converted to equinoctial elements */
/* and stored in an SPK file as a type 17 segment so that this */
/* body can be used within the SPK subsystem of the SPICE system. */
/* Below is a list of the variables used to represent the */
/* classical elements */
/* Variable Meaning */
/* -------- ---------------------------------- */
/* A Semi-major axis in km */
/* ECC Eccentricity of orbit */
/* INC Inclination of orbit */
/* NODE Longitude of the ascending node at epoch */
/* OMEGA Argument of periapse at epoch */
/* M Mean anomaly at epoch */
/* DMDT Mean anomaly rate in radians/second */
/* DNODE Rate of change of longitude of ascending node */
/* in radians/second */
/* DOMEGA Rate of change of argument of periapse in */
/* radians/second */
/* EPOCH is the epoch of the elements in seconds past */
/* the J2000 epoch. */
/* These elements are converted to equinoctial elements (in */
/* the order compatible with type 17) as shown below. */
/* EQEL(1) = A */
/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */
/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */
/* EQEL(4) = M + OMEGA + NODE */
/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */
/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */
/* EQEL(7) = DOMEGA */
/* EQEL(8) = DOMEGA + DMDT + DNODE */
/* EQEL(9) = DNODE */
/* C */
/* C Now add the segment. */
/* C */
/* CALL SPKW17 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */
/* . SEGID, EPOCH, EQEL, RAPOL, DECPOL ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 24-Jun-1999 (WLT) */
/* Corrected typographical errors in the header. */
/* - SPICELIB Version 1.0.0, 8-Jan-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Write a type 17 spk segment */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Segment descriptor size */
/* Segment identifier size */
/* SPK data type */
/* Range of printing characters */
/* Number of items in a segment */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW17", (ftnlen)6);
/* Fetch the various entities from the inputs and put them into */
/* the data record, first the epoch. */
record[0] = *epoch;
/* The trajectory pole vector. */
moved_(eqel, &c__9, &record[1]);
record[10] = *rapol;
record[11] = *decpol;
a = record[1];
h__ = record[2];
k = record[3];
ecc = sqrt(h__ * h__ + k * k);
/* Check all the inputs here for obvious failures. It's much */
/* better to check them now and quit than it is to get a bogus */
/* segment into an SPK file and diagnose it later. */
if (a <= 0.) {
setmsg_("The semimajor axis supplied to the SPK type 17 evaluator wa"
"s non-positive. This value must be positive. The value supp"
"lied was #.", (ftnlen)130);
errdp_("#", &a, (ftnlen)1);
sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18);
chkout_("SPKW17", (ftnlen)6);
return 0;
} else if (ecc > .9) {
setmsg_("The eccentricity supplied for a type 17 segment is greater "
"than 0.9. It must be less than 0.9.The value supplied to th"
"e type 17 evaluator was #. ", (ftnlen)146);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKW17", (ftnlen)6);
return 0;
}
/* Make sure the segment identifier is not too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("SPKW17", (ftnlen)6);
return 0;
}
/* Make sure the segment identifier has only printing characters. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
value = *(unsigned char *)&segid[i__ - 1];
if (value < 32 || value > 126) {
setmsg_("The segment identifier contains the nonprintable charac"
"ter having ascii code #.", (ftnlen)79);
errint_("#", &value, (ftnlen)1);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("SPKW17", (ftnlen)6);
return 0;
}
}
/* All of the obvious checks have been performed on the input */
/* record. Create the segment descriptor. (FIRST and LAST are */
/* checked by SPKPDS as well as consistency between BODY and CENTER). */
spkpds_(body, center, frame, &c__17, first, last, descr, frame_len);
if (failed_()) {
chkout_("SPKW17", (ftnlen)6);
return 0;
}
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW17", (ftnlen)6);
return 0;
}
dafada_(record, &c__12);
if (! failed_()) {
dafena_();
}
chkout_("SPKW17", (ftnlen)6);
return 0;
} /* spkw17_ */
/* $Procedure ZZHULLAX ( Pyramidal FOV convex hull to FOV axis ) */
/* Subroutine */ int zzhullax_(char *inst, integer *n, doublereal *bounds,
doublereal *axis, ftnlen inst_len)
{
/* System generated locals */
integer bounds_dim2, i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
doublereal xvec[3], yvec[3], zvec[3];
integer xidx;
extern doublereal vsep_(doublereal *, doublereal *);
integer next;
logical pass1;
integer i__, m;
doublereal r__, v[3], delta;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vlcom_(
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
integer minix, maxix;
doublereal trans[9] /* was [3][3] */;
extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal
*), vcrss_(doublereal *, doublereal *, doublereal *);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal cp[3];
extern doublereal pi_(void);
logical ok;
extern doublereal halfpi_(void);
extern /* Subroutine */ int reclat_(doublereal *, doublereal *,
doublereal *, doublereal *), sigerr_(char *, ftnlen);
doublereal minlon;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal maxlon;
extern /* Subroutine */ int vhatip_(doublereal *), vsclip_(doublereal *,
doublereal *), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
doublereal lat, sep, lon;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
doublereal ray1[3], ray2[3];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* Identify a face of the convex hull of an instrument's */
/* polygonal FOV, and use this face to generate an axis of the */
/* FOV. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK */
/* FRAMES */
/* GF */
/* IK */
/* KERNEL */
/* $ Keywords */
/* FOV */
/* GEOMETRY */
/* INSTRUMENT */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* MARGIN P Minimum complement of FOV cone angle. */
/* INST I Instrument name. */
/* N I Number of FOV boundary vectors. */
/* BOUNDS I FOV boundary vectors. */
/* AXIS O Instrument FOV axis vector. */
/* $ Detailed_Input */
/* INST is the name of an instrument with which the field of */
/* view (FOV) of interest is associated. This name is */
/* used only to generate long error messages. */
/* N is the number of boundary vectors in the array */
/* BOUNDS. */
/* BOUNDS is an array of N vectors emanating from a common */
/* vertex and defining the edges of a pyramidal region in */
/* three-dimensional space: this the region within the */
/* FOV of the instrument designated by INST. The Ith */
/* vector of BOUNDS resides in elements (1:3,I) of this */
/* array. */
/* The vectors contained in BOUNDS are called the */
/* "boundary vectors" of the FOV. */
/* The boundary vectors must satisfy the constraints: */
/* 1) The boundary vectors must be contained within */
/* a right circular cone of angular radius less */
/* than than (pi/2) - MARGIN radians; in other */
/* words, there must be a vector A such that all */
/* boundary vectors have angular separation from */
/* A of less than (pi/2)-MARGIN radians. */
/* 2) There must be a pair of vectors U, V in BOUNDS */
/* such that all other boundary vectors lie in */
/* the same half space bounded by the plane */
/* containing U and V. Furthermore, all other */
/* boundary vectors must have orthogonal */
/* projections onto a plane normal to this plane */
/* such that the projections have angular */
/* separation of at least 2*MARGIN radians from */
/* the plane spanned by U and V. */
/* Given the first constraint above, there is plane PL */
/* such that each of the set of rays extending the */
/* boundary vectors intersects PL. (In fact, there is an */
/* infinite set of such planes.) The boundary vectors */
/* must be ordered so that the set of line segments */
/* connecting the intercept on PL of the ray extending */
/* the Ith vector to that of the (I+1)st, with the Nth */
/* intercept connected to the first, form a polygon (the */
/* "FOV polygon") constituting the intersection of the */
/* FOV pyramid with PL. This polygon may wrap in either */
/* the positive or negative sense about a ray emanating */
/* from the FOV vertex and passing through the plane */
/* region bounded by the FOV polygon. */
/* The FOV polygon need not be convex; it may be */
/* self-intersecting as well. */
/* No pair of consecutive vectors in BOUNDS may be */
/* linearly dependent. */
/* The boundary vectors need not have unit length. */
/* $ Detailed_Output */
/* AXIS is a unit vector normal to a plane containing the */
/* FOV polygon. All boundary vectors have angular */
/* separation from AXIS of not more than */
/* ( pi/2 ) - MARGIN */
/* radians. */
/* This routine signals an error if it cannot find */
/* a satisfactory value of AXIS. */
/* $ Parameters */
/* MARGIN is a small positive number used to constrain the */
/* orientation of the boundary vectors. See the two */
/* constraints described in the Detailed_Input section */
/* above for specifics. */
/* $ Exceptions */
/* 1) In the input vector count N is not at least 3, the error */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If any pair of consecutive boundary vectors has cross */
/* product zero, the error SPICE(DEGENERATECASE) is signaled. */
/* For this test, the first vector is considered the successor */
/* of the Nth. */
/* 3) If this routine can't find a face of the convex hull of */
/* the set of boundary vectors such that this face satisfies */
/* constraint (2) of the Detailed_Input section above, the */
/* error SPICE(FACENOTFOUND) is signaled. */
/* 4) If any boundary vectors have longitude too close to 0 */
/* or too close to pi radians in the face frame (see discussion */
/* of the search algorithm's steps 3 and 4 in Particulars */
/* below), the respective errors SPICE(NOTSUPPORTED) or */
/* SPICE(FOVTOOWIDE) are signaled. */
/* 5) If any boundary vectors have angular separation of more than */
/* (pi/2)-MARGIN radians from the candidate FOV axis, the */
/* error SPICE(FOVTOOWIDE) is signaled. */
/* $ Files */
/* The boundary vectors input to this routine are typically */
/* obtained from an IK file. */
/* $ Particulars */
/* Normally implementation is not discussed in SPICE headers, but we */
/* make an exception here because this routine's implementation and */
/* specification are deeply intertwined. */
/* This routine produces an "axis" for a polygonal FOV using the */
/* following approach: */
/* 1) Test pairs of consecutive FOV boundary vectors to see */
/* whether there's a pair such that the plane region bounded */
/* by these vectors is */
/* a) part of the convex hull of the set of boundary vectors */
/* b) such that all other boundary vectors have angular */
/* separation of at least MARGIN from the plane */
/* containing these vectors */
/* This search has O(N**2) run time dependency on N. */
/* If this test produces a candidate face of the convex hull, */
/* proceed to step 3. */
/* 2) If step (1) fails, repeat the search for a candidate */
/* convex hull face, but this time search over every pair of */
/* distinct boundary vectors. */
/* This search has O(N**3) run time dependency on N. */
/* If this search fails, signal an error. */
/* 3) Produce a set of basis vectors for a reference frame, */
/* which we'll call the "face frame," using as the +X axis */
/* the angle bisector of the vectors bounding the candidate */
/* face, the +Y axis the inward normal vector to this face, */
/* and the +Z axis completing a right-handed basis. */
/* 4) Transform each boundary vector, other than the two vectors */
/* defining the selected convex hull face, to the face frame */
/* and compute the vector's longitude in that frame. Find the */
/* maximum and minimum longitudes of the vectors in the face */
/* frame. */
/* If any vector's longitude is less than 2*MARGIN or greater */
/* than pi - 2*MARGIN radians, signal an error. */
/* 5) Let DELTA be the difference between pi and the maximum */
/* longitude found in step (4). Rotate the +Y axis (which */
/* points in the inward normal direction relative to the */
/* selected face) by -DELTA/2 radians about the +Z axis of */
/* the face frame. This rotation aligns the +Y axis with the */
/* central longitude of the set of boundary vectors. The */
/* resulting vector is our candidate FOV axis. */
/* 6) Check the angular separation of the candidate FOV axis */
/* against each boundary vector. If any vector has angular */
/* separation of more than (pi/2)-MARGIN radians from the */
/* axis, signal an error. */
/* Note that there are reasonable FOVs that cannot be handled by the */
/* algorithm described here. For example, any FOV whose cross */
/* section is a regular convex polygon can be made unusable by */
/* adding boundary vectors aligned with the angle bisectors of each */
/* face of the pyramid defined by the FOV's boundary vectors. The */
/* resulting set of boundary vectors has no face in its convex hull */
/* such that all other boundary vectors have positive angular */
/* separation from that face. */
/* Because of this limitation, this algorithm should be used only */
/* after a simple FOV axis-finding approach, such as using as the */
/* FOV axis the average of the boundary vectors, has been tried */
/* unsuccessfully. */
/* Note that it's easy to construct FOVs where the average of the */
/* boundary vectors doesn't yield a viable axis: a FOV of angular */
/* width nearly equal to pi radians, with a sufficiently large */
/* number of boundary vectors on one side and few boundary vectors */
/* on the other, is one such example. This routine can find an */
/* axis for many such intractable FOVs---that's why this routine */
/* should be called after the simple approach fails. */
/* $ Examples */
/* See SPICELIB private routine ZZFOVAXI. */
/* $ Restrictions */
/* 1) This is a SPICE private routine. User applications should not */
/* call this routine. */
/* 2) There are "reasonable" polygonal FOVs that cannot be handled */
/* by this routine. See the discussion in Particulars above. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB 1.0.0, 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* Create axis vector for polygonal FOV */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Parameter adjustments */
bounds_dim2 = *n;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("ZZHULLAX", (ftnlen)8);
/* Nothing found yet. */
found = FALSE_;
xidx = 0;
/* We must have at least 3 boundary vectors. */
if (*n < 3) {
setmsg_("Polygonal FOV requires at least 3 boundary vectors but numb"
"er supplied for # was #.", (ftnlen)83);
errch_("#", inst, (ftnlen)1, inst_len);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Find an exterior face of the pyramid defined by the */
/* input boundary vectors. Since most polygonal FOVs will have */
/* an exterior face bounded by two consecutive rays, we'll */
/* try pairs of consecutive rays first. If this fails, we'll */
/* try each pair of rays. */
i__ = 1;
while(i__ <= *n && ! found) {
/* Set the index of the next ray. When we get to the */
/* last boundary vector, the next ray is the first. */
if (i__ == *n) {
next = 1;
} else {
next = i__ + 1;
}
/* Find the cross product of the first ray with the */
/* second. Depending on the ordering of the boundary */
/* vectors, this could be an inward or outward normal, */
/* in the case the current face is exterior. */
vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ?
i__1 : s_rnge("bounds", i__1, "zzhullax_", (ftnlen)408)], &
bounds[(i__2 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__2 ?
i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)408)], cp);
/* We insist on consecutive boundary vectors being */
/* linearly independent. */
if (vzero_(cp)) {
setmsg_("Polygonal FOV must have linearly independent consecutiv"
"e boundary but vectors at indices # and # have cross pro"
"duct equal to the zero vector. Instrument is #.", (ftnlen)
158);
errint_("#", &i__, (ftnlen)1);
errint_("#", &next, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* See whether the other boundary vectors have angular */
/* separation of at least MARGIN from the plane containing */
/* the current face. */
pass1 = TRUE_;
ok = TRUE_;
m = 1;
while(m <= *n && ok) {
/* Find the angular separation of CP and the Mth vector if the */
/* latter is not an edge of the current face. */
if (m != i__ && m != next) {
sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) < bounds_dim2 * 3
&& 0 <= i__1 ? i__1 : s_rnge("bounds", i__1, "zzhull"
"ax_", (ftnlen)446)]);
if (pass1) {
/* Adjust CP if necessary so that it points */
/* toward the interior of the pyramid. */
if (sep > halfpi_()) {
/* Invert the cross product vector and adjust SEP */
/* accordingly. Within this "M" loop, all other */
/* angular separations will be computed using the new */
/* value of CP. */
vsclip_(&c_b20, cp);
sep = pi_() - sep;
}
pass1 = FALSE_;
}
ok = sep < halfpi_() - 1e-12;
}
if (ok) {
/* Consider the next boundary vector. */
++m;
}
}
/* We've tested each boundary vector against the current face, or */
/* else the loop terminated early because a vector with */
/* insufficient angular separation from the plane containing the */
/* face was found. */
if (ok) {
/* The current face is exterior. It's bounded by rays I and */
/* NEXT. */
xidx = i__;
found = TRUE_;
} else {
/* Look at the next face of the pyramid. */
++i__;
}
}
/* If we didn't find an exterior face, we'll have to look at each */
/* face bounded by a pair of rays, even if those rays are not */
/* adjacent. (This can be a very slow process is N is large.) */
if (! found) {
i__ = 1;
while(i__ <= *n && ! found) {
/* Consider all ray pairs (I,NEXT) where NEXT > I. */
next = i__ + 1;
while(next <= *n && ! found) {
/* Find the cross product of the first ray with the second. */
/* If the current face is exterior, CP could be an inward */
/* or outward normal, depending on the ordering of the */
/* boundary vectors. */
vcrss_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__1 ? i__1 : s_rnge("bounds", i__1, "zzhullax_", (
ftnlen)530)], &bounds[(i__2 = next * 3 - 3) <
bounds_dim2 * 3 && 0 <= i__2 ? i__2 : s_rnge("bounds",
i__2, "zzhullax_", (ftnlen)530)], cp);
/* It's allowable for non-consecutive boundary vectors to */
/* be linearly dependent, but if we have such a pair, */
/* it doesn't define an exterior face. */
if (! vzero_(cp)) {
/* The rays having direction vectors indexed I and NEXT */
/* define a semi-infinite sector of a plane that might */
/* be of interest. */
/* Check whether all of the boundary vectors that are */
/* not edges of the current face have angular separation */
/* of at least MARGIN from the plane containing the */
/* current face. */
pass1 = TRUE_;
ok = TRUE_;
m = 1;
while(m <= *n && ok) {
/* Find the angular separation of CP and the Mth */
/* vector if the latter is not an edge of the current */
/* face. */
if (m != i__ && m != next) {
sep = vsep_(cp, &bounds[(i__1 = m * 3 - 3) <
bounds_dim2 * 3 && 0 <= i__1 ? i__1 :
s_rnge("bounds", i__1, "zzhullax_", (
ftnlen)560)]);
if (pass1) {
/* Adjust CP if necessary so that it points */
/* toward the interior of the pyramid. */
if (sep > halfpi_()) {
/* Invert the cross product vector and */
/* adjust SEP accordingly. Within this "M" */
/* loop, all other angular separations will */
/* be computed using the new value of CP. */
vsclip_(&c_b20, cp);
sep = pi_() - sep;
}
pass1 = FALSE_;
}
ok = sep < halfpi_() - 1e-12;
}
if (ok) {
/* Consider the next boundary vector. */
++m;
}
}
/* We've tested each boundary vector against the current */
/* face, or else the loop terminated early because a */
/* vector with insufficient angular separation from the */
/* plane containing the face was found. */
if (ok) {
/* The current face is exterior. It's bounded by rays */
/* I and NEXT. */
xidx = i__;
found = TRUE_;
}
/* End of angular separation test block. */
}
/* End of non-zero cross product block. */
if (! found) {
/* Look at the face bounded by the rays */
/* at indices I and NEXT+1. */
++next;
}
}
/* End of NEXT loop. */
if (! found) {
/* Look at the face bounded by the pairs of rays */
/* including the ray at index I+1. */
++i__;
}
}
/* End of I loop. */
}
/* End of search for exterior face using each pair of rays. */
/* If we still haven't found an exterior face, we can't continue. */
if (! found) {
setmsg_("Unable to find face of convex hull of FOV of instrument #.",
(ftnlen)58);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FACENOTFOUND)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Arrival at this point means that the rays at indices */
/* XIDX and NEXT define a plane such that all boundary */
/* vectors lie in a half-space bounded by that plane. */
/* We're now going to define a set of orthonormal basis vectors: */
/* +X points along the angle bisector of the bounding vectors */
/* of the exterior face. */
/* +Y points along CP. */
/* +Z is the cross product of +X and +Y. */
/* We'll call the reference frame having these basis vectors */
/* the "face frame." */
vhat_(&bounds[(i__1 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1 :
s_rnge("bounds", i__1, "zzhullax_", (ftnlen)683)], ray1);
vhat_(&bounds[(i__1 = next * 3 - 3) < bounds_dim2 * 3 && 0 <= i__1 ? i__1
: s_rnge("bounds", i__1, "zzhullax_", (ftnlen)684)], ray2);
vlcom_(&c_b36, ray1, &c_b36, ray2, xvec);
vhatip_(xvec);
vhat_(cp, yvec);
ucrss_(xvec, yvec, zvec);
/* Create a transformation matrix to map the input boundary */
/* vectors into the face frame. */
for (i__ = 1; i__ <= 3; ++i__) {
trans[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)698)] = xvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("xvec", i__2, "zzhullax_", (
ftnlen)698)];
trans[(i__1 = i__ * 3 - 2) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)699)] = yvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("yvec", i__2, "zzhullax_", (
ftnlen)699)];
trans[(i__1 = i__ * 3 - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("trans",
i__1, "zzhullax_", (ftnlen)700)] = zvec[(i__2 = i__ - 1) < 3
&& 0 <= i__2 ? i__2 : s_rnge("zvec", i__2, "zzhullax_", (
ftnlen)700)];
}
/* Now we're going to compute the longitude of each boundary in the */
/* face frame. The vectors with indices XIDX and NEXT are excluded. */
/* We expect all longitudes to be between MARGIN and pi - MARGIN. */
minlon = pi_();
maxlon = 0.;
minix = 1;
maxix = 1;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (i__ != xidx && i__ != next) {
/* The current vector is not a boundary of our edge, */
/* so find its longitude. */
mxv_(trans, &bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (
ftnlen)720)], v);
reclat_(v, &r__, &lon, &lat);
/* Update the longitude bounds. */
if (lon < minlon) {
minix = i__;
minlon = lon;
}
if (lon > maxlon) {
maxix = i__;
maxlon = lon;
}
}
}
/* If the longitude bounds are not as expected, don't try */
/* to continue. */
if (minlon < 2e-12) {
setmsg_("Minimum boundary vector longitude in exterior face frame is"
" # radians. Minimum occurs at index #. This FOV does not con"
"form to the requirements of this routine. Instrument is #.", (
ftnlen)177);
errdp_("#", &minlon, (ftnlen)1);
errint_("#", &minix, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
} else if (maxlon > pi_() - 2e-12) {
setmsg_("Maximum boundary vector longitude in exterior face frame is"
" # radians. Maximum occurs at index #. This FOV does not con"
"form to the requirements of this routine. Instrument is #.", (
ftnlen)177);
errdp_("#", &maxlon, (ftnlen)1);
errint_("#", &maxix, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
/* Let delta represent the amount we can rotate the exterior */
/* face clockwise about +Z without contacting another boundary */
/* vector. */
delta = pi_() - maxlon;
/* Rotate +Y by -DELTA/2 about +Z. The result is our candidate */
/* FOV axis. Make the axis vector unit length. */
d__1 = -delta / 2;
vrotv_(yvec, zvec, &d__1, axis);
vhatip_(axis);
/* If we have a viable result, ALL boundary vectors have */
/* angular separation less than HALFPI-MARGIN from AXIS. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
sep = vsep_(&bounds[(i__2 = i__ * 3 - 3) < bounds_dim2 * 3 && 0 <=
i__2 ? i__2 : s_rnge("bounds", i__2, "zzhullax_", (ftnlen)794)
], axis);
if (sep > halfpi_() - 1e-12) {
setmsg_("Boundary vector at index # has angular separation of # "
"radians from candidate FOV axis. This FOV does not confo"
"rm to the requirements of this routine. Instrument is #.",
(ftnlen)167);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sep, (ftnlen)1);
errch_("#", inst, (ftnlen)1, inst_len);
sigerr_("SPICE(FOVTOOWIDE)", (ftnlen)17);
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
}
}
chkout_("ZZHULLAX", (ftnlen)8);
return 0;
} /* zzhullax_ */
/* $Procedure SCDECD ( Decode spacecraft clock ) */
/* Subroutine */ int scdecd_(integer *sc, doublereal *sclkdp, char *sclkch,
ftnlen sclkch_len)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
doublereal d__1;
/* Builtin functions */
double d_nint(doublereal *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen);
/* Local variables */
integer part, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
doublereal ticks;
extern /* Subroutine */ int scfmt_(integer *, doublereal *, char *,
ftnlen);
doublereal pstop[9999];
extern logical failed_(void);
extern integer lastnb_(char *, ftnlen);
integer prelen;
extern integer lstled_(doublereal *, integer *, doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer suflen;
extern /* Subroutine */ int scpart_(integer *, integer *, doublereal *,
doublereal *), chkout_(char *, ftnlen), prefix_(char *, integer *,
char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), suffix_(char *, integer *, char *, ftnlen,
ftnlen);
integer nparts;
doublereal pstart[9999];
extern logical return_(void);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
doublereal ptotls[9999];
char prtstr[5];
/* $ Abstract */
/* Convert double precision encoding of spacecraft clock time into */
/* a character representation. */
/* $ 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 */
/* SCLK */
/* $ Keywords */
/* CONVERSION */
/* TIME */
/* $ Declarations */
/* $ Abstract */
/* Include file sclk.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters below define sizes and limits used by */
/* the SCLK system. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* See the declaration section below. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */
/* Increased value of maximum coefficient record count */
/* parameter MXCOEF from 10K to 50K. */
/* - SPICELIB Version 1.0.0, 11-FEB-2008 (NJB) */
/* -& */
/* Number of supported SCLK field delimiters: */
/* Supported SCLK string field delimiters: */
/* Maximum number of partitions: */
/* Partition string length. */
/* Since the maximum number of partitions is given by MXPART is */
/* 9999, PRTSTR needs at most 4 characters for the partition number */
/* and one character for the slash. */
/* Maximum number of coefficient records: */
/* Maximum number of fields in an SCLK string: */
/* Length of strings used to represent D.P. */
/* numbers: */
/* Maximum number of supported parallel time systems: */
/* End of include file sclk.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SC I NAIF spacecraft identification code. */
/* SCLKDP I Encoded representation of a spacecraft clock count. */
/* SCLKCH O Character representation of a clock count. */
/* MXPART P Maximum number of spacecraft clock partitions. */
/* $ Detailed_Input */
/* SC is the NAIF integer code of the spacecraft whose */
/* clock's time is being decoded. */
/* SCLKDP is the double precision encoding of a clock time in */
/* units of ticks since the spacecraft clock start time. */
/* This value does reflect partition information. */
/* An analogy may be drawn between a spacecraft clock */
/* and a standard wall clock. The number of ticks */
/* corresponding to the wall clock string */
/* hh:mm:ss */
/* would be the number of seconds represented by that */
/* time. */
/* For example: */
/* Clock string Number of ticks */
/* ------------ --------------- */
/* 00:00:10 10 */
/* 00:01:00 60 */
/* 00:10:00 600 */
/* 01:00:00 3600 */
/* If SCLKDP contains a fractional part the result */
/* is the same as if SCLKDP had been rounded to the */
/* nearest whole number. */
/* $ Detailed_Output */
/* SCLKCH is the character representation of the clock count. */
/* The exact form that SCLKCH takes depends on the */
/* spacecraft. */
/* Nevertheless, SCLKCH will have the following general */
/* format: */
/* 'pp/sclk_string' */
/* 'pp' is an integer greater than or equal to one and */
/* represents a "partition number". */
/* Each mission is divided into some number of partitions. */
/* A new partition starts when the spacecraft clock */
/* resets, either to zero, or to some other */
/* value. Thus, the first partition for any mission */
/* starts with launch, and ends with the first clock */
/* reset. The second partition starts immediately when */
/* the first stopped, and so on. */
/* In order to be completely unambiguous about a */
/* particular time, you need to specify a partition number */
/* along with the standard clock string. */
/* Information about when partitions occur for different */
/* missions is contained in a spacecraft clock kernel */
/* file which needs to be loaded into the kernel pool */
/* before calling SCDECD. */
/* The routine SCPART may be used to read the partition */
/* start and stop times, in encoded units of ticks, from */
/* the kernel file. */
/* Since the end time of one partition is coincident with */
/* the begin time of the next, two different time strings */
/* with different partition numbers can encode into the */
/* same value. */
/* For example, if partition 1 ends at time t1, and */
/* partition 2 starts at time t2, then */
/* '1/t1' and '2/t2' */
/* will be encoded into the same value, say X. SCDECD */
/* always decodes such values into the latter of the */
/* two partitions. In this example, */
/* CALL SCDECD ( X, SC, CLKSTR ) */
/* will result in */
/* CLKSTR = '2/t2'. */
/* 'sclk_string' is a spacecraft specific clock string, */
/* typically consisting of a number of components */
/* separated by delimiters. */
/* Using Galileo as an example, the full format is */
/* wwwwwwww:xx:y:z */
/* where z is a mod-8 counter (values 0-7) which */
/* increments approximately once every 8 1/3 ms., y is a */
/* mod-10 counter (values 0-9) which increments once */
/* every time z turns over, i.e., approximately once every */
/* 66 2/3 ms., xx is a mod-91 (values 0-90) counter */
/* which increments once every time y turns over, i.e., */
/* once every 2/3 seconds. wwwwwwww is the Real-Time Image */
/* Count (RIM), which increments once every time xx turns */
/* over, i.e., once every 60 2/3 seconds. The roll-over */
/* expression for the RIM is 16777215, which corresponds */
/* to approximately 32 years. */
/* wwwwwwww, xx, y, and z are referred to interchangeably */
/* as the fields or components of the spacecraft clock. */
/* SCLK components may be separated by any of these five */
/* characters: ' ' ':' ',' '-' '.' */
/* The delimiter used is determined by a kernel pool */
/* variable and can be adjusted by the user. */
/* Some spacecraft clock components have offset, or */
/* starting, values different from zero. For example, */
/* with an offset value of 1, a mod 20 counter would */
/* cycle from 1 to 20 instead of from 0 to 19. */
/* See the SCLK required reading for a detailed */
/* description of the Voyager and Mars Observer clock */
/* formats. */
/* $ Parameters */
/* MXPART is the maximum number of spacecraft clock partitions */
/* expected in the kernel file for any one spacecraft. */
/* See the INCLUDE file sclk.inc for this parameter's */
/* value. */
/* $ Exceptions */
/* 1) If kernel variables required by this routine are unavailable, */
/* the error will be diagnosed by routines called by this routine. */
/* SCLKCH will be returned as a blank string in this case. */
/* 2) If the number of partitions in the kernel file for spacecraft */
/* SC exceeds the parameter MXPART, the error */
/* 'SPICE(TOOMANYPARTS)' is signaled. SCLKCH will be returned */
/* as a blank string in this case. */
/* 3) If the encoded value does not fall in the boundaries of the */
/* mission, the error 'SPICE(VALUEOUTOFRANGE)' is signaled. */
/* SCLKCH will be returned as a blank string in this case. */
/* 4) If the declared length of SCLKCH is not large enough to */
/* contain the output clock string the error */
/* 'SPICE(SCLKTRUNCATED)' is signaled either by this routine */
/* or by a routine called by this routine. On output SCLKCH */
/* will contain a portion of the truncated clock string. */
/* $ Files */
/* A kernel file containing spacecraft clock partition information */
/* for the desired spacecraft must be loaded, using the routine */
/* FURNSH, before calling this routine. */
/* $ Particulars */
/* In general, it is difficult to compare spacecraft clock counts */
/* numerically since there are too many clock components for a */
/* single comparison. The routine SCENCD provides a method of */
/* assigning a single double precision number to a spacecraft's */
/* clock count, given one of its character representations. */
/* This routine performs the inverse operation to SCENCD, converting */
/* an encoded double precision number to character format. */
/* To convert the number of ticks since the start of the mission to */
/* a clock format character string, SCDECD: */
/* 1) Determines the spacecraft clock partition that TICKS falls */
/* in. */
/* 2) Subtracts off the number of ticks occurring in previous */
/* partitions, to get the number of ticks since the beginning */
/* of the current partition. */
/* 3) Converts the resulting ticks to clock format and forms the */
/* string */
/* 'partition_number/clock_string' */
/* $ Examples */
/* Double precision encodings of spacecraft clock counts are used to */
/* tag pointing data in the C-kernel. */
/* In the following example, pointing for a sequence of images from */
/* the Voyager 2 narrow angle camera is requested from the C-kernel */
/* using an array of character spacecraft clock counts as input. */
/* The clock counts attached to the output are then decoded to */
/* character and compared with the input strings. */
/* CHARACTER*(25) CLKIN ( 4 ) */
/* CHARACTER*(25) CLKOUT */
/* CHARACTER*(25) CLKTOL */
/* DOUBLE PRECISION TIMEIN */
/* DOUBLE PRECISION TIMOUT */
/* DOUBLE PRECISION CMAT ( 3, 3 ) */
/* INTEGER NPICS */
/* INTEGER SC */
/* DATA NPICS / 4 / */
/* DATA CLKIN / '2/20538:39:768', */
/* . '2/20543:21:768', */
/* . '2/20550:37', */
/* . '2/20561:59' / */
/* DATA CLKTOL / ' 0:01:000' / */
/* C */
/* C The instrument we want pointing for is the Voyager 2 */
/* C narrow angle camera. The reference frame we want is */
/* C J2000. The spacecraft is Voyager 2. */
/* C */
/* INST = -32001 */
/* REF = 'J2000' */
/* SC = -32 */
/* C */
/* C Load the appropriate files. We need */
/* C */
/* C 1) CK file containing pointing data. */
/* C 2) Spacecraft clock kernel file, for SCENCD and SCDECD. */
/* C */
/* CALL CKLPF ( 'VGR2NA.CK' ) */
/* CALL FURNSH ( 'SCLK.KER' ) */
/* C */
/* C Convert the tolerance string to ticks. */
/* C */
/* CALL SCTIKS ( SC, CLKTOL, TOL ) */
/* DO I = 1, NPICS */
/* CALL SCENCD ( SC, CLKIN( I ), TIMEIN ) */
/* CALL CKGP ( INST, TIMEIN, TOL, REF, CMAT, TIMOUT, */
/* . FOUND ) */
/* CALL SCDECD ( SC, TIMOUT, CLKOUT ) */
/* WRITE (*,*) */
/* WRITE (*,*) 'Input s/c clock count: ', CLKIN( I ) */
/* WRITE (*,*) 'Output s/c clock count: ', CLKOUT */
/* WRITE (*,*) 'Output C-Matrix: ', CMAT */
/* END DO */
/* The output from such a program might look like: */
/* Input s/c clock count: 2/20538:39:768 */
/* Output s/c clock count: 2/20538:39:768 */
/* Output C-Matrix: 'first C-matrix' */
/* Input s/c clock count: 2/20543:21:768 */
/* Output s/c clock count: 2/20543:22:768 */
/* Output C-Matrix: 'second C-matrix' */
/* Input s/c clock count: 2/20550:37 */
/* Output s/c clock count: 2/20550:36:768 */
/* Output C-Matrix: 'third C-matrix' */
/* Input s/c clock count: 2/20561:59 */
/* Output s/c clock count: 2/20561:58:768 */
/* Output C-Matrix: 'fourth C-matrix' */
/* $ Restrictions */
/* 1) Assumes that an SCLK kernel file appropriate for the clock */
/* designated by SC is loaded in the kernel pool at the time */
/* this routine is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* J.M. Lynch (JPL) */
/* R.E. Thurman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */
/* Values of parameter MXPART and PARTLN are now */
/* provided by the INCLUDE file sclk.inc. */
/* - SPICELIB Version 2.0.1, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 2.0.0, 17-APR-1992 (JML) (WLT) */
/* The routine was changed to signal an error when SCLKCH is */
/* not long enough to contain the output spacecraft clock */
/* string. */
/* FAILED is now checked after calling SCPART. */
/* References to CLPOOL were deleted. */
/* Miscellaneous minor updates to the header were performed. */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 06-SEP-1990 (JML) (RET) */
/* -& */
/* $ Index_Entries */
/* decode spacecraft_clock */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 10-APR-1992 (JML) (WLT) */
/* The routine was changed to signal an error when SCLKCH is */
/* not long enough to contain the output spacecraft clock */
/* string. Previously, the SCLK routines simply truncated */
/* the clock string on the right. It was determined that */
/* since this truncation could easily go undetected by the */
/* user ( only the leftmost field of a clock string is */
/* required when clock string is used as an input to a */
/* SCLK routine ), it would be better to signal an error */
/* when this happens. */
/* FAILED is checked after calling SCPART in case an */
/* error has occurred reading the kernel file and the */
/* error action is not set to 'abort'. */
/* References to CLPOOL were deleted. */
/* Miscellaneous minor updates to the header were performed. */
/* 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_("SCDECD", (ftnlen)6);
}
/* Use a working copy of the input. */
ticks = d_nint(sclkdp);
s_copy(sclkch, " ", sclkch_len, (ftnlen)1);
/* Read the partition start and stop times (in ticks) for this */
/* mission. Error if there are too many of them. Also need to */
/* check FAILED in case error handling is not in ABORT or */
/* DEFAULT mode. */
scpart_(sc, &nparts, pstart, pstop);
if (failed_()) {
chkout_("SCDECD", (ftnlen)6);
return 0;
}
if (nparts > 9999) {
setmsg_("The number of partitions, #, for spacecraft # exceeds the v"
"alue for parameter MXPART, #.", (ftnlen)88);
errint_("#", &nparts, (ftnlen)1);
errint_("#", sc, (ftnlen)1);
errint_("#", &c__9999, (ftnlen)1);
sigerr_("SPICE(TOOMANYPARTS)", (ftnlen)19);
chkout_("SCDECD", (ftnlen)6);
return 0;
}
/* For each partition, compute the total number of ticks in that */
/* partition plus all preceding partitions. */
d__1 = pstop[0] - pstart[0];
ptotls[0] = d_nint(&d__1);
i__1 = nparts;
for (i__ = 2; i__ <= i__1; ++i__) {
d__1 = ptotls[(i__3 = i__ - 2) < 9999 && 0 <= i__3 ? i__3 : s_rnge(
"ptotls", i__3, "scdecd_", (ftnlen)495)] + pstop[(i__4 = i__
- 1) < 9999 && 0 <= i__4 ? i__4 : s_rnge("pstop", i__4, "scd"
"ecd_", (ftnlen)495)] - pstart[(i__5 = i__ - 1) < 9999 && 0 <=
i__5 ? i__5 : s_rnge("pstart", i__5, "scdecd_", (ftnlen)495)];
ptotls[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls",
i__2, "scdecd_", (ftnlen)495)] = d_nint(&d__1);
}
/* The partition corresponding to the input ticks is the first one */
/* whose tick total is greater than the input value. The one */
/* exception is when the input ticks is equal to the total number */
/* of ticks represented by all the partitions. In this case the */
/* partition number is the last one, i.e. NPARTS. */
/* Error if TICKS comes before the first partition (that is, if it's */
/* negative), or after the last one. */
if (ticks == ptotls[(i__1 = nparts - 1) < 9999 && 0 <= i__1 ? i__1 :
s_rnge("ptotls", i__1, "scdecd_", (ftnlen)510)]) {
part = nparts;
} else {
part = lstled_(&ticks, &nparts, ptotls) + 1;
}
if (ticks < 0. || part > nparts) {
setmsg_("Value for ticks, #, does not fall in any partition for spac"
"ecraft #.", (ftnlen)68);
errdp_("#", &ticks, (ftnlen)1);
errint_("#", sc, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("SCDECD", (ftnlen)6);
return 0;
}
/* To get the count in this partition, subtract off the total of */
/* the preceding partition counts and add the beginning count for */
/* this partition. */
if (part == 1) {
ticks += pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 : s_rnge(
"pstart", i__1, "scdecd_", (ftnlen)535)];
} else {
ticks = ticks + pstart[(i__1 = part - 1) < 9999 && 0 <= i__1 ? i__1 :
s_rnge("pstart", i__1, "scdecd_", (ftnlen)537)] - ptotls[(
i__2 = part - 2) < 9999 && 0 <= i__2 ? i__2 : s_rnge("ptotls",
i__2, "scdecd_", (ftnlen)537)];
}
/* Now create the output SCLK clock string. */
/* First convert from ticks to clock string format. */
scfmt_(sc, &ticks, sclkch, sclkch_len);
/* Now convert the partition number to a character string and prefix */
/* it to the output string. */
intstr_(&part, prtstr, (ftnlen)5);
suffix_("/", &c__0, prtstr, (ftnlen)1, (ftnlen)5);
prelen = lastnb_(prtstr, (ftnlen)5);
suflen = lastnb_(sclkch, sclkch_len);
if (i_len(sclkch, sclkch_len) - suflen < prelen) {
setmsg_("Output string too short to contain clock string. Input tick"
" value: #, requires string of length #, but declared length "
"is #.", (ftnlen)124);
errdp_("#", sclkdp, (ftnlen)1);
i__1 = prelen + suflen;
errint_("#", &i__1, (ftnlen)1);
i__1 = i_len(sclkch, sclkch_len);
errint_("#", &i__1, (ftnlen)1);
sigerr_("SPICE(SCLKTRUNCATED)", (ftnlen)20);
chkout_("SCDECD", (ftnlen)6);
return 0;
}
prefix_(prtstr, &c__0, sclkch, (ftnlen)5, sclkch_len);
chkout_("SCDECD", (ftnlen)6);
return 0;
} /* scdecd_ */
/* $Procedure SPKW21 ( Write SPK segment, type 21 ) */
/* Subroutine */ int spkw21_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
integer *n, integer *dlsize, doublereal *dlines, doublereal *epochs,
ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer dlines_dim1, dlines_offset, i__1, i__2, i__3;
doublereal d__1;
/* Local variables */
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *,
integer *), dafbna_(integer *, doublereal *, char *, ftnlen),
dafena_(void);
extern logical failed_(void);
integer chrcod, refcod, maxdim;
extern integer lastnb_(char *, ftnlen);
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen);
doublereal prvepc;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
integer maxdsz;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen), spkpds_(
integer *, integer *, char *, integer *, doublereal *, doublereal
*, doublereal *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Write a type 21 segment to an SPK file. */
/* $ 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 */
/* NAIF_IDS */
/* SPK */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* FILES */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 21. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 25-DEC-2013 (NJB) */
/* -& */
/* MAXTRM is the maximum number of terms allowed in each */
/* component of the difference table contained in a type */
/* 21 SPK difference line. MAXTRM replaces the fixed */
/* table parameter value of 15 used in SPK type 1 */
/* segments. */
/* Type 21 segments have variable size. Let MAXDIM be */
/* the dimension of each component of the difference */
/* table within each difference line. Then the size */
/* DLSIZE of the difference line is */
/* ( 4 * MAXDIM ) + 11 */
/* MAXTRM is the largest allowed value of MAXDIM. */
/* End of include file spk21.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I NAIF code for an ephemeris object. */
/* CENTER I NAIF code for center of motion of BODY. */
/* FRAME I Reference frame name. */
/* FIRST I Start time of interval covered by segment. */
/* LAST I End time of interval covered by segment. */
/* SEGID I Segment identifier. */
/* N I Number of difference lines in segment. */
/* DLSIZE I Difference line size. */
/* DLINES I Array of difference lines. */
/* EPOCHS I Coverage end times of difference lines. */
/* MAXTRM P Maximum number of terms per difference table */
/* component. */
/* $ Detailed_Input */
/* HANDLE is the file handle of an SPK file that has been */
/* opened for writing. */
/* BODY is the NAIF integer code for an ephemeris object */
/* whose state relative to another body is described */
/* by the segment to be created. */
/* CENTER is the NAIF integer code for the center of motion */
/* of the object identified by BODY. */
/* FRAME is the NAIF name for a reference frame relative to */
/* which the state information for BODY is specified. */
/* FIRST, */
/* LAST are, respectively, the start and stop times of */
/* the time interval over which the segment defines */
/* the state of BODY. */
/* SEGID is the segment identifier. An SPK segment */
/* identifier may contain up to 40 characters. */
/* N is the number of difference lines in the input */
/* difference line array. */
/* DLSIZE is the size of each difference line data structure */
/* in the difference line array input DLINES. Let */
/* MAXDIM be the dimension of each component of the */
/* difference table within each difference line. Then */
/* the size DLSIZE of the difference line is */
/* ( 4 * MAXDIM ) + 11 */
/* DLINES contains a time-ordered array of difference lines. */
/* The Ith difference line occupies elements (1,I) */
/* through (MAXDIM,I) of DLINES, where MAXDIM is */
/* as described above in the description of DLSIZE. */
/* Each difference line represents the state (x, y, */
/* z, dx/dt, dy/dt, dz/dt, in kilometers and */
/* kilometers per second) of BODY relative to CENTER, */
/* specified relative to FRAME, for an interval of */
/* time. The time interval covered by the Ith */
/* difference line ends at the Ith element of the */
/* array EPOCHS (described below). The interval */
/* covered by the first difference line starts at the */
/* segment start time. */
/* The contents of a difference line are as shown */
/* below: */
/* Dimension Description */
/* --------- ---------------------------------- */
/* 1 Reference epoch of difference line */
/* MAXDIM Stepsize function vector */
/* 1 Reference position vector, x */
/* 1 Reference velocity vector, x */
/* 1 Reference position vector, y */
/* 1 Reference velocity vector, y */
/* 1 Reference position vector, z */
/* 1 Reference velocity vector, z */
/* MAXDIM,3 Modified divided difference */
/* arrays (MDAs) */
/* 1 Maximum integration order plus 1 */
/* 3 Integration order array */
/* The reference position and velocity are those of */
/* BODY relative to CENTER at the reference epoch. */
/* (A difference line is essentially a polynomial */
/* expansion of acceleration about the reference */
/* epoch.) */
/* EPOCHS is an array of epochs corresponding to the members */
/* of the difference line array. The epochs are */
/* specified as seconds past J2000 TDB. */
/* The first difference line covers the time interval */
/* from the segment start time to EPOCHS(1). For */
/* I > 1, the Ith difference line covers the half-open */
/* time interval from, but not including, EPOCHS(I-1) */
/* through EPOCHS(I). */
/* The elements of EPOCHS must be strictly increasing. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* MAXTRM is the maximum number of terms allowed in */
/* each component of the difference table */
/* contained in the input argument RECORD. */
/* See the INCLUDE file spk21.inc for the value */
/* of MAXTRM. */
/* $ Exceptions */
/* If any of the following exceptions occur, this routine will return */
/* without creating a new segment. */
/* 1) If FRAME is not a recognized name, the error */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 2) If the last non-blank character of SEGID occurs past index 40, */
/* the error SPICE(SEGIDTOOLONG) is signaled. */
/* 3) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signaled. */
/* 4) If the number of difference lines N is not at least one, */
/* the error SPICE(INVALIDCOUNT) will be signaled. */
/* 5) If FIRST is greater than LAST then the error */
/* SPICE(BADDESCRTIMES) will be signaled. */
/* 6) If the elements of the array EPOCHS are not in strictly */
/* increasing order, the error SPICE(TIMESOUTOFORDER) will be */
/* signaled. */
/* 7) If the last epoch EPOCHS(N) is less than LAST, the error */
/* SPICE(COVERAGEGAP) will be signaled. */
/* 8) If DLSIZE is greater than the limit */
/* ( 4 * MAXTRM ) + 11 */
/* the error SPICE(DIFFLINETOOLARGE) will be signaled. If */
/* DLSIZE is less than 71, the error SPICE(DIFFLINETOOSMALL) */
/* will be signaled. */
/* 9) If any value in the step size array of any difference */
/* line is zero, the error SPICE(ZEROSTEP) will be signaled. */
/* $ Files */
/* A new type 21 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 21 data segment to the open SPK */
/* file according to the format described in the type 21 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* $ Examples */
/* Suppose that you have difference lines and are prepared to */
/* produce a segment of type 21 in an SPK file. */
/* The following code fragment could be used to add the new segment */
/* to a previously opened SPK file attached to HANDLE. The file must */
/* have been opened with write access. */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_SPK_TYPE_21_SEGMENT' */
/* C */
/* C Write the segment. */
/* C */
/* CALL SPKW21 ( HANDLE, BODY, CENTER, FRAME, */
/* . FIRST, LAST, SEGID, N, */
/* . DLSIZE, DLINES, EPOCHS ) */
/* $ Restrictions */
/* 1) The validity of the difference lines is not checked by */
/* this routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 03-FEB-2014 (NJB) */
/* -& */
/* $ Index_Entries */
/* write spk type_21 ephemeris data segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* MINDSZ is the minimum MDA size; this is the size */
/* of type 1 MDAs. */
/* Local variables */
/* Local variables */
/* Standard SPICE error handling. */
/* Parameter adjustments */
dlines_dim1 = *dlsize;
dlines_offset = dlines_dim1 + 1;
/* Function Body */
if (return_()) {
return 0;
}
chkin_("SPKW21", (ftnlen)6);
/* Make sure the difference line size is within limits. */
maxdsz = 111;
if (*dlsize > maxdsz) {
setmsg_("The input difference line size is #, while the maximum supp"
"orted by this routine is #. It is possible that this problem"
" is due to your SPICE Toolkit being out of date.", (ftnlen)
167);
errint_("#", dlsize, (ftnlen)1);
errint_("#", &maxdsz, (ftnlen)1);
sigerr_("SPICE(DIFFLINETOOLARGE)", (ftnlen)23);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
if (*dlsize < 71) {
setmsg_("The input difference line size is #, while the minimum supp"
"orted by this routine is #. It is possible that this problem"
" is due to your SPICE Toolkit being out of date.", (ftnlen)
167);
errint_("#", dlsize, (ftnlen)1);
errint_("#", &c__71, (ftnlen)1);
sigerr_("SPICE(DIFFLINETOOSMALL)", (ftnlen)23);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
namfrm_(frame, &refcod, frame_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", frame, (ftnlen)1, frame_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Now check that all the characters in the segment identifier */
/* can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
chrcod = *(unsigned char *)&segid[i__ - 1];
if (chrcod < 32 || chrcod > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
}
/* The difference line count must be at least one. */
if (*n < 1) {
setmsg_("The difference line count was #; the count must be at least"
" one.", (ftnlen)64);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* The segment stop time should be greater than or equal to */
/* the begin time. */
if (*first > *last) {
setmsg_("The segment start time: # is greater than the segment end t"
"ime: #", (ftnlen)65);
errdp_("#", first, (ftnlen)1);
errdp_("#", last, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Make sure the epochs form a strictly increasing sequence. */
prvepc = epochs[0];
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
if (epochs[i__ - 1] <= prvepc) {
setmsg_("EPOCH # having index # is not greater than its predeces"
"sor #.", (ftnlen)61);
errdp_("#", &epochs[i__ - 1], (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &epochs[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
prvepc = epochs[i__ - 1];
}
/* Make sure there's no gap between the last difference line */
/* epoch and the end of the time interval defined by the segment */
/* descriptor. */
if (epochs[*n - 1] < *last) {
setmsg_("Segment has coverage gap: segment end time # follows last e"
"poch #.", (ftnlen)66);
errdp_("#", last, (ftnlen)1);
errdp_("#", &epochs[*n - 1], (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* Check the step size vectors in the difference lines. */
maxdim = (*dlsize - 11) / 4;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = maxdim + 1;
for (j = 2; j <= i__2; ++j) {
if (dlines[j + i__ * dlines_dim1 - dlines_offset] == 0.) {
setmsg_("Step size was zero at step size vector index # with"
"in difference line #.", (ftnlen)72);
i__3 = j - 1;
errint_("#", &i__3, (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROSTEP)", (ftnlen)15);
chkout_("SPKW21", (ftnlen)6);
return 0;
}
}
}
/* If we made it this far, we're ready to start writing the segment. */
/* Create the segment descriptor. */
spkpds_(body, center, frame, &c__21, first, last, descr, frame_len);
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW21", (ftnlen)6);
return 0;
}
/* The type 21 segment structure is shown below: */
/* +-----------------------+ */
/* | Difference line 1 | */
/* +-----------------------+ */
/* | Difference line 2 | */
/* +-----------------------+ */
/* ... */
/* +-----------------------+ */
/* | Difference line N | */
/* +-----------------------+ */
/* | Epoch 1 | */
/* +-----------------------+ */
/* | Epoch 2 | */
/* +-----------------------+ */
/* ... */
/* +-----------------------+ */
/* | Epoch N | */
/* +-----------------------+ */
/* | Epoch 100 | (First directory) */
/* +-----------------------+ */
/* ... */
/* +-----------------------+ */
/* | Epoch (N/100)*100 | (Last directory) */
/* +-----------------------+ */
/* | Max diff table size | */
/* +-----------------------+ */
/* | Number of diff lines | */
/* +-----------------------+ */
i__1 = *n * *dlsize;
dafada_(dlines, &i__1);
dafada_(epochs, n);
i__1 = *n / 100;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&epochs[i__ * 100 - 1], &c__1);
}
d__1 = (doublereal) maxdim;
dafada_(&d__1, &c__1);
d__1 = (doublereal) (*n);
dafada_(&d__1, &c__1);
/* As long as nothing went wrong, end the segment. */
if (! failed_()) {
dafena_();
}
chkout_("SPKW21", (ftnlen)6);
return 0;
} /* spkw21_ */
/* $Procedure CKW01 ( C-Kernel, write segment to C-kernel, data type 1 ) */
/* Subroutine */ int ckw01_(integer *handle, doublereal *begtim, doublereal *
endtim, integer *inst, char *ref, logical *avflag, char *segid,
integer *nrec, doublereal *sclkdp, doublereal *quats, doublereal *
avvs, ftnlen ref_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Local variables */
integer ndir, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
integer index, value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafada_(
doublereal *, integer *), dafbna_(integer *, doublereal *, char *,
ftnlen), dafena_(void);
extern logical failed_(void);
integer refcod;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
doublereal dirent;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical vzerog_(doublereal *, integer *), return_(void);
doublereal dcd[2];
integer icd[6];
/* $ Abstract */
/* Add a type 1 segment to a C-kernel. */
/* $ 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 */
/* DAF */
/* SCLK */
/* $ Keywords */
/* POINTING */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an open CK file. */
/* BEGTIM I The beginning encoded SCLK of the segment. */
/* ENDTIM I The ending encoded SCLK of the segment. */
/* INST I The NAIF instrument ID code. */
/* REF I The reference frame of the segment. */
/* AVFLAG I True if the segment will contain angular velocity. */
/* SEGID I Segment identifier. */
/* NREC I Number of pointing records. */
/* SCLKDP I Encoded SCLK times. */
/* QUATS I SPICE quaternions representing instrument pointing. */
/* AVVS I Angular velocity vectors. */
/* $ Detailed_Input */
/* HANDLE is the handle of the CK file to which the segment will */
/* be written. The file must have been opened with write */
/* access. */
/* BEGTIM is the beginning encoded SCLK time of the segment. This */
/* value should be less than or equal to the first time in */
/* the segment. */
/* ENDTIM is the encoded SCLK time at which the segment ends. */
/* This value should be greater than or equal to the last */
/* time in the segment. */
/* INST is the NAIF integer ID code for the instrument. */
/* REF is a character string which specifies the */
/* reference frame of the segment. This should be one of */
/* the frames supported by the SPICELIB routine NAMFRM */
/* which is an entry point of FRAMEX. */
/* AVFLAG is a logical flag which indicates whether or not the */
/* segment will contain angular velocity. */
/* SEGID is the segment identifier. A CK segment identifier may */
/* contain up to 40 characters. */
/* NREC is the number of pointing instances in the segment. */
/* SCLKDP are the encoded spacecraft clock times associated with */
/* each pointing instance. These times must be strictly */
/* increasing. */
/* QUATS is an array of SPICE-style quaternions representing a */
/* sequence of C-matrices. See the discussion of */
/* quaternion styles in Particulars below. */
/* AVVS are the angular velocity vectors ( optional ). */
/* If AVFLAG is FALSE then this array is ignored by the */
/* routine, however it still must be supplied as part of */
/* the calling sequence. */
/* $ Detailed_Output */
/* None. See Files section. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If HANDLE is not the handle of a C-kernel opened for writing */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* 2) If SEGID is more than 40 characters long, the error */
/* SPICE(SEGIDTOOLONG) is signalled. */
/* 3) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signalled. */
/* 4) If the first encoded SCLK time is negative then the error */
/* SPICE(INVALIDSCLKTIME) is signalled. If any subsequent times */
/* are negative the error SPICE(TIMESOUTOFORDER) is signalled. */
/* 5) If the encoded SCLK times are not strictly increasing, */
/* the error SPICE(TIMESOUTOFORDER) is signalled. */
/* 6) If BEGTIM is greater than SCLKDP(1) or ENDTIM is less than */
/* SCLKDP(NREC), the error SPICE(INVALIDDESCRTIME) is */
/* signalled. */
/* 7) If the name of the reference frame is not one of those */
/* supported by the routine NAMFRM, the error */
/* SPICE(INVALIDREFFRAME) is signalled. */
/* 8) If NREC, the number of pointing records, is less than or */
/* equal to 0, the error SPICE(INVALIDNUMRECS) is signalled. */
/* 9) If the squared length of any quaternion differes from 1 */
/* by more than 1.0D-2, the error SPICE(NONUNITQUATERNION) is */
/* signalled. */
/* $ Files */
/* This routine adds a type 1 segment to a C-kernel. The C-kernel */
/* may be either a new one or an existing one opened for writing. */
/* $ Particulars */
/* For a detailed description of a type 1 CK segment please see the */
/* CK Required Reading. */
/* This routine relieves the user from performing the repetitive */
/* calls to the DAF routines necessary to construct a CK segment. */
/* Quaternion Styles */
/* ----------------- */
/* There are different "styles" of quaternions used in */
/* science and engineering applications. Quaternion styles */
/* are characterized by */
/* - The order of quaternion elements */
/* - The quaternion multiplication formula */
/* - The convention for associating quaternions */
/* with rotation matrices */
/* Two of the commonly used styles are */
/* - "SPICE" */
/* > Invented by Sir William Rowan Hamilton */
/* > Frequently used in mathematics and physics textbooks */
/* - "Engineering" */
/* > Widely used in aerospace engineering applications */
/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */
/* Quaternions of any other style must be converted to SPICE */
/* quaternions before they are passed to SPICELIB routines. */
/* Relationship between SPICE and Engineering Quaternions */
/* ------------------------------------------------------ */
/* Let M be a rotation matrix such that for any vector V, */
/* M*V */
/* is the result of rotating V by theta radians in the */
/* counterclockwise direction about unit rotation axis vector A. */
/* Then the SPICE quaternions representing M are */
/* (+/-) ( cos(theta/2), */
/* sin(theta/2) A(1), */
/* sin(theta/2) A(2), */
/* sin(theta/2) A(3) ) */
/* while the engineering quaternions representing M are */
/* (+/-) ( -sin(theta/2) A(1), */
/* -sin(theta/2) A(2), */
/* -sin(theta/2) A(3), */
/* cos(theta/2) ) */
/* For both styles of quaternions, if a quaternion q represents */
/* a rotation matrix M, then -q represents M as well. */
/* Given an engineering quaternion */
/* QENG = ( q0, q1, q2, q3 ) */
/* the equivalent SPICE quaternion is */
/* QSPICE = ( q3, -q0, -q1, -q2 ) */
/* Associating SPICE Quaternions with Rotation Matrices */
/* ---------------------------------------------------- */
/* Let FROM and TO be two right-handed reference frames, for */
/* example, an inertial frame and a spacecraft-fixed frame. Let the */
/* symbols */
/* V , V */
/* FROM TO */
/* denote, respectively, an arbitrary vector expressed relative to */
/* the FROM and TO frames. Let M denote the transformation matrix */
/* that transforms vectors from frame FROM to frame TO; then */
/* V = M * V */
/* TO FROM */
/* where the expression on the right hand side represents left */
/* multiplication of the vector by the matrix. */
/* Then if the unit-length SPICE quaternion q represents M, where */
/* q = (q0, q1, q2, q3) */
/* the elements of M are derived from the elements of q as follows: */
/* +- -+ */
/* | 2 2 | */
/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */
/* | | */
/* | | */
/* | 2 2 | */
/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */
/* | | */
/* | | */
/* | 2 2 | */
/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */
/* | | */
/* +- -+ */
/* Note that substituting the elements of -q for those of q in the */
/* right hand side leaves each element of M unchanged; this shows */
/* that if a quaternion q represents a matrix M, then so does the */
/* quaternion -q. */
/* To map the rotation matrix M to a unit quaternion, we start by */
/* decomposing the rotation matrix as a sum of symmetric */
/* and skew-symmetric parts: */
/* 2 */
/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */
/* symmetric skew-symmetric */
/* OMEGA is a skew-symmetric matrix of the form */
/* +- -+ */
/* | 0 -n3 n2 | */
/* | | */
/* OMEGA = | n3 0 -n1 | */
/* | | */
/* | -n2 n1 0 | */
/* +- -+ */
/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */
/* of M and theta is M's rotation angle. Note that N and theta */
/* are not unique. */
/* Let */
/* C = cos(theta/2) */
/* S = sin(theta/2) */
/* Then the unit quaternions Q corresponding to M are */
/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */
/* The mappings between quaternions and the corresponding rotations */
/* are carried out by the SPICELIB routines */
/* Q2M {quaternion to matrix} */
/* M2Q {matrix to quaternion} */
/* M2Q always returns a quaternion with scalar part greater than */
/* or equal to zero. */
/* SPICE Quaternion Multiplication Formula */
/* --------------------------------------- */
/* Given a SPICE quaternion */
/* Q = ( q0, q1, q2, q3 ) */
/* corresponding to rotation axis A and angle theta as above, we can */
/* represent Q using "scalar + vector" notation as follows: */
/* s = q0 = cos(theta/2) */
/* v = ( q1, q2, q3 ) = sin(theta/2) * A */
/* Q = s + v */
/* Let Q1 and Q2 be SPICE quaternions with respective scalar */
/* and vector parts s1, s2 and v1, v2: */
/* Q1 = s1 + v1 */
/* Q2 = s2 + v2 */
/* We represent the dot product of v1 and v2 by */
/* <v1, v2> */
/* and the cross product of v1 and v2 by */
/* v1 x v2 */
/* Then the SPICE quaternion product is */
/* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */
/* If Q1 and Q2 represent the rotation matrices M1 and M2 */
/* respectively, then the quaternion product */
/* Q1*Q2 */
/* represents the matrix product */
/* M1*M2 */
/* $ Examples */
/* C */
/* C This example writes a type 1 C-kernel segment for the */
/* C Galileo scan platform to a previously opened file attached to */
/* C HANDLE. */
/* C */
/* C Assume arrays of quaternions, angular velocities, and the */
/* C associated SCLK times are produced elsewhere. */
/* C */
/* . */
/* . */
/* . */
/* C */
/* C The subroutine CKW01 needs the following items for the */
/* C segment descriptor: */
/* C */
/* C 1) SCLK limits of the segment. */
/* C 2) Instrument code. */
/* C 3) Reference frame. */
/* C 4) The angular velocity flag. */
/* C */
/* BEGTIM = SCLK ( 1 ) */
/* ENDTIM = SCLK ( NREC ) */
/* INST = -77001 */
/* REF = 'J2000' */
/* AVFLAG = .TRUE. */
/* SEGID = 'GLL SCAN PLT - DATA TYPE 1' */
/* C */
/* C Write the segment. */
/* C */
/* CALL CKW01 ( HANDLE, BEGTIM, ENDTIM, INST, REF, AVFLAG, */
/* . SEGID, NREC, SCLKDP, QUATS, AVVS ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 3.0.0, 01-JUN-2010 (NJB) */
/* The check for non-unit quaternions has been replaced */
/* with a check for zero-length quaternions. */
/* - SPICELIB Version 2.2.0, 26-FEB-2008 (NJB) */
/* Updated header; added information about SPICE */
/* quaternion conventions. */
/* Minor typo in a long error message was corrected. */
/* - SPICELIB Version 2.1.0, 22-FEB-1999 (WLT) */
/* Added check to make sure that all quaternions are unit */
/* length to single precision. */
/* - SPICELIB Version 2.0.0, 28-DEC-1993 (WLT) */
/* The routine was upgraded to support non-inertial reference */
/* frames. */
/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */
/* Removed all references to a specific method of opening the CK */
/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */
/* $ Files, and $ Examples sections of the header. It is assumed */
/* that a person using this routine has some knowledge of the DAF */
/* system and the methods for obtaining file handles. */
/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */
/* If the number of pointing records is not positive an error */
/* is now signalled. */
/* FAILED is checked after the call to DAFBNA. */
/* The variable HLDCLK was removed from the loop where the times */
/* were checked. */
/* - 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, 30-AUG-1991 (JML) (NJB) */
/* -& */
/* $ Index_Entries */
/* write ck type_1 pointing data segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.1, 05-SEP-1993 (KRG) */
/* Removed all references to a specific method of opening the CK */
/* file in the $ Brief_I/O, $ Detailed_Input, $ Exceptions, */
/* $ Files, and $ Examples sections of the header. It is assumed */
/* that a person using this routine has some knowledge of the DAF */
/* system and the methods for obtaining file handles. */
/* - SPICELIB Version 1.1.0, 25-NOV-1992 (JML) */
/* If the number of pointing records is not positive an error */
/* is now signalled. */
/* FAILED is checked after the call to DAFBNA. */
/* The variable HLDCLK was removed from the loop where the times */
/* were checked. */
/* - 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, 30-AUG-1991 (JML) (NJB) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* SIDLEN is the maximum number of characters allowed in a CK */
/* segment identifier. */
/* NDC is the size of a packed CK segment descriptor. */
/* ND is the number of double precision components in a CK */
/* segment descriptor. */
/* NI is the number of integer components in a CK segment */
/* descriptor. */
/* DTYPE is the data type of the segment that this routine */
/* operates on. */
/* FPRINT is the integer value of the first printable ASCII */
/* character. */
/* LPRINT is the integer value of the last printable ASCII */
/* character. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKW01", (ftnlen)5);
/* The first thing that we will do is create the segment descriptor. */
/* The structure of the segment descriptor is as follows. */
/* DCD( 1 ) and DCD( 2 ) -- SCLK limits of the segment. */
/* ICD( 1 ) -- Instrument code. */
/* ICD( 2 ) -- Reference frame ID. */
/* ICD( 3 ) -- Data type of the segment. */
/* ICD( 4 ) -- Angular rates flag. */
/* ICD( 5 ) -- Beginning address of segment. */
/* ICD( 6 ) -- Ending address of segment. */
/* Make sure that there is a positive number of pointing records. */
if (*nrec <= 0) {
setmsg_("# is an invalid number of pointing instances for type 1.", (
ftnlen)56);
errint_("#", nrec, (ftnlen)1);
sigerr_("SPICE(INVALIDNUMREC)", (ftnlen)20);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Check that the SCLK bounds on the segment are reasonable. */
if (*begtim > sclkdp[0]) {
setmsg_("The first d.p. component of the descriptor is invalid. DCD("
"1) = # and SCLKDP(1) = # ", (ftnlen)84);
errdp_("#", begtim, (ftnlen)1);
errdp_("#", sclkdp, (ftnlen)1);
sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23);
chkout_("CKW01", (ftnlen)5);
return 0;
}
if (*endtim < sclkdp[*nrec - 1]) {
setmsg_("The second d.p. component of the descriptor is invalid. DCD"
"(2) = # and SCLKDP(NREC) = # ", (ftnlen)88);
errdp_("#", endtim, (ftnlen)1);
errdp_("#", &sclkdp[*nrec - 1], (ftnlen)1);
sigerr_("SPICE(INVALIDDESCRTIME)", (ftnlen)23);
chkout_("CKW01", (ftnlen)5);
return 0;
}
dcd[0] = *begtim;
dcd[1] = *endtim;
/* Get the NAIF integer code for the reference frame. */
namfrm_(ref, &refcod, ref_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Assign values to the integer components of the segment descriptor. */
icd[0] = *inst;
icd[1] = refcod;
icd[2] = 1;
if (*avflag) {
icd[3] = 1;
} else {
icd[3] = 0;
}
/* Now pack the segment descriptor. */
dafps_(&c__2, &c__6, dcd, icd, descr);
/* Check that all the characters in the segid can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
value = *(unsigned char *)&segid[i__ - 1];
if (value < 32 || value > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("CKW01", (ftnlen)5);
return 0;
}
}
/* Also check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Now check that the encoded SCLK times are positive and strictly */
/* increasing. */
/* Check that the first time is nonnegative. */
if (sclkdp[0] < 0.) {
setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37);
errdp_("#", sclkdp, (ftnlen)1);
sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22);
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Now check that the times are ordered properly. */
i__1 = *nrec;
for (i__ = 2; i__ <= i__1; ++i__) {
if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) {
setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)"
" = # and SCLKDP(#) = #.", (ftnlen)78);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 1], (ftnlen)1);
i__2 = i__ - 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("CKW01", (ftnlen)5);
return 0;
}
}
/* Make sure that the quaternions are non-zero. This is just */
/* a check for uninitialized data. */
i__1 = *nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
if (vzerog_(&quats[(i__ << 2) - 4], &c__4)) {
setmsg_("The quaternion at index # has magnitude zero.", (ftnlen)
45);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21);
chkout_("CKW01", (ftnlen)5);
return 0;
}
}
/* No more checks, begin writing the segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("CKW01", (ftnlen)5);
return 0;
}
/* Now add the quaternions and optionally, the angular velocity */
/* vectors. */
if (*avflag) {
i__1 = *nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&quats[(i__ << 2) - 4], &c__4);
dafada_(&avvs[i__ * 3 - 3], &c__3);
}
} else {
i__1 = *nrec;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&quats[(i__ << 2) - 4], &c__4);
}
}
/* Add the SCLK times. */
dafada_(sclkdp, nrec);
/* The time tag directory. The Ith element is defined to be the */
/* average of the (I*100)th and the (I*100+1)st SCLK time. */
ndir = (*nrec - 1) / 100;
index = 100;
i__1 = ndir;
for (i__ = 1; i__ <= i__1; ++i__) {
dirent = (sclkdp[index - 1] + sclkdp[index]) / 2.;
dafada_(&dirent, &c__1);
index += 100;
}
/* Finally, the number of records. */
d__1 = (doublereal) (*nrec);
dafada_(&d__1, &c__1);
/* End the segment. */
dafena_();
chkout_("CKW01", (ftnlen)5);
return 0;
} /* ckw01_ */
/* $Procedure CKW05 ( Write CK segment, type 5 ) */
/* Subroutine */ int ckw05_(integer *handle, integer *subtyp, integer *degree,
doublereal *begtim, doublereal *endtim, integer *inst, char *ref,
logical *avflag, char *segid, integer *n, doublereal *sclkdp,
doublereal *packts, doublereal *rate, integer *nints, doublereal *
starts, ftnlen ref_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Local variables */
integer addr__, i__;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
errdp_(char *, doublereal *, ftnlen), dafada_(doublereal *,
integer *);
doublereal dc[2];
extern /* Subroutine */ int dafbna_(integer *, doublereal *, char *,
ftnlen);
integer ic[6];
extern /* Subroutine */ int dafena_(void);
extern logical failed_(void);
integer chrcod, refcod;
extern integer bsrchd_(doublereal *, integer *, doublereal *);
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
integer packsz;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern integer lstltd_(doublereal *, integer *, doublereal *);
extern logical vzerog_(doublereal *, integer *), return_(void);
integer winsiz;
extern logical odd_(integer *);
/* $ Abstract */
/* Write a type 5 segment to a CK file. */
/* $ 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 */
/* NAIF_IDS */
/* ROTATION */
/* TIME */
/* $ Keywords */
/* POINTING */
/* FILES */
/* $ 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. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an CK file open for writing. */
/* SUBTYP I CK type 5 subtype code. */
/* DEGREE I Degree of interpolating polynomials. */
/* BEGTIM I Start time of interval covered by segment. */
/* ENDTIM I End time of interval covered by segment. */
/* INST I NAIF code for a s/c instrument or structure. */
/* REF I Reference frame name. */
/* AVFLAG I True if the segment will contain angular velocity. */
/* SEGID I Segment identifier. */
/* N I Number of packets. */
/* SCLKDP I Encoded SCLK times. */
/* PACKTS I Array of packets. */
/* RATE I Nominal SCLK rate in seconds per tick. */
/* NINTS I Number of intervals. */
/* STARTS I Encoded SCLK interval start times. */
/* MAXDEG P Maximum allowed degree of interpolating polynomial. */
/* $ Detailed_Input */
/* HANDLE is the file handle of a CK file that has been */
/* opened for writing. */
/* SUBTYP is an integer code indicating the subtype of the */
/* the segment to be created. */
/* DEGREE is the degree of the polynomials used to */
/* interpolate the quaternions contained in the input */
/* packets. All components of the quaternions are */
/* interpolated by polynomials of fixed degree. */
/* BEGTIM, */
/* ENDTIM are the beginning and ending encoded SCLK times */
/* for which the segment provides pointing */
/* information. BEGTIM must be less than or equal to */
/* ENDTIM, and at least one data packet must have a */
/* time tag T such that */
/* BEGTIM < T < ENDTIM */
/* - - */
/* INST is the NAIF integer code for the instrument or */
/* structure for which a segment is to be created. */
/* REF is the NAIF name for a reference frame relative to */
/* which the pointing information for INST is */
/* specified. */
/* AVFLAG is a logical flag which indicates whether or not */
/* the segment will contain angular velocity. */
/* SEGID is the segment identifier. A CK segment */
/* identifier may contain up to 40 characters. */
/* N is the number of packets in the input packet */
/* array. */
/* SCLKDP are the encoded spacecraft clock times associated */
/* with each pointing instance. These times must be */
/* strictly increasing. */
/* PACKTS contains a time-ordered array of data packets */
/* representing the orientation of INST relative to */
/* the frame REF. Each packet contains a SPICE-style */
/* quaternion and optionally, depending on the */
/* segment subtype, attitude derivative data, from */
/* which a C-matrix and an angular velocity vector */
/* may be derived. */
/* See the discussion of quaternion styles in */
/* Particulars below. */
/* The C-matrix represented by the Ith data packet is */
/* a rotation matrix that transforms the components */
/* of a vector expressed in the base frame specified */
/* by REF to components expressed in the instrument */
/* fixed frame at the time SCLKDP(I). */
/* Thus, if a vector V has components x, y, z in the */
/* base frame, then V has components x', y', z' */
/* in the instrument fixed frame where: */
/* [ x' ] [ ] [ x ] */
/* | y' | = | CMAT | | y | */
/* [ z' ] [ ] [ z ] */
/* The attitude derivative information in PACKTS(I) */
/* gives the angular velocity of the instrument fixed */
/* frame at time SCLKDP(I) with respect to the */
/* reference frame specified by REF. */
/* The direction of an angular velocity vector gives */
/* the right-handed axis about which the instrument */
/* fixed reference frame is rotating. The magnitude */
/* of the vector is the magnitude of the */
/* instantaneous velocity of the rotation, in radians */
/* per second. */
/* Packet contents and the corresponding */
/* interpolation methods depend on the segment */
/* subtype, and are as follows: */
/* 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. */
/* Angular velocity is always specified relative to */
/* the base frame. */
/* RATE is the nominal rate of the spacecraft clock */
/* associated with INST. Units are seconds per */
/* tick. RATE is used to scale angular velocity */
/* to radians/second. */
/* NINTS is the number of intervals that the pointing */
/* instances are partitioned into. */
/* STARTS are the start times of each of the interpolation */
/* intervals. These times must be strictly increasing */
/* and must coincide with times for which the segment */
/* contains pointing. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* MAXDEG is the maximum allowed degree of the interpolating */
/* polynomial. If the value of MAXDEG is increased, */
/* the SPICELIB routine CKPFS must be changed */
/* accordingly. In particular, the size of the */
/* record passed to CKRnn and CKEnn must be */
/* increased, and comments describing the record size */
/* must be changed. */
/* $ Exceptions */
/* If any of the following exceptions occur, this routine will return */
/* without creating a new segment. */
/* 1) If HANDLE is not the handle of a C-kernel opened for writing */
/* the error will be diagnosed by routines called by this */
/* routine. */
/* 2) If the last non-blank character of SEGID occurs past index 40, */
/* the error SPICE(SEGIDTOOLONG) is signaled. */
/* 3) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signaled. */
/* 4) If the first encoded SCLK time is negative then the error */
/* SPICE(INVALIDSCLKTIME) is signaled. If any subsequent times */
/* are negative the error will be detected in exception (5). */
/* 5) If the encoded SCLK times are not strictly increasing, */
/* the error SPICE(TIMESOUTOFORDER) is signaled. */
/* 6) If the name of the reference frame is not one of those */
/* supported by the routine FRAMEX, the error */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 7) If the number of packets N is not at least 1, the error */
/* SPICE(TOOFEWPACKETS) will be signaled. */
/* 8) If NINTS, the number of interpolation intervals, is less than */
/* or equal to 0, the error SPICE(INVALIDNUMINTS) is signaled. */
/* 9) If the encoded SCLK interval start times are not strictly */
/* increasing, the error SPICE(TIMESOUTOFORDER) is signaled. */
/* 10) If an interval start time does not coincide with a time for */
/* which there is an actual pointing instance in the segment, */
/* then the error SPICE(INVALIDSTARTTIME) is signaled. */
/* 11) This routine assumes that the rotation between adjacent */
/* quaternions that are stored in the same interval has a */
/* rotation angle of THETA radians, where */
/* 0 < THETA < pi. */
/* _ */
/* The routines that evaluate the data in the segment produced */
/* by this routine cannot distinguish between rotations of THETA */
/* radians, where THETA is in the interval [0, pi), and */
/* rotations of */
/* THETA + 2 * k * pi */
/* radians, where k is any integer. These "large" rotations will */
/* yield invalid results when interpolated. You must ensure that */
/* the data stored in the segment will not be subject to this */
/* sort of ambiguity. */
/* 12) If any quaternion has magnitude zero, the error */
/* SPICE(ZEROQUATERNION) is signaled. */
/* 13) If the interpolation window size implied by DEGREE is not */
/* even, the error SPICE(INVALIDDEGREE) is signaled. The window */
/* size is DEGREE+1 for Lagrange subtypes and is (DEGREE+1)/2 */
/* for Hermite subtypes. */
/* 14) If an unrecognized subtype code is supplied, the error */
/* SPICE(NOTSUPPORTED) is signaled. */
/* 15) If DEGREE is not at least 1 or is greater than MAXDEG, the */
/* error SPICE(INVALIDDEGREE) is signaled. */
/* 16) If the segment descriptor bounds are out of order, the */
/* error SPICE(BADDESCRTIMES) is signaled. */
/* 17) If there is no element of SCLKDP that lies between BEGTIM and */
/* ENDTIM inclusive, the error SPICE(EMPTYSEGMENT) is signaled. */
/* 18) If RATE is zero, the error SPICE(INVALIDVALUE) is signaled. */
/* $ Files */
/* A new type 5 CK segment is written to the CK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes a CK type 5 data segment to the open CK */
/* file according to the format described in the type 5 section of */
/* the CK Required Reading. The CK file must have been opened with */
/* write access. */
/* Quaternion Styles */
/* ----------------- */
/* There are different "styles" of quaternions used in */
/* science and engineering applications. Quaternion styles */
/* are characterized by */
/* - The order of quaternion elements */
/* - The quaternion multiplication formula */
/* - The convention for associating quaternions */
/* with rotation matrices */
/* Two of the commonly used styles are */
/* - "SPICE" */
/* > Invented by Sir William Rowan Hamilton */
/* > Frequently used in mathematics and physics textbooks */
/* - "Engineering" */
/* > Widely used in aerospace engineering applications */
/* SPICELIB subroutine interfaces ALWAYS use SPICE quaternions. */
/* Quaternions of any other style must be converted to SPICE */
/* quaternions before they are passed to SPICELIB routines. */
/* Relationship between SPICE and Engineering Quaternions */
/* ------------------------------------------------------ */
/* Let M be a rotation matrix such that for any vector V, */
/* M*V */
/* is the result of rotating V by theta radians in the */
/* counterclockwise direction about unit rotation axis vector A. */
/* Then the SPICE quaternions representing M are */
/* (+/-) ( cos(theta/2), */
/* sin(theta/2) A(1), */
/* sin(theta/2) A(2), */
/* sin(theta/2) A(3) ) */
/* while the engineering quaternions representing M are */
/* (+/-) ( -sin(theta/2) A(1), */
/* -sin(theta/2) A(2), */
/* -sin(theta/2) A(3), */
/* cos(theta/2) ) */
/* For both styles of quaternions, if a quaternion q represents */
/* a rotation matrix M, then -q represents M as well. */
/* Given an engineering quaternion */
/* QENG = ( q0, q1, q2, q3 ) */
/* the equivalent SPICE quaternion is */
/* QSPICE = ( q3, -q0, -q1, -q2 ) */
/* Associating SPICE Quaternions with Rotation Matrices */
/* ---------------------------------------------------- */
/* Let FROM and TO be two right-handed reference frames, for */
/* example, an inertial frame and a spacecraft-fixed frame. Let the */
/* symbols */
/* V , V */
/* FROM TO */
/* denote, respectively, an arbitrary vector expressed relative to */
/* the FROM and TO frames. Let M denote the transformation matrix */
/* that transforms vectors from frame FROM to frame TO; then */
/* V = M * V */
/* TO FROM */
/* where the expression on the right hand side represents left */
/* multiplication of the vector by the matrix. */
/* Then if the unit-length SPICE quaternion q represents M, where */
/* q = (q0, q1, q2, q3) */
/* the elements of M are derived from the elements of q as follows: */
/* +- -+ */
/* | 2 2 | */
/* | 1 - 2*( q2 + q3 ) 2*(q1*q2 - q0*q3) 2*(q1*q3 + q0*q2) | */
/* | | */
/* | | */
/* | 2 2 | */
/* M = | 2*(q1*q2 + q0*q3) 1 - 2*( q1 + q3 ) 2*(q2*q3 - q0*q1) | */
/* | | */
/* | | */
/* | 2 2 | */
/* | 2*(q1*q3 - q0*q2) 2*(q2*q3 + q0*q1) 1 - 2*( q1 + q2 ) | */
/* | | */
/* +- -+ */
/* Note that substituting the elements of -q for those of q in the */
/* right hand side leaves each element of M unchanged; this shows */
/* that if a quaternion q represents a matrix M, then so does the */
/* quaternion -q. */
/* To map the rotation matrix M to a unit quaternion, we start by */
/* decomposing the rotation matrix as a sum of symmetric */
/* and skew-symmetric parts: */
/* 2 */
/* M = [ I + (1-cos(theta)) OMEGA ] + [ sin(theta) OMEGA ] */
/* symmetric skew-symmetric */
/* OMEGA is a skew-symmetric matrix of the form */
/* +- -+ */
/* | 0 -n3 n2 | */
/* | | */
/* OMEGA = | n3 0 -n1 | */
/* | | */
/* | -n2 n1 0 | */
/* +- -+ */
/* The vector N of matrix entries (n1, n2, n3) is the rotation axis */
/* of M and theta is M's rotation angle. Note that N and theta */
/* are not unique. */
/* Let */
/* C = cos(theta/2) */
/* S = sin(theta/2) */
/* Then the unit quaternions Q corresponding to M are */
/* Q = +/- ( C, S*n1, S*n2, S*n3 ) */
/* The mappings between quaternions and the corresponding rotations */
/* are carried out by the SPICELIB routines */
/* Q2M {quaternion to matrix} */
/* M2Q {matrix to quaternion} */
/* M2Q always returns a quaternion with scalar part greater than */
/* or equal to zero. */
/* SPICE Quaternion Multiplication Formula */
/* --------------------------------------- */
/* Given a SPICE quaternion */
/* Q = ( q0, q1, q2, q3 ) */
/* corresponding to rotation axis A and angle theta as above, we can */
/* represent Q using "scalar + vector" notation as follows: */
/* s = q0 = cos(theta/2) */
/* v = ( q1, q2, q3 ) = sin(theta/2) * A */
/* Q = s + v */
/* Let Q1 and Q2 be SPICE quaternions with respective scalar */
/* and vector parts s1, s2 and v1, v2: */
/* Q1 = s1 + v1 */
/* Q2 = s2 + v2 */
/* We represent the dot product of v1 and v2 by */
/* <v1, v2> */
/* and the cross product of v1 and v2 by */
/* v1 x v2 */
/* Then the SPICE quaternion product is */
/* Q1*Q2 = s1*s2 - <v1,v2> + s1*v2 + s2*v1 + (v1 x v2) */
/* If Q1 and Q2 represent the rotation matrices M1 and M2 */
/* respectively, then the quaternion product */
/* Q1*Q2 */
/* represents the matrix product */
/* M1*M2 */
/* $ Examples */
/* Suppose that you have data packets and are prepared to produce */
/* a segment of type 5 in a CK file. */
/* The following code fragment could be used to add the new segment */
/* to a previously opened CK file attached to HANDLE. The file must */
/* have been opened with write access. */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_CK_TYPE_5_SEGMENT' */
/* C */
/* C Write the segment. */
/* C */
/* CALL CKW05 ( HANDLE, SUBTYP, DEGREE, BEGTIM, ENDTIM, */
/* . INST, REF, AVFLAG, SEGID, N, */
/* . SCLKDP, PACKTS, RATE, NINTS, STARTS ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* J.M. Lynch (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */
/* The check for non-unit quaternions has been replaced */
/* with a check for zero-length quaternions. */
/* - SPICELIB Version 1.1.0, 26-FEB-2008 (NJB) */
/* Updated header; added information about SPICE */
/* quaternion conventions. */
/* Minor typo in a long error message was corrected. */
/* - SPICELIB Version 1.0.1, 07-JAN-2005 (NJB) */
/* Description in Detailed_Input header section of */
/* constraints on BEGTIM and ENDTIM was corrected. */
/* - SPICELIB Version 1.0.0, 30-AUG-2002 (NJB) (KRG) (JML) (WLT) */
/* -& */
/* $ Index_Entries */
/* write ck type_5 data segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 08-FEB-2010 (NJB) */
/* The check for non-unit quaternions has been replaced */
/* with a check for zero-length quaternions. */
/* This change was made to accommodate CK generation, */
/* via the non-SPICE utility MEX2KER, for European missions. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Packet structure parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CKW05", (ftnlen)5);
}
/* Make sure that the number of packets is positive. */
if (*n < 1) {
setmsg_("At least 1 packet is required for CK type 5. Number of pack"
"ets supplied: #", (ftnlen)75);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that there is a positive number of interpolation */
/* intervals. */
if (*nints <= 0) {
setmsg_("# is an invalid number of interpolation intervals for type "
"5.", (ftnlen)61);
errint_("#", nints, (ftnlen)1);
sigerr_("SPICE(INVALIDNUMINTS)", (ftnlen)21);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
namfrm_(ref, &refcod, ref_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Check to see if the segment identifier is too long. */
if (lastnb_(segid, segid_len) > 40) {
setmsg_("Segment identifier contains more than 40 characters.", (
ftnlen)52);
sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Now check that all the characters in the segment identifier */
/* can be printed. */
i__1 = lastnb_(segid, segid_len);
for (i__ = 1; i__ <= i__1; ++i__) {
chrcod = *(unsigned char *)&segid[i__ - 1];
if (chrcod < 32 || chrcod > 126) {
setmsg_("The segment identifier contains nonprintable characters",
(ftnlen)55);
sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Now check that the encoded SCLK times are positive and strictly */
/* increasing. */
/* Check that the first time is nonnegative. */
if (sclkdp[0] < 0.) {
setmsg_("The first SCLKDP time: # is negative.", (ftnlen)37);
errdp_("#", sclkdp, (ftnlen)1);
sigerr_("SPICE(INVALIDSCLKTIME)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Now check that the times are ordered properly. */
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
if (sclkdp[i__ - 1] <= sclkdp[i__ - 2]) {
setmsg_("The SCLKDP times are not strictly increasing. SCLKDP(#)"
" = # and SCLKDP(#) = #.", (ftnlen)78);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 1], (ftnlen)1);
i__2 = i__ - 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &sclkdp[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Now check that the interval start times are ordered properly. */
i__1 = *nints;
for (i__ = 2; i__ <= i__1; ++i__) {
if (starts[i__ - 1] <= starts[i__ - 2]) {
setmsg_("The interval start times are not strictly increasing. S"
"TARTS(#) = # and STARTS(#) = #.", (ftnlen)86);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &starts[i__ - 1], (ftnlen)1);
i__2 = i__ - 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &starts[i__ - 2], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Now make sure that all of the interval start times coincide with */
/* one of the times associated with the actual pointing. */
i__1 = *nints;
for (i__ = 1; i__ <= i__1; ++i__) {
/* We know the SCLKDP array is ordered, so a binary search is */
/* ok. */
if (bsrchd_(&starts[i__ - 1], n, sclkdp) == 0) {
setmsg_("Interval start time number # is invalid. STARTS(#) = *",
(ftnlen)54);
errint_("#", &i__, (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
errdp_("*", &starts[i__ - 1], (ftnlen)1);
sigerr_("SPICE(INVALIDSTARTTIME)", (ftnlen)23);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Set the window, packet size and angular velocity flag, all of */
/* which are functions of the subtype. */
if (*subtyp == 0) {
winsiz = (*degree + 1) / 2;
packsz = 8;
} else if (*subtyp == 1) {
winsiz = *degree + 1;
packsz = 4;
} else if (*subtyp == 2) {
winsiz = (*degree + 1) / 2;
packsz = 14;
} else if (*subtyp == 3) {
winsiz = *degree + 1;
packsz = 7;
} else {
setmsg_("CK type 5 subtype <#> is not supported.", (ftnlen)39);
errint_("#", subtyp, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that the quaternions are non-zero. This is just */
/* a check for uninitialized data. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* We have to address the quaternion explicitly, since the shape */
/* of the packet array is not known at compile time. */
addr__ = packsz * (i__ - 1) + 1;
if (vzerog_(&packts[addr__ - 1], &c__4)) {
setmsg_("The quaternion at index # has magnitude zero.", (ftnlen)
45);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROQUATERNION)", (ftnlen)21);
chkout_("CKW05", (ftnlen)5);
return 0;
}
}
/* Make sure that the degree of the interpolating polynomials is */
/* in range. */
if (*degree < 1 || *degree > 15) {
setmsg_("The interpolating polynomials have degree #; the valid degr"
"ee range is [1, #]", (ftnlen)77);
errint_("#", degree, (ftnlen)1);
errint_("#", &c__15, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that the window size is even. If not, the input */
/* DEGREE is incompatible with the subtype. */
if (odd_(&winsiz)) {
setmsg_("The interpolating polynomials have degree #; for CK type 5,"
" the degree must be equivalent to 3 mod 4 for Hermite interp"
"olation and odd for for Lagrange interpolation.", (ftnlen)166)
;
errint_("#", degree, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* If we made it this far, we're ready to start writing the segment. */
/* Create the segment descriptor. */
/* Assign values to the integer components of the segment descriptor. */
ic[0] = *inst;
ic[1] = refcod;
ic[2] = 5;
if (*avflag) {
ic[3] = 1;
} else {
ic[3] = 0;
}
dc[0] = *begtim;
dc[1] = *endtim;
/* Make sure the descriptor times are in increasing order. */
if (*endtim < *begtim) {
setmsg_("Descriptor bounds are non-increasing: #:#", (ftnlen)41);
errdp_("#", begtim, (ftnlen)1);
errdp_("#", endtim, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Make sure that at least one time tag lies between BEGTIM and */
/* ENDTIM. The first time tag not less than BEGTIM must exist */
/* and must be less than or equal to ENDTIM. */
i__ = lstltd_(begtim, n, sclkdp);
if (i__ == *n) {
setmsg_("All time tags are less than segment start time #.", (ftnlen)
49);
errdp_("#", begtim, (ftnlen)1);
sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
} else if (sclkdp[i__] > *endtim) {
setmsg_("No time tags lie between the segment start time # and segme"
"nt end time #", (ftnlen)72);
errdp_("#", begtim, (ftnlen)1);
errdp_("#", endtim, (ftnlen)1);
sigerr_("SPICE(EMPTYSEGMENT)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* The clock rate must be non-zero. */
if (*rate == 0.) {
setmsg_("The SCLK rate RATE was zero.", (ftnlen)28);
sigerr_("SPICE(INVALIDVALUE)", (ftnlen)19);
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* Now pack the segment descriptor. */
dafps_(&c__2, &c__6, dc, ic, descr);
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("CKW05", (ftnlen)5);
return 0;
}
/* The type 5 segment structure is eloquently described by this */
/* diagram from the CK Required Reading: */
/* +-----------------------+ */
/* | Packet 1 | */
/* +-----------------------+ */
/* | Packet 2 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Packet N | */
/* +-----------------------+ */
/* | Epoch 1 | */
/* +-----------------------+ */
/* | Epoch 2 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Epoch N | */
/* +----------------------------+ */
/* | Epoch 100 | (First directory) */
/* +----------------------------+ */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Epoch ((N-1)/100)*100 | (Last directory) */
/* +----------------------------+ */
/* | Start time 1 | */
/* +----------------------------+ */
/* | Start time 2 | */
/* +----------------------------+ */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Start time M | */
/* +----------------------------+ */
/* | Start time 100 | (First interval start */
/* +----------------------------+ time directory) */
/* . */
/* . */
/* . */
/* +----------------------------+ */
/* | Start time ((M-1)/100)*100 | (Last interval start */
/* +----------------------------+ time directory) */
/* | Seconds per tick | */
/* +----------------------------+ */
/* | Subtype code | */
/* +----------------------------+ */
/* | Window size | */
/* +----------------------------+ */
/* | Number of interp intervals | */
/* +----------------------------+ */
/* | Number of packets | */
/* +----------------------------+ */
i__1 = *n * packsz;
dafada_(packts, &i__1);
dafada_(sclkdp, n);
i__1 = (*n - 1) / 100;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&sclkdp[i__ * 100 - 1], &c__1);
}
/* Now add the interval start times. */
dafada_(starts, nints);
/* And the directory of interval start times. The directory of */
/* start times will simply be every (DIRSIZ)th start time. */
i__1 = (*nints - 1) / 100;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&starts[i__ * 100 - 1], &c__1);
}
/* Add the SCLK rate, segment subtype, window size, interval */
/* count, and packet count. */
dafada_(rate, &c__1);
d__1 = (doublereal) (*subtyp);
dafada_(&d__1, &c__1);
d__1 = (doublereal) winsiz;
dafada_(&d__1, &c__1);
d__1 = (doublereal) (*nints);
dafada_(&d__1, &c__1);
d__1 = (doublereal) (*n);
dafada_(&d__1, &c__1);
/* As long as nothing went wrong, end the segment. */
if (! failed_()) {
dafena_();
}
chkout_("CKW05", (ftnlen)5);
return 0;
} /* ckw05_ */
/* $Procedure DRDPGR ( Derivative of rectangular w.r.t. planetographic ) */
/* Subroutine */ int drdpgr_(char *body, doublereal *lon, doublereal *lat,
doublereal *alt, doublereal *re, doublereal *f, doublereal *jacobi,
ftnlen body_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
integer i__, n;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer sense;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen), bods2c_(char *, integer *, logical *,
ftnlen), drdgeo_(doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
integer bodyid;
doublereal geolon;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen);
char kvalue[80];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
char pmkvar[32], pgrlon[4];
extern /* Subroutine */ int setmsg_(char *, ftnlen), cmprss_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
extern integer plnsns_(integer *);
extern logical return_(void);
char tmpstr[32];
/* $ Abstract */
/* This routine computes the Jacobian matrix of the transformation */
/* from planetographic to rectangular coordinates. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* COORDINATES */
/* DERIVATIVES */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* BODY I Name of body with which coordinates are associated. */
/* LON I Planetographic longitude of a point (radians). */
/* LAT I Planetographic latitude of a point (radians). */
/* ALT I Altitude of a point above reference spheroid. */
/* RE I Equatorial radius of the reference spheroid. */
/* F I Flattening coefficient. */
/* JACOBI O Matrix of partial derivatives. */
/* $ Detailed_Input */
/* BODY Name of the body with which the planetographic */
/* coordinate system is associated. */
/* BODY is used by this routine to look up from the */
/* kernel pool the prime meridian rate coefficient giving */
/* the body's spin sense. See the Files and Particulars */
/* header sections below for details. */
/* LON Planetographic longitude of the input point. This is */
/* the angle between the prime meridian and the meridian */
/* containing the input point. For bodies having */
/* prograde (aka direct) rotation, the direction of */
/* increasing longitude is positive west: from the +X */
/* axis of the rectangular coordinate system toward the */
/* -Y axis. For bodies having retrograde rotation, the */
/* direction of increasing longitude is positive east: */
/* from the +X axis toward the +Y axis. */
/* The earth, moon, and sun are exceptions: */
/* planetographic longitude is measured positive east for */
/* these bodies. */
/* The default interpretation of longitude by this */
/* and the other planetographic coordinate conversion */
/* routines can be overridden; see the discussion in */
/* Particulars below for details. */
/* Longitude is measured in radians. On input, the range */
/* of longitude is unrestricted. */
/* LAT Planetographic latitude of the input point. For a */
/* point P on the reference spheroid, this is the angle */
/* between the XY plane and the outward normal vector at */
/* P. For a point P not on the reference spheroid, the */
/* planetographic latitude is that of the closest point */
/* to P on the spheroid. */
/* Latitude is measured in radians. On input, the */
/* range of latitude is unrestricted. */
/* ALT Altitude of point above the reference spheroid. */
/* Units of ALT must match those of RE. */
/* RE Equatorial radius of a reference spheroid. This */
/* spheroid is a volume of revolution: its horizontal */
/* cross sections are circular. The shape of the */
/* spheroid is defined by an equatorial radius RE and */
/* a polar radius RP. Units of RE must match those of */
/* ALT. */
/* F Flattening coefficient = */
/* (RE-RP) / RE */
/* where RP is the polar radius of the spheroid, and the */
/* units of RP match those of RE. */
/* $ Detailed_Output */
/* JACOBI is the matrix of partial derivatives of the conversion */
/* from planetographic to rectangular coordinates. It */
/* has the form */
/* .- -. */
/* | DX/DLON DX/DLAT DX/DALT | */
/* | DY/DLON DY/DLAT DY/DALT | */
/* | DZ/DLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* evaluated at the input values of LON, LAT and ALT. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the body name BODY cannot be mapped to a NAIF ID code, */
/* and if BODY is not a string representation of an integer, */
/* the error SPICE(IDCODENOTFOUND) will be signaled. */
/* 2) If the kernel variable */
/* BODY<ID code>_PGR_POSITIVE_LON */
/* is present in the kernel pool but has a value other */
/* than one of */
/* 'EAST' */
/* 'WEST' */
/* the error SPICE(INVALIDOPTION) will be signaled. Case */
/* and blanks are ignored when these values are interpreted. */
/* 3) If polynomial coefficients for the prime meridian of BODY */
/* are not available in the kernel pool, and if the kernel */
/* variable BODY<ID code>_PGR_POSITIVE_LON is not present in */
/* the kernel pool, the error SPICE(MISSINGDATA) will be signaled. */
/* 4) If the equatorial radius is non-positive, the error */
/* SPICE(VALUEOUTOFRANGE) is signaled. */
/* 5) If the flattening coefficient is greater than or equal to one, */
/* the error SPICE(VALUEOUTOFRANGE) is signaled. */
/* $ Files */
/* This routine expects a kernel variable giving BODY's prime */
/* meridian angle as a function of time to be available in the */
/* kernel pool. Normally this item is provided by loading a PCK */
/* file. The required kernel variable is named */
/* BODY<body ID>_PM */
/* where <body ID> represents a string containing the NAIF integer */
/* ID code for BODY. For example, if BODY is 'JUPITER', then */
/* the name of the kernel variable containing the prime meridian */
/* angle coefficients is */
/* BODY599_PM */
/* See the PCK Required Reading for details concerning the prime */
/* meridian kernel variable. */
/* The optional kernel variable */
/* BODY<body ID>_PGR_POSITIVE_LON */
/* also is normally defined via loading a text kernel. When this */
/* variable is present in the kernel pool, the prime meridian */
/* coefficients for BODY are not required by this routine. See the */
/* Particulars section below for details. */
/* $ Particulars */
/* It is often convenient to describe the motion of an object in the */
/* planetographic coordinate system. However, when performing */
/* vector computations it's hard to beat rectangular coordinates. */
/* To transform states given with respect to planetographic */
/* coordinates to states with respect to rectangular coordinates, */
/* one makes use of the Jacobian of the transformation between the */
/* two systems. */
/* Given a state in planetographic coordinates */
/* ( lon, lat, alt, dlon, dlat, dalt ) */
/* the velocity in rectangular coordinates is given by the matrix */
/* equation: */
/* t | t */
/* (dx, dy, dz) = JACOBI| * (dlon, dlat, dalt) */
/* |(lon,lat,alt) */
/* This routine computes the matrix */
/* | */
/* JACOBI| */
/* |(lon,lat,alt) */
/* 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 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. */
/* The definition of this kernel variable controls the behavior of */
/* the SPICELIB planetographic routines */
/* PGRREC */
/* RECPGR */
/* DPGRDR */
/* DRDPGR */
/* It does not affect the other SPICELIB coordinate conversion */
/* routines. */
/* $ Examples */
/* Numerical results shown for this example may differ between */
/* platforms as the results depend on the SPICE kernels used as */
/* input and the machine specific arithmetic implementation. */
/* Find the planetographic state of the earth as seen from */
/* Mars in the J2000 reference frame at January 1, 2005 TDB. */
/* Map this state back to rectangular coordinates as a check. */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION RPD */
/* C */
/* C Local variables */
/* C */
/* DOUBLE PRECISION ALT */
/* DOUBLE PRECISION DRECTN ( 3 ) */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION F */
/* DOUBLE PRECISION JACOBI ( 3, 3 ) */
/* DOUBLE PRECISION LAT */
/* DOUBLE PRECISION LON */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION PGRVEL ( 3 ) */
/* DOUBLE PRECISION RADII ( 3 ) */
/* DOUBLE PRECISION RE */
/* DOUBLE PRECISION RECTAN ( 3 ) */
/* DOUBLE PRECISION RP */
/* DOUBLE PRECISION STATE ( 6 ) */
/* INTEGER N */
/* C */
/* C Load a PCK file containing a triaxial */
/* C ellipsoidal shape model and orientation */
/* C data for Mars. */
/* C */
/* CALL FURNSH ( 'pck00008.tpc' ) */
/* C */
/* C Load an SPK file giving ephemerides of earth and Mars. */
/* C */
/* CALL FURNSH ( 'de405.bsp' ) */
/* C */
/* C Load a leapseconds kernel to support time conversion. */
/* C */
/* CALL FURNSH ( 'naif0007.tls' ) */
/* C */
/* C Look up the radii for Mars. Although we */
/* C omit it here, we could first call BADKPV */
/* C to make sure the variable BODY499_RADII */
/* C has three elements and numeric data type. */
/* C If the variable is not present in the kernel */
/* C pool, BODVRD will signal an error. */
/* C */
/* CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII ) */
/* C */
/* C Compute flattening coefficient. */
/* C */
/* RE = RADII(1) */
/* RP = RADII(3) */
/* F = ( RE - RP ) / RE */
/* C */
/* C Look up the geometric state of earth as seen from Mars at */
/* C January 1, 2005 TDB, relative to the J2000 reference */
/* C frame. */
/* C */
/* CALL STR2ET ( 'January 1, 2005 TDB', ET ) */
/* CALL SPKEZR ( 'Earth', ET, 'J2000', 'LT+S', */
/* . 'Mars', STATE, LT ) */
/* C */
/* C Convert position to planetographic coordinates. */
/* C */
/* CALL RECPGR ( 'MARS', STATE, RE, F, LON, LAT, ALT ) */
/* C */
/* C Convert velocity to planetographic coordinates. */
/* C */
/* CALL DPGRDR ( 'MARS', STATE(1), STATE(2), STATE(3), */
/* . RE, F, JACOBI ) */
/* CALL MXV ( JACOBI, STATE(4), PGRVEL ) */
/* C */
/* C As a check, convert the planetographic state back to */
/* C rectangular coordinates. */
/* C */
/* CALL PGRREC ( 'MARS', LON, LAT, ALT, RE, F, RECTAN ) */
/* CALL DRDPGR ( 'MARS', LON, LAT, ALT, RE, F, JACOBI ) */
/* CALL MXV ( JACOBI, PGRVEL, DRECTN ) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular coordinates:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' X (km) = ', STATE(1) */
/* WRITE(*,*) ' Y (km) = ', STATE(2) */
/* WRITE(*,*) ' Z (km) = ', STATE(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular velocity:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' dX/dt (km/s) = ', STATE(4) */
/* WRITE(*,*) ' dY/dt (km/s) = ', STATE(5) */
/* WRITE(*,*) ' dZ/dt (km/s) = ', STATE(6) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Ellipsoid shape parameters: ' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' Equatorial radius (km) = ', RE */
/* WRITE(*,*) ' Polar radius (km) = ', RP */
/* WRITE(*,*) ' Flattening coefficient = ', F */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Planetographic coordinates:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' Longitude (deg) = ', LON / RPD() */
/* WRITE(*,*) ' Latitude (deg) = ', LAT / RPD() */
/* WRITE(*,*) ' Altitude (km) = ', ALT */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Planetographic velocity:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' d Longitude/dt (deg/s) = ', PGRVEL(1)/RPD() */
/* WRITE(*,*) ' d Latitude/dt (deg/s) = ', PGRVEL(2)/RPD() */
/* WRITE(*,*) ' d Altitude/dt (km/s) = ', PGRVEL(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular coordinates from inverse ' // */
/* . 'mapping:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' X (km) = ', RECTAN(1) */
/* WRITE(*,*) ' Y (km) = ', RECTAN(2) */
/* WRITE(*,*) ' Z (km) = ', RECTAN(3) */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) 'Rectangular velocity from inverse mapping:' */
/* WRITE(*,*) ' ' */
/* WRITE(*,*) ' dX/dt (km/s) = ', DRECTN(1) */
/* WRITE(*,*) ' dY/dt (km/s) = ', DRECTN(2) */
/* WRITE(*,*) ' dZ/dt (km/s) = ', DRECTN(3) */
/* WRITE(*,*) ' ' */
/* END */
/* Output from this program should be similar to the following */
/* (rounding and formatting differ across platforms): */
/* Rectangular coordinates: */
/* X (km) = 146039732. */
/* Y (km) = 278546607. */
/* Z (km) = 119750315. */
/* Rectangular velocity: */
/* dX/dt (km/s) = -47.0428824 */
/* dY/dt (km/s) = 9.07021778 */
/* dZ/dt (km/s) = 4.75656274 */
/* Ellipsoid shape parameters: */
/* Equatorial radius (km) = 3396.19 */
/* Polar radius (km) = 3376.2 */
/* Flattening coefficient = 0.00588600756 */
/* Planetographic coordinates: */
/* Longitude (deg) = 297.667659 */
/* Latitude (deg) = 20.844504 */
/* Altitude (km) = 336531825. */
/* Planetographic velocity: */
/* d Longitude/dt (deg/s) = -8.35738632E-06 */
/* d Latitude/dt (deg/s) = 1.59349355E-06 */
/* d Altitude/dt (km/s) = -11.2144327 */
/* Rectangular coordinates from inverse mapping: */
/* X (km) = 146039732. */
/* Y (km) = 278546607. */
/* Z (km) = 119750315. */
/* Rectangular velocity from inverse mapping: */
/* dX/dt (km/s) = -47.0428824 */
/* dY/dt (km/s) = 9.07021778 */
/* dZ/dt (km/s) = 4.75656274 */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 26-DEC-2004 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* Jacobian of rectangular w.r.t. planetographic coordinates */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("DRDPGR", (ftnlen)6);
/* Convert the body name to an ID code. */
bods2c_(body, &bodyid, &found, body_len);
if (! found) {
setmsg_("The value of the input argument BODY is #, this is not a re"
"cognized name of an ephemeris object. The cause of this prob"
"lem may be that you need an updated version of the SPICE Too"
"lkit. ", (ftnlen)185);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* The equatorial radius must be positive. If not, signal an error */
/* and check out. */
if (*re <= 0.) {
setmsg_("Equatorial radius was #.", (ftnlen)24);
errdp_("#", re, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* If the flattening coefficient is greater than 1, the polar radius */
/* is negative. If F is equal to 1, the polar radius is zero. Either */
/* case is a problem, so signal an error and check out. */
if (*f >= 1.) {
setmsg_("Flattening coefficient was #.", (ftnlen)29);
errdp_("#", f, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* Look up the longitude sense override variable from the */
/* kernel pool. */
repmi_("BODY#_PGR_POSITIVE_LON", "#", &bodyid, pmkvar, (ftnlen)22, (
ftnlen)1, (ftnlen)32);
gcpool_(pmkvar, &c__1, &c__1, &n, kvalue, &found, (ftnlen)32, (ftnlen)80);
if (found) {
/* Make sure we recognize the value of PGRLON. */
cmprss_(" ", &c__0, kvalue, tmpstr, (ftnlen)1, (ftnlen)80, (ftnlen)32)
;
ucase_(tmpstr, pgrlon, (ftnlen)32, (ftnlen)4);
if (s_cmp(pgrlon, "EAST", (ftnlen)4, (ftnlen)4) == 0) {
sense = 1;
} else if (s_cmp(pgrlon, "WEST", (ftnlen)4, (ftnlen)4) == 0) {
sense = -1;
} else {
setmsg_("Kernel variable # may have the values EAST or WEST. Ac"
"tual value was #.", (ftnlen)72);
errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
errch_("#", kvalue, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
} else {
/* Look up the spin sense of the body's prime meridian. */
sense = plnsns_(&bodyid);
/* If the required prime meridian rate was not available, */
/* PLNSNS returns the code 0. Here we consider this situation */
/* to be an error. */
if (sense == 0) {
repmi_("BODY#_PM", "#", &bodyid, pmkvar, (ftnlen)8, (ftnlen)1, (
ftnlen)32);
setmsg_("Prime meridian rate coefficient defined by kernel varia"
"ble # is required but not available for body #. ", (
ftnlen)103);
errch_("#", pmkvar, (ftnlen)1, (ftnlen)32);
errch_("#", body, (ftnlen)1, body_len);
sigerr_("SPICE(MISSINGDATA)", (ftnlen)18);
chkout_("DRDPGR", (ftnlen)6);
return 0;
}
/* Handle the special cases: earth, moon, and sun. */
if (bodyid == 399 || bodyid == 301 || bodyid == 10) {
sense = 1;
}
}
/* At this point, SENSE is set to +/- 1. */
/* Adjust the longitude according to the sense of the body's */
/* spin, or according to the override value if one is provided. */
/* We want positive east longitude. */
geolon = sense * *lon;
/* Now that we have geodetic longitude in hand, use the */
/* geodetic equivalent of the input coordinates to find the */
/* Jacobian matrix of rectangular coordinates with respect */
/* to geodetic coordinates. */
drdgeo_(&geolon, lat, alt, re, f, jacobi);
/* The matrix JACOBI is */
/* .- -. */
/* | DX/DGEOLON DX/DLAT DX/DALT | */
/* | DY/DGEOLON DY/DLAT DY/DALT | */
/* | DZ/DGEOLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* which, applying the chain rule to D(*)/DGEOLON, is equivalent to */
/* .- -. */
/* | (1/SENSE) * DX/DLON DX/DLAT DX/DALT | */
/* | (1/SENSE) * DY/DLON DY/DLAT DY/DALT | */
/* | (1/SENSE) * DZ/DLON DZ/DLAT DZ/DALT | */
/* `- -' */
/* So, multiplying the first column of JACOBI by SENSE gives us the */
/* matrix we actually want to compute: the Jacobian matrix of */
/* rectangular coordinates with respect to planetographic */
/* coordinates. */
for (i__ = 1; i__ <= 3; ++i__) {
jacobi[(i__1 = i__ - 1) < 9 && 0 <= i__1 ? i__1 : s_rnge("jacobi",
i__1, "drdpgr_", (ftnlen)736)] = sense * jacobi[(i__2 = i__ -
1) < 9 && 0 <= i__2 ? i__2 : s_rnge("jacobi", i__2, "drdpgr_",
(ftnlen)736)];
}
chkout_("DRDPGR", (ftnlen)6);
return 0;
} /* drdpgr_ */
/* $Procedure PCKR03 ( Read PCK record from segment, type 03 ) */
/* Subroutine */ int pckr03_(integer *handle, doublereal *descr, doublereal *
et, doublereal *record)
{
integer ends, indx;
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical found;
doublereal value;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), sgfcon_(
integer *, doublereal *, integer *, integer *, doublereal *),
sigerr_(char *, ftnlen), chkout_(char *, ftnlen), sgfpkt_(integer
*, doublereal *, integer *, integer *, doublereal *, integer *),
sgfrvi_(integer *, doublereal *, doublereal *, doublereal *,
integer *, logical *), setmsg_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Read a single PCK data record from a segment of type 03. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PCK */
/* $ Keywords */
/* PCK */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I File handle for a PCK file. */
/* DESCR I Descriptor for a type 03 PCK segment. */
/* ET I Target epoch for orientation information. */
/* RECORD O Data record associated with epoch ET. */
/* $ Detailed_Input */
/* HANDLE is the file handle for a type 03 PCK segment. */
/* DESCR is the segment descriptor for a type 03 PCK segment. */
/* ET is a target epoch, for which a data record from */
/* the specified segment is required. */
/* $ Detailed_Output */
/* RECORD is the record from the specified segment which, */
/* when evaluated at epoch ET, will give the RA, DEC, */
/* W and body fixed angular rates for the body associated */
/* with the segment. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) It is assumed that the descriptor and handle supplied are */
/* for a properly constructed type 03 segment. No checks are */
/* performed to ensure this. */
/* 2) If the input ET value is not within the range specified */
/* in the segment descriptor, the error SPICE(TIMEOUTOFBOUNDS) */
/* is signalled. */
/* 3) All other errors are diagnosed by routines in the call tree */
/* of this routine. */
/* $ Files */
/* See argument HANDLE. */
/* $ Particulars */
/* This subroutine reads a type 03 PCK record from the segment */
/* specified by HANDLE and DESCR. The record read will contain */
/* sufficient information to to compute RA, DEC, W and body fixed */
/* angular rates for the body associated with the segment for epoch */
/* ET. */
/* See the PCK Required Reading file for a description of the */
/* structure of a type 03 PCK segment. */
/* $ Examples */
/* The data returned by the PCKRnn 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 PCKRnn */
/* 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 */
/* CALL PCKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 03 ) THEN */
/* CALL PCKR03 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* END IF */
/* $ Restrictions */
/* 1) It is assumed that the descriptor and handle supplied are */
/* for a properly constructed type 03 segment. No checks are */
/* performed to ensure this. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 20-SEP-1995 (KRG) */
/* -& */
/* $ Index_Entries */
/* read record from type_03 pck segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* The number of constant values stored with a type 03 segment */
/* segment. */
/* The beginning location in the output record for the non-constant */
/* segment data. */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PCKR03", (ftnlen)6);
}
/* Check the request time against the time bounds in the segment */
/* descriptor. In order to get the right data back from the generic */
/* segment calls below, we need to be sure that the desired epoch */
/* falls within the bounds of the segment, as specified by the */
/* descriptor. The first two elements of the descriptor are the start */
/* time for the segment and the stop time for the segment, */
/* respectively. */
if (*et < descr[0] || *et > descr[1]) {
setmsg_("Request time # is outside of descriptor bounds # : #.", (
ftnlen)53);
errdp_("#", et, (ftnlen)1);
errdp_("#", descr, (ftnlen)1);
errdp_("#", &descr[1], (ftnlen)1);
sigerr_("SPICE(TIMEOUTOFBOUNDS)", (ftnlen)22);
chkout_("PCKR03", (ftnlen)6);
return 0;
}
/* Fetch the constants and store them in the first part of */
/* the output RECORD. */
sgfcon_(handle, descr, &c__1, &c__1, record);
/* Locate the time in the file less than or equal to the input ET. */
sgfrvi_(handle, descr, et, &value, &indx, &found);
/* Fetch the data record. */
sgfpkt_(handle, descr, &indx, &indx, &record[1], &ends);
chkout_("PCKR03", (ftnlen)6);
return 0;
} /* pckr03_ */
/* $Procedure WNINSD ( Insert an interval into a DP window ) */
/* Subroutine */ int wninsd_(doublereal *left, doublereal *right, doublereal *
window)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
/* Local variables */
integer card, size, i__, j;
extern integer cardd_(doublereal *);
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
extern integer sized_(doublereal *);
extern /* Subroutine */ int scardd_(integer *, doublereal *), excess_(
integer *, char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char
*, ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Insert an interval into a double precision window. */
/* $ 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 */
/* WINDOWS */
/* $ Keywords */
/* WINDOWS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* LEFT, */
/* RIGHT I Left, right endpoints of new interval. */
/* WINDOW I,O Input, output window. */
/* $ Detailed_Input */
/* LEFT, */
/* RIGHT are the left and right endpoints of the interval */
/* to be inserted. */
/* WINDOW on input, is a window containing zero or more */
/* intervals. */
/* $ Detailed_Output */
/* WINDOW on output, is the original window following the */
/* insertion of the interval from LEFT to RIGHT. */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* This routine inserts the interval from LEFT to RIGHT into the */
/* input window. If the new interval overlaps any of the intervals */
/* in the window, the intervals are merged. Thus, the cardinality */
/* of the input window can actually decrease as the result of an */
/* insertion. However, because inserting an interval that is */
/* disjoint from the other intervals in the window can increase the */
/* cardinality of the window, the routine signals an error. */
/* This is the only unary routine to signal an error. No */
/* other unary routine can increase the number of intervals in */
/* the input window. */
/* $ Examples */
/* Let WINDOW contain the intervals */
/* [ 1, 3 ] [ 7, 11 ] [ 23, 27 ] */
/* Then the following series of calls */
/* CALL WNINSD ( 5, 5, WINDOW ) (1) */
/* CALL WNINSD ( 4, 8, WINDOW ) (2) */
/* CALL WNINSD ( 0, 30, WINDOW ) (3) */
/* produces the following series of windows */
/* [ 1, 3 ] [ 5, 5 ] [ 7, 11 ] [ 23, 27 ] (1) */
/* [ 1, 3 ] [ 4, 11 ] [ 23, 27 ] (2) */
/* [ 0, 30 ] (3) */
/* $ Exceptions */
/* 1) If LEFT is greater than RIGHT, the error SPICE(BADENDPOINTS) is */
/* signalled. */
/* 2) If the insertion of the interval causes an excess of elements, */
/* the error SPICE(WINDOWEXCESS) is signalled. */
/* $ Files */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - Beta Version 1.3.0, 04-MAR-1993 (KRG) */
/* There was a bug when moving the intervals in the cell */
/* to the right when inserting a new interval to the left */
/* of the left most interval. the incrementing in the DO */
/* loop was incorrect. */
/* The loop used to read: */
/* DO J = I-1, CARD */
/* WINDOW(J+2) = WINDOW(J) */
/* END DO */
/* which squashed everything to the right of the first interval */
/* with the values of the first interval. */
/* The loop now reads: */
/* DO J = CARD, I-1, -1 */
/* WINDOW(J+2) = WINDOW(J) */
/* END DO */
/* which correctly scoots the elements in reverse order, */
/* preserving their values. */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* insert an interval into a d.p. window */
/* -& */
/* $ Revisions */
/* - Beta Version 1.3.0, 04-MAR-1993 (KRG) */
/* There was a bug when moving the intervals in the cell */
/* to the right when inserting a new interval to the left */
/* of the left most interval. the incrementing in the DO */
/* loop was incorrect. */
/* The loop used to read: */
/* DO J = I-1, CARD */
/* WINDOW(J+2) = WINDOW(J) */
/* END DO */
/* which squashed everything to the right of the first interval */
/* with the values of the first interval. */
/* The loop now reads: */
/* DO J = CARD, I-1, -1 */
/* WINDOW(J+2) = WINDOW(J) */
/* END DO */
/* which correctly scoots the elements in reverse order, */
/* preserving their values. */
/* - Beta Version 1.2.0, 27-FEB-1989 (HAN) */
/* Due to the calling sequence and functionality changes */
/* in the routine EXCESS, the method of signalling an */
/* excess of elements needed to be changed. */
/* - Beta Version 1.1.0, 17-FEB-1989 (HAN) (NJB) */
/* Contents of the Required_Reading section was */
/* changed from "None." to "WINDOWS". Also, the */
/* declaration of the unused variable K was removed. */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("WNINSD", (ftnlen)6);
}
/* Get the size and cardinality of the window. */
size = sized_(window);
card = cardd_(window);
/* Let's try the easy cases first. No input interval? No change. */
/* Signal that an error has occurred and set the error message. */
if (*left > *right) {
setmsg_("Left endpoint was *. Right endpoint was *.", (ftnlen)42);
errdp_("*", left, (ftnlen)1);
errdp_("*", right, (ftnlen)1);
sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19);
chkout_("WNINSD", (ftnlen)6);
return 0;
/* Empty window? Input interval later than the end of the window? */
/* Just insert the interval, if there's room. */
} else if (card == 0 || *left > window[card + 5]) {
if (size >= card + 2) {
i__1 = card + 2;
scardd_(&i__1, window);
window[card + 6] = *left;
window[card + 7] = *right;
} else {
excess_(&c__2, "window", (ftnlen)6);
sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19);
}
chkout_("WNINSD", (ftnlen)6);
return 0;
}
/* Now on to the tougher cases. */
/* Skip intervals which lie completely to the left of the input */
/* interval. (The index I will always point to the right endpoint */
/* of an interval). */
i__ = 2;
while(i__ <= card && window[i__ + 5] < *left) {
i__ += 2;
}
/* There are three ways this can go. The new interval can: */
/* 1) lie entirely between the previous interval and the next. */
/* 2) overlap the next interval, but no others. */
/* 3) overlap more than one interval. */
/* Only the first case can possibly cause an overflow, since the */
/* other two cases require existing intervals to be merged. */
/* Case (1). If there's room, move succeeding intervals back and */
/* insert the new one. If there isn't room, signal an error. */
if (*right < window[i__ + 4]) {
if (size >= card + 2) {
i__1 = i__ - 1;
for (j = card; j >= i__1; --j) {
window[j + 7] = window[j + 5];
}
i__1 = card + 2;
scardd_(&i__1, window);
window[i__ + 4] = *left;
window[i__ + 5] = *right;
} else {
excess_(&c__2, "window", (ftnlen)6);
sigerr_("SPICE(WINDOWEXCESS)", (ftnlen)19);
chkout_("WNINSD", (ftnlen)6);
return 0;
}
/* Cases (2) and (3). */
} else {
/* The left and right endpoints of the new interval may or */
/* may not replace the left and right endpoints of the existing */
/* interval. */
/* Computing MIN */
d__1 = *left, d__2 = window[i__ + 4];
window[i__ + 4] = min(d__1,d__2);
/* Computing MAX */
d__1 = *right, d__2 = window[i__ + 5];
window[i__ + 5] = max(d__1,d__2);
/* Skip any intervals contained in the one we modified. */
/* (Like I, J always points to the right endpoint of an */
/* interval.) */
j = i__ + 2;
while(j <= card && window[j + 5] <= window[i__ + 5]) {
j += 2;
}
/* If the modified interval extends into the next interval, */
/* merge the two. (The modified interval grows to the right.) */
if (j <= card && window[i__ + 5] >= window[j + 4]) {
window[i__ + 5] = window[j + 5];
j += 2;
}
/* Move the rest of the intervals forward to take up the */
/* spaces left by the absorbed intervals. */
while(j <= card) {
i__ += 2;
window[i__ + 4] = window[j + 4];
window[i__ + 5] = window[j + 5];
j += 2;
}
scardd_(&i__, window);
}
chkout_("WNINSD", (ftnlen)6);
return 0;
} /* wninsd_ */
/* $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 STELAB ( Stellar Aberration ) */
/* Subroutine */ int stelab_(doublereal *pobj, doublereal *vobs, doublereal *
appobj)
{
/* Builtin functions */
double asin(doublereal);
/* Local variables */
extern /* Subroutine */ int vhat_(doublereal *, doublereal *);
doublereal vbyc[3];
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *);
doublereal h__[3], u[3];
extern /* Subroutine */ int chkin_(char *, ftnlen), moved_(doublereal *,
integer *, doublereal *), errdp_(char *, doublereal *, ftnlen),
vcrss_(doublereal *, doublereal *, doublereal *);
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
extern doublereal clight_(void);
doublereal onebyc, sinphi;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
doublereal lensqr;
extern logical return_(void);
doublereal phi;
/* $ Abstract */
/* Correct the apparent position of an object for stellar */
/* aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* POBJ I Position of an object with respect to the */
/* observer. */
/* VOBS I Velocity of the observer with respect to the */
/* Solar System barycenter. */
/* APPOBJ O Apparent position of the object with respect to */
/* the observer, corrected for stellar aberration. */
/* $ Detailed_Input */
/* POBJ is the position (x, y, z, km) of an object with */
/* respect to the observer, possibly corrected for */
/* light time. */
/* VOBS is the velocity (dx/dt, dy/dt, dz/dt, km/sec) */
/* of the observer with respect to the Solar System */
/* barycenter. */
/* $ Detailed_Output */
/* APPOBJ is the apparent position of the object relative */
/* to the observer, corrected for stellar aberration. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the velocity of the observer is greater than or equal */
/* to the speed of light, the error SPICE(VALUEOUTOFRANGE) */
/* is signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Let r be the vector from the observer to the object, and v be */
/* - - */
/* the velocity of the observer with respect to the Solar System */
/* barycenter. Let w be the angle between them. The aberration */
/* angle phi is given by */
/* sin(phi) = v sin(w) / c */
/* Let h be the vector given by the cross product */
/* - */
/* h = r X v */
/* - - - */
/* Rotate r by phi radians about h to obtain the apparent position */
/* - - */
/* of the object. */
/* $ Examples */
/* In the following example, STELAB is used to correct the position */
/* of a target body for stellar aberration. */
/* (Previous subroutine calls have loaded the SPK file and */
/* the leapseconds kernel file.) */
/* C */
/* C Get the geometric state of the observer OBS relative to */
/* C the solar system barycenter. */
/* C */
/* CALL SPKSSB ( OBS, ET, 'J2000', SOBS ) */
/* C */
/* C Get the light-time corrected position TPOS of the target */
/* C body TARG as seen by the observer. Normally we would */
/* C call SPKPOS to obtain this vector, but we already have */
/* C the state of the observer relative to the solar system */
/* C barycenter, so we can avoid looking up that state twice */
/* C by calling SPKAPO. */
/* C */
/* CALL SPKAPO ( TARG, ET, 'J2000', SOBS, 'LT', TPOS, LT ) */
/* C */
/* C Apply the correction for stellar aberration to the */
/* C light-time corrected position of the target body. */
/* C The corrected position is returned in the argument */
/* C PCORR. */
/* C */
/* CALL STELAB ( TPOS, SOBS(4), PCORR ) */
/* Note that this example is somewhat contrived. The sequence */
/* of calls above could be replaced by a single call to SPKEZP, */
/* using the aberration correction flag 'LT+S'. */
/* For more information on aberration-corrected states or */
/* positions, see the headers of any of the routines */
/* SPKEZR */
/* SPKEZ */
/* SPKPOS */
/* SPKEZP */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) W.M. Owen, Jr., JPL IOM #314.8-524, "The Treatment of */
/* Aberration in Optical Navigation", 8 February 1985. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 8-JAN-2008 (NJB) */
/* The header example was updated to remove references */
/* to SPKAPP. */
/* - SPICELIB Version 1.1.0, 8-FEB-1999 (WLT) */
/* The example was corrected so that SOBS(4) is passed */
/* into STELAB instead of STARG(4). */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 8-AUG-1990 (HAN) */
/* Examples section of the header was updated to replace */
/* calls to the GEF ephemeris readers by calls to the */
/* new SPK ephemeris reader. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (WLT) */
/* -& */
/* $ Index_Entries */
/* stellar aberration */
/* -& */
/* $ Revisions */
/* - Beta Version 2.1.0, 9-MAR-1989 (HAN) */
/* Declaration of the variable LIGHT was removed from the code. */
/* The variable was declared but never used. */
/* - Beta Version 2.0.0, 28-DEC-1988 (HAN) */
/* Error handling was added to check the velocity of the */
/* observer. If the velocity of the observer is greater */
/* than or equal to the speed of light, the error */
/* SPICE(VALUEOUTOFRANGE) is signalled. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("STELAB", (ftnlen)6);
}
/* We are not going to compute the aberrated vector in exactly the */
/* way described in the particulars section. We can combine some */
/* steps and we take some precautions to prevent floating point */
/* overflows. */
/* Get a unit vector that points in the direction of the object */
/* ( u_obj ). */
vhat_(pobj, u);
/* Get the velocity vector scaled with respect to the speed of light */
/* ( v/c ). */
onebyc = 1. / clight_();
vscl_(&onebyc, vobs, vbyc);
/* If the square of the length of the velocity vector is greater than */
/* or equal to one, the speed of the observer is greater than or */
/* equal to the speed of light. The observer speed is definitely out */
/* of range. Signal an error and check out. */
lensqr = vdot_(vbyc, vbyc);
if (lensqr >= 1.) {
setmsg_("Velocity components of observer were: dx/dt = *, dy/dt = *"
", dz/dt = *.", (ftnlen)71);
errdp_("*", vobs, (ftnlen)1);
errdp_("*", &vobs[1], (ftnlen)1);
errdp_("*", &vobs[2], (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("STELAB", (ftnlen)6);
return 0;
}
/* Compute u_obj x (v/c) */
vcrss_(u, vbyc, h__);
/* If the magnitude of the vector H is zero, the observer is moving */
/* along the line of sight to the object, and no correction is */
/* required. Otherwise, rotate the position of the object by phi */
/* radians about H to obtain the apparent position. */
sinphi = vnorm_(h__);
if (sinphi != 0.) {
phi = asin(sinphi);
vrotv_(pobj, h__, &phi, appobj);
} else {
moved_(pobj, &c__3, appobj);
}
chkout_("STELAB", (ftnlen)6);
return 0;
} /* stelab_ */
/* $Procedure INVORT ( Invert nearly orthogonal matrices ) */
/* Subroutine */ int invort_(doublereal *m, doublereal *mit)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal temp[9] /* was [3][3] */;
integer i__;
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static doublereal bound;
extern doublereal dpmax_(void);
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), xpose_(
doublereal *, doublereal *), unorm_(doublereal *, doublereal *,
doublereal *);
doublereal length;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), vsclip_(doublereal *, doublereal *), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
/* $ Abstract */
/* Construct the inverse of a 3x3 matrix with orthogonal columns */
/* and non-zero norms using a numerical stable algorithm. */
/* $ 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 */
/* MATRIX */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* M I A 3x3 matrix. */
/* MIT I M after transposition and scaling of rows. */
/* $ Detailed_Input */
/* M is a 3x3 matrix. */
/* $ Detailed_Output */
/* MIT is the matrix obtained by transposing M and dividing */
/* the rows by squares of their norms. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If any of the columns of M have zero length, the error */
/* SPICE(ZEROLENGTHCOLUMN) will be signaled. */
/* 2) If any column is too short to allow computation of the */
/* reciprocal of its length without causing a floating */
/* point overflow, the error SPICE(COLUMNTOOSMALL) will */
/* be signaled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* Suppose that M is the matrix */
/* - - */
/* | A*u B*v C*w | */
/* | 1 1 1 | */
/* | | */
/* | A*u B*v C*w | */
/* | 2 2 2 | */
/* | | */
/* | A*u B*v C*w | */
/* | 3 3 3 | */
/* - - */
/* where the vectors (u , u , u ), (v , v , v ), and (w , w , w ) */
/* 1 2 3 1 2 3 1 2 3 */
/* are unit vectors. This routine produces the matrix: */
/* - - */
/* | a*u a*u a*u | */
/* | 1 2 3 | */
/* | | */
/* | b*v b*v b*v | */
/* | 1 2 3 | */
/* | | */
/* | c*w c*w c*w | */
/* | 1 2 3 | */
/* - - */
/* where a = 1/A, b = 1/B, and c = 1/C. */
/* $ Examples */
/* Suppose that you have a matrix M whose columns are orthogonal */
/* and have non-zero norm (but not necessarily norm 1). Then the */
/* routine INVORT can be used to construct the inverse of M: */
/* CALL INVORT ( M, INVERS ) */
/* This method is numerically more robust than calling the */
/* routine INVERT. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 14-NOV-2013 (EDW) */
/* Edit to Abstract. Eliminated unneeded Revisions section. */
/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL call. */
/* - SPICELIB Version 1.0.0, 02-JAN-2002 (WLT) */
/* -& */
/* $ Index_Entries */
/* Transpose a matrix and invert the lengths of the rows */
/* Invert a pseudo orthogonal matrix */
/* -& */
/* SPICELIB functions */
/* Local Variables */
/* Saved variables */
/* Initial values */
/* Use discovery check-in. */
/* The first time through, get a copy of DPMAX. */
if (first) {
bound = dpmax_();
first = FALSE_;
}
/* For each column, construct a scaled copy. However, make sure */
/* everything is do-able before trying something. */
for (i__ = 1; i__ <= 3; ++i__) {
unorm_(&m[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 : s_rnge("m",
i__1, "invort_", (ftnlen)208)], &temp[(i__2 = i__ * 3 - 3) <
9 && 0 <= i__2 ? i__2 : s_rnge("temp", i__2, "invort_", (
ftnlen)208)], &length);
if (length == 0.) {
chkin_("INVORT", (ftnlen)6);
setmsg_("Column # of the input matrix has a norm of zero. ", (
ftnlen)49);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(ZEROLENGTHCOLUMN)", (ftnlen)23);
chkout_("INVORT", (ftnlen)6);
return 0;
}
/* Make sure we can actually rescale the rows. */
if (length < 1.) {
if (length * bound < 1.) {
chkin_("INVORT", (ftnlen)6);
setmsg_("The length of column # is #. This number cannot be "
"inverted. For this reason, the scaled transpose of "
"the input matrix cannot be formed. ", (ftnlen)138);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &length, (ftnlen)1);
sigerr_("SPICE(COLUMNTOOSMALL)", (ftnlen)21);
chkout_("INVORT", (ftnlen)6);
return 0;
}
}
scale = 1. / length;
vsclip_(&scale, &temp[(i__1 = i__ * 3 - 3) < 9 && 0 <= i__1 ? i__1 :
s_rnge("temp", i__1, "invort_", (ftnlen)246)]);
}
/* If we make it this far, we just need to transpose TEMP into MIT. */
xpose_(temp, mit);
return 0;
} /* invort_ */
/* $Procedure BODMAT ( Return transformation matrix for a body ) */
/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm)
{
/* Initialized data */
static logical first = TRUE_;
static logical found = FALSE_;
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_dnnt(doublereal *);
double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *)
;
/* Local variables */
integer cent;
char item[32];
doublereal j2ref[9] /* was [3][3] */;
extern integer zzbodbry_(integer *);
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
doublereal d__;
integer i__, j;
doublereal dcoef[3], t, w;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
doublereal delta;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal theta;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, errdp_(char *, doublereal *, ftnlen);
doublereal costh[100];
extern doublereal vdotg_(doublereal *, doublereal *, integer *);
char dtype[1];
doublereal sinth[100], tsipm[36] /* was [6][6] */;
extern doublereal twopi_(void);
static integer j2code;
doublereal ac[100], dc[100];
integer na, nd;
doublereal ra, wc[100];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern logical bodfnd_(integer *, char *, ftnlen);
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern doublereal halfpi_(void);
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
integer nw;
doublereal conepc, conref;
extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *,
doublereal *, logical *);
integer ntheta;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char fixfrm[32], errmsg[1840];
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen), errint_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
irfrot_(integer *, integer *, doublereal *);
extern logical return_(void);
char timstr[35];
extern doublereal j2000_(void);
doublereal dec;
integer dim, ref;
doublereal phi;
extern doublereal rpd_(void), spd_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return the J2000 to body Equator and Prime Meridian coordinate */
/* transformation matrix for a specified body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PCK */
/* NAIF_IDS */
/* TIME */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation from Inertial to PM for BODY at ET. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* transformation is requested. Bodies are numbered */
/* according to the standard NAIF numbering scheme. */
/* ET is the epoch at which the transformation is */
/* requested. (This is typically the epoch of */
/* observation minus the one-way light time from */
/* the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is the transformation matrix from Inertial to body */
/* Equator and Prime Meridian. The X axis of the PM */
/* system is directed to the intersection of the */
/* equator and prime meridian. The Z axis points north. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If data required to define the body-fixed frame associated */
/* with BODY are not found in the binary PCK system or the kernel */
/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */
/* the case of IAU style body-fixed frames, the absence of */
/* prime meridian polynomial data (which are required) is used */
/* as an indicator of missing data. */
/* 2) If the test for exception (1) passes, but in fact requested */
/* data are not available in the kernel pool, the error will be */
/* signaled by routines in the call tree of this routine. */
/* 3) If the kernel pool does not contain all of the data required */
/* to define the number of nutation precession angles */
/* corresponding to the available nutation precession */
/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */
/* signaled. */
/* 4) If the reference frame REF is not recognized, a routine */
/* called by BODMAT will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 5) If the specified body code BODY is not recognized, the */
/* error is diagnosed by a routine called by BODMAT. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine is related to the more general routine TIPBOD */
/* which returns a matrix that transforms vectors from a */
/* specified inertial reference frame to body equator and */
/* prime meridian coordinates. TIPBOD accepts an input argument */
/* REF that allows the caller to specify an inertial reference */
/* frame. */
/* The transformation represented by BODMAT's output argument TIPM */
/* is defined as follows: */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If there exists high-precision binary PCK kernel information */
/* for the body at the requested time, these angles, W, DELTA */
/* and PHI are computed directly from that file. The most */
/* recently loaded binary PCK file has first priority followed */
/* by previously loaded binary PCK files in backward time order. */
/* If no binary PCK file has been loaded, the text P_constants */
/* kernel file is used. */
/* If there is only text PCK kernel information, it is */
/* expressed in terms of RA, DEC and W (same W as above), where */
/* RA = PHI - HALFPI() */
/* DEC = HALFPI() - DELTA */
/* RA, DEC, and W are defined as follows in the text PCK file: */
/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */
/* i i */
/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */
/* i i */
/* W = W0 + W1*d + W2*d*d + w sin theta */
/* i i */
/* where: */
/* d = days past J2000. */
/* T = Julian centuries past J2000. */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0 * THETA1*T are specific to each planet. */
/* i */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* In the following code fragment, BODMAT is used to rotate */
/* the position vector (POS) from a target body (BODY) to a */
/* spacecraft from inertial coordinates to body-fixed coordinates */
/* at a specific epoch (ET), in order to compute the planetocentric */
/* longitude (PCLONG) of the spacecraft. */
/* CALL BODMAT ( BODY, ET, TIPM ) */
/* CALL MXV ( TIPM, POS, POS ) */
/* CALL RECLAT ( POS, RADIUS, PCLONG, LAT ) */
/* To compute the equivalent planetographic longitude (PGLONG), */
/* it is necessary to know the direction of rotation of the target */
/* body, as shown below. */
/* CALL BODVCD ( BODY, 'PM', 3, DIM, VALUES ) */
/* IF ( VALUES(2) .GT. 0.D0 ) THEN */
/* PGLONG = PCLONG */
/* ELSE */
/* PGLONG = TWOPI() - PCLONG */
/* END IF */
/* Note that the items necessary to compute the transformation */
/* TIPM must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the NAIF_IDS required reading file for a complete */
/* list of the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 4.1.1, 01-FEB-2008 (NJB) */
/* The routine was updated to improve the error messages created */
/* when required PCK data are not found. Now in most cases the */
/* messages are created locally rather than by the kernel pool */
/* access routines. In particular missing binary PCK data will */
/* be indicated with a reasonable error message. */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Implementation changes were made to improve robustness */
/* of the code. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* Gets TSIPM matrix from PCKMAT (instead of Euler angles */
/* from PCKEUL.) */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* Ability to get Euler angles from binary PCK file added. */
/* This uses the new routine PCKEUL. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* fetch transformation matrix for a body */
/* transformation from j2000 position to bodyfixed */
/* transformation from j2000 to bodyfixed coordinates */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Calls to deprecated kernel pool access routine RTPOOL */
/* were replaced by calls to GDPOOL. */
/* Calls to BODVAR have been replaced with calls to */
/* ZZBODVCD. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* BODMAT now get the TSIPM matrix from PCKMAT, and */
/* unpacks TIPM from it. Also the calculated but unused */
/* variable LAMBDA was removed. */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* BODMAT now uses new software to check for the */
/* existence of binary PCK files, search the for */
/* data corresponding to the requested body and time, */
/* and return the appropriate Euler angles, using the */
/* new routine PCKEUL. Otherwise the code calculates */
/* the Euler angles from the P_constants kernel file. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* BODMAT now checks the kernel pool for presence of the */
/* variables */
/* BODY#_CONSTANTS_REF_FRAME */
/* and */
/* BODY#_CONSTANTS_JED_EPOCH */
/* where # is the NAIF integer code of the barycenter of a */
/* planetary system or of a body other than a planet or */
/* satellite. If either or both of these variables are */
/* present, the P_constants for BODY are presumed to be */
/* referenced to the specified inertial frame or epoch. */
/* If the epoch of the constants is not J2000, the input */
/* time ET is converted to seconds past the reference epoch. */
/* If the frame of the constants is not J2000, the rotation from */
/* the P_constants' frame to body-fixed coordinates is */
/* transformed to the rotation from J2000 coordinates to */
/* body-fixed coordinates. */
/* For efficiency reasons, this routine now duplicates much */
/* of the code of BODEUL so that it doesn't have to call BODEUL. */
/* In some cases, BODEUL must covert Euler angles to a matrix, */
/* rotate the matrix, and convert the result back to Euler */
/* angles. If this routine called BODEUL, then in such cases */
/* this routine would convert the transformed angles back to */
/* a matrix. That would be a bit much.... */
/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */
/* Examples section completed. Declaration of unused variable */
/* FOUND removed. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODMAT", (ftnlen)6);
}
/* Get the code for the J2000 frame, if we don't have it yet. */
if (first) {
irfnum_("J2000", &j2code, (ftnlen)5);
first = FALSE_;
}
/* Get Euler angles from high precision data file. */
pckmat_(body, et, &ref, tsipm, &found);
if (found) {
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 :
s_rnge("tipm", i__1, "bodmat_", (ftnlen)485)] = tsipm[
(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("tsipm", i__2, "bodmat_", (ftnlen)485)];
}
}
} else {
/* The data for the frame of interest are not available in a */
/* loaded binary PCK file. This is not an error: the data may be */
/* present in the kernel pool. */
/* Conduct a non-error-signaling check for the presence of a */
/* kernel variable that is required to implement an IAU style */
/* body-fixed reference frame. If the data aren't available, we */
/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */
/* we want to issue the error signal locally, with a better error */
/* message. */
s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1);
if (! found) {
/* Now we do have an error. */
/* We don't have the data we'll need to produced the requested */
/* state transformation matrix. In order to create an error */
/* message understandable to the user, find, if possible, the */
/* name of the reference frame associated with the input body. */
/* Note that the body is really identified by a PCK frame class */
/* ID code, though most of the documentation just calls it a */
/* body ID code. */
ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32);
etcal_(et, timstr, (ftnlen)35);
s_copy(errmsg, "PCK data required to compute the orientation of "
"the # # for epoch # TDB were not found. If these data we"
"re to be provided by a binary PCK file, then it is possi"
"ble that the PCK file does not have coverage for the spe"
"cified body-fixed frame at the time of interest. If the "
"data were to be provided by a text PCK file, then possib"
"ly the file does not contain data for the specified body"
"-fixed frame. In either case it is possible that a requi"
"red PCK file was not loaded at all.", (ftnlen)1840, (
ftnlen)475);
/* Fill in the variable data in the error message. */
if (found) {
/* The frame system knows the name of the body-fixed frame. */
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16);
errch_("#", fixfrm, (ftnlen)1, (ftnlen)32);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
} else {
/* The frame system doesn't know the name of the */
/* body-fixed frame, most likely due to a missing */
/* frame kernel. */
suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840);
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame associated with the ID code", (
ftnlen)1, (ftnlen)44);
errint_("#", body, (ftnlen)1);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
errch_("#", "Also, a frame kernel defining the body-fixed fr"
"ame associated with body # may need to be loaded.", (
ftnlen)1, (ftnlen)96);
errint_("#", body, (ftnlen)1);
}
sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Find the body code used to label the reference frame and epoch */
/* specifiers for the orientation constants for BODY. */
/* For planetary systems, the reference frame and epoch for the */
/* orientation constants is associated with the system */
/* barycenter, not with individual bodies in the system. For any */
/* other bodies, (the Sun or asteroids, for example) the body's */
/* own code is used as the label. */
refid = zzbodbry_(body);
/* Look up the epoch of the constants. The epoch is specified */
/* as a Julian ephemeris date. The epoch defaults to J2000. */
s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32);
if (found) {
/* The reference epoch is returned as a JED. Convert to */
/* ephemeris seconds past J2000. Then convert the input ET to */
/* seconds past the reference epoch. */
conepc = spd_() * (conepc - j2000_());
epoch = *et - conepc;
} else {
epoch = *et;
}
/* Look up the reference frame of the constants. The reference */
/* frame is specified by a code recognized by CHGIRF. The */
/* default frame is J2000, symbolized by the code J2CODE. */
s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32);
if (found) {
ref = i_dnnt(&conref);
} else {
ref = j2code;
}
/* Whatever the body, it has quadratic time polynomials for */
/* the RA and Dec of the pole, and for the rotation of the */
/* Prime Meridian. */
s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7);
cleard_(&c__3, rcoef);
bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32);
s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8);
cleard_(&c__3, dcoef);
bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32);
s_copy(item, "PM", (ftnlen)32, (ftnlen)2);
cleard_(&c__3, wcoef);
bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32);
/* There may be additional nutation and libration (THETA) terms. */
ntheta = 0;
na = 0;
nd = 0;
nw = 0;
s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15);
if (bodfnd_(&refid, item, (ftnlen)32)) {
bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32);
ntheta /= 2;
}
s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32);
}
s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32);
}
s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32);
}
/* Computing MAX */
i__1 = max(na,nd);
if (max(i__1,nw) > ntheta) {
setmsg_("Insufficient number of nutation/precession angles for b"
"ody * at time #.", (ftnlen)71);
errint_("*", body, (ftnlen)1);
errdp_("#", et, (ftnlen)1);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Evaluate the time polynomials at EPOCH. */
d__ = epoch / spd_();
t = d__ / 36525.;
ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]);
dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]);
w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]);
/* Add nutation and libration as appropriate. */
i__1 = ntheta;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 :
s_rnge("tcoef", i__2, "bodmat_", (ftnlen)700)] + t *
tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 :
s_rnge("tcoef", i__3, "bodmat_", (ftnlen)700)]) * rpd_();
sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth",
i__2, "bodmat_", (ftnlen)702)] = sin(theta);
costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh",
i__2, "bodmat_", (ftnlen)703)] = cos(theta);
}
ra += vdotg_(ac, sinth, &na);
dec += vdotg_(dc, costh, &nd);
w += vdotg_(wc, sinth, &nw);
/* Convert from degrees to radians and mod by two pi. */
ra *= rpd_();
dec *= rpd_();
w *= rpd_();
d__1 = twopi_();
ra = d_mod(&ra, &d__1);
d__1 = twopi_();
dec = d_mod(&dec, &d__1);
d__1 = twopi_();
w = d_mod(&w, &d__1);
/* Convert to Euler angles. */
phi = ra + halfpi_();
delta = halfpi_() - dec;
/* Produce the rotation matrix defined by the Euler angles. */
eul2m_(&w, &delta, &phi, &c__3, &c__1, &c__3, tipm);
}
/* Convert TIPM to the J2000-to-bodyfixed rotation, if is is not */
/* already referenced to J2000. */
if (ref != j2code) {
/* Find the transformation from the J2000 frame to the frame */
/* designated by REF. Form the transformation from `REF' */
/* coordinates to body-fixed coordinates. Compose the */
/* transformations to obtain the J2000-to-body-fixed */
/* transformation. */
irfrot_(&j2code, &ref, j2ref);
mxm_(tipm, j2ref, tmpmat);
moved_(tmpmat, &c__9, tipm);
}
/* TIPM now gives the transformation from J2000 to */
/* body-fixed coordinates at epoch ET seconds past J2000, */
/* regardless of the epoch and frame of the orientation constants */
/* for the specified body. */
chkout_("BODMAT", (ftnlen)6);
return 0;
} /* bodmat_ */
/* $Procedure GFRFOV ( GF, is ray in FOV? ) */
/* Subroutine */ int gfrfov_(char *inst, doublereal *raydir, char *rframe,
char *abcorr, char *obsrvr, doublereal *step, doublereal *cnfine,
doublereal *result, ftnlen inst_len, ftnlen rframe_len, ftnlen
abcorr_len, ftnlen obsrvr_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
extern /* Subroutine */ int chkin_(char *, ftnlen), errdp_(char *,
doublereal *, ftnlen);
extern integer sized_(doublereal *);
extern logical gfbail_();
extern /* Subroutine */ int gfrefn_(), gfrepf_(), gfrepi_();
extern /* Subroutine */ int gffove_(char *, char *, doublereal *, char *,
char *, char *, char *, doublereal *, U_fp, U_fp, logical *, U_fp,
U_fp, U_fp, logical *, L_fp, doublereal *, doublereal *, ftnlen,
ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
extern /* Subroutine */ int gfrepu_(), gfstep_();
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int chkout_(char *, ftnlen), gfsstp_(doublereal *)
;
/* $ Abstract */
/* Determine time intervals when a specified ray intersects the */
/* space bounded by the field-of-view (FOV) of a specified */
/* instrument. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CK */
/* FRAMES */
/* GF */
/* KERNEL */
/* NAIF_IDS */
/* PCK */
/* SPK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* EVENT */
/* FOV */
/* GEOMETRY */
/* INSTRUMENT */
/* SEARCH */
/* WINDOW */
/* $ Declarations */
/* $ Abstract */
/* This file contains public, 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) */
/* L.E. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 08-SEP-2009 (EDW) */
/* Added NWRR parameter. */
/* Added NWUDS parameter. */
/* - SPICELIB Version 1.0.0, 21-FEB-2009 (NJB) (LSE) (EDW) */
/* -& */
/* Root finding parameters: */
/* CNVTOL is the default convergence tolerance used by the */
/* high-level GF search API routines. This tolerance is */
/* used to terminate searches for binary state transitions: */
/* when the time at which a transition occurs is bracketed */
/* by two times that differ by no more than CNVTOL, the */
/* transition time is considered to have been found. */
/* Units are TDB seconds. */
/* NWMAX is the maximum number of windows allowed for user-defined */
/* workspace array. */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWMAX ) */
/* Currently no more than twelve windows are required; the three */
/* extra windows are spares. */
/* Callers of GFEVNT can include this file and use the parameter */
/* NWMAX to declare the second dimension of the workspace array */
/* if necessary. */
/* Callers of GFIDST should declare their workspace window */
/* count using NWDIST. */
/* Callers of GFSEP should declare their workspace window */
/* count using NWSEP. */
/* Callers of GFRR should declare their workspace window */
/* count using NWRR. */
/* Callers of GFUDS should declare their workspace window */
/* count using NWUDS. */
/* ADDWIN is a parameter used to expand each interval of the search */
/* (confinement) window by a small amount at both ends in order to */
/* accommodate searches using equality constraints. The loaded */
/* kernel files must accommodate these expanded time intervals. */
/* FRMNLN is a string length for frame names. */
/* NVRMAX is the maximum number of vertices if FOV type is "POLYGON" */
/* FOVTLN -- maximum length for FOV string. */
/* Specify the character strings that are allowed in the */
/* specification of field of view shapes. */
/* Character strings that are allowed in the */
/* specification of occultation types: */
/* Occultation target shape specifications: */
/* Specify the number of supported occultation types and occultation */
/* type string length: */
/* Instrument field-of-view (FOV) parameters */
/* Maximum number of FOV boundary vectors: */
/* FOV shape parameters: */
/* circle */
/* ellipse */
/* polygon */
/* rectangle */
/* End of file gf.inc. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* MARGIN P Minimum complement of FOV cone angle. */
/* LBCELL P SPICE Cell lower bound. */
/* CNVTOL P Convergence tolerance. */
/* MAXVRT P Maximum number of FOV boundary vertices. */
/* INST I Name of the instrument. */
/* RAYDIR I Ray's direction vector. */
/* RFRAME I Reference frame of ray's direction vector. */
/* ABCORR I Aberration correction flag. */
/* OBSRVR I Name of the observing body. */
/* STEP I Step size in seconds for finding FOV events. */
/* CNFINE I SPICE window to which the search is restricted. */
/* RESULT O SPICE window containing results. */
/* $ Detailed_Input */
/* INST indicates the name of an instrument, such as a */
/* spacecraft-mounted framing camera, the field of view */
/* (FOV) of which is to be used for an target intersection */
/* search: the direction from the observer to a target */
/* is represented by a ray, and times when the specified */
/* ray intersects the region of space bounded by the FOV */
/* are sought. */
/* The position of the instrument designated by INST is */
/* considered to coincide with that of the ephemeris */
/* object designated by the input argument OBSRVR (see */
/* description below). */
/* INST must have a corresponding NAIF ID and a frame */
/* defined, as is normally done in a frame kernel. It */
/* must also have an associated reference frame and a FOV */
/* shape, boresight and boundary vertices (or reference */
/* vector and reference angles) defined, as is usually */
/* done in an instrument kernel. */
/* See the header of the SPICELIB routine GETFOV for a */
/* description of the required parameters associated with */
/* an instrument. */
/* RAYDIR is the direction vector associated with a ray */
/* representing a target. The ray emanates from the */
/* location of the ephemeris object designated by the */
/* input argument OBSRVR and is expressed relative to the */
/* reference frame designated by RFRAME (see descriptions */
/* below). */
/* RFRAME is the name of the reference frame associated with */
/* the input ray's direction vector RAYDIR. */
/* Since light time corrections are not supported for */
/* rays, the orientation of the frame is always evaluated */
/* at the epoch associated with the observer, as opposed */
/* to the epoch associated with the light-time corrected */
/* position of the frame center. */
/* Case and leading or trailing blanks bracketing a */
/* non-blank frame name are not significant in the string */
/* RFRAME. */
/* ABCORR indicates the aberration corrections to be applied */
/* when computing the ray's direction. */
/* The supported aberration correction options are */
/* 'NONE' No correction. */
/* 'S' Stellar aberration correction, */
/* reception case. */
/* 'XS' Stellar aberration correction, */
/* transmission case. */
/* For detailed information, see the geometry finder */
/* required reading, gf.req. */
/* Case, leading and trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSRVR is the name of the body from which the target */
/* represented by RAYDIR is observed. The instrument */
/* designated by INST is treated as if it were co-located */
/* with the observer. */
/* Optionally, you may supply the integer NAIF ID code */
/* for the body as a string. */
/* Case and leading or trailing blanks are not */
/* significant in the string OBSRVR. */
/* STEP is the step size to be used in the search. STEP must */
/* be shorter than any interval, within the confinement */
/* window, over which the specified condition is met. In */
/* other words, STEP must be shorter than the shortest */
/* visibility event that the user wishes to detect. STEP */
/* also must be shorter than the minimum duration */
/* separating any two visibility events. 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; the */
/* precision is controlled by the convergence tolerance. */
/* See the discussion of the parameter CNVTOL for */
/* details. */
/* STEP has units of seconds. */
/* CNFINE is a SPICE window that confines the time period over */
/* which the specified search is conducted. CNFINE may */
/* consist of a single interval or a collection of */
/* intervals. */
/* The endpoints of the time intervals comprising CNFINE */
/* are interpreted as seconds past J2000 TDB. */
/* See the Examples section below for a code example */
/* that shows how to create a confinement window. */
/* CNFINE must be initialized by the caller via the */
/* SPICELIB routine SSIZED. */
/* $ Detailed_Output */
/* RESULT is a SPICE window representing the set of time */
/* intervals, within the confinement period, when the */
/* input ray is "visible"; that is, when the ray is */
/* contained in the space bounded by the specified */
/* instrument's field of view. */
/* The endpoints of the time intervals comprising RESULT */
/* are interpreted as seconds past J2000 TDB. */
/* If RESULT is non-empty on input, its contents */
/* will be discarded before GFRFOV conducts its */
/* search. */
/* $ Parameters */
/* LBCELL is the lower bound for SPICE cell arrays. */
/* CNVTOL is the convergence tolerance used for finding */
/* endpoints of the intervals comprising the result */
/* window. CNVTOL is used to determine when binary */
/* searches for roots should terminate: when a root is */
/* bracketed within an interval of length CNVTOL; the */
/* root is considered to have been found. */
/* The accuracy, as opposed to precision, of roots found */
/* by this routine depends on the accuracy of the input */
/* data. In most cases, the accuracy of solutions will be */
/* inferior to their precision. */
/* MAXVRT is the maximum number of vertices that may be used */
/* to define the boundary of the specified instrument's */
/* field of view. */
/* MARGIN is a small positive number used to constrain the */
/* orientation of the boundary vectors of polygonal */
/* FOVs. Such FOVs must satisfy the following constraints: */
/* 1) The boundary vectors must be contained within */
/* a right circular cone of angular radius less */
/* than than (pi/2) - MARGIN radians; in other */
/* words, there must be a vector A such that all */
/* boundary vectors have angular separation from */
/* A of less than (pi/2)-MARGIN radians. */
/* 2) There must be a pair of boundary vectors U, V */
/* such that all other boundary vectors lie in */
/* the same half space bounded by the plane */
/* containing U and V. Furthermore, all other */
/* boundary vectors must have orthogonal */
/* projections onto a specific plane normal to */
/* this plane (the normal plane contains the angle */
/* bisector defined by U and V) such that the */
/* projections have angular separation of at least */
/* 2*MARGIN radians from the plane spanned by U */
/* and V. */
/* MARGIN is currently set to 1.D-12. */
/* See INCLUDE file gf.inc for declarations and descriptions of */
/* parameters used throughout the GF system. */
/* $ Exceptions */
/* 1) In order for this routine to produce correct results, */
/* the step size must be appropriate for the problem at hand. */
/* Step sizes that are too large may cause this routine to miss */
/* roots; step sizes that are too small may cause this routine */
/* to run unacceptably slowly and in some cases, find spurious */
/* roots. */
/* This routine does not diagnose invalid step sizes, except */
/* that if the step size is non-positive, the error */
/* SPICE(INVALIDSTEPSIZE) will be signaled. */
/* 2) Due to numerical errors, in particular, */
/* - Truncation error in time values */
/* - Finite tolerance value */
/* - Errors in computed geometric quantities */
/* it is *normal* for the condition of interest to not always be */
/* satisfied near the endpoints of the intervals comprising the */
/* result window. */
/* The result window may need to be contracted slightly by the */
/* caller to achieve desired results. The SPICE window routine */
/* WNCOND can be used to contract the result window. */
/* 3) If the observer's name cannot be mapped to an ID code, the */
/* error SPICE(IDCODENOTFOUND) is signaled. */
/* 4) If the aberration correction flag calls for light time */
/* correction, the error SPICE(INVALIDOPTION) is signaled. */
/* 5) If the ray's direction vector is zero, the error */
/* SPICE(ZEROVECTOR) is signaled. */
/* 6) If the instrument name INST does not have corresponding NAIF */
/* ID code, the error will be diagnosed by a routine in the call */
/* tree of this routine. */
/* 7) If the FOV parameters of the instrument are not present in */
/* the kernel pool, the error will be be diagnosed by routines */
/* in the call tree of this routine. */
/* 8) If the FOV boundary has more than MAXVRT vertices, the error */
/* will be be diagnosed by routines in the call tree of this */
/* routine. */
/* 9) If the instrument FOV is polygonal, and this routine cannot */
/* find a ray R emanating from the FOV vertex such that maximum */
/* angular separation of R and any FOV boundary vector is within */
/* the limit (pi/2)-MARGIN radians, the error will be diagnosed */
/* by a routine in the call tree of this routine. If the FOV */
/* is any other shape, the same error check will be applied with */
/* the instrument boresight vector serving the role of R. */
/* 10) If the loaded kernels provide insufficient data to compute a */
/* requested state vector, the error will be diagnosed by a */
/* routine in the call tree of this routine. */
/* 11) If an error occurs while reading an SPK or other kernel file, */
/* the error will be diagnosed by a routine in the call tree */
/* of this routine. */
/* 12) If the output SPICE window RESULT has insufficient capacity */
/* to contain the number of intervals on which the specified */
/* visibility condition is met, the error will be diagnosed */
/* by a routine in the call tree of this routine. If the result */
/* window has size less than 2, the error SPICE(WINDOWTOOSMALL) */
/* will be signaled by this routine. */
/* $ Files */
/* Appropriate SPICE kernels must be loaded by the calling program */
/* before this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for the observer for the period */
/* defined by the confinement window 'CNFINE' must be loaded. */
/* If aberration corrections are used, the state of the */
/* observer relative to the solar system barycenter must be */
/* calculable from the available ephemeris data. Typically */
/* ephemeris data are made available by loading one or more SPK */
/* files via FURNSH. */
/* - Data defining the reference frame associated with the */
/* instrument designated by INST must be available in the kernel */
/* pool. Additionally the name INST must be associated with an */
/* ID code. Normally these data are made available by loading */
/* a frame kernel via FURNSH. */
/* - IK data: the kernel pool must contain data such that */
/* the SPICELIB routine GETFOV may be called to obtain */
/* parameters for INST. Normally such data are provided by */
/* an IK via FURNSH. */
/* The following data may be required: */
/* - CK data: if the instrument frame is fixed to a spacecraft, */
/* at least one CK file will be needed to permit transformation */
/* of vectors between that frame and the J2000 frame. */
/* - SCLK data: if a CK file is needed, an associated SCLK */
/* kernel is required to enable conversion between encoded SCLK */
/* (used to time-tag CK data) and barycentric dynamical time */
/* (TDB). */
/* - Since the input ray direction may be expressed in any */
/* frame, FKs, CKs, SCLK kernels, PCKs, and SPKs may be */
/* required to map the direction to the J2000 frame. */
/* Kernel data are normally loaded once per program run, NOT every */
/* time this routine is called. */
/* $ Particulars */
/* This routine determines a set of one or more time intervals when */
/* the specified ray in contained within the field of view of a */
/* specified instrument. We'll use the term "visibility event" to */
/* designate such an appearance. The set of time intervals resulting */
/* from the search is returned as a SPICE window. */
/* This routine provides a simpler, but less flexible, interface */
/* than does the SPICELIB routine GFFOVE for conducting searches for */
/* visibility events. Applications that require support for progress */
/* reporting, interrupt handling, non-default step or refinement */
/* functions, or non-default convergence tolerance should call */
/* GFFOVE rather than this routine. */
/* Below we discuss in greater detail aspects of this routine's */
/* solution process that are relevant to correct and efficient use */
/* of this routine in user applications. */
/* The Search Process */
/* ================== */
/* The search for visibility events is treated as a search for state */
/* transitions: times are sought when the state of the ray */
/* changes from "not visible" to "visible" or vice versa. */
/* Step Size */
/* ========= */
/* Each interval of the confinement window is searched as follows: */
/* first, the input step size is used to determine the time */
/* separation at which the visibility state will be sampled. */
/* Starting at the left endpoint of an interval, samples will be */
/* taken at each step. If a state change is detected, a root has */
/* been bracketed; at that point, the "root"--the time at which the */
/* state change occurs---is found by a refinement process, for */
/* example, via binary search. */
/* Note that the optimal choice of step size depends on the lengths */
/* of the intervals over which the visibility state is constant: */
/* the step size should be shorter than the shortest visibility event */
/* duration and the shortest period between visibility events, within */
/* the confinement window. */
/* Having some knowledge of the relative geometry of the ray and */
/* observer can be a valuable aid in picking a reasonable step size. */
/* In general, the user can compensate for lack of such knowledge by */
/* picking a very short step size; the cost is increased computation */
/* time. */
/* Note that the step size is not related to the precision with which */
/* the endpoints of the intervals of the result window are computed. */
/* That precision level is controlled by the convergence tolerance. */
/* Convergence Tolerance */
/* ===================== */
/* Once a root has been bracketed, a refinement process is used to */
/* narrow down the time interval within which the root must lie. */
/* This refinement process terminates when the location of the root */
/* has been determined to within an error margin called the */
/* "convergence tolerance." The convergence tolerance used by this */
/* routine is set via the parameter CNVTOL. */
/* The value of CNVTOL is set to a "tight" value so that the */
/* tolerance doesn't become the limiting factor in the accuracy of */
/* solutions found by this routine. In general the accuracy of input */
/* data will be the limiting factor. */
/* To use a different tolerance value, a lower-level GF routine such */
/* as GFFOVE must be called. Making the tolerance tighter than */
/* CNVTOL is unlikely to be useful, since the results are unlikely */
/* to be more accurate. Making the tolerance looser will speed up */
/* searches somewhat, since a few convergence steps will be omitted. */
/* However, in most cases, the step size is likely to have a much */
/* greater effect on processing time than would the convergence */
/* tolerance. */
/* The Confinement Window */
/* ====================== */
/* The simplest use of the confinement window is to specify a time */
/* interval within which a solution is sought. However, the */
/* confinement window can, in some cases, be used to make searches */
/* more efficient. Sometimes it's possible to do an efficient search */
/* to reduce the size of the time period over which a relatively */
/* slow search of interest must be performed. For an example, see */
/* the program CASCADE in the GF Example Programs chapter of the GF */
/* Required Reading, gf.req. */
/* $ Examples */
/* The numerical results shown for these examples may differ across */
/* platforms. The results depend on the SPICE kernels used as */
/* input, the compiler and supporting libraries, and the machine */
/* specific arithmetic implementation. */
/* 1) This example is an extension of example #1 in the */
/* header of */
/* GFTFOV */
/* The problem statement for that example is */
/* Search for times when Saturn's satellite Phoebe is within */
/* the FOV of the Cassini narrow angle camera */
/* (CASSINI_ISS_NAC). To simplify the problem, restrict the */
/* search to a short time period where continuous Cassini bus */
/* attitude data are available. */
/* Use a step size of 10 seconds to reduce chances of missing */
/* short visibility events. */
/* Here we search the same confinement window for times when a */
/* selected background star is visible. We use the FOV of the */
/* Cassini ISS wide angle camera (CASSINI_ISS_WAC) to enhance the */
/* probability of viewing the star. */
/* The star we'll use has catalog number 6000 in the Hipparcos */
/* Catalog. The star's J2000 right ascension and declination, */
/* proper motion, and parallax are taken from that catalog. */
/* Use the meta-kernel from the GFTFOV example: */
/* KPL/MK */
/* File name: gftfov_ex1.tm */
/* This meta-kernel is intended to support operation of SPICE */
/* example programs. The kernels shown here should not be */
/* assumed to contain adequate or correct versions of data */
/* required by SPICE-based user applications. */
/* In order for an application to use this meta-kernel, the */
/* kernels referenced here must be present in the user's */
/* current working directory. */
/* The names and contents of the kernels referenced */
/* by this meta-kernel are as follows: */
/* File name Contents */
/* --------- -------- */
/* naif0009.tls Leapseconds */
/* cpck05Mar2004.tpc Satellite orientation and */
/* radii */
/* 981005_PLTEPH-DE405S.bsp Planetary ephemeris */
/* 020514_SE_SAT105.bsp Satellite ephemeris */
/* 030201AP_SK_SM546_T45.bsp Spacecraft ephemeris */
/* cas_v37.tf Cassini FK */
/* 04135_04171pc_psiv2.bc Cassini bus CK */
/* cas00084.tsc Cassini SCLK kernel */
/* cas_iss_v09.ti Cassini IK */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'naif0009.tls', */
/* 'cpck05Mar2004.tpc', */
/* '981005_PLTEPH-DE405S.bsp', */
/* '020514_SE_SAT105.bsp', */
/* '030201AP_SK_SM546_T45.bsp', */
/* 'cas_v37.tf', */
/* '04135_04171pc_psiv2.bc', */
/* 'cas00084.tsc', */
/* 'cas_iss_v09.ti' ) */
/* \begintext */
/* Example code begins here. */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION J1950 */
/* DOUBLE PRECISION J2000 */
/* DOUBLE PRECISION JYEAR */
/* DOUBLE PRECISION RPD */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* CHARACTER*(*) META */
/* PARAMETER ( META = 'gftfov_ex1.tm' ) */
/* CHARACTER*(*) TIMFMT */
/* PARAMETER ( TIMFMT = */
/* . 'YYYY-MON-DD HR:MN:SC.######::TDB (TDB)' ) */
/* DOUBLE PRECISION AU */
/* PARAMETER ( AU = 149597870.693D0 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXWIN */
/* PARAMETER ( MAXWIN = 10000 ) */
/* INTEGER CORLEN */
/* PARAMETER ( CORLEN = 10 ) */
/* INTEGER BDNMLN */
/* PARAMETER ( BDNMLN = 36 ) */
/* INTEGER FRNMLN */
/* PARAMETER ( FRNMLN = 32 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 35 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(CORLEN) ABCORR */
/* CHARACTER*(BDNMLN) INST */
/* CHARACTER*(LNSIZE) LINE */
/* CHARACTER*(BDNMLN) OBSRVR */
/* CHARACTER*(FRNMLN) RFRAME */
/* CHARACTER*(TIMLEN) TIMSTR ( 2 ) */
/* DOUBLE PRECISION CNFINE ( LBCELL : MAXWIN ) */
/* DOUBLE PRECISION DEC */
/* DOUBLE PRECISION DECEPC */
/* DOUBLE PRECISION DECPM */
/* DOUBLE PRECISION DECDEG */
/* DOUBLE PRECISION DECDG0 */
/* DOUBLE PRECISION DTDEC */
/* DOUBLE PRECISION DTRA */
/* DOUBLE PRECISION ENDPT ( 2 ) */
/* DOUBLE PRECISION ET0 */
/* DOUBLE PRECISION ET1 */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION PARLAX */
/* DOUBLE PRECISION PLXDEG */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION PSTAR ( 3 ) */
/* DOUBLE PRECISION RA */
/* DOUBLE PRECISION RADEG */
/* DOUBLE PRECISION RADEG0 */
/* DOUBLE PRECISION RAEPC */
/* DOUBLE PRECISION RAPM */
/* DOUBLE PRECISION RAYDIR ( 3 ) */
/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */
/* DOUBLE PRECISION RSTAR */
/* DOUBLE PRECISION STEPSZ */
/* DOUBLE PRECISION T */
/* INTEGER CATNO */
/* INTEGER I */
/* INTEGER J */
/* INTEGER N */
/* C */
/* C Load kernels. */
/* C */
/* CALL FURNSH ( META ) */
/* C */
/* C Initialize windows. */
/* C */
/* CALL SSIZED ( MAXWIN, CNFINE ) */
/* CALL SSIZED ( MAXWIN, RESULT ) */
/* C */
/* C Insert search time interval bounds into the */
/* C confinement window. */
/* C */
/* CALL STR2ET ( '2004 JUN 11 06:30:00 TDB', ET0 ) */
/* CALL STR2ET ( '2004 JUN 11 12:00:00 TDB', ET1 ) */
/* CALL WNINSD ( ET0, ET1, CNFINE ) */
/* C */
/* C Initialize inputs for the search. */
/* C */
/* INST = 'CASSINI_ISS_WAC' */
/* C */
/* C Create a unit direction vector pointing from */
/* c observer to star. We'll assume the direction */
/* C is constant during the confinement window, and */
/* C we'll use et0 as the epoch at which to compute the */
/* C direction from the spacecraft to the star. */
/* C */
/* C The data below are for the star with catalog */
/* C number 6000 in the Hipparcos catalog. Angular */
/* C units are degrees; epochs have units of Julian */
/* C years and have a reference epoch of J1950. */
/* C The reference frame is J2000. */
/* C */
/* CATNO = 6000 */
/* PLXDEG = 0.000001056D0 */
/* RADEG0 = 19.290789927D0 */
/* RAPM = -0.000000720D0 */
/* RAEPC = 41.2000D0 */
/* DECDG0 = 2.015271007D0 */
/* DECPM = 0.000001814D0 */
/* DECEPC = 41.1300D0 */
/* RFRAME = 'J2000' */
/* C */
/* C Correct the star's direction for proper motion. */
/* C */
/* C The argument t represents et0 as Julian years */
/* C past J1950. */
/* C */
/* T = ET0/JYEAR() */
/* . + ( J2000()- J1950() ) / 365.25D0 */
/* DTRA = T - RAEPC */
/* DTDEC = T - DECEPC */
/* RADEG = RADEG0 + DTRA * RAPM */
/* DECDEG = DECDG0 + DTDEC * DECPM */
/* RA = RADEG * RPD() */
/* DEC = DECDEG * RPD() */
/* CALL RADREC ( 1.D0, RA, DEC, PSTAR ) */
/* C */
/* C Correct star position for parallax applicable at */
/* C the Cassini orbiter's position. (The parallax effect */
/* C is negligible in this case; we're simply demonstrating */
/* C the computation.) */
/* C */
/* PARLAX = PLXDEG * RPD() */
/* RSTAR = AU / TAN(PARLAX) */
/* C */
/* C Scale the star's direction vector by its distance from */
/* C the solar system barycenter. Subtract off the position */
/* C of the spacecraft relative to the solar system barycenter; */
/* C the result is the ray's direction vector. */
/* C */
/* CALL VSCLIP ( RSTAR, PSTAR ) */
/* CALL SPKPOS ( 'CASSINI', ET0, 'J2000', 'NONE', */
/* . 'SOLAR SYSTEM BARYCENTER', POS, LT ) */
/* CALL VSUB ( PSTAR, POS, RAYDIR ) */
/* C */
/* C Correct the star direction for stellar aberration when */
/* C we conduct the search. */
/* C */
/* ABCORR = 'S' */
/* OBSRVR = 'CASSINI' */
/* STEPSZ = 10.D0 */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Instrument: '//INST */
/* WRITE (*,*) 'Star''s catalog number: ', CATNO */
/* WRITE (*,*) ' ' */
/* C */
/* C Perform the search. */
/* C */
/* CALL GFRFOV ( INST, RAYDIR, RFRAME, ABCORR, */
/* . OBSRVR, STEPSZ, CNFINE, RESULT ) */
/* N = WNCARD( RESULT ) */
/* IF ( N .EQ. 0 ) THEN */
/* WRITE (*,*) 'No FOV intersection found.' */
/* ELSE */
/* WRITE (*,*) */
/* . ' Visibility start time Stop time' */
/* DO I = 1, N */
/* CALL WNFETD ( RESULT, I, ENDPT(1), ENDPT(2) ) */
/* DO J = 1, 2 */
/* CALL TIMOUT ( ENDPT(J), TIMFMT, TIMSTR(J) ) */
/* END DO */
/* LINE( :3) = ' ' */
/* LINE(2: ) = TIMSTR(1) */
/* LINE(37:) = TIMSTR(2) */
/* WRITE (*,*) LINE */
/* END DO */
/* END IF */
/* WRITE (*,*) ' ' */
/* END */
/* When this program was executed on a PC/Linux/g77 platform, the */
/* output was: */
/* Instrument: CASSINI_ISS_WAC */
/* Star's catalog number: 6000 */
/* Visibility start time Stop time */
/* 2004-JUN-11 06:30:00.000000 (TDB) 2004-JUN-11 12:00:00.000000 (TDB) */
/* The star is visible throughout the confinement window. */
/* $ Restrictions */
/* The kernel files to be used by GFRFOV must be loaded (normally via */
/* the SPICELIB routine FURNSH) before GFRFOV is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* L.S. Elson (JPL) */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 15-APR-2009 (NJB) (LSE) (EDW) */
/* -& */
/* $ Index_Entries */
/* GF ray in instrument FOV search */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* External routines */
/* Interrupt handler: */
/* Routines to set step size, refine transition times */
/* and report work: */
/* Local parameters */
/* Geometric quantity bail switch: */
/* Progress report switch: */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("GFRFOV", (ftnlen)6);
/* Note to maintenance programmer: input exception checks */
/* are delegated to GFFOVE. If the implementation of that */
/* routine changes, or if this routine is modified to call */
/* a different routine in place of GFFOVE, then the error */
/* handling performed by GFFOVE will have to be performed */
/* here or in a routine called by this routine. */
/* Check the result window's size. */
if (sized_(result) < 2) {
setmsg_("Result window size must be at least 2 but was #.", (ftnlen)
48);
i__1 = sized_(result);
errint_("#", &i__1, (ftnlen)1);
sigerr_("SPICE(WINDOWTOOSMALL)", (ftnlen)21);
chkout_("GFRFOV", (ftnlen)6);
return 0;
}
/* Check step size. */
if (*step <= 0.) {
setmsg_("Step size must be positive but was #.", (ftnlen)37);
errdp_("#", step, (ftnlen)1);
sigerr_("SPICE(INVALIDSTEP)", (ftnlen)18);
chkout_("GFRFOV", (ftnlen)6);
return 0;
}
/* Set the step size. */
gfsstp_(step);
/* Look for solutions. */
gffove_(inst, "RAY", raydir, " ", rframe, abcorr, obsrvr, &c_b13, (U_fp)
gfstep_, (U_fp)gfrefn_, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (
U_fp)gfrepf_, &c_false, (L_fp)gfbail_, cnfine, result, inst_len, (
ftnlen)3, (ftnlen)1, rframe_len, abcorr_len, obsrvr_len);
chkout_("GFRFOV", (ftnlen)6);
return 0;
} /* gfrfov_ */
/* $Procedure SGFRVI ( Generic Segments: Fetch ref. value and index ) */
/* Subroutine */ int sgfrvi_(integer *handle, doublereal *descr, doublereal *
x, doublereal *value, integer *indx, logical *found)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
logical done;
integer i__, begin;
extern /* Subroutine */ int chkin_(char *, ftnlen);
logical myfnd;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), dafgda_(
integer *, integer *, integer *, doublereal *);
extern logical failed_(void);
doublereal endref;
integer nfetch;
doublereal buffer[101];
integer bfindx, remain;
extern /* Subroutine */ int sgmeta_(integer *, doublereal *, integer *,
integer *);
doublereal dpimax;
integer myrefb;
extern integer lstled_(doublereal *, integer *, doublereal *);
doublereal dptemp;
integer fullrd, rdridx, myrdrb;
extern integer intmax_(void);
integer mynref;
logical isdirv;
integer myindx;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen);
integer mynrdr;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
doublereal myvalu;
extern logical return_(void);
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer myrdrt, mynpkt, end;
/* $ Abstract */
/* Given the handle of a DAF and the descriptor associated with */
/* a generic DAF segment in the file, find the reference value */
/* associated with the value X and it's index. */
/* $ 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 */
/* DAF Required Reading. */
/* $ Keywords */
/* GENERIC SEGMENTS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I The handle of a DAF open for reading. */
/* DESCR I The descriptor for a DAF generic segment. */
/* X I The key value used to find a reference and index. */
/* VALUE O The reference value associated with X. */
/* INDX O The index of VALUE within the reference values. */
/* FOUND O A flag indicating whether values for X were found. */
/* $ Detailed_Input */
/* HANDLE is the handle of a DAF open for reading */
/* DESCR is the descriptor of the generic segment that we are */
/* going to search for a reference value to associate with */
/* X. */
/* X a value for which the associated reference value */
/* and reference index is requested. */
/* $ Detailed_Output */
/* VALUE is the reference value associated with the input value */
/* X. */
/* INDX is the index of VALUE within the set of reference */
/* values for the generic segment. This value may be used */
/* to obtain a particular packet of data from the generic */
/* segment. */
/* FOUND is a logical flag indicating whether a reference value */
/* associated with X was found. If a reference value was */
/* found, FOUND will have a value of TRUE; otherwise it */
/* will have a value of FALSE. */
/* $ Parameters */
/* This subroutine makes use of parameters defined in the file */
/* 'sgparam.inc'. */
/* $ Files */
/* See the description of HANDLE above. */
/* $ Exceptions */
/* 1) The error SPICE(UNKNOWNREFDIR) will be signalled if */
/* the reference directory structure is unrecognized. The most */
/* likely cause of this error is that an upgrade to your */
/* version of the SPICE toolkit is needed. */
/* 2) If a value computed for the index of an implicitly indexed */
/* generic segment is too large to be represented as an integer, */
/* the error SPICE(INDEXTOOLARGE) will be signalled. */
/* $ Particulars */
/* This routine allows you to easily find the index and value */
/* of the reference item that should be associated with a */
/* value X. Given this information you can then easily retrieve */
/* the packet that should be associated with X. */
/* $ Examples */
/* Suppose that you have a generic segment that contains the */
/* following items. */
/* 1) Packets that model the motion of a body as a function */
/* of time over some interval of time. */
/* 2) Reference values that are the epochs corresponding */
/* to the beginning of the intervals for the packets. */
/* To retrieve the correct packet to use to compute the position */
/* and velocity of the body at a particular epoch, ET, you could */
/* use the following code. (Note this block of code assumes that */
/* you aren't going to run into any exceptional cases such as ET */
/* falling outside the range of times for which the packets can */
/* provide ephemeris data.) */
/* Find out the index of the time that should be associated */
/* with the ET we've been given */
/* CALL SGFRVI ( HANDLE, DESCR, ET, ETFND, INDX, FOUND ) */
/* Fetch the INDX'th ephemeris packet from the segment. */
/* CALL SGFPKT ( HANDLE, DESCR, INDX, EPHEM ) */
/* $ Restrictions */
/* The segment described by DESCR MUST be a generic segment, */
/* otherwise the results of this routine are not predictable. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.2.0, 07-SEP-2001 (EDW) */
/* Replaced DAFRDA call with DAFGDA. */
/* - SPICELIB Version 1.1.0, 08-MAY-1996 (WLT) */
/* A bug was found in the EXPCLS index case when the */
/* trying to retrieve the last value in a generic segment. */
/* This bug was discovered by the HP compiler complaining */
/* that an index used was not initialized. */
/* The offending line was */
/* MYVALU = BUFFER(I) */
/* The corrected line is: */
/* MYVALU = BUFFER(BFINDX) */
/* - SPICELIB Version 1.0.0, 28-Mar-1994 (KRG) (WLT) */
/* -& */
/* $ Index_Entries */
/* find the index of a reference value in a generic segment */
/* -& */
/* Spicelib Functions */
/* Local Parameters */
/* Include the mnemonic values for the generic segment declarations. */
/* $ Abstract */
/* Parameter declarations for the generic segments subroutines. */
/* $ 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 */
/* DAF Required Reading */
/* $ Keywords */
/* GENERIC SEGMENTS */
/* $ Particulars */
/* This include file contains the parameters used by the generic */
/* segments subroutines, SGxxxx. A generic segment is a */
/* generalization of a DAF array which places a particular structure */
/* on the data contained in the array, as described below. */
/* This file defines the mnemonics that are used for the index types */
/* allowed in generic segments as well as mnemonics for the meta data */
/* items which are used to describe a generic segment. */
/* A DAF generic segment contains several logical data partitions: */
/* 1) A partition for constant values to be associated with each */
/* data packet in the segment. */
/* 2) A partition for the data packets. */
/* 3) A partition for reference values. */
/* 4) A partition for a packet directory, if the segment contains */
/* variable sized packets. */
/* 5) A partition for a reference value directory. */
/* 6) A reserved partition that is not currently used. This */
/* partition is only for the use of the NAIF group at the Jet */
/* Propulsion Laboratory (JPL). */
/* 7) A partition for the meta data which describes the locations */
/* and sizes of other partitions as well as providing some */
/* additional descriptive information about the generic */
/* segment. */
/* +============================+ */
/* | Constants | */
/* +============================+ */
/* | Packet 1 | */
/* |----------------------------| */
/* | Packet 2 | */
/* |----------------------------| */
/* | . | */
/* | . | */
/* | . | */
/* |----------------------------| */
/* | Packet N | */
/* +============================+ */
/* | Reference Values | */
/* +============================+ */
/* | Packet Directory | */
/* +============================+ */
/* | Reference Directory | */
/* +============================+ */
/* | Reserved Area | */
/* +============================+ */
/* | Segment Meta Data | */
/* +----------------------------+ */
/* Only the placement of the meta data at the end of a generic */
/* segment is required. The other data partitions may occur in any */
/* order in the generic segment because the meta data will contain */
/* pointers to their appropriate locations within the generic */
/* segment. */
/* The meta data for a generic segment should only be obtained */
/* through use of the subroutine SGMETA. The meta data should not be */
/* written through any mechanism other than the ending of a generic */
/* segment begun by SGBWFS or SGBWVS using SGWES. */
/* $ Restrictions */
/* 1) If new reference index types are added, the new type(s) should */
/* be defined to be the consecutive integer(s) after the last */
/* defined reference index type used. In this way a value for */
/* the maximum allowed index type may be maintained. This value */
/* must also be updated if new reference index types are added. */
/* 2) If new meta data items are needed, mnemonics for them must be */
/* added to the end of the current list of mnemonics and before */
/* the NMETA mnemonic. In this way compatibility with files having */
/* a different, but smaller, number of meta data items may be */
/* maintained. See the description and example below. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* Generic Segments Required Reading. */
/* DAF Required Reading. */
/* $ Version */
/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */
/* Header update: equations for comptutations of packet indices */
/* for the cases of index types 0 and 1 were corrected. */
/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */
/* Added parameter MNMETA, the minimum number of meta data items */
/* that must be present in a generic DAF segment. */
/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */
/* -& */
/* Mnemonics for the type of reference value index. */
/* Two forms of indexing are provided: */
/* 1) An implicit form of indexing based on using two values, a */
/* starting value, which will have an index of 1, and a step */
/* size between reference values, which are used to compute an */
/* index and a reference value associated with a specified key */
/* value. See the descriptions of the implicit types below for */
/* the particular formula used in each case. */
/* 2) An explicit form of indexing based on a reference value for */
/* each data packet. */
/* Reference Index Type 0 */
/* ---------------------- */
/* Implied index. The index and reference value of a data packet */
/* associated with a specified key value are computed from the two */
/* generic segment reference values using the formula below. The two */
/* generic segment reference values, REF(1) and REF(2), represent, */
/* respectively, a starting value and a step size between reference */
/* values. The index of the data packet associated with a key value */
/* of VALUE is given by: */
/* / VALUE - REF(1) \ */
/* INDEX = 1 + INT | -------------------- | */
/* \ REF(2) / */
/* and the reference value associated with VALUE is given by: */
/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
/* Reference Index Type 1 */
/* ---------------------- */
/* Implied index. The index and reference value of a data packet */
/* associated with a specified key value are computed from the two */
/* generic segment reference values using the formula below. The two */
/* generic segment reference values, REF(1) and REF(2), represent, */
/* respectively, a starting value and a step size between reference */
/* values. The index of the data packet associated with a key value */
/* of VALUE is given by: */
/* / VALUE - REF(1) \ */
/* INDEX = 1 + INT | 0.5 + -------------------- | */
/* \ REF(2) / */
/* and the reference value associated with VALUE is given by: */
/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
/* We get the larger index in the event that VALUE is halfway between */
/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */
/* Reference Index Type 2 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the last reference item */
/* that is strictly less than VALUE. The reference values must be in */
/* ascending order, REF(I) < REF(I+1). */
/* Reference Index Type 3 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the last reference item */
/* that is less than or equal to VALUE. The reference values must be */
/* in ascending order, REF(I) < REF(I+1). */
/* Reference Index Type 4 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the reference item */
/* that is closest to the value of VALUE. In the event of a "tie" */
/* the larger index is selected. The reference values must be in */
/* ascending order, REF(I) < REF(I+1). */
/* These parameters define the valid range for the index types. An */
/* index type code, MYTYPE, for a generic segment must satisfy the */
/* relation MNIDXT <= MYTYPE <= MXIDXT. */
/* The following meta data items will appear in all generic segments. */
/* Other meta data items may be added if a need arises. */
/* 1) CONBAS Base Address of the constants in a generic segment. */
/* 2) NCON Number of constants in a generic segment. */
/* 3) RDRBAS Base Address of the reference directory for a */
/* generic segment. */
/* 4) NRDR Number of items in the reference directory of a */
/* generic segment. */
/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */
/* generic segment. */
/* 6) REFBAS Base Address of the reference items for a generic */
/* segment. */
/* 7) NREF Number of reference items in a generic segment. */
/* 8) PDRBAS Base Address of the Packet Directory for a generic */
/* segment. */
/* 9) NPDR Number of items in the Packet Directory of a generic */
/* segment. */
/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */
/* segment. */
/* 11) PKTBAS Base Address of the Packets for a generic segment. */
/* 12) NPKT Number of Packets in a generic segment. */
/* 13) RSVBAS Base Address of the Reserved Area in a generic */
/* segment. */
/* 14) NRSV Number of items in the reserved area of a generic */
/* segment. */
/* 15) PKTSZ Size of the packets for a segment with fixed width */
/* data packets or the size of the largest packet for a */
/* segment with variable width data packets. */
/* 16) PKTOFF Offset of the packet data from the start of a packet */
/* record. Each data packet is placed into a packet */
/* record which may have some bookkeeping information */
/* prepended to the data for use by the generic */
/* segments software. */
/* 17) NMETA Number of meta data items in a generic segment. */
/* Meta Data Item 1 */
/* ----------------- */
/* Meta Data Item 2 */
/* ----------------- */
/* Meta Data Item 3 */
/* ----------------- */
/* Meta Data Item 4 */
/* ----------------- */
/* Meta Data Item 5 */
/* ----------------- */
/* Meta Data Item 6 */
/* ----------------- */
/* Meta Data Item 7 */
/* ----------------- */
/* Meta Data Item 8 */
/* ----------------- */
/* Meta Data Item 9 */
/* ----------------- */
/* Meta Data Item 10 */
/* ----------------- */
/* Meta Data Item 11 */
/* ----------------- */
/* Meta Data Item 12 */
/* ----------------- */
/* Meta Data Item 13 */
/* ----------------- */
/* Meta Data Item 14 */
/* ----------------- */
/* Meta Data Item 15 */
/* ----------------- */
/* Meta Data Item 16 */
/* ----------------- */
/* If new meta data items are to be added to this list, they should */
/* be added above this comment block as described below. */
/* INTEGER NEW1 */
/* PARAMETER ( NEW1 = PKTOFF + 1 ) */
/* INTEGER NEW2 */
/* PARAMETER ( NEW2 = NEW1 + 1 ) */
/* INTEGER NEWEST */
/* PARAMETER ( NEWEST = NEW2 + 1 ) */
/* and then the value of NMETA must be changed as well to be: */
/* INTEGER NMETA */
/* PARAMETER ( NMETA = NEWEST + 1 ) */
/* Meta Data Item 17 */
/* ----------------- */
/* Maximum number of meta data items. This is always set equal to */
/* NMETA. */
/* Minimum number of meta data items that must be present in a DAF */
/* generic segment. This number is to remain fixed even if more */
/* meta data items are added for compatibility with old DAF files. */
/* Local Variables */
/* Saved Variables */
/* Initial Values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SGFRVI", (ftnlen)6);
/* Set the value for the maximum index as a double precision number, */
/* but only do it the first time into the subroutine. */
if (first) {
first = FALSE_;
dpimax = (doublereal) intmax_();
}
/* Collect the necessary meta data values common to all cases. */
sgmeta_(handle, descr, &c__12, &mynpkt);
sgmeta_(handle, descr, &c__7, &mynref);
sgmeta_(handle, descr, &c__5, &myrdrt);
sgmeta_(handle, descr, &c__6, &myrefb);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* Check to be sure that we know how to deal with the type of index */
/* in the segment. The index type should be between the minimum */
/* allowed index type, MNIDXT, and the maximum allowed index type, */
/* MXIDXT, as specified in the file 'sgparam.inc'. */
if (myrdrt < 0 || myrdrt > 4) {
setmsg_("The generic DAF segment you attempted to read has an unsupp"
"orted reference directory structure. The integer code given "
"for this structure is #, and allowed codes are within the ra"
"nge # to #. The likely cause of this anamoly is your version"
" of SPICELIB needs updating. Contact your system administrat"
"or or NAIF for a toolkit update.", (ftnlen)331);
errint_("#", &myrdrt, (ftnlen)1);
errint_("#", &c__0, (ftnlen)1);
errint_("#", &c__4, (ftnlen)1);
sigerr_("SPICE(UNKNOWNREFDIR)", (ftnlen)20);
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* We don't have an index yet and we initialize things to zero. */
myfnd = FALSE_;
myindx = 0;
myvalu = 0.;
/* We pass the idiot checks, so lets proceed. We have a IF block for */
/* each allowed reference directory type code. */
/* For implicitly indexed data packets, the interval */
/* [ BUFFER(1), BUFFER(1) + (N - 1) * BUFFER(2) ) */
/* is divided into subintervals as follows: */
/* (-infinity, r1), [r_1,r_2) [r_2, r_3), ..., [r_i, r_(i+1)), */
/* ..., [r_N, +infinity), */
/* where N = the number of packets in the segment, MYNPKT, and */
/* r_i = BUFFER(1) + (i-1) * BUFFER(2). */
/* If X is in [r_i, r_(i+1)), i = 1, N-1, then we found a value */
/* and the index returned will be i with the reference value */
/* returned will be r_i. */
/* If X is in [r_N, +infinity), then we found a value and the */
/* index returned will be N and the reference value returned will */
/* be r_N. */
/* If X is in (-infinity, r1), we have two possibilities: */
/* 1) If the index type is implicit closest, we found a value, */
/* the index returned will be 1 and the reference value */
/* returned will be r_1. */
/* 2) If the index type is implicit less than or equal, we do */
/* not find a value. */
/* For explicitly indexed packets we simply search the reference */
/* directory for an appropriate reference value. */
if (myrdrt != 0 && myrdrt != 1) {
/* In addition to the meta data items we already have, we also */
/* need these. */
sgmeta_(handle, descr, &c__4, &mynrdr);
sgmeta_(handle, descr, &c__3, &myrdrb);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* We need to scan the reference directory (if there is one) to */
/* determine the appropriate block of reference values to read */
/* from the generic segment. Then we compute the number of */
/* reference values to fetch and examine. Finally, based on the */
/* index type we figure out whether we have found a reference */
/* value or not. It will take a little while to get there, so */
/* let's get going. */
/* We have not started yet, so we're not done and we cannot have a */
/* reference directory value yet. */
done = FALSE_;
isdirv = FALSE_;
/* We have not read any full buffers of reference directory values */
/* yet, all of the reference directory values remain to be read, */
/* and we have no index for a reference directory value. */
fullrd = 0;
remain = mynrdr;
rdridx = 0;
/* Search the reference directory values to select the appropriate */
/* block of reference values to read. */
while(! done && remain > 0) {
/* Read a buffer of reference directory items. */
nfetch = min(100,remain);
begin = myrdrb + fullrd * 100 + 1;
end = begin + nfetch - 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
/* See if X is in the current buffer. */
rdridx = lstled_(x, &nfetch, buffer);
if (rdridx == 0) {
/* If not, then X < BUFFER(1) and we're done. This indicates */
/* that the desired reference value is before, or in, the */
/* previous block of reference values. */
done = TRUE_;
} else if (rdridx == nfetch) {
/* If we get the last value of the buffer, then either we */
/* are done, X = BUFFER(NFETCH), or X > BUFFER(NFETCH). */
if (*x == buffer[(i__1 = nfetch - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)417)]
) {
/* If X = BUFFER(NFETCH) we are done, we have a directory */
/* value, and it might be a value we want to return. */
done = TRUE_;
isdirv = TRUE_;
} else {
/* Otherwise, we might have more stuff to read, so update */
/* the remainder and the current number of full buffer */
/* reads and try the loop again. */
remain -= nfetch;
if (remain > 0) {
/* We don't want to increment FULLRD for a partial */
/* buffer read. The arithmetic for the index */
/* calculations below will use RDRIDX to deal with */
/* this. */
++fullrd;
}
}
} else {
/* BUFFER(1) <= X < BUFFER(NFETCH), i.e., we have something */
/* in the buffer. Check to see if X = BUFFER(RDRIDX). If so, */
/* we are done, we have a directory value, and it might be a */
/* value we want to return. Otherwise, we are just done. */
done = TRUE_;
if (*x == buffer[(i__1 = rdridx - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)455)]
) {
isdirv = TRUE_;
}
}
}
rdridx = fullrd * 100 + rdridx;
/* There are three cases that we need to consider when X is not a */
/* reference directory value: */
/* Case 1: 0 < RDRIDX < MYNRDR (most common first) */
/* Case 2: RDRIDX = 0 */
/* Case 3: RDRIDX = MYNRDR */
if (! isdirv) {
if (rdridx > 0 && rdridx < mynrdr) {
/* If we were able to bracket X before reaching the end of */
/* the reference directory, then we KNOW that we have a */
/* candidate for a reference value in the reference data. */
/* All we need to do is read the reference data and find it */
/* in the buffer. We also read the reference directory */
/* values that bracket the desired reference value into */
/* BUFFER, so that they are there if we need them. */
/* Computing MIN */
i__1 = 101, i__2 = mynref - rdridx * 100 + 1;
nfetch = min(i__1,i__2);
begin = myrefb + rdridx * 100;
end = begin + nfetch - 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
bfindx = lstled_(x, &nfetch, buffer);
myindx = rdridx * 100 + bfindx - 1;
} else if (rdridx == 0) {
/* The reference value may be one of the reference values */
/* less than the first reference directory item. So we */
/* compute the beginning and ending addresses for the data, */
/* read it in, and try to find a reference value. */
nfetch = min(101,mynref);
begin = myrefb + 1;
end = begin + nfetch - 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
bfindx = lstled_(x, &nfetch, buffer);
myindx = bfindx;
} else if (rdridx == mynrdr) {
/* If we were not able to bracket X before reaching the end */
/* of the reference directory, then we might have a */
/* candidate for a reference value in the reference data */
/* after the last reference directory value. All we need to */
/* do is read the reference data and look. */
/* NOTE: NFETCH can never be zero or negative, so we can */
/* glibly use it. The reason for this is the NFETCH can only */
/* be zero if the desired reference value is a reference */
/* directory value, and we already know that the reference */
/* value we want is not a reference directory value, because */
/* we are here. For similar reasons, NFETCH can never be */
/* negative. */
begin = myrefb + rdridx * 100;
end = myrefb + mynref;
nfetch = end - begin + 1;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
bfindx = lstled_(x, &nfetch, buffer);
myindx = rdridx * 100 + bfindx - 1;
}
} else {
/* We have a reference directory value, whose index is easy to */
/* compute. */
myindx = rdridx * 100;
}
/* Now, if we have a candidate for a reference value, lets make */
/* sure, based onthe type of index we have. */
if (myrdrt == 2) {
/* We have a reference value only if X > some reference */
/* value. */
if (! isdirv) {
/* If the value is not a reference directory value, then */
/* we have two cases: */
/* Case 1: 0 < MYINDX <= MYNREF */
/* Case 2: MYINDX = 0 */
if (myindx > 0 && myindx <= mynref) {
/* We found a reference value. The reference value we */
/* want is either the value indicated by MYINDX or */
/* the reference value immediately preceding MYINDX, */
/* if there is such a value. To deal with this we */
/* split the test up into two cases. */
if (myindx > 1) {
/* If X > BUFFER(BFINDX) then we are done, so set the */
/* value. If not, then we want the reference value */
/* that is immediately before the current one. */
if (*x > buffer[(i__1 = bfindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
, (ftnlen)595)]) {
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1,
"sgfrvi_", (ftnlen)598)];
} else {
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 2) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1,
"sgfrvi_", (ftnlen)603)];
--myindx;
}
} else {
/* Remember, MYINDX is 1 here. If we are greater */
/* than the first reference value in the segment, */
/* we are done. Otherwise there is no reference */
/* value to be associated with X. */
if (*x > buffer[(i__1 = myindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1, "sgfrvi_"
, (ftnlen)615)]) {
myfnd = TRUE_;
myvalu = buffer[(i__1 = myindx - 1) < 101 && 0 <=
i__1 ? i__1 : s_rnge("buffer", i__1,
"sgfrvi_", (ftnlen)618)];
} else {
/* We did not find a reference value. X was */
/* equal to the first reference value of the */
/* generic segment. */
myfnd = FALSE_;
}
}
} else if (myindx == 0) {
/* We did not find a reference value. X was < the */
/* first reference value for the generic segment. */
myfnd = FALSE_;
}
} else {
/* We have a reference directory value, and we are done. */
/* Either the reference directory value is the one we */
/* want or the reference value immediately preceeding it */
/* is the one we want. */
myfnd = TRUE_;
--myindx;
begin = myrefb + myindx;
end = begin;
dafgda_(handle, &begin, &end, &myvalu);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
}
} else if (myrdrt == 3) {
/* We have a reference value only if X >= some reference */
/* value. At this point, either we have the value and index */
/* we want or X is before the first reference value of the */
/* generic segment. We consider two cases, the first when X */
/* is not a referecne directory value, and the second when */
/* it is. */
if (! isdirv) {
/* If X is not a directory value, then MYINDX is either */
/* equal to zero, implying that X is before the first */
/* reference value in the generic segment, or MYINDX > 0, */
/* implying that we have found a reference value. */
if (myindx > 0 && myindx <= mynref) {
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
684)];
} else if (myindx == 0) {
/* We did not find a reference value. X was < the */
/* first reference value for the generic segment. */
myfnd = FALSE_;
}
} else {
/* We have a reference directory value, and it is the one */
/* we want. */
myfnd = TRUE_;
myvalu = *x;
}
} else if (myrdrt == 4) {
/* We have a reference value for every value of X. If X < */
/* the first reference value of the generic segment, the */
/* closest value is the first reference value. If X > the */
/* last reference value of the generic segment, the closest */
/* value is the last reference value. For X between the */
/* first and last reference values we simple take the */
/* closest reference value to X, resolving a tie by */
/* accepting the larger reference value. */
if (! isdirv) {
/* If X is not a directory value, then MYINDX is either */
/* equal to zero, implying that X is before the first */
/* reference value in the generic segment, */
/* 0 < MYINDX < MYNPKT, implying X is between the first */
/* and last reference values in the generic segment, or */
/* MYINDX = MYNPKT implying that X is greater than or */
/* equal to the last reference value. */
if (myindx > 0 && myindx < mynref) {
i__ = bfindx;
/* Find the closest value to X, choosing the larger in */
/* the event of a tie. */
if (buffer[(i__1 = i__) < 101 && 0 <= i__1 ? i__1 :
s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)734)] -
*x <= *x - buffer[(i__2 = i__ - 1) < 101 && 0 <=
i__2 ? i__2 : s_rnge("buffer", i__2, "sgfrvi_", (
ftnlen)734)]) {
++i__;
++myindx;
}
myfnd = TRUE_;
myvalu = buffer[(i__1 = i__ - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
742)];
} else if (myindx == 0) {
/* X is before the first reference value for the */
/* generic segment, so the closest reference value is */
/* the first one. */
myfnd = TRUE_;
myindx = 1;
myvalu = buffer[0];
} else if (myindx == mynref) {
/* X is at of after the last reference value for the */
/* generic segment, so the closest reference value is */
/* the last reference value, which will be in BUFFER. */
myfnd = TRUE_;
myvalu = buffer[(i__1 = bfindx - 1) < 101 && 0 <= i__1 ?
i__1 : s_rnge("buffer", i__1, "sgfrvi_", (ftnlen)
762)];
}
} else {
/* We have a reference directory value, and it is the one */
/* we want. */
myfnd = TRUE_;
myvalu = *x;
}
}
} else if (myrdrt == 0) {
/* Get the begin and end addresses from which to read the */
/* reference values and get the reference values. */
begin = myrefb + 1;
end = myrefb + 2;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];
/* Compute the index if we can. */
if (*x < buffer[0]) {
/* If X is less than BUFFER(1), we do not have a reference */
/* value. */
myfnd = FALSE_;
} else if (*x > endref) {
/* If X is greater than ENDREF, then we have a reference */
/* value, ENDREF. */
myfnd = TRUE_;
myindx = mynpkt;
myvalu = endref;
} else {
/* r_1 < X < r_N, i.e., we found a value. Compute the index */
/* and the reference value. */
if (mynpkt > 1) {
myfnd = TRUE_;
/* Compute the index. */
dptemp = (*x - buffer[0]) / buffer[1] + 1.;
/* Test to see if we can safely convert the index to an */
/* integer. */
if (dptemp > dpimax) {
setmsg_("The computed index is too large to be represent"
"ed as an integer. The most likely problem is tha"
"t an incorrect value was stored for the step siz"
"e. The value found for the step was: #", (ftnlen)
181);
errdp_("#", &buffer[1], (ftnlen)1);
sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
myindx = (integer) dptemp;
myindx = min(myindx,mynpkt);
} else {
/* There is only one packet. */
myindx = 1;
}
/* Compute the reference value. */
myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
}
} else if (myrdrt == 1) {
/* Get the begin and end addresses from which to read the */
/* reference values and get the reference values. */
begin = myrefb + 1;
end = myrefb + 2;
dafgda_(handle, &begin, &end, buffer);
if (failed_()) {
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
endref = buffer[0] + (doublereal) (mynpkt - 1) * buffer[1];
/* Compute the index if we can. */
if (*x < buffer[0]) {
/* If X < BUFFER(1), then we found a value, the index */
/* returned will be 1 and the reference value returned will */
/* be BUFFER(1). */
myfnd = TRUE_;
myindx = 1;
myvalu = buffer[0];
} else if (*x > endref) {
/* If X > ENDREF, then we found a value, the index returned */
/* will be MYNPKT and the reference value returned will be */
/* ENDREF. */
myfnd = TRUE_;
myindx = mynpkt;
myvalu = endref;
} else {
/* r_1 < X < r_N, i.e., we found a value. Compute the index */
/* and the reference value. If X is closer to r_I, the index */
/* returned will be I with a reference value of r_I. If X is */
/* closer to r_(I+1), the index returned will be I+1 with a */
/* reference value of r_(I+1). */
if (mynpkt > 1) {
myfnd = TRUE_;
/* Compute the index. */
dptemp = (*x - buffer[0]) / buffer[1] + 1.5;
if (dptemp > dpimax + .5) {
setmsg_("The computed index is too large to be represent"
"ed as an integer. The most likely problem is tha"
"t an incorrect value was stored for the step siz"
"e. The value found for the step was: #", (ftnlen)
181);
errdp_("#", &buffer[1], (ftnlen)1);
sigerr_("SPICE(INDEXTOOLARGE)", (ftnlen)20);
chkout_("SGFRVI", (ftnlen)6);
return 0;
}
myindx = (integer) dptemp;
} else {
/* There is only one packet. */
myindx = 1;
}
/* Compute the reference value. */
myvalu = buffer[0] + (doublereal) (myindx - 1) * buffer[1];
}
}
/* At this point, we have either found a value or not. If so, then we */
/* need to set the index, value, and found flag for output. */
/* Otherwise, we simply set the found flag. */
if (myfnd) {
*indx = myindx;
*value = myvalu;
}
*found = myfnd;
chkout_("SGFRVI", (ftnlen)6);
return 0;
} /* sgfrvi_ */
/* $Procedure CKCOV ( CK coverage ) */
/* Subroutine */ int ckcov_(char *ck, integer *idcode, logical *needav, char *
level, doublereal *tol, char *timsys, doublereal *cover, ftnlen
ck_len, ftnlen level_len, ftnlen timsys_len)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
char arch[80];
logical avok;
extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int dafgs_(doublereal *);
integer clkid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal descr[5];
extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dctol[2];
logical istdb, found;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
integer dtype;
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal dc[2];
integer ic[6];
extern /* Subroutine */ int daffna_(logical *);
extern logical failed_(void);
extern /* Subroutine */ int dafbfs_(integer *);
doublereal et;
integer handle, segbeg;
extern /* Subroutine */ int dafcls_(integer *), ckmeta_(integer *, char *,
integer *, ftnlen);
integer segend;
extern /* Subroutine */ int getfat_(char *, char *, char *, ftnlen,
ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char
*, ftnlen);
logical seglvl;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), wninsd_(doublereal *, doublereal *, doublereal *),
errint_(char *, integer *, ftnlen);
char kertyp[80];
extern logical return_(void);
extern /* Subroutine */ int zzckcv01_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv02_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv03_(integer *, integer *, integer *,
integer *, doublereal *, char *, doublereal *, ftnlen), zzckcv04_(
integer *, integer *, integer *, integer *, doublereal *, char *,
doublereal *, ftnlen), zzckcv05_(integer *, integer *, integer *,
integer *, doublereal *, doublereal *, char *, doublereal *,
ftnlen);
/* $ Abstract */
/* Find the coverage window for a specified object in a specified CK */
/* file. */
/* $ 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 */
/* CELLS */
/* DAF */
/* CK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* POINTING */
/* TIME */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CK I Name of CK file. */
/* IDCODE I ID code of object. */
/* NEEDAV I Flag indicating whether angular velocity is needed. */
/* LEVEL I Coverage level: 'SEGMENT' OR 'INTERVAL'. */
/* TOL I Tolerance in ticks. */
/* TIMSYS I Time system used to represent coverage. */
/* COVER I/O Window giving coverage for IDCODE. */
/* $ Detailed_Input */
/* CK is the name of a C-kernel. */
/* IDCODE is the integer ID code of an object, normally */
/* a spacecraft structure or instrument, for which */
/* pointing data are expected to exist in the */
/* specified CK file. */
/* NEEDAV is a logical variable indicating whether only */
/* segments having angular velocity are to be */
/* considered when determining coverage. When */
/* NEEDAV is .TRUE., segments without angular */
/* velocity don't contribute to the coverage */
/* window; when NEEDAV is .FALSE., all segments for */
/* IDCODE may contribute to the coverage window. */
/* LEVEL is the level (granularity) at which the coverage */
/* is examined. Allowed values and corresponding */
/* meanings are: */
/* 'SEGMENT' The output coverage window */
/* contains intervals defined by the */
/* start and stop times of segments */
/* for the object designated by */
/* IDCODE. */
/* 'INTERVAL' The output coverage window */
/* contains interpolation intervals */
/* of segments for the object */
/* designated by IDCODE. For type 1 */
/* segments, which don't have */
/* interpolation intervals, each */
/* epoch associated with a pointing */
/* instance is treated as a singleton */
/* interval; these intervals are */
/* added to the coverage window. */
/* All interpolation intervals are */
/* considered to lie within the */
/* segment bounds for the purpose of */
/* this summary: if an interpolation */
/* interval extends beyond the */
/* segment coverage interval, only */
/* its intersection with the segment */
/* coverage interval is considered to */
/* contribute to the total coverage. */
/* TOL is a tolerance value expressed in ticks of the */
/* spacecraft clock associated with IDCODE. Before */
/* each interval is inserted into the coverage */
/* window, the interval is intersected with the */
/* segment coverage interval, then if the */
/* intersection is non-empty, it is expanded by TOL: */
/* the left endpoint of the intersection interval is */
/* reduced by TOL and the right endpoint is increased */
/* by TOL. Adjusted interval endpoints, when */
/* expressed as encoded SCLK, never are less than */
/* zero ticks. Any intervals that overlap as a */
/* result of the expansion are merged. */
/* The coverage window returned when TOL > 0 */
/* indicates the coverage provided by the file to the */
/* CK readers CKGPAV and CKGP when that value of TOL */
/* is passed to them as an input. */
/* TIMSYS is a string indicating the time system used */
/* in the output coverage window. TIMSYS may */
/* have the values: */
/* 'SCLK' Elements of COVER are expressed in */
/* encoded SCLK ("ticks"), where the */
/* clock is associated with the object */
/* designated by IDCODE. */
/* 'TDB' Elements of COVER are expressed as */
/* seconds past J2000 TDB. */
/* COVER is an initialized SPICELIB window data structure. */
/* COVER optionally may contain coverage data on */
/* input; on output, the data already present in */
/* COVER will be combined with coverage found for the */
/* object designated by IDCODE in the file CK. */
/* If COVER contains no data on input, its size and */
/* cardinality still must be initialized. */
/* $ Detailed_Output */
/* COVER is a SPICELIB window data structure which */
/* represents the merged coverage for IDCODE. When */
/* the coverage level is 'INTERVAL', this is the set */
/* of time intervals for which data for IDCODE are */
/* present in the file CK, merged with the set of */
/* time intervals present in COVER on input. The */
/* merged coverage is represented as the union of one */
/* or more disjoint time intervals. The window COVER */
/* contains the pairs of endpoints of these */
/* intervals. */
/* When the coverage level is 'SEGMENT', COVER is */
/* computed in a manner similar to that described */
/* above, but the coverage intervals used in the */
/* computation are those of segments rather than */
/* interpolation intervals within segments. */
/* When TOL is > 0, the intervals comprising the */
/* coverage window for IDCODE are expanded by TOL and */
/* any intervals overlapping as a result are merged. */
/* The resulting window is returned in COVER. The */
/* expanded window in no case extends beyond the */
/* segment bounds in either direction by more than */
/* TOL. */
/* The interval endpoints contained in COVER are */
/* encoded spacecraft clock times if TIMSYS is */
/* 'SCLK'; otherwise the times are converted from */
/* encoded spacecraft clock to seconds past J2000 */
/* TDB. */
/* See the Examples section below for a complete */
/* example program showing how to retrieve the */
/* endpoints from COVER. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file has transfer format, the error */
/* SPICE(INVALIDFORMAT) is signaled. */
/* 2) If the input file is not a transfer file but has architecture */
/* other than DAF, the error SPICE(BADARCHTYPE) is signaled. */
/* 3) If the input file is a binary DAF file of type other than */
/* CK, the error SPICE(BADFILETYPE) is signaled. */
/* 4) If the CK file cannot be opened or read, the error will */
/* be diagnosed by routines called by this routine. The output */
/* window will not be modified. */
/* 5) If the size of the output WINDOW argument COVER is */
/* insufficient to contain the actual number of intervals in the */
/* coverage window for IDCODE, the error will be diagnosed by */
/* routines called by this routine. */
/* 6) If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is */
/* signaled. */
/* 7) If LEVEL is not recognized, the error SPICE(INVALIDOPTION) */
/* is signaled. */
/* 8) If TIMSYS is not recognized, the error SPICE(NOTSUPPORTED) */
/* is signaled. */
/* 9) If a time conversion error occurs, the error will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 10) If the output time system is TDB, the CK subsystem must be */
/* able to map IDCODE to the ID code of the associated */
/* spacecraft clock. If this mapping cannot be performed, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* $ Files */
/* This routine reads a C-kernel. */
/* If the output time system is 'TDB', then a leapseconds kernel */
/* and an SCLK kernel for the spacecraft clock associated with */
/* IDCODE must be loaded before this routine is called. */
/* If the ID code of the clock associated with IDCODE is not */
/* equal to */
/* IDCODE / 1000 */
/* then the kernel variable */
/* CK_<IDCODE>_SCLK */
/* must be present in the kernel pool to identify the clock */
/* associated with IDCODE. This variable must contain the ID code */
/* to be used for conversion between SCLK and TDB. Normally this */
/* variable is provided in a text kernel loaded via FURNSH. */
/* $ Particulars */
/* This routine provides an API via which applications can determine */
/* the coverage a specified CK file provides for a specified */
/* object. */
/* $ Examples */
/* 1) Display the interval-level coverage for each object in a */
/* specified CK file. Use tolerance of zero ticks. Do not */
/* request angular velocity. Express the results in the TDB time */
/* system. */
/* Find the set of objects in the file. Loop over the contents */
/* of the ID code set: find the coverage for each item in the */
/* set and display the coverage. */
/* PROGRAM CKCVR */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* INTEGER CARDI */
/* C */
/* C Local parameters */
/* C */
/* C */
/* C Declare the coverage window. Make enough room */
/* C for MAXIV intervals. */
/* C */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER MAXIV */
/* PARAMETER ( MAXIV = 100000 ) */
/* INTEGER WINSIZ */
/* PARAMETER ( WINSIZ = 2 * MAXIV ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* INTEGER MAXOBJ */
/* PARAMETER ( MAXOBJ = 1000 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) CK */
/* CHARACTER*(FILSIZ) LSK */
/* CHARACTER*(FILSIZ) SCLK */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : WINSIZ ) */
/* DOUBLE PRECISION E */
/* INTEGER I */
/* INTEGER IDS ( LBCELL : MAXOBJ ) */
/* INTEGER J */
/* INTEGER NIV */
/* C */
/* C Load a leapseconds kernel and SCLK kernel for output */
/* C time conversion. Note that we assume a single spacecraft */
/* C clock is associated with all of the objects in the CK. */
/* C */
/* CALL PROMPT ( 'Name of leapseconds kernel > ', LSK ) */
/* CALL FURNSH ( LSK ) */
/* CALL PROMPT ( 'Name of SCLK kernel > ', SCLK ) */
/* CALL FURNSH ( SCLK ) */
/* C */
/* C Get name of CK file. */
/* C */
/* CALL PROMPT ( 'Name of CK file > ', CK ) */
/* C */
/* C Initialize the set IDS. */
/* C */
/* CALL SSIZEI ( MAXOBJ, IDS ) */
/* C */
/* C Initialize the window COVER. */
/* C */
/* CALL SSIZED ( WINSIZ, COVER ) */
/* C */
/* C Find the set of objects in the CK file. */
/* C */
/* CALL CKOBJ ( CK, IDS ) */
/* C */
/* C We want to display the coverage for each object. Loop */
/* C over the contents of the ID code set, find the coverage */
/* C for each item in the set, and display the coverage. */
/* C */
/* DO I = 1, CARDI( IDS ) */
/* C */
/* C Find the coverage window for the current */
/* C object. Empty the coverage window each time */
/* C so we don't include data for the previous object. */
/* C */
/* CALL SCARDD ( 0, COVER ) */
/* CALL CKCOV ( CK, IDS(I), .FALSE., */
/* . 'INTERVAL', 0.D0, 'TDB', COVER ) */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) '========================================' */
/* WRITE (*,*) 'Coverage for object ', IDS(I) */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO J = 1, NIV */
/* C */
/* C Get the endpoints of the Jth interval. */
/* C */
/* CALL WNFETD ( COVER, J, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', J */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* WRITE (*,*) '========================================' */
/* END DO */
/* END */
/* 2) Find the segment-level coverage for the object designated by */
/* IDCODE provided by the set of CK files loaded via a */
/* metakernel. (The metakernel must also specify leapseconds and */
/* SCLK kernels.) Use tolerance of zero ticks. Do not request */
/* angular velocity. Express the results in the TDB time system. */
/* PROGRAM CKMET */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* INTEGER WNCARD */
/* C */
/* C Local parameters */
/* C */
/* INTEGER LBCELL */
/* PARAMETER ( LBCELL = -5 ) */
/* INTEGER FILSIZ */
/* PARAMETER ( FILSIZ = 255 ) */
/* INTEGER LNSIZE */
/* PARAMETER ( LNSIZE = 80 ) */
/* INTEGER MAXCOV */
/* PARAMETER ( MAXCOV = 100000 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 50 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(FILSIZ) FILE */
/* CHARACTER*(LNSIZE) IDCH */
/* CHARACTER*(FILSIZ) META */
/* CHARACTER*(FILSIZ) SOURCE */
/* CHARACTER*(TIMLEN) TIMSTR */
/* CHARACTER*(LNSIZE) TYPE */
/* DOUBLE PRECISION B */
/* DOUBLE PRECISION COVER ( LBCELL : 2*MAXCOV ) */
/* DOUBLE PRECISION E */
/* INTEGER COUNT */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER IDCODE */
/* INTEGER NIV */
/* LOGICAL FOUND */
/* C */
/* C Prompt for the metakernel name; load the metakernel. */
/* C The metakernel lists the CK files whose coverage */
/* C for IDCODE we'd like to determine. The metakernel */
/* C must also specify a leapseconds kernel and an SCLK */
/* C kernel for the clock associated with IDCODE. */
/* C */
/* CALL PROMPT ( 'Enter name of metakernel > ', META ) */
/* CALL FURNSH ( META ) */
/* C */
/* C Get the ID code of interest. */
/* C */
/* CALL PROMPT ( 'Enter ID code > ', IDCH ) */
/* CALL PRSINT ( IDCH, IDCODE ) */
/* C */
/* C Initialize the coverage window. */
/* C */
/* CALL SSIZED ( MAXCOV, COVER ) */
/* C */
/* C Find out how many kernels are loaded. Loop over the */
/* C kernels: for each loaded CK file, add its coverage */
/* C for IDCODE, if any, to the coverage window. */
/* C */
/* CALL KTOTAL ( 'CK', COUNT ) */
/* DO I = 1, COUNT */
/* CALL KDATA ( I, 'CK', FILE, TYPE, */
/* . SOURCE, HANDLE, FOUND ) */
/* CALL CKCOV ( FILE, IDCODE, .FALSE., */
/* . 'SEGMENT', 0.0, 'TDB', COVER ) */
/* END DO */
/* C */
/* C Display results. */
/* C */
/* C Get the number of intervals in the coverage */
/* C window. */
/* C */
/* NIV = WNCARD( COVER ) */
/* C */
/* C Display a simple banner. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Coverage for object ', IDCODE */
/* C */
/* C Convert the coverage interval start and stop */
/* C times to TDB calendar strings. */
/* C */
/* DO I = 1, NIV */
/* C */
/* C Get the endpoints of the Ith interval. */
/* C */
/* CALL WNFETD ( COVER, I, B, E ) */
/* C */
/* C Convert the endpoints to TDB calendar */
/* C format time strings and display them. */
/* C */
/* CALL TIMOUT ( B, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Interval: ', I */
/* WRITE (*,*) 'Start: ', TIMSTR */
/* CALL TIMOUT ( E, */
/* . 'YYYY MON DD HR:MN:SC.###### ' // */
/* . '(TDB) ::TDB', */
/* . TIMSTR ) */
/* WRITE (*,*) 'Stop: ', TIMSTR */
/* WRITE (*,*) ' ' */
/* END DO */
/* END */
/* $ Restrictions */
/* 1) When this routine is used to accumulate coverage for IDCODE */
/* provided by multiple CK files, the inputs NEEDAV, LEVEL, TOL, */
/* and TIMSYS must have the same values for all files in order */
/* for the result to be meaningful. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 30-NOV-2007 (NJB) */
/* Corrected bug in first program in header Examples section: */
/* program now empties the coverage window prior to collecting */
/* data for the current object. Updated examples to use WNCARD */
/* rather than CARDD. */
/* - SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */
/* -& */
/* $ Index_Entries */
/* get coverage window for ck object */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("CKCOV", (ftnlen)5);
/* Check tolerance value. */
if (*tol < 0.) {
setmsg_("Tolerance must be non-negative; actual value was #.", (
ftnlen)51);
errdp_("#", tol, (ftnlen)1);
sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Use a logical flag to indicate whether this is a segment-level */
/* coverage description. */
seglvl = eqstr_(level, "SEGMENT", level_len, (ftnlen)7);
/* Check coverage level keyword. */
if (! (seglvl || eqstr_(level, "INTERVAL", level_len, (ftnlen)8))) {
setmsg_("Allowed values of LEVEL are # and #; actual value was #.", (
ftnlen)56);
errch_("#", "SEGMENT", (ftnlen)1, (ftnlen)7);
errch_("#", "INTERVAL", (ftnlen)1, (ftnlen)8);
errch_("#", level, (ftnlen)1, level_len);
sigerr_("SPICE(INVALIDOPTION)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* See whether GETFAT thinks we've got a CK file. */
getfat_(ck, arch, kertyp, ck_len, (ftnlen)80, (ftnlen)80);
if (s_cmp(arch, "XFR", (ftnlen)80, (ftnlen)3) == 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. If the input file i"
"s an CK file in transfer format, run TOBIN on the file to co"
"nvert it to binary format.", (ftnlen)205);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(arch, "DAF", (ftnlen)80, (ftnlen)3) != 0) {
setmsg_("Input file # has architecture #. The file must be a binary "
"CK file to be readable by this routine. Binary CK files hav"
"e DAF architecture. If you expected the file to be a binary"
" CK file, the problem may be due to the file being an old no"
"n-native file lacking binary file format information. It's a"
"lso possible the file has been corrupted.", (ftnlen)340);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", arch, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDARCHTYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
} else if (s_cmp(kertyp, "CK", (ftnlen)80, (ftnlen)2) != 0) {
setmsg_("Input file # has file type #. The file must be a binary CK "
"file to be readable by this routine. If you expected the fil"
"e to be a binary CK file, the problem may be due to the file"
" being an old non-native file lacking binary file format inf"
"ormation. It's also possible the file has been corrupted.", (
ftnlen)296);
errch_("#", ck, (ftnlen)1, ck_len);
errch_("#", kertyp, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(INVALIDFILETYPE)", (ftnlen)22);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* Set a logical flag indicating whether the time systm is SCLK. */
istdb = eqstr_(timsys, "TDB", timsys_len, (ftnlen)3);
/* Check time system. */
if (! istdb) {
if (! eqstr_(timsys, "SCLK", timsys_len, (ftnlen)4)) {
setmsg_("Time system spec TIMSYS was #; allowed values are SCLK "
"and TDB.", (ftnlen)63);
errch_("#", timsys, (ftnlen)1, timsys_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* If the output time system is TDB, find the clock ID associated */
/* with IDCODE. */
if (istdb) {
ckmeta_(idcode, "SCLK", &clkid, (ftnlen)4);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* Open the file for reading. */
dafopr_(ck, &handle, ck_len);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
/* We will examine each segment descriptor in the file, and */
/* we'll update our coverage bounds according to the data found */
/* in these descriptors. */
/* If TOL > 0, we'll apply TOL after we've found the coverage */
/* for the zero-tolerance case. */
/* If the time system is TDB, we'll convert the times to TDB */
/* at the end of this routine. */
/* Start a forward search. */
dafbfs_(&handle);
/* Find the next DAF array. */
daffna_(&found);
while(found) {
/* Note: we check FAILED() at the bottom of this loop; this */
/* routine returns if FAILED() returns .TRUE. at that point. */
/* Fetch and unpack the segment descriptor. */
dafgs_(descr);
dafus_(descr, &c__2, &c__6, dc, ic);
/* Let AVOK indicate whether the segment satisfies the */
/* angular velocity restriction. */
avok = ic[3] == 1 || ! (*needav);
if (ic[0] == *idcode && avok) {
/* This segment is for the body of interest. If angular */
/* velocity is needed, this segment has it. */
if (seglvl) {
/* This is a segment-level summary. */
/* Insert the coverage bounds into the coverage window. */
/* Adjust the interval using the tolerance. */
/* Computing MAX */
d__1 = dc[0] - *tol;
dctol[0] = max(d__1,0.);
dctol[1] = dc[1] + *tol;
/* Convert the time to TDB if necessary. */
if (istdb) {
/* Convert the time bounds to TDB before inserting */
/* into the window. */
for (i__ = 1; i__ <= 2; ++i__) {
sct2e_(&clkid, &dctol[(i__1 = i__ - 1) < 2 && 0 <=
i__1 ? i__1 : s_rnge("dctol", i__1, "ckcov_",
(ftnlen)868)], &et);
dctol[(i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 :
s_rnge("dctol", i__1, "ckcov_", (ftnlen)869)]
= et;
}
}
if (dctol[0] <= dctol[1]) {
wninsd_(dctol, &dctol[1], cover);
}
} else {
/* We're looking for an interval-level coverage window. */
/* This information must be retrieved in a */
/* data-type-dependent fashion. The coverage routines */
/* we'll call will, if necessary, adjust intervals by TOL */
/* and convert interval times to TDB. */
dtype = ic[2];
segbeg = ic[4];
segend = ic[5];
if (dtype == 1) {
zzckcv01_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 2) {
zzckcv02_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 3) {
zzckcv03_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 4) {
zzckcv04_(&handle, &segbeg, &segend, &clkid, tol, timsys,
cover, timsys_len);
} else if (dtype == 5) {
/* Note: this calling sequence is exceptional; the */
/* segment bounds are an input. */
zzckcv05_(&handle, &segbeg, &segend, &clkid, dc, tol,
timsys, cover, timsys_len);
} else {
setmsg_("Supported CK data types are 1, 2, 3, 4, 5. Dat"
"a type of segment: #. This problem may indicate "
"that you need to update your SPICE Toolkit.", (
ftnlen)138);
errint_("#", &dtype, (ftnlen)1);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
}
daffna_(&found);
if (failed_()) {
chkout_("CKCOV", (ftnlen)5);
return 0;
}
}
/* COVER now represents the coverage of the entire file at the */
/* granularity indicated by LEVEL, combined with the coverage */
/* contained in COVER on input. */
/* Release the file. */
dafcls_(&handle);
chkout_("CKCOV", (ftnlen)5);
return 0;
} /* ckcov_ */