/* $Procedure ZZGFSSOB ( GF, state of sub-observer point ) */
/* Subroutine */ int zzgfssob_(char *method, integer *trgid, doublereal *et,
char *fixref, char *abcorr, integer *obsid, doublereal *radii,
doublereal *state, ftnlen method_len, ftnlen fixref_len, ftnlen
abcorr_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer prvobs = 0;
static integer prvtrg = 0;
static char svobs[36] = " ";
static char svtarg[36] = " ";
/* System generated locals */
integer i__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
doublereal dalt[2];
logical near__, geom;
extern /* Subroutine */ int vhat_(doublereal *, doublereal *), vscl_(
doublereal *, doublereal *, doublereal *);
extern doublereal vdot_(doublereal *, doublereal *);
logical xmit;
extern /* Subroutine */ int mxvg_(doublereal *, doublereal *, integer *,
integer *, doublereal *);
doublereal upos[3];
extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal
*, doublereal *, doublereal *, doublereal *), zzcorsxf_(logical *,
doublereal *, doublereal *, doublereal *);
integer i__;
extern /* Subroutine */ int zzprscor_(char *, logical *, ftnlen);
doublereal t;
extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *,
doublereal *);
doublereal scale;
extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
ftnlen, ftnlen);
doublereal savel[3];
logical found;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vsubg_(doublereal *, doublereal *, integer *, doublereal *);
doublereal stemp[6];
extern logical eqstr_(char *, char *, ftnlen, ftnlen);
doublereal xform[36] /* was [6][6] */;
logical uselt;
extern /* Subroutine */ int bodc2s_(integer *, char *, ftnlen);
doublereal ssbtg0[6];
extern logical failed_(void);
doublereal sa[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal lt;
integer frcode;
extern doublereal clight_(void);
extern logical return_(void);
doublereal corxfi[36] /* was [6][6] */, corxfm[36] /* was [6][6]
*/, fxosta[6], fxpsta[6], fxpvel[3], fxtsta[6], obspnt[6], obssta[
12] /* was [6][2] */, obstrg[6], acc[3], pntsta[6], raysta[6],
sastat[6], spoint[3], srfvec[3], ssbobs[6], ssbtrg[6], trgepc;
integer center, clssid, frclss;
logical attblk[6], usestl;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
logical fnd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), namfrm_(char *, integer *, ftnlen), frinfo_(integer *,
integer *, integer *, integer *, logical *), errint_(char *,
integer *, ftnlen), spkgeo_(integer *, doublereal *, char *,
integer *, doublereal *, doublereal *, ftnlen), vminug_(
doublereal *, integer *, doublereal *), dnearp_(doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, logical *), surfpv_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, logical *)
, subpnt_(char *, char *, doublereal *, char *, char *, char *,
doublereal *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen,
ftnlen, ftnlen), spkssb_(integer *, doublereal *, char *,
doublereal *, ftnlen);
doublereal dlt;
extern /* Subroutine */ int sxform_(char *, char *, doublereal *,
doublereal *, ftnlen, ftnlen), qderiv_(integer *, doublereal *,
doublereal *, doublereal *, doublereal *), invstm_(doublereal *,
doublereal *);
/* $ 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. */
/* Return the state of a sub-observer point used to define */
/* coordinates referenced in a GF search. */
/* $ 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 */
/* NAIF_IDS */
/* FRAMES */
/* $ Keywords */
/* GEOMETRY */
/* PRIVATE */
/* SEARCH */
/* $ 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 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. */
/* $ Abstract */
/* Include file zzabcorr.inc */
/* SPICE private file intended solely for the support of SPICE */
/* routines. Users should not include this file directly due */
/* to the volatile nature of this file */
/* The parameters below define the structure of an aberration */
/* correction attribute block. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* An aberration correction attribute block is an array of logical */
/* flags indicating the attributes of the aberration correction */
/* specified by an aberration correction string. The attributes */
/* are: */
/* - Is the correction "geometric"? */
/* - Is light time correction indicated? */
/* - Is stellar aberration correction indicated? */
/* - Is the light time correction of the "converged */
/* Newtonian" variety? */
/* - Is the correction for the transmission case? */
/* - Is the correction relativistic? */
/* The parameters defining the structure of the block are as */
/* follows: */
/* NABCOR Number of aberration correction choices. */
/* ABATSZ Number of elements in the aberration correction */
/* block. */
/* GEOIDX Index in block of geometric correction flag. */
/* LTIDX Index of light time flag. */
/* STLIDX Index of stellar aberration flag. */
/* CNVIDX Index of converged Newtonian flag. */
/* XMTIDX Index of transmission flag. */
/* RELIDX Index of relativistic flag. */
/* The following parameter is not required to define the block */
/* structure, but it is convenient to include it here: */
/* CORLEN The maximum string length required by any aberration */
/* correction string */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */
/* -& */
/* Number of aberration correction choices: */
/* Aberration correction attribute block size */
/* (number of aberration correction attributes): */
/* Indices of attributes within an aberration correction */
/* attribute block: */
/* Maximum length of an aberration correction string: */
/* End of include file zzabcorr.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* METHOD I Computation method. */
/* TRGID I Target ID code. */
/* ET I Computation epoch. */
/* FIXREF I Reference frame name. */
/* ABCORR I Aberration correction. */
/* OBSID I Observer ID code. */
/* RADII I Target radii. */
/* STATE O State used to define coordinates. */
/* $ Detailed_Input */
/* METHOD is a short string providing parameters defining */
/* the computation method to be used. Any value */
/* supported by SUBPNT may be used. */
/* TRGID is the NAIF ID code of the target object. */
/* *This routine assumes that the target is modeled */
/* as a tri-axial ellipsoid.* */
/* ET is the time, expressed as ephemeris seconds past J2000 */
/* TDB, at which the specified state is to be computed. */
/* FIXREF is the name of the reference frame relative to which */
/* the state of interest is specified. */
/* FIXREF must be centered on the target body. */
/* Case, leading and trailing blanks are not significant */
/* in the string FIXREF. */
/* 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. The orientation */
/* of the target body will also be corrected for one-way */
/* light time when light time corrections are requested. */
/* Supported aberration correction options for */
/* observation (case where radiation is received by */
/* observer at ET) are: */
/* NONE No correction. */
/* LT Light time only. */
/* LT+S Light time and stellar aberration. */
/* CN Converged Newtonian (CN) light time. */
/* CN+S CN light time and stellar aberration. */
/* Supported aberration correction options for */
/* transmission (case where radiation is emitted from */
/* observer at ET) are: */
/* XLT Light time only. */
/* XLT+S Light time and stellar aberration. */
/* XCN Converged Newtonian (CN) light time. */
/* XCN+S CN light time and stellar aberration. */
/* For detailed information, see the geometry finder */
/* required reading, gf.req. Also see the header of */
/* SPKEZR, which contains a detailed discussion of */
/* aberration corrections. */
/* Case, leading and trailing blanks are not significant */
/* in the string ABCORR. */
/* OBSID is the NAIF ID code of the observer. */
/* RADII is an array containing three radii defining */
/* a reference ellipsoid for the target body. */
/* $ Detailed_Output */
/* STATE is the state of the sub-observer point at ET. */
/* The first three components of STATE contain the */
/* sub-observer point itself; the last three */
/* components contain the derivative with respect to */
/* time of the position. The state is expressed */
/* relative to the body-fixed frame designated by */
/* FIXREF. */
/* Units are km and km/s. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the aberration correction ABCORR is not recognized, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 2) If the frame FIXREF is not recognized by the frames */
/* subsystem, the error will be diagnosed by routines in the */
/* call tree of this routine. */
/* 3) FIXREF must be centered on the target body; if it isn't, */
/* the error will be diagnosed by routines in the call tree */
/* of this routine. */
/* 4) Any error that occurs while look up the state of the target */
/* or observer will be diagnosed by routines in the call tree of */
/* this routine. */
/* 5) Any error that occurs while look up the orientation of */
/* the target will be diagnosed by routines in the call tree of */
/* this routine. */
/* 6) If the input method is not recognized, the error */
/* SPICE(NOTSUPPORTED) will be signaled. */
/* $ Files */
/* Appropriate kernels must be loaded by the calling program before */
/* this routine is called. */
/* The following data are required: */
/* - SPK data: ephemeris data for target and observer 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. */
/* - PCK data: if the target body shape is modeled as an */
/* ellipsoid, triaxial radii for the target body must be loaded */
/* into the kernel pool. Typically this is done by loading a */
/* text PCK file via FURNSH. */
/* - Further PCK data: rotation data for the target body must be */
/* loaded. These may be provided in a text or binary PCK file. */
/* - Frame data: if a frame definition is required to convert the */
/* observer and target states to the body-fixed frame of the */
/* target, that definition must be available in the kernel */
/* pool. Typically the definition is supplied by loading a */
/* frame kernel via FURNSH. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine isolates the computation of the sub-observer state */
/* (that is, the sub-observer point and its derivative with respect */
/* to time). */
/* This routine is used by the GF coordinate utility routines in */
/* order to solve for time windows on which specified mathematical */
/* conditions involving coordinates are satisfied. The role of */
/* this routine is to provide Cartesian state vectors enabling */
/* the GF coordinate utilities to determine the signs of the */
/* derivatives with respect to time of coordinates of interest. */
/* $ Examples */
/* See ZZGFCOST. */
/* $ Restrictions */
/* 1) This routine is restricted to use with ellipsoidal target */
/* shape models. */
/* 2) The computations performed by this routine are intended */
/* to be compatible with those performed by the SPICE */
/* routine SUBPNT. If that routine changes, this routine */
/* may need to be updated. */
/* 3) This routine presumes that error checking of inputs */
/* has, where possible, already been performed by the */
/* GF coordinate utility initialization routine. */
/* 4) The interface and functionality of this set of routines may */
/* change without notice. These routines should be called only */
/* by SPICELIB routines. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0 12-MAY-2009 (NJB) */
/* Upgraded to support targets and observers having */
/* no names associated with their ID codes. */
/* - SPICELIB Version 1.0.0 05-MAR-2009 (NJB) */
/* -& */
/* $ Index_Entries */
/* sub-observer state */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZGFSSOB", (ftnlen)8);
if (first || *trgid != prvtrg) {
bodc2s_(trgid, svtarg, (ftnlen)36);
prvtrg = *trgid;
}
if (first || *obsid != prvobs) {
bodc2s_(obsid, svobs, (ftnlen)36);
prvobs = *obsid;
}
first = FALSE_;
/* Parse the aberration correction specifier. */
zzprscor_(abcorr, attblk, abcorr_len);
geom = attblk[0];
uselt = attblk[1];
usestl = attblk[2];
xmit = attblk[4];
/* Decide whether the sub-observer point is computed using */
/* the "near point" or "surface intercept" method. Only */
/* ellipsoids may be used a shape models for this computation. */
if (eqstr_(method, "Near point: ellipsoid", method_len, (ftnlen)21)) {
near__ = TRUE_;
} else if (eqstr_(method, "Intercept: ellipsoid", method_len, (ftnlen)20))
{
near__ = FALSE_;
} else {
setmsg_("Sub-observer point computation method # is not supported by"
" this routine.", (ftnlen)73);
errch_("#", method, (ftnlen)1, method_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (geom) {
/* This is the geometric case. */
/* We need to check the body-fixed reference frame here. */
namfrm_(fixref, &frcode, fixref_len);
frinfo_(&frcode, ¢er, &frclss, &clssid, &fnd);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (! fnd) {
setmsg_("Input reference frame # was not recognized.", (ftnlen)43)
;
errch_("#", fixref, (ftnlen)1, fixref_len);
sigerr_("SPICE(NOFRAME)", (ftnlen)14);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
if (center != *trgid) {
setmsg_("Input reference frame # is centered on body # instead o"
"f body #.", (ftnlen)64);
errch_("#", fixref, (ftnlen)1, fixref_len);
errint_("#", ¢er, (ftnlen)1);
errint_("#", trgid, (ftnlen)1);
sigerr_("SPICE(INVALIDFRAME)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Get the state of the target with respect to the observer, */
/* expressed relative to the target body-fixed frame. We don't */
/* need to propagate states to the solar system barycenter in */
/* this case. */
spkgeo_(trgid, et, fixref, obsid, fxtsta, <, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the state of the observer with respect to the target */
/* in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the sub-observer */
/* point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &found)
;
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. DNEARP re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface */
/* intercept point." The ray direction is simply */
/* the negative of the observer's position relative */
/* to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to */
/* be unable to compute an intercept state, it *is* */
/* an error in this case, since the ray points toward */
/* the center of the target. */
if (! found) {
setmsg_("The sub-observer state could could not be computed "
"because the velocity was not well defined. SURFPV re"
"turned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
} else if (uselt) {
/* Light time and possibly stellar aberration corrections are */
/* applied. */
/* Most our work consists of getting ready to call either of the */
/* SPICELIB routines DNEARP or SURFPV. In order to make this */
/* call, we'll need the velocity of the observer relative to the */
/* target body's center in the target body-fixed frame. We must */
/* evaluate the rotation state of the target at the correct */
/* epoch, and account for the rate of change of light time, if */
/* light time corrections are used. The algorithm we use depends */
/* on the algorithm used in SUBPNT, since we're computing the */
/* derivative with respect to time of the solution found by that */
/* routine. */
/* In this algorithm, we must take into account the fact that */
/* SUBPNT performs light time and stellar aberration corrections */
/* for the sub-observer point, not for the center of the target */
/* body. */
/* If light time and stellar aberration corrections are used, */
/* - Find the aberration corrected sub-observer point and the */
/* light time-corrected epoch TRGEPC associated with the */
/* sub-observer point. */
/* - Use TRGEPC to find the position of the target relative to */
/* the solar system barycenter. */
/* - Use TRGEPC to find the orientation of the target relative */
/* to the J2000 reference frame. */
/* - Find the light-time corrected position of the */
/* sub-observer point; use this to compute the stellar */
/* aberration offset that applies to the sub-observer point, */
/* as well as the velocity of this offset. */
/* - Find the corrected state of the target center as seen */
/* from the observer, where the corrections are those */
/* applicable to the sub-observer point. */
/* - Negate the corrected target center state to obtain the */
/* state of the observer relative to the target. */
/* - Express the state of the observer relative to the target */
/* in the target body fixed frame at TRGEPC. */
/* Below, we'll use the convention that vectors expressed */
/* relative to the body-fixed frame have names of the form */
/* FX* */
/* Note that SUBPNT will signal an error if FIXREF is not */
/* actually centered on the target body. */
subpnt_(method, svtarg, et, fixref, abcorr, svobs, spoint, &trgepc,
srfvec, method_len, (ftnlen)36, fixref_len, abcorr_len, (
ftnlen)36);
/* Get J2000-relative states of observer and target with respect */
/* to the solar system barycenter at their respective epochs of */
/* participation. */
spkssb_(obsid, et, "J2000", ssbobs, (ftnlen)5);
spkssb_(trgid, &trgepc, "J2000", ssbtg0, (ftnlen)5);
/* Get the uncorrected J2000 to body-fixed to state */
/* transformation at TRGEPC. */
sxform_("J2000", fixref, &trgepc, xform, (ftnlen)5, fixref_len);
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Initialize the state of the sub-observer point in the */
/* body-fixed frame. At this point we don't know the */
/* point's velocity; set it to zero. */
moved_(spoint, &c__3, fxpsta);
cleard_(&c__3, &fxpsta[3]);
if (usestl) {
/* We're going to need the acceleration of the observer */
/* relative to the SSB. Compute this now. */
for (i__ = 1; i__ <= 2; ++i__) {
/* The epoch is ET -/+ TDELTA. */
t = *et + ((i__ << 1) - 3) * 1.;
spkssb_(obsid, &t, "J2000", &obssta[(i__1 = i__ * 6 - 6) < 12
&& 0 <= i__1 ? i__1 : s_rnge("obssta", i__1, "zzgfss"
"ob_", (ftnlen)652)], (ftnlen)5);
}
if (failed_()) {
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Compute the observer's acceleration using a quadratic */
/* approximation. */
qderiv_(&c__3, &obssta[3], &obssta[9], &c_b40, acc);
}
/* The rest of the algorithm is iterative. On the first */
/* iteration, we don't have a good estimate of the velocity */
/* of the sub-observer point relative to the body-fixed */
/* frame. Since we're using this velocity as an input */
/* to the aberration velocity computations, we */
/* expect that treating this velocity as zero on the first */
/* pass yields a reasonable estimate. On the second pass, */
/* we'll use the velocity derived on the first pass. */
cleard_(&c__3, fxpvel);
/* We'll also estimate the rate of change of light time */
/* as zero on the first pass. */
dlt = 0.;
for (i__ = 1; i__ <= 2; ++i__) {
/* Correct the target's velocity for the rate of */
/* change of light time. */
if (xmit) {
scale = dlt + 1.;
} else {
scale = 1. - dlt;
}
/* Scale the velocity portion of the target state to */
/* correct the velocity for the rate of change of light */
/* time. */
moved_(ssbtg0, &c__3, ssbtrg);
vscl_(&scale, &ssbtg0[3], &ssbtrg[3]);
/* Get the state of the target with respect to the observer. */
vsubg_(ssbtrg, ssbobs, &c__6, obstrg);
/* Correct the J2000 to body-fixed state transformation matrix */
/* for the rate of change of light time. */
zzcorsxf_(&xmit, &dlt, xform, corxfm);
/* Invert CORXFM to obtain the corrected */
/* body-fixed to J2000 state transformation. */
invstm_(corxfm, corxfi);
/* Convert the sub-observer point state to the J2000 frame. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
/* Find the J2000-relative state of the sub-observer */
/* point with respect to the target. */
vaddg_(obstrg, pntsta, &c__6, obspnt);
if (usestl) {
/* Now compute the stellar aberration correction */
/* applicable to OBSPNT. We need the velocity of */
/* this correction as well. */
zzstelab_(&xmit, acc, &ssbobs[3], obspnt, sa, savel);
moved_(sa, &c__3, sastat);
moved_(savel, &c__3, &sastat[3]);
/* Adding the stellar aberration state to the target center */
/* state gives us the state of the target center with */
/* respect to the observer, corrected for the aberrations */
/* applicable to the sub-observer point. */
vaddg_(obstrg, sastat, &c__6, stemp);
} else {
moved_(obstrg, &c__6, stemp);
}
/* Convert STEMP to the body-fixed reference frame. */
mxvg_(corxfm, stemp, &c__6, &c__6, fxtsta);
/* At long last, compute the state of the observer */
/* with respect to the target in the body-fixed frame. */
vminug_(fxtsta, &c__6, fxosta);
/* Now we can obtain the surface velocity of the */
/* sub-observer point. */
if (near__) {
/* The sub-observer point method is "near point." */
dnearp_(fxosta, radii, &radii[1], &radii[2], fxpsta, dalt, &
found);
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. "
"DNEARP returned \"not found.\"", (ftnlen)123);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
} else {
/* The sub-observer point method is "surface intercept */
/* point." The ray direction is simply the negative of the */
/* observer's position relative to the target center. */
vminug_(fxosta, &c__6, raysta);
surfpv_(fxosta, raysta, radii, &radii[1], &radii[2], fxpsta, &
found);
/* Although in general it's not an error for SURFPV to be */
/* unable to compute an intercept state, it *is* an error */
/* in this case, since the ray points toward the center of */
/* the target. */
if (! found) {
setmsg_("The sub-observer state could could not be compu"
"ted because the velocity was not well defined. S"
"URFPV returned \"not found.\"", (ftnlen)122);
sigerr_("SPICE(DEGENERATECASE)", (ftnlen)21);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
}
/* At this point we can update the surface point */
/* velocity and light time derivative estimates. */
/* In order to compute the light time rate, we'll */
/* need the J2000-relative velocity of the sub-observer */
/* point with respect to the observer. First convert */
/* the sub-observer state to the J2000 frame, then */
/* add the result to the state of the target center */
/* with respect to the observer. */
mxvg_(corxfi, fxpsta, &c__6, &c__6, pntsta);
vaddg_(obstrg, pntsta, &c__6, obspnt);
/* Now that we have an improved estimate of the */
/* sub-observer state, we can estimate the rate of */
/* change of light time as */
/* range rate */
/* ---------- */
/* c */
/* If we're correcting for stellar aberration, *ideally* we */
/* should remove that correction now, since the light time */
/* rate is based on light time between the observer and the */
/* light-time corrected sub-observer point. But the error made */
/* by including stellar aberration is too small to make it */
/* worthwhile to make this adjustment. */
vhat_(obspnt, upos);
dlt = vdot_(&obspnt[3], upos) / clight_();
/* With FXPVEL and DLT updated, we'll repeat our */
/* computations. */
}
} else {
/* We should never get here. */
setmsg_("Aberration correction # was not recognized.", (ftnlen)43);
errch_("#", abcorr, (ftnlen)1, abcorr_len);
sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
}
/* Copy the computed state to the output argument STATE. */
moved_(fxpsta, &c__6, state);
chkout_("ZZGFSSOB", (ftnlen)8);
return 0;
} /* zzgfssob_ */
/* $Procedure FRMCHG (Frame Change) */
/* Subroutine */ int frmchg_(integer *frame1, integer *frame2, doublereal *et,
doublereal *xform)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10,
i__11, i__12, i__13;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer node;
logical done;
integer cent, this__;
extern /* Subroutine */ int zznofcon_(doublereal *, integer *, integer *,
integer *, integer *, char *, ftnlen);
integer i__, j, k, l, frame[10];
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer class__;
logical found;
integer relto;
doublereal trans[504] /* was [6][6][14] */, trans2[72] /*
was [6][6][2] */;
extern logical failed_(void);
integer cmnode;
extern integer isrchi_(integer *, integer *, integer *);
integer clssid;
extern /* Subroutine */ int frinfo_(integer *, integer *, integer *,
integer *, logical *), frmget_(integer *, doublereal *,
doublereal *, integer *, logical *);
logical gotone;
extern /* Subroutine */ int chkout_(char *, ftnlen);
char errmsg[1840];
extern /* Subroutine */ int sigerr_(char *, ftnlen), setmsg_(char *,
ftnlen);
doublereal tempxf[36] /* was [6][6] */;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int invstm_(doublereal *, doublereal *), zzmsxf_(
doublereal *, integer *, doublereal *);
integer inc, get, put;
/* $ Abstract */
/* Return the state transformation matrix from one */
/* frame to another. */
/* $ 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 */
/* FRAMES */
/* $ Declarations */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* ALL indicates any of the above classes. This parameter */
/* is used in APIs that fetch information about frames */
/* of a specified class. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */
/* The parameter ALL was added to support frame fetch APIs. */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* End of INCLUDE file frmtyp.inc */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FRAME1 I the frame id-code for some reference frame */
/* FRAME2 I the frame id-code for some reference frame */
/* ET I an epoch in TDB seconds past J2000. */
/* XFORM O a state transformation matrix */
/* $ Detailed_Input */
/* FRAME1 is the frame id-code in which some states are known. */
/* FRAME2 is the frame id-code for some frame in which you */
/* would like to represent states. */
/* ET is the epoch at which to compute the state */
/* transformation matrix. This epoch should be */
/* in TDB seconds past the ephemeris epoch of J2000. */
/* $ Detailed_Output */
/* XFORM is a 6 x 6 state transformation matrix that can */
/* be used to transform states relative to the frame */
/* corresponding to frame FRAME2 to states relative */
/* to the frame FRAME2. More explicitly, if STATE */
/* is the state of some object relative to the reference */
/* frame of FRAME1 then STATE2 is the state of the */
/* same object relative to FRAME2 where STATE2 is */
/* computed via the subroutine call below */
/* CALL MXVG ( XFORM, STATE, 6, 6, STATE2 ) */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If either of the reference frames is unrecognized, the error */
/* SPICE(UNKNOWNFRAME) will be signaled. */
/* 2) If the auxiliary information needed to compute a non-inertial */
/* frame is not available an error will be diagnosed and signaled */
/* by a routine in the call tree of this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine allows you to compute the state transformation matrix */
/* between two reference frames. */
/* The currently supported reference frames are IAU bodyfixed frames */
/* and inertial reference frames. */
/* $ Examples */
/* Example 1. Suppose that you have a state STATE1 at epoch ET */
/* relative to FRAME1 and wish to determine its representation */
/* STATE2 relative to FRAME2. The following subroutine calls */
/* would suffice to make this transformation. */
/* CALL FRMCHG ( FRAME1, FRAME2, ET, XFORM ) */
/* CALL MXVG ( XFORM, STATE1, 6, 6, STATE2 ) */
/* Example 2. Suppose that you have the angular velocity, W, of some */
/* rotation relative to FRAME1 at epoch ET and that you wish to */
/* express this angular velocity with respect to FRAME2. The */
/* following subroutines will suffice to perform this computation. */
/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */
/* Recall that a state transformation matrix has the following form. */
/* - - */
/* | | */
/* | R 0 | */
/* | | */
/* | | */
/* | dR | */
/* | -- R | */
/* | dt | */
/* | | */
/* - - */
/* The velocity of an arbitrary point P undergoing rotation with the */
/* angular velocity W is W x P */
/* Thus the velocity of P in FRAME2 is: */
/* dR */
/* -- P + R*(W x P ) */
/* dt */
/* dR t */
/* = ( -- R R P + R*(W x P) ) ( 1 ) */
/* dt */
/* dR t t */
/* But -- R is skew symmetric (simply differentiate R*R to see */
/* dt */
/* dR t */
/* this ). Hence -- R R P can be written as Ax(R*P) for some fixed */
/* dt */
/* vector A. Moreover the vector A can be read from the upper */
/* dR t */
/* triangular portion of -- R . So that equation (1) above can */
/* dt */
/* be re-written as */
/* dR t */
/* = ( -- R R*P + R*(WxP) ) */
/* dt */
/* = Ax(R*P) + R*W x R*P */
/* = ( [A+R*W] x R*P ) */
/* From this final expression it follows that in FRAME2 the angular */
/* velocity vector is given by [A+R*W]. */
/* The code below implements these ideas. */
/* CALL FRMCHG ( FRAME1, FRAME2, ET, STXFRM ) */
/* DO I = 1, 3 */
/* DO J = 1, 3 */
/* RT ( I, J ) = STXFRM ( I, J ) */
/* DRDT( I, J ) = STXFRM ( I+3, J ) */
/* END DO */
/* END DO */
/* CALL MXMT ( DRDT, R, AMATRIX ) */
/* Read the angular velocity of R from the skew symmetric matrix */
/* dR t */
/* -- R */
/* dt */
/* Recall that if A has components A1, A2, A3 then the matrix */
/* corresponding to the cross product linear mapping is: */
/* - - */
/* | 0 -A3 A2 | */
/* | | */
/* | A3 0 -A1 | */
/* | | */
/* | -A2 A1 0 | */
/* - - */
/* A(1) = -AMATRIX(2,3) */
/* A(2) = AMATRIX(1,3) */
/* A(3) = -AMATRIX(1,2) */
/* CALL MXV ( R, W1, W ) */
/* CALL VADD ( A, W, W2 ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.1, 16-JAN-2014 (NJB) */
/* Corrected equation 1 in header comments. Corrected */
/* numerous spelling errors in comments. */
/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */
/* Upgraded long error message associated with frame */
/* connection failure. */
/* - SPICELIB Version 1.1.0, 25-JUL-1996 (WLT) */
/* Bug Fix: */
/* The previous edition of the routine had a bug in the */
/* first pass of the DO WHILE that looks for a frame */
/* in the chain of frames associated with FRAME2 that is */
/* in common with the chain of frames for FRAME1. */
/* On machines where variables are created as static */
/* variables, this error could lead to finding a frame */
/* when a legitimate path between FRAME1 and FRAME2 */
/* did not exist. */
/* - SPICELIB Version 1.0.1, 06-MAR-1996 (WLT) */
/* An typo was fixed in the Brief I/O section. It used */
/* to say TDT instead of the correct time system TDB. */
/* - SPICELIB Version 1.0.0, 28-SEP-1994 (WLT) */
/* -& */
/* $ Index_Entries */
/* Transform states from one frame to another */
/* -& */
/* SPICE functions */
/* Local Parameters */
/* The root of all reference frames is J2000 (Frame ID = 1). */
/* Local Variables */
/* TRANS contains the transformations from FRAME1 to FRAME2 */
/* TRANS(1...6,1...6,I) has the transformation from FRAME(I) */
/* to FRAME(I+1). We make extra room in TRANS because we */
/* plan to add transformations beyond the obvious chain from */
/* FRAME1 to a root node. */
/* TRANS2 is used to store intermediate transformations from */
/* FRAME2 to some node in the chain from FRAME1 to PCK or */
/* INERTL frames. */
/* FRAME contains the frames we transform from in going from */
/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */
/* NODE counts the number of transformations needed to go */
/* from FRAME1 to FRAME2. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("FRMCHG", (ftnlen)6);
/* Do the obvious thing first. If FRAME1 and FRAME2 are the */
/* same then we simply return the identity matrix. */
if (*frame1 == *frame2) {
for (i__ = 1; i__ <= 6; ++i__) {
xform[(i__1 = i__ + i__ * 6 - 7) < 36 && 0 <= i__1 ? i__1 :
s_rnge("xform", i__1, "frmchg_", (ftnlen)376)] = 1.;
i__1 = i__ - 1;
for (j = 1; j <= i__1; ++j) {
xform[(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("xform", i__2, "frmchg_", (ftnlen)379)] = 0.;
xform[(i__2 = j + i__ * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("xform", i__2, "frmchg_", (ftnlen)380)] = 0.;
}
}
chkout_("FRMCHG", (ftnlen)6);
return 0;
}
/* Now perform the obvious check to make sure that both */
/* frames are recognized. */
frinfo_(frame1, ¢, &class__, &clssid, &found);
if (! found) {
setmsg_("The number # is not a recognized id-code for a reference fr"
"ame. ", (ftnlen)64);
errint_("#", frame1, (ftnlen)1);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("FRMCHG", (ftnlen)6);
return 0;
}
frinfo_(frame2, ¢, &class__, &clssid, &found);
if (! found) {
setmsg_("The number # is not a recognized id-code for a reference fr"
"ame. ", (ftnlen)64);
errint_("#", frame2, (ftnlen)1);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("FRMCHG", (ftnlen)6);
return 0;
}
node = 1;
frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1,
"frmchg_", (ftnlen)423)] = *frame1;
found = TRUE_;
/* Follow the chain of transformations until we run into */
/* one that transforms to J2000 (frame id = 1) or we hit FRAME2. */
while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "frmchg_", (ftnlen)429)] != 1 && node < 10 && frame[(i__2 =
node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "frmc"
"hg_", (ftnlen)429)] != *frame2 && found) {
/* Find out what transformation is available for this */
/* frame. */
frmget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"frame", i__1, "frmchg_", (ftnlen)437)], et, &trans[(i__2 = (
node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge(
"trans", i__2, "frmchg_", (ftnlen)437)], &frame[(i__3 = node)
< 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "frmchg_", (
ftnlen)437)], &found);
if (found) {
/* We found a transformation matrix. TRANS(1,1,NODE) */
/* now contains the transformation from FRAME(NODE) */
/* to FRAME(NODE+1). We need to look up the information */
/* for the next NODE. */
++node;
}
}
done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "frmchg_", (ftnlen)453)] == 1 || frame[(i__2 = node - 1) <
10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "frmchg_", (ftnlen)
453)] == *frame2 || ! found;
while(! done) {
/* The only way to get to this point is to have run out of */
/* room in the array of reference frame transformation */
/* buffers. We will now build the transformation from */
/* the previous NODE to whatever the next node in the */
/* chain is. We'll do this until we get to one of the */
/* root classes or we run into FRAME2. */
frmget_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"frame", i__1, "frmchg_", (ftnlen)467)], et, &trans[(i__2 = (
node * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge(
"trans", i__2, "frmchg_", (ftnlen)467)], &relto, &found);
if (found) {
/* Recall that TRANS(1,1,NODE-1) contains the transformation */
/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */
/* FRAME(NODE) with the frame indicated by RELTO. This means */
/* that TRANS(1,1,NODE-1) should be replaced with the */
/* transformation from FRAME(NODE) to RELTO. */
frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "frmchg_", (ftnlen)478)] = relto;
zzmsxf_(&trans[(i__1 = ((node - 1) * 6 + 1) * 6 - 42) < 504 && 0
<= i__1 ? i__1 : s_rnge("trans", i__1, "frmchg_", (ftnlen)
479)], &c__2, tempxf);
for (i__ = 1; i__ <= 6; ++i__) {
for (j = 1; j <= 6; ++j) {
trans[(i__1 = i__ + (j + (node - 1) * 6) * 6 - 43) < 504
&& 0 <= i__1 ? i__1 : s_rnge("trans", i__1, "frm"
"chg_", (ftnlen)483)] = tempxf[(i__2 = i__ + j * 6
- 7) < 36 && 0 <= i__2 ? i__2 : s_rnge("tempxf",
i__2, "frmchg_", (ftnlen)483)];
}
}
}
/* We are done if the class of the last frame is J2000 */
/* or if the last frame is FRAME2 or if we simply couldn't get */
/* another transformation. */
done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"frame", i__1, "frmchg_", (ftnlen)493)] == 1 || frame[(i__2 =
node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2,
"frmchg_", (ftnlen)493)] == *frame2 || ! found;
}
/* Right now we have the following situation. We have in hand */
/* a collection of transformations between frames. (Assuming */
/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */
/* no transformations computed yet. */
/* TRANS(1...6, 1...6, 1 ) transforms FRAME1 to FRAME(2) */
/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */
/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */
/* . */
/* . */
/* . */
/* TRANS(1...6, 1...6, NODE-1 ) transforms FRAME(NODE-1) */
/* to FRAME(NODE) */
/* One of the following situations is true. */
/* 1) FRAME(NODE) is the root of all frames, J2000. */
/* 2) FRAME(NODE) is the same as FRAME2 */
/* 3) There is no transformation from FRAME(NODE) to another */
/* more fundamental frame. The chain of transformations */
/* from FRAME1 stops at FRAME(NODE). This means that the */
/* "frame atlas" is incomplete because we can't get to the */
/* root frame. */
/* We now have to do essentially the same thing for FRAME2. */
if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "frmchg_", (ftnlen)531)] == *frame2) {
/* We can handle this one immediately with the private routine */
/* ZZMSXF which multiplies a series of state transformation */
/* matrices. */
i__1 = node - 1;
zzmsxf_(trans, &i__1, xform);
chkout_("FRMCHG", (ftnlen)6);
return 0;
}
/* We didn't luck out above. So we follow the chain of */
/* transformation for FRAME2. Note that at the moment the */
/* chain of transformations from FRAME2 to other frames */
/* does not share a node in the chain for FRAME1. */
/* ( GOTONE = .FALSE. ) . */
this__ = *frame2;
gotone = FALSE_;
/* First see if there is any chain to follow. */
done = this__ == 1;
/* Set up the matrices TRANS2(,,1) and TRANS(,,2) and set up */
/* PUT and GET pointers so that we know where to GET the partial */
/* transformation from and where to PUT partial results. */
if (! done) {
for (k = 1; k <= 2; ++k) {
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 4; j <= 6; ++j) {
trans2[(i__1 = i__ + (j + k * 6) * 6 - 43) < 72 && 0 <=
i__1 ? i__1 : s_rnge("trans2", i__1, "frmchg_", (
ftnlen)568)] = 0.;
}
}
}
put = 1;
get = 1;
inc = 1;
}
/* Follow the chain of transformations until we run into */
/* one that transforms to the root frame or we land in the */
/* chain of nodes for FRAME1. */
/* Note that this time we will simply keep track of the full */
/* translation from FRAME2 to the last node. */
while(! done) {
/* Find out what transformation is available for this */
/* frame. */
if (this__ == *frame2) {
/* This is the first pass, just put the transformation */
/* directly into TRANS2(,,PUT). */
frmget_(&this__, et, &trans2[(i__1 = (put * 6 + 1) * 6 - 42) < 72
&& 0 <= i__1 ? i__1 : s_rnge("trans2", i__1, "frmchg_", (
ftnlen)597)], &relto, &found);
if (found) {
this__ = relto;
get = put;
put += inc;
inc = -inc;
cmnode = isrchi_(&this__, &node, frame);
gotone = cmnode > 0;
}
} else {
/* Fetch the transformation into a temporary spot TEMPXF */
frmget_(&this__, et, tempxf, &relto, &found);
if (found) {
/* Next multiply TEMPXF on the right by the last partial */
/* product (in TRANS2(,,GET) ). We do this in line because */
/* we can cut down the number of multiplies to 3/8 of the */
/* normal result of MXMG. For a discussion of why this */
/* works see ZZMSXF. */
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 &&
0 <= i__1 ? i__1 : s_rnge("trans2", i__1,
"frmchg_", (ftnlen)626)] = tempxf[(i__2 = i__
- 1) < 36 && 0 <= i__2 ? i__2 : s_rnge("temp"
"xf", i__2, "frmchg_", (ftnlen)626)] * trans2[(
i__3 = (j + get * 6) * 6 - 42) < 72 && 0 <=
i__3 ? i__3 : s_rnge("trans2", i__3, "frmchg_"
, (ftnlen)626)] + tempxf[(i__4 = i__ + 5) <
36 && 0 <= i__4 ? i__4 : s_rnge("tempxf",
i__4, "frmchg_", (ftnlen)626)] * trans2[(i__5
= (j + get * 6) * 6 - 41) < 72 && 0 <= i__5 ?
i__5 : s_rnge("trans2", i__5, "frmchg_", (
ftnlen)626)] + tempxf[(i__6 = i__ + 11) < 36
&& 0 <= i__6 ? i__6 : s_rnge("tempxf", i__6,
"frmchg_", (ftnlen)626)] * trans2[(i__7 = (j
+ get * 6) * 6 - 40) < 72 && 0 <= i__7 ? i__7
: s_rnge("trans2", i__7, "frmchg_", (ftnlen)
626)];
}
}
for (i__ = 4; i__ <= 6; ++i__) {
for (j = 1; j <= 3; ++j) {
trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 &&
0 <= i__1 ? i__1 : s_rnge("trans2", i__1,
"frmchg_", (ftnlen)635)] = tempxf[(i__2 = i__
- 1) < 36 && 0 <= i__2 ? i__2 : s_rnge("temp"
"xf", i__2, "frmchg_", (ftnlen)635)] * trans2[(
i__3 = (j + get * 6) * 6 - 42) < 72 && 0 <=
i__3 ? i__3 : s_rnge("trans2", i__3, "frmchg_"
, (ftnlen)635)] + tempxf[(i__4 = i__ + 5) <
36 && 0 <= i__4 ? i__4 : s_rnge("tempxf",
i__4, "frmchg_", (ftnlen)635)] * trans2[(i__5
= (j + get * 6) * 6 - 41) < 72 && 0 <= i__5 ?
i__5 : s_rnge("trans2", i__5, "frmchg_", (
ftnlen)635)] + tempxf[(i__6 = i__ + 11) < 36
&& 0 <= i__6 ? i__6 : s_rnge("tempxf", i__6,
"frmchg_", (ftnlen)635)] * trans2[(i__7 = (j
+ get * 6) * 6 - 40) < 72 && 0 <= i__7 ? i__7
: s_rnge("trans2", i__7, "frmchg_", (ftnlen)
635)] + tempxf[(i__8 = i__ + 17) < 36 && 0 <=
i__8 ? i__8 : s_rnge("tempxf", i__8, "frmchg_"
, (ftnlen)635)] * trans2[(i__9 = (j + get * 6)
* 6 - 39) < 72 && 0 <= i__9 ? i__9 : s_rnge(
"trans2", i__9, "frmchg_", (ftnlen)635)] +
tempxf[(i__10 = i__ + 23) < 36 && 0 <= i__10 ?
i__10 : s_rnge("tempxf", i__10, "frmchg_", (
ftnlen)635)] * trans2[(i__11 = (j + get * 6) *
6 - 38) < 72 && 0 <= i__11 ? i__11 : s_rnge(
"trans2", i__11, "frmchg_", (ftnlen)635)] +
tempxf[(i__12 = i__ + 29) < 36 && 0 <= i__12 ?
i__12 : s_rnge("tempxf", i__12, "frmchg_", (
ftnlen)635)] * trans2[(i__13 = (j + get * 6) *
6 - 37) < 72 && 0 <= i__13 ? i__13 : s_rnge(
"trans2", i__13, "frmchg_", (ftnlen)635)];
}
}
/* Note that we don't have to compute the upper right */
/* hand block. It's already set to zero by construction. */
/* Finally we can just copy the lower right hand block */
/* from the upper left hand block of the matrix. */
for (i__ = 4; i__ <= 6; ++i__) {
k = i__ - 3;
for (j = 4; j <= 6; ++j) {
l = j - 3;
trans2[(i__1 = i__ + (j + put * 6) * 6 - 43) < 72 &&
0 <= i__1 ? i__1 : s_rnge("trans2", i__1,
"frmchg_", (ftnlen)654)] = trans2[(i__2 = k +
(l + put * 6) * 6 - 43) < 72 && 0 <= i__2 ?
i__2 : s_rnge("trans2", i__2, "frmchg_", (
ftnlen)654)];
}
}
/* Adjust GET and PUT so that GET points to the slots */
/* where we just stored the result of our multiply and */
/* so that PUT points to the next available storage */
/* locations. */
get = put;
put += inc;
inc = -inc;
this__ = relto;
cmnode = isrchi_(&this__, &node, frame);
gotone = cmnode > 0;
}
}
/* See if we have a common node and determine whether or not */
/* we are done with this loop. */
done = this__ == 1 || gotone || ! found;
}
/* There are two possible scenarios. Either the chain of */
/* transformations from FRAME2 ran into a node in the chain for */
/* FRAME1 or it didn't. (The common node might very well be */
/* the root node.) If we didn't run into a common one, then */
/* the two chains don't intersect and there is no way to */
/* get from FRAME1 to FRAME2. */
if (! gotone) {
zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("frame", i__1, "frmchg_", (ftnlen)697)], frame2,
&this__, errmsg, (ftnlen)1840);
if (failed_()) {
/* We were unable to create the error message. This */
/* unfortunate situation could arise if a frame kernel */
/* is corrupted. */
chkout_("FRMCHG", (ftnlen)6);
return 0;
}
/* The normal case: signal an error with a descriptive long */
/* error message. */
setmsg_(errmsg, (ftnlen)1840);
sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21);
chkout_("FRMCHG", (ftnlen)6);
return 0;
}
/* Recall that we have the following. */
/* TRANS(1...6, 1...6, 1 ) transforms FRAME(1) to FRAME(2) */
/* TRANS(1...6, 1...6, 2 ) transforms FRAME(2) to FRAME(3) */
/* TRANS(1...6, 1...6, 3 ) transforms FRAME(3) to FRAME(4) */
/* TRANS(1...6, 1...6, CMNODE-1) transforms FRAME(CMNODE-1) */
/* to FRAME(CMNODE) */
/* and that TRANS2(1,1,GET) transforms from FRAME2 to CMNODE. */
/* Hence the inverse of TRANS2(1,1,GET) transforms from CMNODE */
/* to FRAME2. */
/* If we compute the inverse of TRANS2 and store it in */
/* the next available slot of TRANS (.i.e. TRANS(1,1,CMNODE) */
/* we can simply apply our custom routine that multiplies a */
/* sequence of transformation matrices together to get the */
/* result from FRAME1 to FRAME2. */
invstm_(&trans2[(i__1 = (get * 6 + 1) * 6 - 42) < 72 && 0 <= i__1 ? i__1 :
s_rnge("trans2", i__1, "frmchg_", (ftnlen)740)], &trans[(i__2 = (
cmnode * 6 + 1) * 6 - 42) < 504 && 0 <= i__2 ? i__2 : s_rnge(
"trans", i__2, "frmchg_", (ftnlen)740)]);
zzmsxf_(trans, &cmnode, xform);
chkout_("FRMCHG", (ftnlen)6);
return 0;
} /* frmchg_ */
/* $Procedure ZZREFCH1 (Reference frame Change) */
/* Subroutine */ int zzrefch1_(integer *frame1, integer *frame2, doublereal *
et, doublereal *rotate)
{
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
integer node;
logical done;
integer cent, this__;
extern /* Subroutine */ int zzrotgt1_(integer *, doublereal *, doublereal
*, integer *, logical *), zznofcon_(doublereal *, integer *,
integer *, integer *, integer *, char *, ftnlen);
integer i__, j, frame[10];
extern /* Subroutine */ int chkin_(char *, ftnlen), ident_(doublereal *);
integer class__;
logical found;
integer relto;
extern /* Subroutine */ int xpose_(doublereal *, doublereal *), zzrxr_(
doublereal *, integer *, doublereal *);
extern logical failed_(void);
integer cmnode;
extern integer isrchi_(integer *, integer *, integer *);
integer clssid;
extern /* Subroutine */ int frinfo_(integer *, integer *, integer *,
integer *, logical *);
logical gotone;
char errmsg[1840];
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), sigerr_(char *,
ftnlen);
extern logical return_(void);
doublereal tmprot[9] /* was [3][3] */;
integer inc, get;
doublereal rot[126] /* was [3][3][14] */;
integer put;
doublereal rot2[18] /* was [3][3][2] */;
/* $ Abstract */
/* Return the transformation matrix from one */
/* frame to another. */
/* $ 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 */
/* FRAMES */
/* $ Declarations */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* FRAME1 I the frame id-code for some reference frame */
/* FRAME2 I the frame id-code for some reference frame */
/* ET I an epoch in TDB seconds past J2000. */
/* ROTATE O a rotation matrix */
/* $ Detailed_Input */
/* FRAME1 is the frame id-code in which some positions */
/* are known. */
/* FRAME2 is the frame id-code for some frame in which you */
/* would like to represent positions. */
/* ET is the epoch at which to compute the transformation */
/* matrix. This epoch should be in TDB seconds past */
/* the ephemeris epoch of J2000. */
/* $ Detailed_Output */
/* ROTATE is a 3 x 3 rotaion matrix that can be used to */
/* transform positions relative to the frame */
/* correspsonding to frame FRAME2 to positions relative */
/* to the frame FRAME2. More explicitely, if POS is */
/* the position of some object relative to the */
/* reference frame of FRAME1 then POS2 is the position */
/* of the same object relative to FRAME2 where POS2 is */
/* computed via the subroutine call below */
/* CALL MXV ( ROTATE, POS, POS2 ) */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If either of the reference frames is unrecognized, the error */
/* SPICE(UNKNOWNFRAME) will be signalled. */
/* 2) If the auxillary information needed to compute a non-inertial */
/* frame is not available an error will be diagnosed and signalled */
/* by a routine in the call tree of this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine allows you to compute the rotation matrix */
/* between two reference frames. */
/* $ Examples */
/* Suppose that you have a position POS1 at epoch ET */
/* relative to FRAME1 and wish to determine its representation */
/* POS2 relative to FRAME2. The following subroutine calls */
/* would suffice to make this rotation. */
/* CALL REFCHG ( FRAME1, FRAME2, ET, ROTATE ) */
/* CALL MXV ( ROTATE, POS1, POS2 ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 14-DEC-2008 (NJB) */
/* Upgraded long error message associated with frame */
/* connection failure. */
/* - SPICELIB Version 1.2.0, 26-APR-2004 (NJB) */
/* Another typo was corrected in the long error message, and */
/* in a comment. */
/* - SPICELIB Version 1.1.0, 23-MAY-2000 (WLT) */
/* A typo was corrected in the long error message. */
/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */
/* -& */
/* $ Index_Entries */
/* Rotate positions from one frame to another */
/* -& */
/* SPICE functions */
/* Local Paramters */
/* The root of all reference frames is J2000 (Frame ID = 1). */
/* Local Variables */
/* ROT contains the rotations from FRAME1 to FRAME2 */
/* ROT(1...3,1...3,I) has the rotation from FRAME(I) */
/* to FRAME(I+1). We make extra room in ROT because we */
/* plan to add rotations beyond the obvious chain from */
/* FRAME1 to a root node. */
/* ROT2 is used to store intermediate rotation from */
/* FRAME2 to some node in the chain from FRAME1 to PCK or */
/* INERTL frames. */
/* FRAME contains the frames we transform from in going from */
/* FRAME1 to FRAME2. FRAME(1) = FRAME1 by construction. */
/* NODE counts the number of rotations needed to go */
/* from FRAME1 to FRAME2. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("ZZREFCH1", (ftnlen)8);
/* Do the obvious thing first. If FRAME1 and FRAME2 are the */
/* same then we simply return the identity matrix. */
if (*frame1 == *frame2) {
ident_(rotate);
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
}
/* Now perform the obvious check to make sure that both */
/* frames are recognized. */
frinfo_(frame1, ¢, &class__, &clssid, &found);
if (! found) {
setmsg_("The number # is not a recognized id-code for a reference fr"
"ame. ", (ftnlen)64);
errint_("#", frame1, (ftnlen)1);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
}
frinfo_(frame2, ¢, &class__, &clssid, &found);
if (! found) {
setmsg_("The number # is not a recognized id-code for a reference fr"
"ame. ", (ftnlen)64);
errint_("#", frame2, (ftnlen)1);
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
}
node = 1;
frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame", i__1,
"zzrefch1_", (ftnlen)287)] = *frame1;
found = TRUE_;
/* Follow the chain of rotations until we run into */
/* one that rotates to J2000 (frame id = 1) or we hit FRAME2. */
while(frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "zzrefch1_", (ftnlen)293)] != 1 && node < 10 && frame[(i__2
= node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2,
"zzrefch1_", (ftnlen)293)] != *frame2 && found) {
/* Find out what rotation is available for this */
/* frame. */
zzrotgt1_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"frame", i__1, "zzrefch1_", (ftnlen)301)], et, &rot[(i__2 = (
node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge(
"rot", i__2, "zzrefch1_", (ftnlen)301)], &frame[(i__3 = node)
< 10 && 0 <= i__3 ? i__3 : s_rnge("frame", i__3, "zzrefch1_",
(ftnlen)301)], &found);
if (found) {
/* We found a rotation matrix. ROT(1,1,NODE) */
/* now contains the rotation from FRAME(NODE) */
/* to FRAME(NODE+1). We need to look up the information */
/* for the next NODE. */
++node;
}
}
done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "zzrefch1_", (ftnlen)317)] == 1 || frame[(i__2 = node - 1) <
10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2, "zzrefch1_", (
ftnlen)317)] == *frame2 || ! found;
while(! done) {
/* The only way to get to this point is to have run out of */
/* room in the array of reference frame rotation */
/* buffers. We will now build the rotation from */
/* the previous NODE to whatever the next node in the */
/* chain is. We'll do this until we get to one of the */
/* root classes or we run into FRAME2. */
zzrotgt1_(&frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"frame", i__1, "zzrefch1_", (ftnlen)331)], et, &rot[(i__2 = (
node * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge(
"rot", i__2, "zzrefch1_", (ftnlen)331)], &relto, &found);
if (found) {
/* Recall that ROT(1,1,NODE-1) contains the rotation */
/* from FRAME(NODE-1) to FRAME(NODE). We are going to replace */
/* FRAME(NODE) with the frame indicated by RELTO. This means */
/* that ROT(1,1,NODE-1) should be replaced with the */
/* rotation from FRAME(NODE) to RELTO. */
frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "zzrefch1_", (ftnlen)342)] = relto;
zzrxr_(&rot[(i__1 = ((node - 1) * 3 + 1) * 3 - 12) < 126 && 0 <=
i__1 ? i__1 : s_rnge("rot", i__1, "zzrefch1_", (ftnlen)
343)], &c__2, tmprot);
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
rot[(i__1 = i__ + (j + (node - 1) * 3) * 3 - 13) < 126 &&
0 <= i__1 ? i__1 : s_rnge("rot", i__1, "zzrefch1_"
, (ftnlen)347)] = tmprot[(i__2 = i__ + j * 3 - 4)
< 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot", i__2,
"zzrefch1_", (ftnlen)347)];
}
}
}
/* We are done if the class of the last frame is J2000 */
/* or if the last frame is FRAME2 or if we simply couldn't get */
/* another rotation. */
done = frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"frame", i__1, "zzrefch1_", (ftnlen)357)] == 1 || frame[(i__2
= node - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("frame", i__2,
"zzrefch1_", (ftnlen)357)] == *frame2 || ! found;
}
/* Right now we have the following situation. We have in hand */
/* a collection of rotations between frames. (Assuming */
/* that is that NODE .GT. 1. If NODE .EQ. 1 then we have */
/* no rotations computed yet. */
/* ROT(1...3, 1...3, 1 ) rotates FRAME1 to FRAME(2) */
/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */
/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */
/* . */
/* . */
/* . */
/* ROT(1...3, 1...3, NODE-1 ) rotates FRAME(NODE-1) */
/* to FRAME(NODE) */
/* One of the following situations is true. */
/* 1) FRAME(NODE) is the root of all frames, J2000. */
/* 2) FRAME(NODE) is the same as FRAME2 */
/* 3) There is no rotation from FRAME(NODE) to another */
/* more fundamental frame. The chain of rotations */
/* from FRAME1 stops at FRAME(NODE). This means that the */
/* "frame atlas" is incomplete because we can't get to the */
/* root frame. */
/* We now have to do essentially the same thing for FRAME2. */
if (frame[(i__1 = node - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("frame",
i__1, "zzrefch1_", (ftnlen)395)] == *frame2) {
/* We can handle this one immediately with the private routine */
/* ZZRXR which multiplies a series of matrices. */
i__1 = node - 1;
zzrxr_(rot, &i__1, rotate);
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
}
/* We didn't luck out above. So we follow the chain of */
/* rotation for FRAME2. Note that at the moment the */
/* chain of rotations from FRAME2 to other frames */
/* does not share a node in the chain for FRAME1. */
/* ( GOTONE = .FALSE. ) . */
this__ = *frame2;
gotone = FALSE_;
/* First see if there is any chain to follow. */
done = this__ == 1;
/* Set up the matrices ROT2(,,1) and ROT(,,2) and set up */
/* PUT and GET pointers so that we know where to GET the partial */
/* rotation from and where to PUT partial results. */
if (! done) {
put = 1;
get = 1;
inc = 1;
}
/* Follow the chain of rotations until we run into */
/* one that rotates to the root frame or we land in the */
/* chain of nodes for FRAME1. */
/* Note that this time we will simply keep track of the full */
/* rotation from FRAME2 to the last node. */
while(! done) {
/* Find out what rotation is available for this */
/* frame. */
if (this__ == *frame2) {
/* This is the first pass, just put the rotation */
/* directly into ROT2(,,PUT). */
zzrotgt1_(&this__, et, &rot2[(i__1 = (put * 3 + 1) * 3 - 12) < 18
&& 0 <= i__1 ? i__1 : s_rnge("rot2", i__1, "zzrefch1_", (
ftnlen)452)], &relto, &found);
if (found) {
this__ = relto;
get = put;
put += inc;
inc = -inc;
cmnode = isrchi_(&this__, &node, frame);
gotone = cmnode > 0;
}
} else {
/* Fetch the rotation into a temporary spot TMPROT */
zzrotgt1_(&this__, et, tmprot, &relto, &found);
if (found) {
/* Next multiply TMPROT on the right by the last partial */
/* product (in ROT2(,,GET) ). We do this in line. */
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
rot2[(i__1 = i__ + (j + put * 3) * 3 - 13) < 18 && 0
<= i__1 ? i__1 : s_rnge("rot2", i__1, "zzref"
"ch1_", (ftnlen)478)] = tmprot[(i__2 = i__ - 1)
< 9 && 0 <= i__2 ? i__2 : s_rnge("tmprot",
i__2, "zzrefch1_", (ftnlen)478)] * rot2[(i__3
= (j + get * 3) * 3 - 12) < 18 && 0 <= i__3 ?
i__3 : s_rnge("rot2", i__3, "zzrefch1_", (
ftnlen)478)] + tmprot[(i__4 = i__ + 2) < 9 &&
0 <= i__4 ? i__4 : s_rnge("tmprot", i__4,
"zzrefch1_", (ftnlen)478)] * rot2[(i__5 = (j
+ get * 3) * 3 - 11) < 18 && 0 <= i__5 ? i__5
: s_rnge("rot2", i__5, "zzrefch1_", (ftnlen)
478)] + tmprot[(i__6 = i__ + 5) < 9 && 0 <=
i__6 ? i__6 : s_rnge("tmprot", i__6, "zzrefc"
"h1_", (ftnlen)478)] * rot2[(i__7 = (j + get *
3) * 3 - 10) < 18 && 0 <= i__7 ? i__7 :
s_rnge("rot2", i__7, "zzrefch1_", (ftnlen)478)
];
}
}
/* Adjust GET and PUT so that GET points to the slots */
/* where we just stored the result of our multiply and */
/* so that PUT points to the next available storage */
/* locations. */
get = put;
put += inc;
inc = -inc;
this__ = relto;
cmnode = isrchi_(&this__, &node, frame);
gotone = cmnode > 0;
}
}
/* See if we have a common node and determine whether or not */
/* we are done with this loop. */
done = this__ == 1 || gotone || ! found;
}
/* There are two possible scenarios. Either the chain of */
/* rotations from FRAME2 ran into a node in the chain for */
/* FRAME1 or it didn't. (The common node might very well be */
/* the root node.) If we didn't run into a common one, then */
/* the two chains don't intersect and there is no way to */
/* get from FRAME1 to FRAME2. */
if (! gotone) {
zznofcon_(et, frame1, &frame[(i__1 = node - 1) < 10 && 0 <= i__1 ?
i__1 : s_rnge("frame", i__1, "zzrefch1_", (ftnlen)525)],
frame2, &this__, errmsg, (ftnlen)1840);
if (failed_()) {
/* We were unable to create the error message. This */
/* unfortunate situation could arise if a frame kernel */
/* is corrupted. */
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
}
/* The normal case: signal an error with a descriptive long */
/* error message. */
setmsg_(errmsg, (ftnlen)1840);
sigerr_("SPICE(NOFRAMECONNECT)", (ftnlen)21);
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
}
/* Recall that we have the following. */
/* ROT(1...3, 1...3, 1 ) rotates FRAME(1) to FRAME(2) */
/* ROT(1...3, 1...3, 2 ) rotates FRAME(2) to FRAME(3) */
/* ROT(1...3, 1...3, 3 ) rotates FRAME(3) to FRAME(4) */
/* ROT(1...3, 1...3, CMNODE-1) rotates FRAME(CMNODE-1) */
/* to FRAME(CMNODE) */
/* and that ROT2(1,1,GET) rotates from FRAME2 to CMNODE. */
/* Hence the inverse of ROT2(1,1,GET) rotates from CMNODE */
/* to FRAME2. */
/* If we compute the inverse of ROT2 and store it in */
/* the next available slot of ROT (.i.e. ROT(1,1,CMNODE) */
/* we can simply apply our custom routine that multiplies a */
/* sequence of rotation matrices together to get the */
/* result from FRAME1 to FRAME2. */
xpose_(&rot2[(i__1 = (get * 3 + 1) * 3 - 12) < 18 && 0 <= i__1 ? i__1 :
s_rnge("rot2", i__1, "zzrefch1_", (ftnlen)568)], &rot[(i__2 = (
cmnode * 3 + 1) * 3 - 12) < 126 && 0 <= i__2 ? i__2 : s_rnge(
"rot", i__2, "zzrefch1_", (ftnlen)568)]);
zzrxr_(rot, &cmnode, rotate);
chkout_("ZZREFCH1", (ftnlen)8);
return 0;
} /* zzrefch1_ */