/* $Procedure ZZSPKAP1 ( S/P Kernel, apparent state ) */
/* Subroutine */ int zzspkap1_(integer *targ, doublereal *et, char *ref,
doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt,
ftnlen ref_len, ftnlen abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static char flags[5*9] = "NONE " "LT " "LT+S " "CN " "CN+S " "XLT "
"XLT+S" "XCN " "XCN+S";
static char prvcor[5] = " ";
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
char corr[5];
extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *,
doublereal *, ftnlen);
static logical xmit;
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer i__, refid;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *);
static logical usecn;
doublereal sapos[3];
extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *,
doublereal *);
static logical uselt;
extern doublereal vnorm_(doublereal *), clight_(void);
extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int stelab_(doublereal *, doublereal *,
doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
stlabx_(doublereal *, doublereal *, doublereal *);
integer ltsign;
extern /* Subroutine */ int ljucrs_(integer *, char *, char *, ftnlen,
ftnlen), setmsg_(char *, ftnlen);
doublereal tstate[6];
integer maxitr;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen);
extern logical return_(void);
static logical usestl;
extern logical odd_(integer *);
/* $ Abstract */
/* Deprecated: This routine has been superseded by SPKAPS. This */
/* routine is supported for purposes of backward compatibility only. */
/* Return the state (position and velocity) of a target body */
/* relative to an observer, optionally corrected for light time and */
/* stellar aberration. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Observer epoch. */
/* REF I Inertial reference frame of observer's state. */
/* SOBS I State of observer wrt. solar system barycenter. */
/* ABCORR I Aberration correction flag. */
/* STARG O State of target. */
/* LT O One way light time between observer and target. */
/* $ Detailed_Input */
/* TARG is the NAIF ID code for a target body. The target */
/* and observer define a state vector whose position */
/* component points from the observer to the target. */
/* ET is the ephemeris time, expressed as seconds past J2000 */
/* TDB, at which the state of the target body relative to */
/* the observer is to be computed. ET refers to time at */
/* the observer's location. */
/* REF is the inertial reference frame with respect to which */
/* the observer's state SOBS is expressed. REF must be */
/* recognized by the SPICE Toolkit. The acceptable */
/* frames are listed in the Frames Required Reading, as */
/* well as in the SPICELIB routine CHGIRF. */
/* Case and blanks are not significant in the string REF. */
/* SOBS is the geometric (uncorrected) state of the observer */
/* relative to the solar system barycenter at epoch ET. */
/* SOBS is a 6-vector: the first three components of */
/* SOBS represent a Cartesian position vector; the last */
/* three components represent the corresponding velocity */
/* vector. SOBS is expressed relative to the inertial */
/* reference frame designated by REF. */
/* Units are always km and km/sec. */
/* ABCORR indicates the aberration corrections to be applied */
/* to the state of the target body to account for one-way */
/* light time and stellar aberration. See the discussion */
/* in the Particulars section for recommendations on */
/* how to choose aberration corrections. */
/* ABCORR may be any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric state of the target body */
/* relative to the observer. */
/* The following values of ABCORR apply to the */
/* "reception" case in which photons depart from the */
/* target's location at the light-time corrected epoch */
/* ET-LT and *arrive* at the observer's location at ET: */
/* 'LT' Correct for one-way light time (also */
/* called "planetary aberration") using a */
/* Newtonian formulation. This correction */
/* yields the state of the target at the */
/* moment it emitted photons arriving at */
/* the observer at ET. */
/* The light time correction involves */
/* iterative solution of the light time */
/* equation (see Particulars for details). */
/* The solution invoked by the 'LT' option */
/* uses one iteration. */
/* 'LT+S' Correct for one-way light time and */
/* stellar aberration using a Newtonian */
/* formulation. This option modifies the */
/* state obtained with the 'LT' option to */
/* account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The result is the apparent */
/* state of the target---the position and */
/* velocity of the target as seen by the */
/* observer. */
/* 'CN' Converged Newtonian light time */
/* correction. In solving the light time */
/* equation, the 'CN' correction iterates */
/* until the solution converges (three */
/* iterations on all supported platforms). */
/* Whether the 'CN+S' solution is */
/* substantially more accurate than the */
/* 'LT' solution depends on the geometry */
/* of the participating objects and on the */
/* accuracy of the input data. In all */
/* cases this routine will execute more */
/* slowly when a converged solution is */
/* computed. See the Particulars section */
/* of SPKEZR for a discussion of precision */
/* of light time corrections. */
/* 'CN+S' Converged Newtonian light time */
/* correction and stellar aberration */
/* correction. */
/* The following values of ABCORR apply to the */
/* "transmission" case in which photons *depart* from */
/* the observer's location at ET and arrive at the */
/* target's location at the light-time corrected epoch */
/* ET+LT: */
/* 'XLT' "Transmission" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. This correction yields the */
/* state of the target at the moment it */
/* receives photons emitted from the */
/* observer's location at ET. */
/* 'XLT+S' "Transmission" case: correct for */
/* one-way light time and stellar */
/* aberration using a Newtonian */
/* formulation This option modifies the */
/* state obtained with the 'XLT' option to */
/* account for the observer's velocity */
/* relative to the solar system */
/* barycenter. The position component of */
/* the computed target state indicates the */
/* direction that photons emitted from the */
/* observer's location must be "aimed" to */
/* hit the target. */
/* 'XCN' "Transmission" case: converged */
/* Newtonian light time correction. */
/* 'XCN+S' "Transmission" case: converged */
/* Newtonian light time correction and */
/* stellar aberration correction. */
/* Neither special nor general relativistic effects are */
/* accounted for in the aberration corrections applied */
/* by this routine. */
/* Case and blanks are not significant in the string */
/* ABCORR. */
/* $ Detailed_Output */
/* STARG is a Cartesian state vector representing the position */
/* and velocity of the target body relative to the */
/* specified observer. STARG is corrected for the */
/* specified aberrations, and is expressed with respect */
/* to the specified inertial reference frame. The first */
/* three components of STARG represent the x-, y- and */
/* z-components of the target's position; last three */
/* components form the corresponding velocity vector. */
/* The position component of STARG points from the */
/* observer's location at ET to the aberration-corrected */
/* location of the target. Note that the sense of the */
/* position vector is independent of the direction of */
/* radiation travel implied by the aberration */
/* correction. */
/* The velocity component of STARG is obtained by */
/* evaluating the target's geometric state at the light */
/* time corrected epoch, so for aberration-corrected */
/* states, the velocity is not precisely equal to the */
/* time derivative of the position. */
/* Units are always km and km/sec. */
/* LT is the one-way light time between the observer and */
/* target in seconds. If the target state is corrected */
/* for aberrations, then LT is the one-way light time */
/* between the observer and the light time corrected */
/* target location. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the value of ABCORR is not recognized, the error */
/* 'SPICE(SPKINVALIDOPTION)' is signaled. */
/* 2) If the reference frame requested is not a recognized */
/* inertial reference frame, the error 'SPICE(BADFRAME)' */
/* is signaled. */
/* 3) If the state of the target relative to the solar system */
/* barycenter cannot be computed, the error will be diagnosed */
/* by routines in the call tree of this routine. */
/* $ Files */
/* This routine computes states using SPK files that have been */
/* loaded into the SPICE system, normally via the kernel loading */
/* interface routine FURNSH. Application programs typically load */
/* kernels once before this routine is called, for example during */
/* program initialization; kernels need not be loaded repeatedly. */
/* See the routine FURNSH and the SPK and KERNEL Required Reading */
/* for further information on loading (and unloading) kernels. */
/* If any of the ephemeris data used to compute STARG are expressed */
/* relative to a non-inertial frame in the SPK files providing those */
/* data, additional kernels may be needed to enable the reference */
/* frame transformations required to compute the state. Normally */
/* these additional kernels are PCK files or frame kernels. Any */
/* such kernels must already be loaded at the time this routine is */
/* called. */
/* $ Particulars */
/* In space science or engineering applications one frequently */
/* wishes to know where to point a remote sensing instrument, such */
/* as an optical camera or radio antenna, in order to observe or */
/* otherwise receive radiation from a target. This pointing problem */
/* is complicated by the finite speed of light: one needs to point */
/* to where the target appears to be as opposed to where it actually */
/* is at the epoch of observation. We use the adjectives */
/* "geometric," "uncorrected," or "true" to refer to an actual */
/* position or state of a target at a specified epoch. When a */
/* geometric position or state vector is modified to reflect how it */
/* appears to an observer, we describe that vector by any of the */
/* terms "apparent," "corrected," "aberration corrected," or "light */
/* time and stellar aberration corrected." */
/* The SPICE Toolkit can correct for two phenomena affecting the */
/* apparent location of an object: one-way light time (also called */
/* "planetary aberration") and stellar aberration. Correcting for */
/* one-way light time is done by computing, given an observer and */
/* observation epoch, where a target was when the observed photons */
/* departed the target's location. The vector from the observer to */
/* this computed target location is called a "light time corrected" */
/* vector. The light time correction depends on the motion of the */
/* target, but it is independent of the velocity of the observer */
/* relative to the solar system barycenter. Relativistic effects */
/* such as light bending and gravitational delay are not accounted */
/* for in the light time correction performed by this routine. */
/* The velocity of the observer also affects the apparent location */
/* of a target: photons arriving at the observer are subject to a */
/* "raindrop effect" whereby their velocity relative to the observer */
/* is, using a Newtonian approximation, the photons' velocity */
/* relative to the solar system barycenter minus the velocity of the */
/* observer relative to the solar system barycenter. This effect is */
/* called "stellar aberration." Stellar aberration is independent */
/* of the velocity of the target. The stellar aberration formula */
/* used by this routine is non-relativistic. */
/* Stellar aberration corrections are applied after light time */
/* corrections: the light time corrected target position vector is */
/* used as an input to the stellar aberration correction. */
/* When light time and stellar aberration corrections are both */
/* applied to a geometric position vector, the resulting position */
/* vector indicates where the target "appears to be" from the */
/* observer's location. */
/* As opposed to computing the apparent position of a target, one */
/* may wish to compute the pointing direction required for */
/* transmission of photons to the target. This requires correction */
/* of the geometric target position for the effects of light time and */
/* stellar aberration, but in this case the corrections are computed */
/* for radiation traveling from the observer to the target. */
/* The "transmission" light time correction yields the target's */
/* location as it will be when photons emitted from the observer's */
/* location at ET arrive at the target. The transmission stellar */
/* aberration correction is the inverse of the traditional stellar */
/* aberration correction: it indicates the direction in which */
/* radiation should be emitted so that, using a Newtonian */
/* approximation, the sum of the velocity of the radiation relative */
/* to the observer and of the observer's velocity, relative to the */
/* solar system barycenter, yields a velocity vector that points in */
/* the direction of the light time corrected position of the target. */
/* The traditional aberration corrections applicable to observation */
/* and those applicable to transmission are related in a simple way: */
/* one may picture the geometry of the "transmission" case by */
/* imagining the "observation" case running in reverse time order, */
/* and vice versa. */
/* One may reasonably object to using the term "observer" in the */
/* transmission case, in which radiation is emitted from the */
/* observer's location. The terminology was retained for */
/* consistency with earlier documentation. */
/* Below, we indicate the aberration corrections to use for some */
/* common applications: */
/* 1) Find the apparent direction of a target for a remote-sensing */
/* observation. */
/* Use 'LT+S' or 'CN+S: apply both light time and stellar */
/* aberration corrections. */
/* Note that using light time corrections alone ('LT' or 'CN') */
/* is generally not a good way to obtain an approximation to */
/* an apparent target vector: since light time and stellar */
/* aberration corrections often partially cancel each other, */
/* it may be more accurate to use no correction at all than to */
/* use light time alone. */
/* 2) Find the corrected pointing direction to radiate a signal */
/* to a target. This computation is often applicable for */
/* implementing communications sessions. */
/* Use 'XLT+S' or 'XCN+S: apply both light time and stellar */
/* aberration corrections for transmission. */
/* 3) Compute the apparent position of a target body relative */
/* to a star or other distant object. */
/* Use 'LT', 'CN', 'LT+S', or 'CN+S' as needed to match the */
/* correction applied to the position of the distant */
/* object. For example, if a star position is obtained from */
/* a catalog, the position vector may not be corrected for */
/* stellar aberration. In this case, to find the angular */
/* separation of the star and the limb of a planet, the */
/* vector from the observer to the planet should be */
/* corrected for light time but not stellar aberration. */
/* 4) Obtain an uncorrected state vector derived directly from */
/* data in an SPK file. */
/* Use 'NONE'. */
/* C */
/* 5) Use a geometric state vector as a low-accuracy estimate */
/* of the apparent state for an application where execution */
/* speed is critical: */
/* Use 'NONE'. */
/* 6) While this routine cannot perform the relativistic */
/* aberration corrections required to compute states */
/* with the highest possible accuracy, it can supply the */
/* geometric states required as inputs to these computations: */
/* Use 'NONE', then apply high-accuracy aberration */
/* corrections (not available in the SPICE Toolkit). */
/* Below, we discuss in more detail how the aberration corrections */
/* applied by this routine are computed. */
/* Geometric case */
/* ============== */
/* SPKAPP begins by computing the geometric position T(ET) of the */
/* target body relative to the solar system barycenter (SSB). */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the geometric position of the target body relative to the */
/* observer. The one-way light time, LT, is given by */
/* | T(ET) - O(ET) | */
/* LT = ------------------- */
/* c */
/* The geometric relationship between the observer, target, and */
/* solar system barycenter is as shown: */
/* SSB ---> O(ET) */
/* | / */
/* | / */
/* | / */
/* | / T(ET) - O(ET) */
/* V V */
/* T(ET) */
/* The returned state consists of the position vector */
/* T(ET) - O(ET) */
/* and a velocity obtained by taking the difference of the */
/* corresponding velocities. In the geometric case, the */
/* returned velocity is actually the time derivative of the */
/* position. */
/* Reception case */
/* ============== */
/* When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */
/* selected, SPKAPP computes the position of the target body at */
/* epoch ET-LT, where LT is the one-way light time. Let T(t) and */
/* O(t) represent the positions of the target and observer */
/* relative to the solar system barycenter at time t; then LT is */
/* the solution of the light-time equation */
/* | T(ET-LT) - O(ET) | */
/* LT = ------------------------ (1) */
/* c */
/* The ratio */
/* | T(ET) - O(ET) | */
/* --------------------- (2) */
/* c */
/* is used as a first approximation to LT; inserting (2) into the */
/* RHS of the light-time equation (1) yields the "one-iteration" */
/* estimate of the one-way light time. Repeating the process */
/* until the estimates of LT converge yields the "converged */
/* Newtonian" light time estimate. */
/* Subtracting the geometric position of the observer O(ET) gives */
/* the position of the target body relative to the observer: */
/* T(ET-LT) - O(ET). */
/* SSB ---> O(ET) */
/* | \ | */
/* | \ | */
/* | \ | T(ET-LT) - O(ET) */
/* | \ | */
/* V V V */
/* T(ET) T(ET-LT) */
/* The position component of the light-time corrected state */
/* is the vector */
/* T(ET-LT) - O(ET) */
/* The velocity component of the light-time corrected state */
/* is the difference */
/* T_vel(ET-LT) - O_vel(ET) */
/* where T_vel and O_vel are, respectively, the velocities of */
/* the target and observer relative to the solar system */
/* barycenter at the epochs ET-LT and ET. */
/* If correction for stellar aberration is requested, the target */
/* position is rotated toward the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as follows: */
/* Let r be the light time corrected 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. */
/* The velocity component of the output state STARG is */
/* not corrected for stellar aberration. */
/* Transmission case */
/* ================== */
/* When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */
/* selected, SPKAPP computes the position of the target body T at */
/* epoch ET+LT, where LT is the one-way light time. LT is the */
/* solution of the light-time equation */
/* | T(ET+LT) - O(ET) | */
/* LT = ------------------------ (3) */
/* c */
/* Subtracting the geometric position of the observer, O(ET), */
/* gives the position of the target body relative to the */
/* observer: T(ET-LT) - O(ET). */
/* SSB --> O(ET) */
/* / | * */
/* / | * T(ET+LT) - O(ET) */
/* / |* */
/* / *| */
/* V V V */
/* T(ET+LT) T(ET) */
/* The position component of the light-time corrected state */
/* is the vector */
/* T(ET+LT) - O(ET) */
/* The velocity component of the light-time corrected state */
/* is the difference */
/* T_vel(ET+LT) - O_vel(ET) */
/* where T_vel and O_vel are, respectively, the velocities of */
/* the target and observer relative to the solar system */
/* barycenter at the epochs ET+LT and ET. */
/* If correction for stellar aberration is requested, the target */
/* position is rotated away from the solar system barycenter- */
/* relative velocity vector of the observer. The rotation is */
/* computed as in the reception case, but the sign of the */
/* rotation angle is negated. */
/* The velocity component of the output state STARG is */
/* not corrected for stellar aberration. */
/* Neither special nor general relativistic effects are accounted */
/* for in the aberration corrections performed by this routine. */
/* $ Examples */
/* In the following code fragment, SPKSSB and SPKAPP are used */
/* to display the position of Io (body 501) as seen from the */
/* Voyager 2 spacecraft (Body -32) at a series of epochs. */
/* Normally, one would call the high-level reader SPKEZR to obtain */
/* state vectors. The example below illustrates the interface */
/* of this routine but is not intended as a recommendation on */
/* how to use the SPICE SPK subsystem. */
/* The use of integer ID codes is necessitated by the low-level */
/* interface of this routine. */
/* IO = 501 */
/* VGR2 = -32 */
/* DO WHILE ( EPOCH .LE. END ) */
/* CALL SPKSSB ( VGR2, EPOCH, 'J2000', STVGR2 ) */
/* CALL SPKAPP ( IO, EPOCH, 'J2000', STVGR2, */
/* . 'LT+S', STIO, LT ) */
/* CALL RECRAD ( STIO, RANGE, RA, DEC ) */
/* WRITE (*,*) RA * DPR(), DEC * DPR() */
/* EPOCH = EPOCH + DELTA */
/* END DO */
/* $ Restrictions */
/* 1) The kernel files to be used by SPKAPP must be loaded */
/* (normally by the SPICELIB kernel loader FURNSH) before */
/* this routine is called. */
/* 2) Unlike most other SPK state computation routines, this */
/* routine requires that the input state be relative to an */
/* inertial reference frame. Non-inertial frames are not */
/* supported by this routine. */
/* 3) In a future version of this routine, the implementation */
/* of the aberration corrections may be enhanced to improve */
/* accuracy. */
/* $ Literature_References */
/* SPK Required Reading. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* B.V. Semenov (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 3.1.0, 04-JUL-2014 (NJB) (BVS) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* Last update was 21-SEP-2013 (BVS) */
/* Updated to call LJUCRS instead of CMPRSS/UCASE. */
/* - SPICELIB Version 3.0.3, 18-MAY-2010 (BVS) */
/* Index lines now state that this routine is deprecated. */
/* - SPICELIB Version 3.0.2, 08-JAN-2008 (NJB) */
/* The Abstract section of the header was updated to */
/* indicate that this routine has been deprecated. */
/* - SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */
/* Added mention that LT returns in seconds. */
/* Corrected spelling errors. */
/* - SPICELIB Version 3.0.0, 18-DEC-2001 (NJB) */
/* Updated to handle aberration corrections for transmission */
/* of radiation. Formerly, only the reception case was */
/* supported. The header was revised and expanded to explain */
/* the functionality of this routine in more detail. */
/* - SPICELIB Version 2.1.0, 09-JUL-1996 (WLT) */
/* Corrected the description of LT in the Detailed Output */
/* section of the header. */
/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */
/* The routine was modified to support the options 'CN' and */
/* 'CN+S' aberration corrections. Moreover, diagnostics were */
/* added to check for reference frames that are not recognized */
/* inertial frames. */
/* - SPICELIB Version 1.1.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */
/* In the example program, the calling sequence of SPKAPP */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */
/* The local variable CORR was added to eliminate a */
/* run-time error that occurred when SPKAPP was determining */
/* what corrections to apply to the state. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* DEPRECATED low-level aberration correction */
/* DEPRECATED apparent state from spk file */
/* DEPRECATED get apparent state */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */
/* The routine was modified to support the options 'CN' and */
/* 'CN+S' aberration corrections. Moreover, diagnostics were */
/* added to check for reference frames that are not recognized */
/* inertial frames. */
/* - SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */
/* In the example program, the calling sequence of SPKAPP */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */
/* The local variable CORR was added to eliminate a run-time */
/* error that occurred when SPKAPP was determining what */
/* corrections to apply to the state. If the literal string */
/* 'LT' was assigned to ABCORR, SPKAPP attempted to look at */
/* ABCORR(3:4). Because ABCORR is a passed length argument, its */
/* length is not guaranteed, and those positions may not exist. */
/* Searching beyond the bounds of a string resulted in a */
/* run-time error at NAIF because NAIF compiles SPICELIB using the */
/* CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */
/* Also, without the local variable CORR, SPKAPP would have to */
/* modify the value of a passed argument, ABCORR. That's a no no. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Indices of flags in the FLAGS array: */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("ZZSPKAP1", (ftnlen)8);
}
if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {
/* The aberration correction flag differs from the value it */
/* had on the previous call, if any. Analyze the new flag. */
/* Remove leading and embedded white space from the aberration */
/* correction flag and convert to upper case. */
ljucrs_(&c__0, abcorr, corr, abcorr_len, (ftnlen)5);
/* Locate the flag in our list of flags. */
i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5);
if (i__ == 0) {
setmsg_("Requested aberration correction # is not supported.", (
ftnlen)51);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23);
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
}
/* The aberration correction flag is recognized; save it. */
s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);
/* Set logical flags indicating the attributes of the requested */
/* correction. */
xmit = i__ > 5;
uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7;
usestl = i__ > 1 && odd_(&i__);
usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9;
first = FALSE_;
}
/* See if the reference frame is a recognized inertial frame. */
irfnum_(ref, &refid, ref_len);
if (refid == 0) {
setmsg_("The requested frame '#' is not a recognized inertial frame. "
, (ftnlen)60);
errch_("#", ref, (ftnlen)1, ref_len);
sigerr_("SPICE(BADFRAME)", (ftnlen)15);
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
}
/* Determine the sign of the light time offset. */
if (xmit) {
ltsign = 1;
} else {
ltsign = -1;
}
/* Find the geometric state of the target body with respect to the */
/* solar system barycenter. Subtract the state of the observer */
/* to get the relative state. Use this to compute the one-way */
/* light time. */
zzspksb1_(targ, et, ref, starg, ref_len);
vsubg_(starg, sobs, &c__6, tstate);
moved_(tstate, &c__6, starg);
*lt = vnorm_(starg) / clight_();
/* To correct for light time, find the state of the target body */
/* at the current epoch minus the one-way light time. Note that */
/* the observer remains where he is. */
if (uselt) {
maxitr = 1;
} else if (usecn) {
maxitr = 3;
} else {
maxitr = 0;
}
i__1 = maxitr;
for (i__ = 1; i__ <= i__1; ++i__) {
d__1 = *et + ltsign * *lt;
zzspksb1_(targ, &d__1, ref, starg, ref_len);
vsubg_(starg, sobs, &c__6, tstate);
moved_(tstate, &c__6, starg);
*lt = vnorm_(starg) / clight_();
}
/* At this point, STARG contains the light time corrected */
/* state of the target relative to the observer. */
/* If stellar aberration correction is requested, perform it now. */
/* Stellar aberration corrections are not applied to the target's */
/* velocity. */
if (usestl) {
if (xmit) {
/* This is the transmission case. */
/* Compute the position vector obtained by applying */
/* "reception" stellar aberration to STARG. */
stlabx_(starg, &sobs[3], sapos);
vequ_(sapos, starg);
} else {
/* This is the reception case. */
/* Compute the position vector obtained by applying */
/* "reception" stellar aberration to STARG. */
stelab_(starg, &sobs[3], sapos);
vequ_(sapos, starg);
}
}
chkout_("ZZSPKAP1", (ftnlen)8);
return 0;
} /* zzspkap1_ */
/* $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 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 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 GFPA ( GF, phase angle search ) */
/* Subroutine */ int gfpa_(char *target, char *illmn, char *abcorr, char *
obsrvr, char *relate, doublereal *refval, doublereal *adjust,
doublereal *step, doublereal *cnfine, integer *mw, integer *nw,
doublereal *work, doublereal *result, ftnlen target_len, ftnlen
illmn_len, ftnlen abcorr_len, ftnlen obsrvr_len, ftnlen relate_len)
{
/* System generated locals */
integer work_dim1, work_offset, i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int chkin_(char *, ftnlen);
extern integer sized_(doublereal *);
extern logical gfbail_();
logical ok;
extern /* Subroutine */ int scardd_(integer *, doublereal *);
extern /* Subroutine */ int gfrefn_(), gfrepi_(), gfrepf_(), gfrepu_(),
gfstep_();
char qcpars[80*4], qpnams[80*4];
extern logical return_(void);
doublereal qdpars[4];
integer qipars[4];
logical qlpars[4];
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), gfsstp_(doublereal *), gfevnt_(U_fp, U_fp, char *,
integer *, char *, char *, doublereal *, integer *, logical *,
char *, doublereal *, doublereal *, doublereal *, doublereal *,
logical *, U_fp, U_fp, U_fp, integer *, integer *, doublereal *,
logical *, L_fp, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen);
extern logical odd_(integer *);
doublereal tol;
extern /* Subroutine */ int zzholdd_(integer *, integer *, logical *,
doublereal *);
/* $ Abstract */
/* Determine time intervals for which a specified constraint */
/* on the phase angle between an illumination source, a target, */
/* and observer body centers is met. */
/* $ 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 */
/* NAIF_IDS */
/* SPK */
/* TIME */
/* WINDOWS */
/* $ Keywords */
/* EVENT */
/* GEOMETRY */
/* 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.3.0, 01-OCT-2011 (NJB) */
/* Added NWILUM parameter. */
/* - SPICELIB Version 1.2.0, 14-SEP-2010 (EDW) */
/* Added NWPA parameter. */
/* - SPICELIB Version 1.1.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. */
/* Callers of GFPA should declare their workspace window */
/* count using NWPA. */
/* Callers of GFILUM should declare their workspace window */
/* count using NWILUM. */
/* 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 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 file contains parameter declarations for the ZZHOLDD */
/* 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 */
/* None. */
/* $ Declarations */
/* None. */
/* $ Brief_I/O */
/* None. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* GEN general value, primarily for testing. */
/* GF_REF user defined GF reference value. */
/* GF_TOL user defined GF convergence tolerance. */
/* GF_DT user defined GF step for numeric differentiation. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0 03-DEC-2013 (EDW) */
/* -& */
/* OP codes. The values exist in the integer domain */
/* [ -ZZNOP, -1], */
/* Current number of OP codes. */
/* ID codes. The values exist in the integer domain */
/* [ 1, NID], */
/* General use, primarily testing. */
/* The user defined GF reference value. */
/* The user defined GF convergence tolerance. */
/* The user defined GF step for numeric differentiation. */
/* Current number of ID codes, dimension of array */
/* in ZZHOLDD. Bad things can happen if this parameter */
/* does not have the proper value. */
/* End of file zzholdd.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* LBCELL P SPICE Cell lower bound. */
/* CNVTOL P Default convergence tolerance. */
/* TARGET I Name of the target body. */
/* ILLMN I Name of the illuminating body. */
/* ABCORR I Aberration correction flag. */
/* OBSRVR I Name of the observing body. */
/* RELATE I Relational operator. */
/* REFVAL I Reference value. */
/* ADJUST I Adjustment value for absolute extrema searches. */
/* STEP I Step size used for locating extrema and roots. */
/* CNFINE I SPICE window to which the search is confined. */
/* MW I Workspace window size. */
/* NW I The number of workspace windows needed for */
/* the search. */
/* WORK I-O Array of workspace windows. */
/* RESULT I-O SPICE window containing results. */
/* $ Detailed_Input */
/* TARGET the string name of a target body. Optionally, you may */
/* supply the integer ID code for the object as an */
/* integer string. For example both 'MOON' and '301' */
/* are legitimate strings that indicate the moon is the */
/* target body. */
/* Case and leading or trailing blanks are not significant */
/* in the string TARGET. */
/* ILLMN the string name of the illuminating body. This will */
/* normally be 'SUN' but the algorithm can use any */
/* ephemeris object */
/* Case and leading or trailing blanks are not significant */
/* in the string ILLMN. */
/* ABCORR the string description of the aberration corrections to */
/* apply to the state evaluations to account for one-way */
/* light time and stellar aberration. */
/* This routine accepts only reception mode aberration */
/* corrections. See the header of SPKEZR for a detailed */
/* description of the aberration correction options. */
/* For convenience, the allowed aberation options are */
/* listed below: */
/* 'NONE' Apply no correction. Returns the "true" */
/* geometric state. */
/* 'LT' "Reception" case: correct for */
/* one-way light time using a Newtonian */
/* formulation. */
/* 'LT+S' "Reception" case: correct for */
/* one-way light time and stellar */
/* aberration using a Newtonian */
/* formulation. */
/* 'CN' "Reception" case: converged */
/* Newtonian light time correction. */
/* 'CN+S' "Reception" case: converged */
/* Newtonian light time and stellar */
/* aberration corrections. */
/* Case and leading or trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSRVR the string name of an observing body. Optionally, you */
/* may supply the ID code of the object as an integer */
/* string. For example both "MOON" and "301" are legitimate */
/* strings that indicate the Moon is the observer. */
/* Case and leading or trailing blanks are not significant */
/* in the string OBSRVR. */
/* RELATE the string or character describing the relational */
/* operator that defines the constraint on the */
/* phase angle of the observer-target vector. The result */
/* window found by this routine indicates the time intervals */
/* where the constraint is satisfied. Supported values of */
/* RELATE and corresponding meanings are shown below: */
/* '>' The phase angle value is greater than the */
/* reference value REFVAL. */
/* '=' The phase angle value is equal to the */
/* reference value REFVAL. */
/* '<' The phase angle value is less than the */
/* reference value REFVAL. */
/* 'ABSMAX' The phase angle value is at an absolute */
/* maximum. */
/* 'ABSMIN' The phase angle value is at an absolute */
/* minimum. */
/* 'LOCMAX' The phase angle value is at a local */
/* maximum. */
/* 'LOCMIN' The phase angle value 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 measure of an absolute extremum. */
/* The argument ADJUST (described below) is used to */
/* specify this measure. */
/* 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. */
/* Case and leading or trailing blanks are not */
/* significant in the string RELATE. */
/* REFVAL the double precision reference value used together with */
/* the argument RELATE to define an equality or inequality */
/* to satisfy by the phase angle of the observer-target */
/* vector. See the discussion of RELATE above for */
/* further information. */
/* The units of REFVAL are radians. */
/* ADJUST a double precision value used to modify searches for */
/* absolute extrema: when RELATE is set to ABSMAX or ABSMIN */
/* and ADJUST is set to a positive value, GFPA finds */
/* times when the phase angle is within */
/* ADJUST radians of the specified extreme value. */
/* For RELATE set to ABSMAX, the RESULT window contains */
/* time intervals when the phase angle has */
/* values between ABSMAX - ADJUST and ABSMAX. */
/* For RELATE set to ABSMIN, the RESULT window contains */
/* time intervals when the phase angle has */
/* values between ABSMIN and ABSMIN + ADJUST. */
/* ADJUST is not used for searches for local extrema, */
/* equality or inequality conditions. */
/* STEP the double precision time step size to use in the search. */
/* STEP must be short enough for a search using this step */
/* size to locate the time intervals where the phase angle */
/* 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 a double precision 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 using 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. NW should be set to the */
/* parameter NWPA; this parameter is declared in the */
/* include file gf.inc. (The reason this dimension is */
/* an input argument is that this allows run-time */
/* error checking to be performed.) */
/* WORK is an array used to store workspace windows. This */
/* array should be declared by the caller as shown: */
/* INCLUDE 'gf.inc' */
/* ... */
/* DOUBLE PRECISION WORK ( LBCELL : MW, NWPA ) */
/* where MW is a constant declared by the caller and */
/* NWPA is a constant defined in the SPICELIB INCLUDE */
/* file gf.inc. See the discussion of MW above. */
/* WORK need not be initialized by the caller. */
/* RESULT a double precision SPICE window that will contain the */
/* search results. RESULT must be initialized using */
/* a call to SSIZED. 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. */
/* If RESULT is non-empty on input, its contents */
/* will be discarded before GFPA conducts its */
/* search. */
/* $ Detailed_Output */
/* WORK the input workspace array, modified by this */
/* routine. */
/* RESULT the SPICE window of intervals, contained within the */
/* confinement window CNFINE, on which the specified */
/* constraint is satisfied. */
/* 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 */
/* constraint, RESULT will return 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 default 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 phase angle 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) SPICE(INVALIDDIMENSION) signals if workspace window size, MW, */
/* is not at least 2 and an even value. */
/* 4) SPICE(INVALIDDIMENSION) signals if workspace window count, */
/* NW, is not at least NWPA. */
/* 5) SPICE(INVALIDDIMENSION) signals if result window, RESULT, */
/* is not at least 2 and an even value. */
/* 6) If RESULT has insufficient capacity to contain the */
/* number of intervals on which the specified angle condition */
/* is met, the error will be diagnosed by a routine in the call */
/* tree of this routine. */
/* 7) 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. */
/* 8) If the relational operator RELATE is not recognized, an */
/* error is signaled by a routine in the call tree of this */
/* routine. */
/* 9) If ADJUST is negative an error is signaled 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. */
/* 10) If any of the input body names, TARGET, ILLMN, OBSRVR, do */
/* not map to NAIF ID codes, an error is signaled by a routine */
/* in the call tree of this routine. */
/* 11) If the input body names, TARGET, ILLMN, OBSRVR, are not */
/* distinct, an error is signaled by a routine in the call */
/* tree of this routine. */
/* 12) If required ephemerides or other kernel data are not */
/* available, an error is signaled by a routine in the call tree */
/* of this routine. */
/* 13) An error signals from a routine in the call tree of */
/* this routine for any transmit mode aberration correction. */
/* $ Files */
/* Appropriate SPK and PCK kernels must be loaded by the calling */
/* program before this routine is called. */
/* The following data are required: */
/* - SPK data: the calling application must load ephemeris data */
/* for the targets, observer, and any intermediate objects in */
/* a chain connecting the targets and observer that cover the */
/* time period specified by the window CNFINE. 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 using */
/* FURNSH. */
/* Kernel data are normally loaded once per program run, NOT every */
/* time this routine is called. */
/* $ Particulars */
/* ILLMN OBS */
/* ILLMN as seen * / */
/* from TARG at | / */
/* ET - LT. | / */
/* >|..../< phase angle */
/* | / */
/* . | / */
/* . | / */
/* . * TARG as seen from OBS */
/* SEP . TARG at ET */
/* . / */
/* / */
/* * */
/* This routine determines if the caller-specified constraint */
/* condition on the geometric event (phase angle) is satisfied for */
/* any time intervals within the confinement window CNFINE. If one */
/* or more such time intervals exist, those intervals are added */
/* to the RESULT window. */
/* This routine provides a simpler, but less flexible interface */
/* than does the routine GFEVNT for conducting searches for */
/* illuminator-target-observer phase angle value events. */
/* Applications that require support for progress reporting, */
/* interrupt handling, non-default step or refinement functions */
/* should call GFEVNT 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 */
/* ================== */
/* 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 */
/* phase angle 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 phase angle */
/* 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 contained in */
/* the union of */
/* - the set of points where an equality constraint is met */
/* - the boundary points of the confinement window */
/* 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 phase angle 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 */
/* phase angle 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 phase angle 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 longer than the */
/* shortest solution interval. */
/* Having some knowledge of the relative geometry of the target, */
/* illumination source, 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 */
/* ===================== */
/* As described above, the root-finding process used by this routine */
/* involves first bracketing roots and then using a search process */
/* to locate them. "Roots" are both times when local extrema are */
/* attained and times when the geometric quantity function is equal */
/* to a reference value. All endpoints of the intervals comprising */
/* the result window are either endpoints of intervals of the */
/* confinement window or roots. */
/* 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 default convergence tolerance */
/* used by this routine is set by the parameter CNVTOL (defined */
/* in gf.inc). */
/* 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. */
/* The user may change the convergence tolerance from the default */
/* CNVTOL value by calling the routine GFSTOL, e.g. */
/* CALL GFSTOL( tolerance value ) */
/* Call GFSTOL prior to calling this routine. All subsequent */
/* searches will use the updated tolerance value. */
/* Setting 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. */
/* $ 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. */
/* 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. */
/* The names and contents of the kernels referenced */
/* by this meta-kernel are as follows: */
/* File name Contents */
/* --------- -------- */
/* de421.bsp Planetary ephemeris */
/* pck00009.tpc Planet orientation and */
/* radii */
/* naif0009.tls Leapseconds */
/* \begindata */
/* KERNELS_TO_LOAD = ( 'de421.bsp', */
/* 'pck00009.tpc', */
/* 'naif0009.tls' ) */
/* \begintext */
/* Determine the time windows from December 1, 2006 UTC to */
/* January 31, 2007 UTC for which the sun-moon-earth configuration */
/* phase angle satisfies the relation conditions with respect to a */
/* reference value of .57598845 radians (the phase angle at */
/* January 1, 2007 00:00:00.000 UTC, 33.001707 degrees). Also */
/* determine the time windows corresponding to the local maximum and */
/* minimum phase angles, and the absolute maximum and minimum phase */
/* angles during the search interval. The configuration defines the */
/* sun as the illuminator, the moon as the target, and the earth as */
/* the observer. */
/* PROGRAM GFPA_T */
/* IMPLICIT NONE */
/* C */
/* C Include GF parameter declarations: */
/* C */
/* INCLUDE 'gf.inc' */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION SPD */
/* DOUBLE PRECISION PHASEQ */
/* 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 = 1000 ) */
/* C */
/* C Length of strings: */
/* C */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 26 ) */
/* INTEGER NLOOPS */
/* PARAMETER ( NLOOPS = 7 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(TIMLEN) RELATE (NLOOPS) */
/* CHARACTER*(6) ABCORR */
/* CHARACTER*(6) ILLMN */
/* CHARACTER*(6) OBSRVR */
/* CHARACTER*(6) TARGET */
/* CHARACTER*(TIMLEN) TIMSTR */
/* DOUBLE PRECISION CNFINE ( LBCELL : 2 ) */
/* DOUBLE PRECISION RESULT ( LBCELL : MAXWIN ) */
/* DOUBLE PRECISION WORK ( LBCELL : MAXWIN, NWPA ) */
/* DOUBLE PRECISION ADJUST */
/* DOUBLE PRECISION ET0 */
/* DOUBLE PRECISION ET1 */
/* DOUBLE PRECISION FINISH */
/* DOUBLE PRECISION PHASE */
/* DOUBLE PRECISION REFVAL */
/* DOUBLE PRECISION START */
/* DOUBLE PRECISION STEP */
/* INTEGER I */
/* INTEGER J */
/* C */
/* C The relation values for the search. */
/* C */
/* 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 ) */
/* C */
/* C Store the time bounds of our search interval in */
/* C the confinement window. */
/* C */
/* CALL STR2ET ( '2006 DEC 01', ET0 ) */
/* CALL STR2ET ( '2007 JAN 31', 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 0.57598845 radians. We're not */
/* C using the adjustment feature, so we set ADJUST to zero. */
/* C */
/* STEP = SPD() */
/* REFVAL = 0.57598845D0 */
/* ADJUST = 0.D0 */
/* C */
/* C Define the values for target, observer, illuminator, and */
/* C aberration correction. */
/* C */
/* TARGET = 'MOON' */
/* ILLMN = 'SUN' */
/* ABCORR = 'LT+S' */
/* OBSRVR = 'EARTH' */
/* 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 GFPA ( TARGET, ILLMN, ABCORR, OBSRVR, */
/* . RELATE(J), REFVAL, ADJUST, STEP, */
/* . CNFINE, MAXWIN, NWPA, 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 ) */
/* PHASE = PHASEQ( START, TARGET, ILLMN, OBSRVR, */
/* . ABCORR ) */
/* CALL TIMOUT ( START, */
/* . 'YYYY-MON-DD HR:MN:SC.###', */
/* . TIMSTR ) */
/* WRITE (*, '(A,F16.9)') 'Start time = '//TIMSTR, */
/* . PHASE */
/* PHASE = PHASEQ( FINISH, TARGET, ILLMN, OBSRVR, */
/* . ABCORR ) */
/* CALL TIMOUT ( FINISH, */
/* . 'YYYY-MON-DD HR:MN:SC.###', */
/* . TIMSTR ) */
/* WRITE (*, '(A,F16.9)') 'Stop time = '//TIMSTR, */
/* . PHASE */
/* END DO */
/* END IF */
/* WRITE(*,*) ' ' */
/* END DO */
/* END */
/* The program outputs: */
/* Relation condition: = */
/* Start time = 2006-DEC-02 13:31:34.414 0.575988450 */
/* Stop time = 2006-DEC-02 13:31:34.414 0.575988450 */
/* Start time = 2006-DEC-07 14:07:55.470 0.575988450 */
/* Stop time = 2006-DEC-07 14:07:55.470 0.575988450 */
/* Start time = 2006-DEC-31 23:59:59.997 0.575988450 */
/* Stop time = 2006-DEC-31 23:59:59.997 0.575988450 */
/* Start time = 2007-JAN-06 08:16:25.512 0.575988450 */
/* Stop time = 2007-JAN-06 08:16:25.512 0.575988450 */
/* Start time = 2007-JAN-30 11:41:32.557 0.575988450 */
/* Stop time = 2007-JAN-30 11:41:32.557 0.575988450 */
/* Relation condition: < */
/* Start time = 2006-DEC-02 13:31:34.414 0.575988450 */
/* Stop time = 2006-DEC-07 14:07:55.470 0.575988450 */
/* Start time = 2006-DEC-31 23:59:59.997 0.575988450 */
/* Stop time = 2007-JAN-06 08:16:25.512 0.575988450 */
/* Start time = 2007-JAN-30 11:41:32.557 0.575988450 */
/* Stop time = 2007-JAN-31 00:00:00.000 0.468279091 */
/* Relation condition: > */
/* Start time = 2006-DEC-01 00:00:00.000 0.940714974 */
/* Stop time = 2006-DEC-02 13:31:34.414 0.575988450 */
/* Start time = 2006-DEC-07 14:07:55.470 0.575988450 */
/* Stop time = 2006-DEC-31 23:59:59.997 0.575988450 */
/* Start time = 2007-JAN-06 08:16:25.512 0.575988450 */
/* Stop time = 2007-JAN-30 11:41:32.557 0.575988450 */
/* Relation condition: LOCMIN */
/* Start time = 2006-DEC-05 00:16:50.416 0.086121423 */
/* Stop time = 2006-DEC-05 00:16:50.416 0.086121423 */
/* Start time = 2007-JAN-03 14:18:32.086 0.079899769 */
/* Stop time = 2007-JAN-03 14:18:32.086 0.079899769 */
/* Relation condition: ABSMIN */
/* Start time = 2007-JAN-03 14:18:32.086 0.079899769 */
/* Stop time = 2007-JAN-03 14:18:32.086 0.079899769 */
/* Relation condition: LOCMAX */
/* Start time = 2006-DEC-20 14:09:10.496 3.055062862 */
/* Stop time = 2006-DEC-20 14:09:10.496 3.055062862 */
/* Start time = 2007-JAN-19 04:27:54.694 3.074603891 */
/* Stop time = 2007-JAN-19 04:27:54.694 3.074603891 */
/* Relation condition: ABSMAX */
/* Start time = 2007-JAN-19 04:27:54.694 3.074603891 */
/* Stop time = 2007-JAN-19 04:27:54.694 3.074603891 */
/* $ Restrictions */
/* 1) The kernel files to be used by this routine must be loaded */
/* (normally using the SPICELIB routine FURNSH) before this */
/* routine is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 15-JUL-2014 (EDW) (NJB) */
/* -& */
/* $ Index_Entries */
/* GF phase angle search */
/* -& */
/* SPICELIB functions */
/* Routines to set step size, refine transition times */
/* and report work. */
/* Local parameters */
/* Local variables */
/* Quantity definition parameter arrays: */
/* Standard SPICE error handling. */
/* Parameter adjustments */
work_dim1 = *mw + 6;
work_offset = work_dim1 - 5;
/* Function Body */
if (return_()) {
return 0;
}
/* Check into the error subsystem. */
chkin_("GFPA", (ftnlen)4);
/* 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_("GFPA", (ftnlen)4);
return 0;
}
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_("GFPA", (ftnlen)4);
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_("GFPA", (ftnlen)4);
return 0;
}
/* Set up a call to GFEVNT specific to the phase angle search. */
s_copy(qpnams, "TARGET", (ftnlen)80, (ftnlen)6);
s_copy(qcpars, target, (ftnlen)80, target_len);
s_copy(qpnams + 80, "OBSERVER", (ftnlen)80, (ftnlen)8);
s_copy(qcpars + 80, obsrvr, (ftnlen)80, obsrvr_len);
s_copy(qpnams + 160, "ABCORR", (ftnlen)80, (ftnlen)6);
s_copy(qcpars + 160, abcorr, (ftnlen)80, abcorr_len);
s_copy(qpnams + 240, "ILLUM", (ftnlen)80, (ftnlen)5);
s_copy(qcpars + 240, illmn, (ftnlen)80, illmn_len);
/* Set the step size. */
gfsstp_(step);
/* Retrieve the convergence tolerance, if set. */
zzholdd_(&c_n1, &c__3, &ok, &tol);
/* Use the default value CNVTOL if no stored tolerance value. */
if (! ok) {
tol = 1e-6;
}
/* Initialize the RESULT window to empty. */
scardd_(&c__0, result);
/* Look for solutions. */
/* Progress report and interrupt options are set to .FALSE. */
gfevnt_((U_fp)gfstep_, (U_fp)gfrefn_, "PHASE ANGLE", &c__4, qpnams,
qcpars, qdpars, qipars, qlpars, relate, refval, &tol, adjust,
cnfine, &c_false, (U_fp)gfrepi_, (U_fp)gfrepu_, (U_fp)gfrepf_, mw,
&c__5, work, &c_false, (L_fp)gfbail_, result, (ftnlen)11, (
ftnlen)80, (ftnlen)80, relate_len);
chkout_("GFPA", (ftnlen)4);
return 0;
} /* gfpa_ */
/* $Procedure SPKW19 ( Write SPK segment, type 19 ) */
/* Subroutine */ int spkw19_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
integer *nintvl, integer *npkts, integer *subtps, integer *degres,
doublereal *packts, doublereal *epochs, doublereal *ivlbds, logical *
sellst, ftnlen frame_len, ftnlen segid_len)
{
/* Initialized data */
static integer pktszs[2] = { 12,6 };
/* System generated locals */
integer i__1, i__2;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer isel, ndir, i__, j, k;
extern /* Subroutine */ int chkin_(char *, ftnlen), dafps_(integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
integer bepix, eepix;
extern /* Subroutine */ int 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 segbeg, chrcod, refcod, segend, pktbeg;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
extern integer lastnb_(char *, ftnlen);
integer pktend;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
integer minisz;
extern logical return_(void);
integer pktdsz, winsiz, pktsiz, subtyp;
extern logical odd_(integer *);
/* $ Abstract */
/* Write a type 19 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 */
/* DAF */
/* NAIF_IDS */
/* SPC */
/* SPK */
/* TIME */
/* $ Keywords */
/* EPHEMERIS */
/* FILES */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 19. */
/* $ 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) */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 07-MAR-2014 (NJB) (BVS) */
/* -& */
/* Maximum polynomial degree supported by the current */
/* implementation of this SPK type. */
/* The degree is compatible with the maximum degrees */
/* supported by types 13 and 21. */
/* Integer code indicating `true': */
/* Integer code indicating `false': */
/* SPK type 19 subtype codes: */
/* Subtype 0: Hermite interpolation, 12-element packets. */
/* Subtype 1: Lagrange interpolation, 6-element packets. */
/* Packet sizes associated with the various subtypes: */
/* Number of subtypes: */
/* Maximum packet size for type 19: */
/* Minimum packet size for type 19: */
/* The SPKPVN record size declared in spkrec.inc must be at least as */
/* large as the maximum possible size of an SPK type 19 record. */
/* The largest possible SPK type 19 record has subtype 1 (note that */
/* records of subtype 0 have half as many epochs as those of subtype */
/* 1, for a given polynomial degree). A type 1 record contains */
/* - The subtype and packet count */
/* - MAXDEG+1 packets of size S19PS1 */
/* - MAXDEG+1 time tags */
/* End of include file spk19.inc. */
/* $ Abstract */
/* Declare SPK data record size. This record is declared in */
/* SPKPVN and is passed to SPK reader (SPKRxx) and evaluator */
/* (SPKExx) routines. */
/* $ 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 */
/* 1) If new SPK types are added, it may be necessary to */
/* increase the size of this record. The header of SPKPVN */
/* should be updated as well to show the record size */
/* requirement for each data type. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 2.0.0, 05-OCT-2012 (NJB) */
/* Updated to support increase of maximum degree to 27 for types */
/* 2, 3, 8, 9, 12, 13, 18, and 19. See SPKPVN for a list */
/* of record size requirements as a function of data type. */
/* - SPICELIB Version 1.0.0, 16-AUG-2002 (NJB) */
/* -& */
/* End include file spkrec.inc */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of an SPK file open for writing. */
/* BODY I NAIF ID code for an ephemeris object. */
/* CENTER I NAIF ID 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. */
/* NINTVL I Number of mini-segments and interpolation */
/* intervals. */
/* NPKTS I Array of packet counts of mini-segments. */
/* SUBTPS I Array of segment subtypes of mini-segments. */
/* DEGRES I Array of polynomial degrees of mini-segments. */
/* PACKTS I Array of data packets of mini-segments. */
/* EPOCHS I Array of epochs of mini-segments. */
/* IVLBDS I Interpolation interval bounds. */
/* SELLST I Interval selection flag. */
/* MAXDEG P Maximum allowed degree of interpolating polynomial. */
/* $ Detailed_Input */
/* HANDLE is the 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 bounds of the time interval */
/* over which the segment defines the state of BODY. */
/* FIRST must be greater than or equal to the first */
/* interpolation interval start time; LAST must be */
/* less than or equal to the last interpolation */
/* interval stop time. See the description of IVLBDS */
/* below. */
/* SEGID is the segment identifier. An SPK segment */
/* identifier may contain up to 40 characters. */
/* NINTVL is the number of interpolation intervals */
/* associated with the input data. The interpolation */
/* intervals are associated with data sets referred */
/* to as "mini-segments." */
/* The input data comprising each mini-segment are: */
/* - a packet count */
/* - a type 19 subtype */
/* - an interpolating polynomial degree */
/* - a sequence of type 19 data packets */
/* - a sequence of packet epochs */
/* These inputs are described below. */
/* NPKTS is an array of packet counts. The Ith element of */
/* NPKTS is the packet count of the Ith interpolation */
/* interval/mini-segment. */
/* NPKTS has dimension NINTVL. */
/* SUBTPS is an array of type 19 subtypes. The Ith element */
/* of SUBTPS is the subtype of the packets associated */
/* with the Ith interpolation interval/mini-segment. */
/* SUBTPS has dimension NINTVL. */
/* DEGRES is an array of interpolating polynomial degrees. */
/* The Ith element of DEGRES is the polynomial degree */
/* of the packets associated with the Ith */
/* interpolation interval/mini-segment. */
/* For subtype 0, interpolation degrees must be */
/* equivalent to 3 mod 4, that is, they must be in */
/* the set */
/* { 3, 7, 11, ..., MAXDEG } */
/* For subtype 1, interpolation degrees must be odd */
/* and must be in the range 1:MAXDEG. */
/* DEGRES has dimension NINTVL. */
/* PACKTS is an array containing data packets for all input */
/* mini-segments. The packets for a given */
/* mini-segment are stored contiguously in increasing */
/* time order. The order of the sets of packets for */
/* different mini-segments is the same as the order */
/* of their corresponding interpolation intervals. */
/* Each packet represents geometric states of BODY */
/* relative to CENTER, specified relative to FRAME. */
/* The packet structure depends on the segment */
/* subtype as follows: */
/* Type 0 (indicated by code S19TP0): */
/* x, y, z, dx/dt, dy/dt, dz/dt, */
/* vx, vy, vz, dvx/dt, dvy/dt, dvz/dt */
/* where x, y, z represent Cartesian position */
/* components and vx, vy, vz represent Cartesian */
/* velocity components. Note well: vx, vy, and */
/* vz *are not necessarily equal* to the time */
/* derivatives of x, y, and z. This packet */
/* structure mimics that of the Rosetta/MEX orbit */
/* file. */
/* Type 1 (indicated by code S19TP1): */
/* x, y, z, dx/dt, dy/dt, dz/dt */
/* where x, y, z represent Cartesian position */
/* components and vx, vy, vz represent Cartesian */
/* velocity components. */
/* Position units are kilometers, velocity units */
/* are kilometers per second, and acceleration units */
/* are kilometers per second per second. */
/* EPOCHS is an array containing epochs for all input */
/* mini-segments. Each epoch is expressed as seconds */
/* past J2000 TDB. The epochs have a one-to-one */
/* relationship with the packets in the input packet */
/* array. */
/* The epochs for a given mini-segment are stored */
/* contiguously in increasing order. The order of the */
/* sets of epochs for different mini-segments is the */
/* same as the order of their corresponding */
/* interpolation intervals. */
/* For each mini-segment, "padding" is allowed: the */
/* sequence of epochs for that mini-segment may start */
/* before the corresponding interpolation interval */
/* start time and end after the corresponding */
/* interpolation interval stop time. Padding is used */
/* to control behavior of interpolating polynomials */
/* near interpolation interval boundaries. */
/* Due to possible use of padding, the elements of */
/* EPOCHS, taken as a whole, may not be in increasing */
/* order. */
/* IVLBDS is an array of interpolation interval boundary */
/* times. This array is an ordered list of the */
/* interpolation interval start times, to which the */
/* the end time for the last interval is appended. */
/* The Ith interpolation interval is the time */
/* coverage interval of the Ith mini-segment (see the */
/* description of NPKTS above). */
/* For each mini-segment, the corresponding */
/* interpolation interval's start time is greater */
/* than or equal to the mini-segment's first epoch, */
/* and the interval's stop time is less than or equal */
/* to the mini-segment's last epoch. */
/* For each interpolation interval other than the */
/* last, the interval's coverage stop time coincides */
/* with the coverage start time of the next interval. */
/* There are no coverage gaps, and coverage overlap */
/* for adjacent intervals consists of a single epoch. */
/* IVLBDS has dimension NINTVL+1. */
/* SELLST is a logical flag indicating to the SPK type 19 */
/* segment reader SPKR19 how to select the */
/* interpolation interval when a request time */
/* coincides with a time boundary shared by two */
/* interpolation intervals. When SELLST ("select */
/* last") is .TRUE., the later interval is selected; */
/* otherwise the earlier interval is selected. */
/* $ 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. */
/* See the INCLUDE file spk19.inc for the value of */
/* MAXDEG. */
/* $ Exceptions */
/* If any of the following exceptions occur, this routine will return */
/* without creating a new segment. */
/* 1) If FIRST is greater than LAST then the error */
/* SPICE(BADDESCRTIMES) will be signaled. */
/* 2) If FRAME is not a recognized name, the error */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 3) If the last non-blank character of SEGID occurs past index */
/* 40, the error SPICE(SEGIDTOOLONG) is signaled. */
/* 4) If SEGID contains any nonprintable characters, the error */
/* SPICE(NONPRINTABLECHARS) is signaled. */
/* 5) If NINTVL is not at least 1, the error SPICE(INVALIDCOUNT) */
/* is signaled. */
/* 6) If the elements of the array IVLBDS are not in strictly */
/* increasing order, the error SPICE(BOUNDSOUTOFORDER) will be */
/* signaled. */
/* 7) If the first interval start time IVLBDS(1) is greater than */
/* FIRST, or if the last interval end time IVLBDS(N+1) is less */
/* than LAST, the error SPICE(COVERAGEGAP) will be signaled. */
/* 8) If any packet count in the array NPKTS is not at least 2, the */
/* error SPICE(TOOFEWPACKETS) will be signaled. */
/* 9) If any subtype code in the array SUBTPS is not recognized, */
/* the error SPICE(INVALIDSUBTYPE) will be signaled. */
/* 10) If any interpolation degree in the array DEGRES */
/* is not at least 1 or is greater than MAXDEG, the */
/* error SPICE(INVALIDDEGREE) is signaled. */
/* 11) If the window size implied by any element of the array DEGRES */
/* is odd, the error SPICE(BADWINDOWSIZE) is signaled. */
/* 12) If the elements of the array EPOCHS corresponding to a given */
/* mini-segment are not in strictly increasing order, the error */
/* SPICE(TIMESOUTOFORDER) will be signaled. */
/* 13) If the first epoch of a mini-segment exceeds the start */
/* time of the associated interpolation interval, or if the */
/* last epoch of the mini-segment precedes the end time of the */
/* interpolation interval, the error SPICE(BOUNDSDISAGREE) */
/* is signaled. */
/* 14) Any error that occurs while writing the output segment will */
/* be diagnosed by routines in the call tree of this routine. */
/* $ Files */
/* A new type 19 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 19 data segment to the open SPK */
/* file according to the format described in the type 19 section of */
/* the SPK Required Reading. The SPK file must have been opened with */
/* write access. */
/* $ Examples */
/* Suppose that you have states and are prepared to produce */
/* a segment of type 19 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_19_SEGMENT' */
/* C */
/* C Write the segment. */
/* C */
/* CALL SPKW19 ( HANDLE, BODY, CENTER, FRAME, */
/* . FIRST, LAST, SEGID, NINTVL, */
/* . NPKTS, SUBTPS, DEGRES, PACKTS, */
/* . EPOCHS, IVLBDS, SELLST ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 05-FEB-2014 (NJB) (BVS) */
/* -& */
/* $ Index_Entries */
/* write spk type_19 ephemeris data segment */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved values */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW19", (ftnlen)6);
/* Start with a parameter compatibility check. */
if (FALSE_) {
setmsg_("SPK type 19 record size may be as large as #, but SPKPVN re"
"cord size is #.", (ftnlen)74);
errint_("#", &c__198, (ftnlen)1);
errint_("#", &c__198, (ftnlen)1);
sigerr_("SPICE(BUG0)", (ftnlen)11);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure the segment descriptor bounds are */
/* correctly ordered. */
if (*last < *first) {
setmsg_("Segment start time is #; stop time is #; bounds must be in "
"nondecreasing order.", (ftnlen)79);
errdp_("#", first, (ftnlen)1);
errdp_("#", last, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("SPKW19", (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_("SPKW19", (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_("SPKW19", (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_("SPKW19", (ftnlen)6);
return 0;
}
}
/* The mini-segment/interval count must be positive. */
if (*nintvl < 1) {
setmsg_("Mini-segment/interval count was #; this count must be posit"
"ive.", (ftnlen)63);
errint_("#", nintvl, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure the interval bounds form a strictly */
/* increasing sequence. */
/* Note that there are NINTVL+1 bounds. */
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
if (ivlbds[i__ - 1] >= ivlbds[i__]) {
setmsg_("Interval bounds at indices # and # are # and # respecti"
"vely. The difference is #. The bounds are required to be"
" strictly increasing.", (ftnlen)132);
errint_("#", &i__, (ftnlen)1);
i__2 = i__ + 1;
errint_("#", &i__2, (ftnlen)1);
errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
errdp_("#", &ivlbds[i__], (ftnlen)1);
d__1 = ivlbds[i__] - ivlbds[i__ - 1];
errdp_("#", &d__1, (ftnlen)1);
sigerr_("SPICE(BOUNDSOUTOFORDER)", (ftnlen)23);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* Make sure the time span of the descriptor doesn't extend */
/* beyond the span of the interval bounds. */
if (*first < ivlbds[0] || *last > ivlbds[*nintvl]) {
setmsg_("First interval start time is #; segment start time is #; se"
"gment stop time is #; last interval stop time is #. This seq"
"uence of times is required to be non-decreasing: segment cov"
"erage must be contained within the union of the interpolatio"
"n intervals.", (ftnlen)251);
errdp_("#", ivlbds, (ftnlen)1);
errdp_("#", first, (ftnlen)1);
errdp_("#", last, (ftnlen)1);
errdp_("#", &ivlbds[*nintvl], (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Check the input data before writing to the file. */
/* This order of operations entails some redundant */
/* calculations, but it allows for rapid error */
/* detection. */
/* Initialize the mini-segment packet array indices, */
/* and those of the mini-segment epoch array as well. */
pktbeg = 0;
pktend = 0;
bepix = 0;
eepix = 0;
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
/* First, just make sure the packet count for the current */
/* mini-segment is at least two. This check reduces our chances */
/* of a subscript range violation. */
/* Check the number of packets. */
if (npkts[i__ - 1] < 2) {
setmsg_("At least 2 packets are required for SPK type 19. Number"
" of packets supplied was # in mini-segment at index #.", (
ftnlen)109);
errint_("#", &npkts[i__ - 1], (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(TOOFEWPACKETS)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Set the packet size, which is a function of the subtype. Also */
/* set the window size. First check the subtype, which will be */
/* used as an array index. */
subtyp = subtps[i__ - 1];
if (subtyp < 0 || subtyp > 1) {
setmsg_("Unexpected SPK type 19 subtype # found in mini-segment "
"#.", (ftnlen)57);
errint_("#", &subtyp, (ftnlen)1);
errint_("#", &i__, (ftnlen)1);
sigerr_("SPICE(INVALIDSUBTYPE)", (ftnlen)21);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
pktsiz = pktszs[(i__2 = subtyp) < 2 && 0 <= i__2 ? i__2 : s_rnge(
"pktszs", i__2, "spkw19_", (ftnlen)689)];
if (odd_(&subtyp)) {
winsiz = degres[i__ - 1] + 1;
} else {
winsiz = (degres[i__ - 1] + 1) / 2;
}
/* Make sure that the degree of the interpolating polynomials is */
/* in range. */
if (degres[i__ - 1] < 1 || degres[i__ - 1] > 27) {
setmsg_("The interpolating polynomials of mini-segment # have de"
"gree #; the valid degree range is [1, #]", (ftnlen)95);
errint_("#", &i__, (ftnlen)1);
errint_("#", °res[i__ - 1], (ftnlen)1);
errint_("#", &c__27, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure that the window size is even. */
if (odd_(&winsiz)) {
setmsg_("The interpolating polynomials of mini-segment # have wi"
"ndow size # and degree # for SPK type 19. The mini-segme"
"nt subtype is #. The degree must be equivalent to 3 mod "
"4 for subtype 0 (Hermite interpolation) and be odd for s"
"ubtype 1 (Lagrange interpolation).", (ftnlen)257);
errint_("#", &i__, (ftnlen)1);
errint_("#", &winsiz, (ftnlen)1);
errint_("#", °res[i__ - 1], (ftnlen)1);
errint_("#", &subtps[i__ - 1], (ftnlen)1);
sigerr_("SPICE(BADWINDOWSIZE)", (ftnlen)20);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Make sure the epochs of the Ith mini-segment form a */
/* strictly increasing sequence. */
/* To start out, determine the indices of the epoch sequence */
/* of the Ith mini-segment. We'll call the begin and end */
/* epoch indices BEPIX and EEPIX respectively. */
bepix = eepix + 1;
eepix = bepix - 1 + npkts[i__ - 1];
i__2 = npkts[i__ - 1] - 1;
for (j = 1; j <= i__2; ++j) {
k = bepix + j - 1;
if (epochs[k - 1] >= epochs[k]) {
setmsg_("In mini-segment #, epoch # having index # in array "
"EPOCHS and index # in the mini-segment is greater th"
"an or equal to its successor #.", (ftnlen)134);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &epochs[k - 1], (ftnlen)1);
errint_("#", &k, (ftnlen)1);
errint_("#", &j, (ftnlen)1);
errdp_("#", &epochs[k], (ftnlen)1);
sigerr_("SPICE(TIMESOUTOFORDER)", (ftnlen)22);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* Make sure that the span of the input epochs of the Ith */
/* mini-segment includes the Ith interpolation interval. */
if (epochs[bepix - 1] > ivlbds[i__ - 1]) {
setmsg_("Interpolation interval # start time # precedes mini-seg"
"ment's first epoch #.", (ftnlen)76);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &ivlbds[i__ - 1], (ftnlen)1);
errdp_("#", &epochs[bepix - 1], (ftnlen)1);
sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21);
chkout_("SPKW19", (ftnlen)6);
return 0;
} else if (epochs[eepix - 1] < ivlbds[i__]) {
setmsg_("Interpolation interval # end time # exceeds mini-segmen"
"t's last epoch #.", (ftnlen)72);
errint_("#", &i__, (ftnlen)1);
errdp_("#", &ivlbds[i__], (ftnlen)1);
errdp_("#", &epochs[eepix - 1], (ftnlen)1);
sigerr_("SPICE(BOUNDSDISAGREE)", (ftnlen)21);
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* If we made it this far, we're ready to start writing the segment. */
/* The type 19 segment structure is eloquently described by this */
/* diagram from the SPK Required Reading: */
/* +--------------------------------+ */
/* | Interval 1 mini-segment | */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval N mini-segment | */
/* +--------------------------------+ */
/* | Interval 1 start time | */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval N start time | */
/* +--------------------------------+ */
/* | Interval N stop time | */
/* +--------------------------------+ */
/* | Interval start 100 | (First interval directory) */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval start (N/100)*100 | (Last interval directory) */
/* +--------------------------------+ */
/* | Interval 1 start pointer | */
/* +--------------------------------+ */
/* . */
/* . */
/* . */
/* +--------------------------------+ */
/* | Interval N start pointer | */
/* +--------------------------------+ */
/* | Interval N stop pointer + 1 | */
/* +--------------------------------+ */
/* | Boundary choice flag | */
/* +--------------------------------+ */
/* | Number of intervals | */
/* +--------------------------------+ */
/* SPK type 19 mini-segments have the following structure: */
/* +-----------------------+ */
/* | Packet 1 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Packet M | */
/* +-----------------------+ */
/* | Epoch 1 | */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Epoch M | */
/* +-----------------------+ */
/* | Epoch 100 | (First time tag directory) */
/* +-----------------------+ */
/* . */
/* . */
/* . */
/* +-----------------------+ */
/* | Epoch ((M-1)/100)*100 | (Last time tag directory) */
/* +-----------------------+ */
/* | Subtype code | */
/* +-----------------------+ */
/* | Window size | */
/* +-----------------------+ */
/* | Number of packets | */
/* +-----------------------+ */
/* Create the segment descriptor. We don't use SPKPDS because */
/* that routine doesn't allow creation of a singleton segment. */
ic[0] = *body;
ic[1] = *center;
ic[2] = refcod;
ic[3] = 19;
dc[0] = *first;
dc[1] = *last;
dafps_(&c__2, &c__6, dc, ic, descr);
/* Begin a new segment. */
dafbna_(handle, descr, segid, segid_len);
if (failed_()) {
chkout_("SPKW19", (ftnlen)6);
return 0;
}
/* Re-initialize the mini-segment packet array indices, */
/* and those of the mini-segment epoch array as well. */
pktbeg = 0;
pktend = 0;
bepix = 0;
eepix = 0;
/* Write data for each mini-segment to the file. */
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Set the packet size, which is a function of the subtype. */
subtyp = subtps[i__ - 1];
pktsiz = pktszs[(i__2 = subtyp) < 2 && 0 <= i__2 ? i__2 : s_rnge(
"pktszs", i__2, "spkw19_", (ftnlen)931)];
if (odd_(&subtyp)) {
winsiz = degres[i__ - 1] + 1;
} else {
winsiz = (degres[i__ - 1] + 1) / 2;
}
/* Now that we have the packet size, we can compute */
/* mini-segment packet index range. We'll let PKTDSZ */
/* be the total count of packet data entries for this */
/* mini-segment. */
pktdsz = npkts[i__ - 1] * pktsiz;
pktbeg = pktend + 1;
pktend = pktbeg - 1 + pktdsz;
/* At this point, we're read to start writing the */
/* current mini-segment to the file. Start with the */
/* packet data. */
dafada_(&packts[pktbeg - 1], &pktdsz);
/* Write the epochs for this mini-segment. */
bepix = eepix + 1;
eepix = bepix - 1 + npkts[i__ - 1];
dafada_(&epochs[bepix - 1], &npkts[i__ - 1]);
/* Compute the number of epoch directories for the */
/* current mini-segment. */
ndir = (npkts[i__ - 1] - 1) / 100;
/* Write the epoch directories to the segment. */
i__2 = ndir;
for (j = 1; j <= i__2; ++j) {
k = bepix - 1 + j * 100;
dafada_(&epochs[k - 1], &c__1);
}
/* Write the mini-segment's subtype, window size, and packet */
/* count to the segment. */
d__1 = (doublereal) subtps[i__ - 1];
dafada_(&d__1, &c__1);
d__1 = (doublereal) winsiz;
dafada_(&d__1, &c__1);
d__1 = (doublereal) npkts[i__ - 1];
dafada_(&d__1, &c__1);
if (failed_()) {
chkout_("SPKW19", (ftnlen)6);
return 0;
}
}
/* We've finished writing the mini-segments. */
/* Next write the interpolation interval bounds. */
i__1 = *nintvl + 1;
dafada_(ivlbds, &i__1);
/* Create and write directories for the interval */
/* bounds. */
/* The directory count is the interval bound count */
/* (N+1), minus 1, divided by the directory size. */
ndir = *nintvl / 100;
i__1 = ndir;
for (i__ = 1; i__ <= i__1; ++i__) {
dafada_(&ivlbds[i__ * 100 - 1], &c__1);
}
/* Now we compute and write the start/stop pointers */
/* for each mini-segment. */
/* The pointers are relative to the DAF address */
/* preceding the segment. For example, a pointer */
/* to the first DAF address in the segment has */
/* value 1. */
segend = 0;
i__1 = *nintvl;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Set the packet size, which is a function of the subtype. */
pktsiz = pktszs[(i__2 = subtps[i__ - 1]) < 2 && 0 <= i__2 ? i__2 :
s_rnge("pktszs", i__2, "spkw19_", (ftnlen)1033)];
/* In order to compute the end pointer of the current */
/* mini-segment, we must compute the size, in terms */
/* of DAF addresses, of this mini-segment. The formula */
/* for the size is */
/* size = n_packets * packet_size */
/* + n_epochs */
/* + n_epoch_directories */
/* + 3 */
/* = n_packets * ( packet_size + 1 ) */
/* + ( n_packets - 1 ) / DIRSIZ */
/* + 3 */
minisz = npkts[i__ - 1] * (pktsiz + 1) + (npkts[i__ - 1] - 1) / 100 +
3;
segbeg = segend + 1;
segend = segbeg + minisz - 1;
/* Write the mini-segment begin pointer. */
/* After the loop terminates, the final end pointer, incremented */
/* by 1, will be written. */
d__1 = (doublereal) segbeg;
dafada_(&d__1, &c__1);
}
/* Write the last mini-segment end pointer, incremented by one. */
/* SEGEND was computed on the last iteration of the above loop. */
d__1 = (doublereal) (segend + 1);
dafada_(&d__1, &c__1);
/* Write out the interval selection flag. The input */
/* boolean value is represented by a numeric constant. */
if (*sellst) {
isel = 1;
} else {
isel = -1;
}
d__1 = (doublereal) isel;
dafada_(&d__1, &c__1);
/* Write the mini-segment/interpolation interval count. */
d__1 = (doublereal) (*nintvl);
dafada_(&d__1, &c__1);
/* End the segment. */
dafena_();
chkout_("SPKW19", (ftnlen)6);
return 0;
} /* spkw19_ */
