/* $Procedure BODMAT ( Return transformation matrix for a body ) */
/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm)
{
/* Initialized data */
static logical first = TRUE_;
static logical found = FALSE_;
/* System generated locals */
integer i__1, i__2, i__3;
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_dnnt(doublereal *);
double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *)
;
/* Local variables */
integer cent;
char item[32];
doublereal j2ref[9] /* was [3][3] */;
extern integer zzbodbry_(integer *);
extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal
*, integer *, integer *, integer *, doublereal *);
doublereal d__;
integer i__, j;
doublereal dcoef[3], t, w;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
doublereal delta;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, rcoef[3], tcoef[200] /* was [2][100] */, wcoef[3];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal theta;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
, errdp_(char *, doublereal *, ftnlen);
doublereal costh[100];
extern doublereal vdotg_(doublereal *, doublereal *, integer *);
char dtype[1];
doublereal sinth[100], tsipm[36] /* was [6][6] */;
extern doublereal twopi_(void);
static integer j2code;
doublereal ac[100], dc[100];
integer na, nd;
doublereal ra, wc[100];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
extern logical bodfnd_(integer *, char *, ftnlen);
extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer
*, doublereal *, ftnlen);
integer frcode;
extern doublereal halfpi_(void);
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
integer nw;
doublereal conepc, conref;
extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *,
doublereal *, logical *);
integer ntheta;
extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer
*, doublereal *, logical *, ftnlen);
char fixfrm[32], errmsg[1840];
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_(
char *, logical *, integer *, char *, ftnlen, ftnlen);
doublereal tmpmat[9] /* was [3][3] */;
extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *,
integer *, char *, ftnlen, ftnlen), errint_(char *, integer *,
ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
irfrot_(integer *, integer *, doublereal *);
extern logical return_(void);
char timstr[35];
extern doublereal j2000_(void);
doublereal dec;
integer dim, ref;
doublereal phi;
extern doublereal rpd_(void), spd_(void);
extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Return the J2000 to body Equator and Prime Meridian coordinate */
/* transformation matrix for a specified body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* PCK */
/* NAIF_IDS */
/* TIME */
/* $ Keywords */
/* CONSTANTS */
/* $ Declarations */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* Include File: SPICELIB Error Handling Parameters */
/* errhnd.inc Version 2 18-JUN-1997 (WLT) */
/* The size of the long error message was */
/* reduced from 25*80 to 23*80 so that it */
/* will be accepted by the Microsoft Power Station */
/* FORTRAN compiler which has an upper bound */
/* of 1900 for the length of a character string. */
/* errhnd.inc Version 1 29-JUL-1997 (NJB) */
/* Maximum length of the long error message: */
/* Maximum length of the short error message: */
/* End Include File: SPICELIB Error Handling Parameters */
/* $ Abstract */
/* The parameters below form an enumerated list of the recognized */
/* frame types. They are: INERTL, PCK, CK, TK, DYN. The meanings */
/* are outlined below. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* INERTL an inertial frame that is listed in the routine */
/* CHGIRF and that requires no external file to */
/* compute the transformation from or to any other */
/* inertial frame. */
/* PCK is a frame that is specified relative to some */
/* INERTL frame and that has an IAU model that */
/* may be retrieved from the PCK system via a call */
/* to the routine TISBOD. */
/* CK is a frame defined by a C-kernel. */
/* TK is a "text kernel" frame. These frames are offset */
/* from their associated "relative" frames by a */
/* constant rotation. */
/* DYN is a "dynamic" frame. These currently are */
/* parameterized, built-in frames where the full frame */
/* definition depends on parameters supplied via a */
/* frame kernel. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */
/* The parameter DYN was added to support the dynamic frame class. */
/* - SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */
/* Various unused frames types were removed and the */
/* frame time TK was added. */
/* - SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */
/* -& */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* BODY I ID code of body. */
/* ET I Epoch of transformation. */
/* TIPM O Transformation from Inertial to PM for BODY at ET. */
/* $ Detailed_Input */
/* BODY is the integer ID code of the body for which the */
/* transformation is requested. Bodies are numbered */
/* according to the standard NAIF numbering scheme. */
/* ET is the epoch at which the transformation is */
/* requested. (This is typically the epoch of */
/* observation minus the one-way light time from */
/* the observer to the body at the epoch of */
/* observation.) */
/* $ Detailed_Output */
/* TIPM is the transformation matrix from Inertial to body */
/* Equator and Prime Meridian. The X axis of the PM */
/* system is directed to the intersection of the */
/* equator and prime meridian. The Z axis points north. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If data required to define the body-fixed frame associated */
/* with BODY are not found in the binary PCK system or the kernel */
/* pool, the error SPICE(FRAMEDATANOTFOUND) is signaled. In */
/* the case of IAU style body-fixed frames, the absence of */
/* prime meridian polynomial data (which are required) is used */
/* as an indicator of missing data. */
/* 2) If the test for exception (1) passes, but in fact requested */
/* data are not available in the kernel pool, the error will be */
/* signaled by routines in the call tree of this routine. */
/* 3) If the kernel pool does not contain all of the data required */
/* to define the number of nutation precession angles */
/* corresponding to the available nutation precession */
/* coefficients, the error SPICE(INSUFFICIENTANGLES) is */
/* signaled. */
/* 4) If the reference frame REF is not recognized, a routine */
/* called by BODMAT will diagnose the condition and invoke the */
/* SPICE error handling system. */
/* 5) If the specified body code BODY is not recognized, the */
/* error is diagnosed by a routine called by BODMAT. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine is related to the more general routine TIPBOD */
/* which returns a matrix that transforms vectors from a */
/* specified inertial reference frame to body equator and */
/* prime meridian coordinates. TIPBOD accepts an input argument */
/* REF that allows the caller to specify an inertial reference */
/* frame. */
/* The transformation represented by BODMAT's output argument TIPM */
/* is defined as follows: */
/* TIPM = [W] [DELTA] [PHI] */
/* 3 1 3 */
/* If there exists high-precision binary PCK kernel information */
/* for the body at the requested time, these angles, W, DELTA */
/* and PHI are computed directly from that file. The most */
/* recently loaded binary PCK file has first priority followed */
/* by previously loaded binary PCK files in backward time order. */
/* If no binary PCK file has been loaded, the text P_constants */
/* kernel file is used. */
/* If there is only text PCK kernel information, it is */
/* expressed in terms of RA, DEC and W (same W as above), where */
/* RA = PHI - HALFPI() */
/* DEC = HALFPI() - DELTA */
/* RA, DEC, and W are defined as follows in the text PCK file: */
/* RA = RA0 + RA1*T + RA2*T*T + a sin theta */
/* i i */
/* DEC = DEC0 + DEC1*T + DEC2*T*T + d cos theta */
/* i i */
/* W = W0 + W1*d + W2*d*d + w sin theta */
/* i i */
/* where: */
/* d = days past J2000. */
/* T = Julian centuries past J2000. */
/* a , d , and w arrays apply to satellites only. */
/* i i i */
/* theta = THETA0 * THETA1*T are specific to each planet. */
/* i */
/* These angles -- typically nodal rates -- vary in number and */
/* definition from one planetary system to the next. */
/* $ Examples */
/* In the following code fragment, BODMAT is used to rotate */
/* the position vector (POS) from a target body (BODY) to a */
/* spacecraft from inertial coordinates to body-fixed coordinates */
/* at a specific epoch (ET), in order to compute the planetocentric */
/* longitude (PCLONG) of the spacecraft. */
/* CALL BODMAT ( BODY, ET, TIPM ) */
/* CALL MXV ( TIPM, POS, POS ) */
/* CALL RECLAT ( POS, RADIUS, PCLONG, LAT ) */
/* To compute the equivalent planetographic longitude (PGLONG), */
/* it is necessary to know the direction of rotation of the target */
/* body, as shown below. */
/* CALL BODVCD ( BODY, 'PM', 3, DIM, VALUES ) */
/* IF ( VALUES(2) .GT. 0.D0 ) THEN */
/* PGLONG = PCLONG */
/* ELSE */
/* PGLONG = TWOPI() - PCLONG */
/* END IF */
/* Note that the items necessary to compute the transformation */
/* TIPM must have been loaded into the kernel pool (by one or more */
/* previous calls to FURNSH). */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* 1) Refer to the NAIF_IDS required reading file for a complete */
/* list of the NAIF integer ID codes for bodies. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 4.1.1, 01-FEB-2008 (NJB) */
/* The routine was updated to improve the error messages created */
/* when required PCK data are not found. Now in most cases the */
/* messages are created locally rather than by the kernel pool */
/* access routines. In particular missing binary PCK data will */
/* be indicated with a reasonable error message. */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Implementation changes were made to improve robustness */
/* of the code. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* Gets TSIPM matrix from PCKMAT (instead of Euler angles */
/* from PCKEUL.) */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* Ability to get Euler angles from binary PCK file added. */
/* This uses the new routine PCKEUL. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* fetch transformation matrix for a body */
/* transformation from j2000 position to bodyfixed */
/* transformation from j2000 to bodyfixed coordinates */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 4.1.0, 25-AUG-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in MXM call. */
/* Calls to ZZBODVCD have been replaced with calls to */
/* BODVCD. */
/* - SPICELIB Version 4.0.0, 12-FEB-2004 (NJB) */
/* Code has been updated to support satellite ID codes in the */
/* range 10000 to 99999 and to allow nutation precession angles */
/* to be associated with any object. */
/* Calls to deprecated kernel pool access routine RTPOOL */
/* were replaced by calls to GDPOOL. */
/* Calls to BODVAR have been replaced with calls to */
/* ZZBODVCD. */
/* - SPICELIB Version 3.2.0, 22-MAR-1995 (KSZ) */
/* BODMAT now get the TSIPM matrix from PCKMAT, and */
/* unpacks TIPM from it. Also the calculated but unused */
/* variable LAMBDA was removed. */
/* - SPICELIB Version 3.0.0, 10-MAR-1994 (KSZ) */
/* BODMAT now uses new software to check for the */
/* existence of binary PCK files, search the for */
/* data corresponding to the requested body and time, */
/* and return the appropriate Euler angles, using the */
/* new routine PCKEUL. Otherwise the code calculates */
/* the Euler angles from the P_constants kernel file. */
/* - SPICELIB Version 2.0.0, 04-SEP-1991 (NJB) */
/* Updated to handle P_constants referenced to different epochs */
/* and inertial reference frames. */
/* The header was updated to specify that the inertial reference */
/* frame used by BODMAT is restricted to be J2000. */
/* BODMAT now checks the kernel pool for presence of the */
/* variables */
/* BODY#_CONSTANTS_REF_FRAME */
/* and */
/* BODY#_CONSTANTS_JED_EPOCH */
/* where # is the NAIF integer code of the barycenter of a */
/* planetary system or of a body other than a planet or */
/* satellite. If either or both of these variables are */
/* present, the P_constants for BODY are presumed to be */
/* referenced to the specified inertial frame or epoch. */
/* If the epoch of the constants is not J2000, the input */
/* time ET is converted to seconds past the reference epoch. */
/* If the frame of the constants is not J2000, the rotation from */
/* the P_constants' frame to body-fixed coordinates is */
/* transformed to the rotation from J2000 coordinates to */
/* body-fixed coordinates. */
/* For efficiency reasons, this routine now duplicates much */
/* of the code of BODEUL so that it doesn't have to call BODEUL. */
/* In some cases, BODEUL must covert Euler angles to a matrix, */
/* rotate the matrix, and convert the result back to Euler */
/* angles. If this routine called BODEUL, then in such cases */
/* this routine would convert the transformed angles back to */
/* a matrix. That would be a bit much.... */
/* - Beta Version 1.1.0, 16-FEB-1989 (IMU) (NJB) */
/* Examples section completed. Declaration of unused variable */
/* FOUND removed. */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Saved variables */
/* Initial values */
/* Standard SPICE Error handling. */
if (return_()) {
return 0;
} else {
chkin_("BODMAT", (ftnlen)6);
}
/* Get the code for the J2000 frame, if we don't have it yet. */
if (first) {
irfnum_("J2000", &j2code, (ftnlen)5);
first = FALSE_;
}
/* Get Euler angles from high precision data file. */
pckmat_(body, et, &ref, tsipm, &found);
if (found) {
for (i__ = 1; i__ <= 3; ++i__) {
for (j = 1; j <= 3; ++j) {
tipm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 :
s_rnge("tipm", i__1, "bodmat_", (ftnlen)485)] = tsipm[
(i__2 = i__ + j * 6 - 7) < 36 && 0 <= i__2 ? i__2 :
s_rnge("tsipm", i__2, "bodmat_", (ftnlen)485)];
}
}
} else {
/* The data for the frame of interest are not available in a */
/* loaded binary PCK file. This is not an error: the data may be */
/* present in the kernel pool. */
/* Conduct a non-error-signaling check for the presence of a */
/* kernel variable that is required to implement an IAU style */
/* body-fixed reference frame. If the data aren't available, we */
/* don't want BODVCD to signal a SPICE(KERNELVARNOTFOUND) error; */
/* we want to issue the error signal locally, with a better error */
/* message. */
s_copy(item, "BODY#_PM", (ftnlen)32, (ftnlen)8);
repmi_(item, "#", body, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
dtpool_(item, &found, &nw, dtype, (ftnlen)32, (ftnlen)1);
if (! found) {
/* Now we do have an error. */
/* We don't have the data we'll need to produced the requested */
/* state transformation matrix. In order to create an error */
/* message understandable to the user, find, if possible, the */
/* name of the reference frame associated with the input body. */
/* Note that the body is really identified by a PCK frame class */
/* ID code, though most of the documentation just calls it a */
/* body ID code. */
ccifrm_(&c__2, body, &frcode, fixfrm, ¢, &found, (ftnlen)32);
etcal_(et, timstr, (ftnlen)35);
s_copy(errmsg, "PCK data required to compute the orientation of "
"the # # for epoch # TDB were not found. If these data we"
"re to be provided by a binary PCK file, then it is possi"
"ble that the PCK file does not have coverage for the spe"
"cified body-fixed frame at the time of interest. If the "
"data were to be provided by a text PCK file, then possib"
"ly the file does not contain data for the specified body"
"-fixed frame. In either case it is possible that a requi"
"red PCK file was not loaded at all.", (ftnlen)1840, (
ftnlen)475);
/* Fill in the variable data in the error message. */
if (found) {
/* The frame system knows the name of the body-fixed frame. */
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame", (ftnlen)1, (ftnlen)16);
errch_("#", fixfrm, (ftnlen)1, (ftnlen)32);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
} else {
/* The frame system doesn't know the name of the */
/* body-fixed frame, most likely due to a missing */
/* frame kernel. */
suffix_("#", &c__1, errmsg, (ftnlen)1, (ftnlen)1840);
setmsg_(errmsg, (ftnlen)1840);
errch_("#", "body-fixed frame associated with the ID code", (
ftnlen)1, (ftnlen)44);
errint_("#", body, (ftnlen)1);
errch_("#", timstr, (ftnlen)1, (ftnlen)35);
errch_("#", "Also, a frame kernel defining the body-fixed fr"
"ame associated with body # may need to be loaded.", (
ftnlen)1, (ftnlen)96);
errint_("#", body, (ftnlen)1);
}
sigerr_("SPICE(FRAMEDATANOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Find the body code used to label the reference frame and epoch */
/* specifiers for the orientation constants for BODY. */
/* For planetary systems, the reference frame and epoch for the */
/* orientation constants is associated with the system */
/* barycenter, not with individual bodies in the system. For any */
/* other bodies, (the Sun or asteroids, for example) the body's */
/* own code is used as the label. */
refid = zzbodbry_(body);
/* Look up the epoch of the constants. The epoch is specified */
/* as a Julian ephemeris date. The epoch defaults to J2000. */
s_copy(item, "BODY#_CONSTANTS_JED_EPOCH", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conepc, &found, (ftnlen)32);
if (found) {
/* The reference epoch is returned as a JED. Convert to */
/* ephemeris seconds past J2000. Then convert the input ET to */
/* seconds past the reference epoch. */
conepc = spd_() * (conepc - j2000_());
epoch = *et - conepc;
} else {
epoch = *et;
}
/* Look up the reference frame of the constants. The reference */
/* frame is specified by a code recognized by CHGIRF. The */
/* default frame is J2000, symbolized by the code J2CODE. */
s_copy(item, "BODY#_CONSTANTS_REF_FRAME", (ftnlen)32, (ftnlen)25);
repmi_(item, "#", &refid, item, (ftnlen)32, (ftnlen)1, (ftnlen)32);
gdpool_(item, &c__1, &c__1, &dim, &conref, &found, (ftnlen)32);
if (found) {
ref = i_dnnt(&conref);
} else {
ref = j2code;
}
/* Whatever the body, it has quadratic time polynomials for */
/* the RA and Dec of the pole, and for the rotation of the */
/* Prime Meridian. */
s_copy(item, "POLE_RA", (ftnlen)32, (ftnlen)7);
cleard_(&c__3, rcoef);
bodvcd_(body, item, &c__3, &na, rcoef, (ftnlen)32);
s_copy(item, "POLE_DEC", (ftnlen)32, (ftnlen)8);
cleard_(&c__3, dcoef);
bodvcd_(body, item, &c__3, &nd, dcoef, (ftnlen)32);
s_copy(item, "PM", (ftnlen)32, (ftnlen)2);
cleard_(&c__3, wcoef);
bodvcd_(body, item, &c__3, &nw, wcoef, (ftnlen)32);
/* There may be additional nutation and libration (THETA) terms. */
ntheta = 0;
na = 0;
nd = 0;
nw = 0;
s_copy(item, "NUT_PREC_ANGLES", (ftnlen)32, (ftnlen)15);
if (bodfnd_(&refid, item, (ftnlen)32)) {
bodvcd_(&refid, item, &c__100, &ntheta, tcoef, (ftnlen)32);
ntheta /= 2;
}
s_copy(item, "NUT_PREC_RA", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &na, ac, (ftnlen)32);
}
s_copy(item, "NUT_PREC_DEC", (ftnlen)32, (ftnlen)12);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nd, dc, (ftnlen)32);
}
s_copy(item, "NUT_PREC_PM", (ftnlen)32, (ftnlen)11);
if (bodfnd_(body, item, (ftnlen)32)) {
bodvcd_(body, item, &c__100, &nw, wc, (ftnlen)32);
}
/* Computing MAX */
i__1 = max(na,nd);
if (max(i__1,nw) > ntheta) {
setmsg_("Insufficient number of nutation/precession angles for b"
"ody * at time #.", (ftnlen)71);
errint_("*", body, (ftnlen)1);
errdp_("#", et, (ftnlen)1);
sigerr_("SPICE(KERNELVARNOTFOUND)", (ftnlen)24);
chkout_("BODMAT", (ftnlen)6);
return 0;
}
/* Evaluate the time polynomials at EPOCH. */
d__ = epoch / spd_();
t = d__ / 36525.;
ra = rcoef[0] + t * (rcoef[1] + t * rcoef[2]);
dec = dcoef[0] + t * (dcoef[1] + t * dcoef[2]);
w = wcoef[0] + d__ * (wcoef[1] + d__ * wcoef[2]);
/* Add nutation and libration as appropriate. */
i__1 = ntheta;
for (i__ = 1; i__ <= i__1; ++i__) {
theta = (tcoef[(i__2 = (i__ << 1) - 2) < 200 && 0 <= i__2 ? i__2 :
s_rnge("tcoef", i__2, "bodmat_", (ftnlen)700)] + t *
tcoef[(i__3 = (i__ << 1) - 1) < 200 && 0 <= i__3 ? i__3 :
s_rnge("tcoef", i__3, "bodmat_", (ftnlen)700)]) * rpd_();
sinth[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("sinth",
i__2, "bodmat_", (ftnlen)702)] = sin(theta);
costh[(i__2 = i__ - 1) < 100 && 0 <= i__2 ? i__2 : s_rnge("costh",
i__2, "bodmat_", (ftnlen)703)] = cos(theta);
}
ra += vdotg_(ac, sinth, &na);
dec += vdotg_(dc, costh, &nd);
w += vdotg_(wc, sinth, &nw);
/* Convert from degrees to radians and mod by two pi. */
ra *= rpd_();
dec *= rpd_();
w *= rpd_();
d__1 = twopi_();
ra = d_mod(&ra, &d__1);
d__1 = twopi_();
dec = d_mod(&dec, &d__1);
d__1 = twopi_();
w = d_mod(&w, &d__1);
/* Convert to Euler angles. */
phi = ra + halfpi_();
delta = halfpi_() - dec;
/* Produce the rotation matrix defined by the Euler angles. */
eul2m_(&w, &delta, &phi, &c__3, &c__1, &c__3, tipm);
}
/* Convert TIPM to the J2000-to-bodyfixed rotation, if is is not */
/* already referenced to J2000. */
if (ref != j2code) {
/* Find the transformation from the J2000 frame to the frame */
/* designated by REF. Form the transformation from `REF' */
/* coordinates to body-fixed coordinates. Compose the */
/* transformations to obtain the J2000-to-body-fixed */
/* transformation. */
irfrot_(&j2code, &ref, j2ref);
mxm_(tipm, j2ref, tmpmat);
moved_(tmpmat, &c__9, tipm);
}
/* TIPM now gives the transformation from J2000 to */
/* body-fixed coordinates at epoch ET seconds past J2000, */
/* regardless of the epoch and frame of the orientation constants */
/* for the specified body. */
chkout_("BODMAT", (ftnlen)6);
return 0;
} /* bodmat_ */
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref,
integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
);
integer cobs, legs;
doublereal sobs[6];
extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
integer refid;
extern /* Subroutine */ int chkin_(char *, ftnlen);
char oname[40];
doublereal descr[5];
integer ctarg[20];
char ident[40], tname[40];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen),
moved_(doublereal *, integer *, doublereal *);
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
doublereal starg[120] /* was [6][20] */;
logical nofrm;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
extern logical failed_(void);
extern /* Subroutine */ int cleard_(integer *, doublereal *);
integer handle, cframe;
extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *,
doublereal *);
extern doublereal clight_(void);
integer tframe[20];
extern integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
integer tmpfrm;
extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *),
spksfs_(integer *, doublereal *, integer *, doublereal *, char *,
logical *, ftnlen);
extern integer frstnp_(char *, ftnlen);
extern logical return_(void);
doublereal psxfrm[9] /* was [3][3] */;
extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), intstr_(integer *, char *,
ftnlen);
integer nct;
doublereal rot[9] /* was [3][3] */;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
char tstring[80];
/* $ Abstract */
/* Compute the geometric position of a target body relative to an */
/* observing body. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* This file contains the number of inertial reference */
/* frames that are currently known by the SPICE toolkit */
/* software. */
/* $ 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 */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* NINERT P Number of known inertial reference frames. */
/* $ Parameters */
/* NINERT is the number of recognized inertial reference */
/* frames. This value is needed by both CHGIRF */
/* ZZFDAT, and FRAMEX. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */
/* -& */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Parameters */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TARG I Target body. */
/* ET I Target epoch. */
/* REF I Target reference frame. */
/* OBS I Observing body. */
/* POS O Position of target. */
/* LT O Light time. */
/* $ Detailed_Input */
/* TARG is the standard NAIF ID code for a target body. */
/* ET is the epoch (ephemeris time) at which the position */
/* of the target body is to be computed. */
/* REF is the name of the reference frame to */
/* which the vectors returned by the routine should */
/* be rotated. This may be any frame supported by */
/* the SPICELIB subroutine REFCHG. */
/* OBS is the standard NAIF ID code for an observing body. */
/* $ Detailed_Output */
/* POS contains the position of the target */
/* body, relative to the observing body. This vector is */
/* rotated into the specified reference frame. Units */
/* are always km. */
/* LT is the one-way light time from the observing body */
/* to the geometric position of the target body at the */
/* specified epoch. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If insufficient ephemeris data has been loaded to compute */
/* the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/* signalled. */
/* $ Files */
/* See: $Restrictions. */
/* $ Particulars */
/* SPKGPS computes the geometric position, T(t), of the target */
/* body and the geometric position, O(t), of the observing body */
/* relative to the first common center of motion. Subtracting */
/* O(t) from T(t) gives the geometric position of the target */
/* body relative to the observer. */
/* CENTER ----- O(t) */
/* | / */
/* | / */
/* | / */
/* | / T(t) - O(t) */
/* | / */
/* T(t) */
/* The one-way light time, tau, is given by */
/* | T(t) - O(t) | */
/* tau = ----------------- */
/* c */
/* For example, if the observing body is -94, the Mars Observer */
/* spacecraft, and the target body is 401, Phobos, then the */
/* first common center is probably 4, the Mars Barycenter. */
/* O(t) is the position of -94 relative to 4 and T(t) is the */
/* position of 401 relative to 4. */
/* The center could also be the Solar System Barycenter, body 0. */
/* For example, if the observer is 399, Earth, and the target */
/* is 299, Venus, then O(t) would be the position of 399 relative */
/* to 0 and T(t) would be the position of 299 relative to 0. */
/* Ephemeris data from more than one segment may be required */
/* to determine the positions of the target body and observer */
/* relative to a common center. SPKGPS reads as many segments */
/* as necessary, from as many files as necessary, using files */
/* that have been loaded by previous calls to SPKLEF (load */
/* ephemeris file). */
/* SPKGPS is similar to SPKGEO but returns geometric positions */
/* only. */
/* $ Examples */
/* The following code example computes the geometric */
/* position of the moon with respect to the earth and */
/* then prints the distance of the moon from the */
/* the earth at a number of epochs. */
/* Assume the SPK file SAMPLE.BSP contains ephemeris data */
/* for the moon relative to earth over the time interval */
/* from BEGIN to END. */
/* INTEGER EARTH */
/* PARAMETER ( EARTH = 399 ) */
/* INTEGER MOON */
/* PARAMETER ( MOON = 301 ) */
/* INTEGER N */
/* PARAMETER ( N = 100 ) */
/* INTEGER I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* C */
/* C Divide the interval of coverage [BEGIN,END] into */
/* C N steps. At each step, compute the position, and */
/* C print out the epoch in UTC time and position norm. */
/* C */
/* DELTA = ( END - BEGIN ) / N */
/* DO I = 0, N */
/* ET = BEGIN + I*DELTA */
/* CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */
/* CALL ET2UTC ( ET, 'C', 0, UTC ) */
/* WRITE (*,*) UTC, VNORM ( POS ) */
/* END DO */
/* $ Restrictions */
/* 1) The ephemeris files to be used by SPKGPS must be loaded */
/* by SPKLEF before SPKGPS is called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* - SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */
/* Tests of routine FAILED() were added. */
/* - SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */
/* -& */
/* $ Index_Entries */
/* geometric position of one body relative to another */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VADD calls. */
/* -& */
/* This is the idea: */
/* Every body moves with respect to some center. The center */
/* is itself a body, which in turn moves about some other */
/* center. If we begin at the target body (T), follow */
/* the chain, */
/* T */
/* \ */
/* SSB \ */
/* \ C[1] */
/* \ / */
/* \ / */
/* \ / */
/* \ / */
/* C[3]-----------C[2] */
/* and avoid circular definitions (A moves about B, and B moves */
/* about A), eventually we get the position relative to the solar */
/* system barycenter (which, for our purposes, doesn't move). */
/* Thus, */
/* T = T + C[1] + C[2] + ... + C[n] */
/* SSB C[1] C[2] [C3] SSB */
/* where */
/* X */
/* Y */
/* is the position of body X relative to body Y. */
/* However, we don't want to follow each chain back to the SSB */
/* if it isn't necessary. Instead we will just follow the chain */
/* of the target body and follow the chain of the observing body */
/* until we find a common node in the tree. */
/* In the example below, C is the first common node. We compute */
/* the position of TARG relative to C and the position of OBS */
/* relative to C, then subtract the two positions. */
/* TARG */
/* \ */
/* SSB \ */
/* \ A */
/* \ / OBS */
/* \ / | */
/* \ / | */
/* \ / | */
/* B-------------C-----------------D */
/* SPICELIB functions */
/* Local parameters */
/* CHLEN is the maximum length of a chain. That is, */
/* it is the maximum number of bodies in the chain from */
/* the target or observer to the SSB. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKGPS", (ftnlen)6);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* We take care of the obvious case first. It TARG and OBS are the */
/* same we can just fill in zero. */
if (*targ == *obs) {
*lt = 0.;
cleard_(&c__3, pos);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* CTARG contains the integer codes of the bodies in the */
/* target body chain, beginning with TARG itself and then */
/* the successive centers of motion. */
/* STARG(1,I) is the position of the target body relative */
/* to CTARG(I). The id-code of the frame of this position is */
/* stored in TFRAME(I). */
/* COBS and SOBS will contain the centers and positions of the */
/* observing body. (They are single elements instead of arrays */
/* because we only need the current center and position of the */
/* observer relative to it.) */
/* First, we construct CTARG and STARG. CTARG(1) is */
/* just the target itself, and STARG(1,1) is just a zero */
/* vector, that is, the position of the target relative */
/* to itself. */
/* Then we follow the chain, filling up CTARG and STARG */
/* as we go. We use SPKSFS to search through loaded */
/* files to find the first segment applicable to CTARG(1) */
/* and time ET. Then we use SPKPVN to compute the position */
/* of the body CTARG(1) at ET in the segment that was found */
/* and get its center and frame of motion (CTARG(2) and TFRAME(2). */
/* We repeat the process for CTARG(2) and so on, until */
/* there is no data found for some CTARG(I) or until we */
/* reach the SSB. */
/* Next, we find centers and positions in a similar manner */
/* for the observer. It's a similar construction as */
/* described above, but I is always 1. COBS and SOBS */
/* are overwritten with each new center and position, */
/* beginning at OBS. However, we stop when we encounter */
/* a common center of motion, that is when COBS is equal */
/* to CTARG(I) for some I. */
/* Finally, we compute the desired position of the target */
/* relative to the observer by subtracting the position of */
/* the observing body relative to the common node from */
/* the position of the target body relative to the common */
/* node. */
/* CTPOS is the position in CTARG of the common node. */
/* Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(ref, &refid, ref_len);
}
if (refid == 0) {
if (frstnp_(ref, ref_len) > 0) {
setmsg_("The string supplied to specify the reference frame, ('#"
"') contains non-printing characters. The two most commo"
"n causes for this kind of error are: 1. an error in the "
"call to SPKGPS; 2. an uninitialized variable. ", (ftnlen)
213);
errch_("#", ref, (ftnlen)1, ref_len);
} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
setmsg_("The string supplied to specify the reference frame is b"
"lank. The most common cause for this kind of error is a"
"n uninitialized variable. ", (ftnlen)137);
} else {
setmsg_("The string supplied to specify the reference frame was "
"'#'. This frame is not recognized. Possible causes for "
"this error are: 1. failure to load the frame definition "
"into the kernel pool; 2. An out-of-date edition of the t"
"oolkit. ", (ftnlen)231);
errch_("#", ref, (ftnlen)1, ref_len);
}
sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
/* Fill in CTARG and STARG until no more data is found */
/* or until we reach the SSB. If the chain gets too */
/* long to fit in CTARG, that is if I equals CHLEN, */
/* then overwrite the last elements of CTARG and STARG. */
/* Note the check for FAILED in the loop. If SPKSFS */
/* or SPKPVN happens to fail during execution, and the */
/* current error handling action is to NOT abort, then */
/* FOUND may be stuck at TRUE, CTARG(I) will never */
/* become zero, and the loop will execute indefinitely. */
/* Construct CTARG and STARG. Begin by assigning the */
/* first elements: TARG and the position of TARG relative */
/* to itself. */
i__ = 1;
ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1,
"spkgps_", (ftnlen)603)] = *targ;
found = TRUE_;
cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)606)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "spkgps_", (ftnlen)608)] != 0) {
/* Find a file and segment that has position */
/* data for CTARG(I). */
spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"ctarg", i__1, "spkgps_", (ftnlen)617)], et, &handle, descr,
ident, &found, (ftnlen)40);
if (found) {
/* Get the position of CTARG(I) relative to some */
/* center of motion. This new center goes in */
/* CTARG(I+1) and the position is called STEMP. */
++i__;
spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <=
i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "spkgps_", (ftnlen)627)]);
/* Here's what we have. STARG is the position of CTARG(I-1) */
/* relative to CTARG(I) in reference frame TFRAME(I) */
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
tframe[0] = tframe[1];
/* If the loop above ended because we ran out of */
/* room in the arrays CTARG and STARG, then we */
/* continue finding positions but we overwrite the */
/* last elements of CTARG and STARG. */
/* If, as a result, the first common node is */
/* overwritten, we'll just have to settle for */
/* the last common node. This will cause a small */
/* loss of precision, but it's better than other */
/* alternatives. */
if (i__ == 20) {
while(found && ctarg[19] != 0 && ctarg[19] != *obs) {
/* Find a file and segment that has position */
/* data for CTARG(CHLEN). */
spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
;
if (found) {
/* Get the position of CTARG(CHLEN) relative to */
/* some center of motion. The new center */
/* overwrites the old. The position is called */
/* STEMP. */
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);
/* Add STEMP to the position of TARG relative to */
/* the old center to get the position of TARG */
/* relative to the new center. Overwrite */
/* the last element of STARG. */
if (tframe[19] == tmpfrm) {
moved_(&starg[114], &c__3, vtemp);
} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 &&
tframe[19] <= 21) {
irfrot_(&tframe[19], &tmpfrm, rot);
mxv_(rot, &starg[114], vtemp);
} else {
refchg_(&tframe[19], &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[114], vtemp);
}
vadd_(vtemp, stemp, &starg[114]);
tframe[19] = tmpfrm;
/* If one of the routines above failed during */
/* execution, we just give up and check out. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
}
}
}
nct = i__;
/* NCT is the number of elements in CTARG, */
/* the chain length. We have in hand the following information */
/* STARG(1...3,K) position of body */
/* CTARG(K-1) relative to body CTARG(K) in the frame */
/* TFRAME(K) */
/* For K = 2,..., NCT. */
/* CTARG(1) = TARG */
/* STARG(1...3,1) = ( 0, 0, 0 ) */
/* TFRAME(1) = TFRAME(2) */
/* Now follow the observer's chain. Assign */
/* the first values for COBS and SOBS. */
cobs = *obs;
cleard_(&c__6, sobs);
/* Perhaps we have a common node already. */
/* If so it will be the last node on the */
/* list CTARG. */
/* We let CTPOS will be the position of the common */
/* node in CTARG if one is found. It will */
/* be zero if COBS is not found in CTARG. */
if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg",
i__1, "spkgps_", (ftnlen)762)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)764)];
} else {
ctpos = 0;
}
/* Repeat the same loop as above, but each time */
/* we encounter a new center of motion, check to */
/* see if it is a common node. (When CTPOS is */
/* not zero, CTARG(CTPOS) is the first common node.) */
/* Note that we don't need a centers array nor a */
/* positions array, just a single center and position */
/* is sufficient --- we just keep overwriting them. */
/* When the common node is found, we have everything */
/* we need in that one center (COBS) and position */
/* (SOBS-position of the target relative to COBS). */
found = TRUE_;
nofrm = TRUE_;
legs = 0;
while(found && cobs != 0 && ctpos == 0) {
/* Find a file and segment that has position */
/* data for COBS. */
spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
if (found) {
/* Get the position of COBS; call it STEMP. */
/* The center of motion of COBS becomes the */
/* new COBS. */
if (legs == 0) {
spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
} else {
spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
}
if (nofrm) {
nofrm = FALSE_;
cframe = tmpfrm;
}
/* Add STEMP to the position of OBS relative to */
/* the old COBS to get the position of OBS */
/* relative to the new COBS. */
if (cframe == tmpfrm) {
/* On the first leg of the position of the observer, we */
/* don't have to add anything, the position of the */
/* observer is already in SOBS. We only have to add when */
/* the number of legs in the observer position is one or */
/* greater. */
if (legs > 0) {
vadd_(sobs, stemp, vtemp);
vequ_(vtemp, sobs);
}
} else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <=
21) {
irfrot_(&cframe, &tmpfrm, rot);
mxv_(rot, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
} else {
refchg_(&cframe, &tmpfrm, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, vtemp);
vadd_(vtemp, stemp, sobs);
cframe = tmpfrm;
}
/* Check failed. We don't want to loop */
/* indefinitely. */
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* We now have one more leg of the path for OBS. Set */
/* LEGS to reflect this. Then see if the new center */
/* is a common node. If not, repeat the loop. */
++legs;
ctpos = isrchi_(&cobs, &nct, ctarg);
}
}
/* If CTPOS is zero at this point, it means we */
/* have not found a common node though we have */
/* searched through all the available data. */
if (ctpos == 0) {
bodc2n_(targ, tname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
;
} else {
intstr_(targ, tname, (ftnlen)40);
}
bodc2n_(obs, oname, &found, (ftnlen)40);
if (found) {
prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
} else {
intstr_(obs, oname, (ftnlen)40);
}
setmsg_("Insufficient ephemeris data has been loaded to compute the "
"position of TARG relative to OBS at the ephemeris epoch #. ",
(ftnlen)118);
etcal_(et, tstring, (ftnlen)80);
errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
errch_("#", tstring, (ftnlen)1, (ftnlen)80);
sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
/* If CTPOS is not zero, then we have reached a */
/* common node, specifically, */
/* CTARG(CTPOS) = COBS = CENTER */
/* (in diagram below). The POSITION of the target */
/* (TARG) relative to the observer (OBS) is just */
/* STARG(1,CTPOS) - SOBS. */
/* SOBS */
/* CENTER ---------------->OBS */
/* | . */
/* | . N */
/* S | . O */
/* T | . I */
/* A | . T */
/* R | . I */
/* G | . S */
/* | . O */
/* | . P */
/* V L */
/* TARG */
/* And the light-time between them is just */
/* | POSITION | */
/* LT = --------- */
/* c */
/* Compute the position of the target relative to CTARG(CTPOS) */
if (ctpos == 1) {
tframe[0] = cframe;
}
i__1 = ctpos - 1;
for (i__ = 2; i__ <= i__1; ++i__) {
if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
, i__2, "spkgps_", (ftnlen)960)] == tframe[(i__3 = i__) < 20
&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
ftnlen)960)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], stemp);
moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
963)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 &&
0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2
: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)967)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
970)]);
} else {
refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)974)], et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)981)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)],
vtemp);
moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0
<= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
983)]);
}
}
/* To avoid unnecessary frame transformations we'll do */
/* a bit of extra decision making here. It's a lot */
/* faster to make logical checks than it is to compute */
/* frame transformations. */
if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe",
i__1, "spkgps_", (ftnlen)996)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1000)] == refid) {
/* If the last frame associated with the target is already */
/* in the requested output frame, we convert the position of */
/* the observer to that frame and then subtract the position */
/* of the observer from the position of the target. */
if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
irfrot_(&cframe, &refid, rot);
mxv_(rot, sobs, stemp);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, sobs, stemp);
}
/* We've now transformed SOBS into the requested reference frame. */
/* Set CFRAME to reflect this. */
cframe = refid;
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1031)], stemp, pos);
} else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 21) {
/* If both frames are inertial we use IRFROT instead of */
/* REFCHG to get things into a common frame. */
irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1040)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], stemp);
vsub_(stemp, sobs, pos);
} else {
/* Use the more general routine REFCHG to make the transformation. */
refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1048)], &cframe, et,
psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1055)], stemp);
vsub_(stemp, sobs, pos);
}
/* Finally, rotate as needed into the requested frame. */
if (cframe == refid) {
/* We don't have to do anything in this case. */
} else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
/* Since both frames are inertial, we use the more direct */
/* routine IRFROT to get the transformation to REFID. */
irfrot_(&cframe, &refid, rot);
mxv_(rot, pos, stemp);
moved_(stemp, &c__3, pos);
} else {
refchg_(&cframe, &refid, et, psxfrm);
if (failed_()) {
chkout_("SPKGPS", (ftnlen)6);
return 0;
}
mxv_(psxfrm, pos, stemp);
moved_(stemp, &c__3, pos);
}
*lt = vnorm_(pos) / clight_();
chkout_("SPKGPS", (ftnlen)6);
return 0;
} /* spkgps_ */
/* $Procedure DISTIM ( Format Time for Displaying by BRIEF ) */
/* Subroutine */ int distim_(char *timtyp, doublereal *et, char *timlbl, char
*timstr, ftnlen timtyp_len, ftnlen timlbl_len, ftnlen timstr_len)
{
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen), dpfmt_(
doublereal *, char *, char *, ftnlen, ftnlen), sigerr_(char *,
ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int timout_(doublereal *, char *, char *, ftnlen,
ftnlen);
/* $ Abstract */
/* Format time for displaying by BRIEF. */
/* $ 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 */
/* KERNEL */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TIMTYP I Desired output format */
/* ET I ET to be formatted */
/* TIMLBL O Label for BRIEF table heading. */
/* TIMSTR O Output time string. */
/* $ Detailed_Input */
/* TIMTYP is the desired output format type: ETCAL, UTCCAL, */
/* UTCDOY, or ETSEC. */
/* ET is the input ET seconds past J2000 to be formatted. */
/* $ Detailed_Output */
/* TIMLBL is the label for BRIEF table heading. */
/* TIMSTR is the output time string. */
/* $ Parameters */
/* The output format pictures for TIMOUT and DPFMT are provided */
/* using parameters UCLPIC, UDYPIC, and ESCPIC. */
/* $ Exceptions */
/* 1) If the desired output time type is not recognized, then the */
/* error SPICE(BADTIMEFORMAT) is signaled. */
/* 2) If required LSK data are not loaded an error will be signaled */
/* by routines in the calling tree of this routine. */
/* $ Files */
/* An LSK file must be loaded prior to calling this routine. */
/* $ Particulars */
/* The following label and time string will be returned for each */
/* of the allowed time formats: */
/* ETCAL: */
/* TIMLBL = 'ET' */
/* TIMSTR returned by ETCAL */
/* UTCCAL: */
/* TIMLBL = 'UTC' */
/* TIMSTR returned by TIMOUT in */
/* 'YYYY-MON-DD HR:MN:SC.###' format */
/* UTCDOY: */
/* TIMLBL = 'UTC' */
/* TIMSTR returned by TIMOUT in */
/* 'YYYY-DOY // HR:MN:SC.###' format */
/* ETSEC: */
/* TIMLBL = 'ET' */
/* TIMSTR returned by DPFMT in */
/* 'xxxxxxxxxxxxxxxxx.xxxxxx' format */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* This routine must not be called by any routines except BRIEF's */
/* DISPLY routine. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - BRIEF Version 1.0.0, 22-OCT-2007 (BVS) */
/* -& */
/* $ Index_Entries */
/* format time for display by BRIEF */
/* -& */
/* SPICELIB functions */
/* Local parameters. */
/* Output format pictures. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DISTIM", (ftnlen)6);
}
/* Set outputs. */
if (s_cmp(timtyp, "ETCAL", timtyp_len, (ftnlen)5) == 0) {
s_copy(timlbl, "ET", timlbl_len, (ftnlen)2);
etcal_(et, timstr, timstr_len);
} else if (s_cmp(timtyp, "UTCCAL", timtyp_len, (ftnlen)6) == 0) {
s_copy(timlbl, "UTC", timlbl_len, (ftnlen)3);
timout_(et, "YYYY-MON-DD HR:MN:SC.###", timstr, (ftnlen)24,
timstr_len);
} else if (s_cmp(timtyp, "UTCDOY", timtyp_len, (ftnlen)6) == 0) {
s_copy(timlbl, "UTC", timlbl_len, (ftnlen)3);
timout_(et, "YYYY-DOY // HR:MN:SC.###", timstr, (ftnlen)24,
timstr_len);
} else if (s_cmp(timtyp, "ETSEC", timtyp_len, (ftnlen)5) == 0) {
s_copy(timlbl, "ET", timlbl_len, (ftnlen)2);
dpfmt_(et, "xxxxxxxxxxxxxxxxx.xxxxxx", timstr, (ftnlen)24, timstr_len)
;
} else {
setmsg_("Time type '#' is not recognized.", (ftnlen)32);
errch_("#", timtyp, (ftnlen)1, timtyp_len);
sigerr_("SPICE(BADTIMEFORMAT)", (ftnlen)20);
chkout_("DISTIM", (ftnlen)6);
return 0;
}
/* All done. */
chkout_("DISTIM", (ftnlen)6);
return 0;
} /* distim_ */
/* $Procedure SPKS10 ( S/P Kernel, subset, type 10 ) */
/* Subroutine */ int spks10_(integer *srchan, doublereal *srcdsc, integer *
dsthan, doublereal *dstdsc, char *dstsid, ftnlen dstsid_len)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
char time[40];
integer i__;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), dafus_(doublereal *, integer *, integer *,
doublereal *, integer *), errch_(char *, char *, ftnlen, ftnlen);
doublereal dtemp[2];
logical found;
integer itemp[6];
doublereal myref;
extern /* Subroutine */ int sgwes_(integer *);
integer dummy;
extern logical failed_(void);
integer begidx;
doublereal begtim, packet[14];
integer endidx, nepoch;
doublereal endtim;
extern /* Subroutine */ int sgfcon_(integer *, doublereal *, integer *,
integer *, doublereal *), sgbwfs_(integer *, doublereal *, char *,
integer *, doublereal *, integer *, integer *, ftnlen), chkout_(
char *, ftnlen), sigerr_(char *, ftnlen), sgfrvi_(integer *,
doublereal *, doublereal *, doublereal *, integer *, logical *),
setmsg_(char *, ftnlen), sgmeta_(integer *, doublereal *, integer
*, integer *), sgfpkt_(integer *, doublereal *, integer *,
integer *, doublereal *, integer *), sgfref_(integer *,
doublereal *, integer *, integer *, doublereal *);
doublereal consts[8];
extern /* Subroutine */ int sgwfpk_(integer *, integer *, doublereal *,
integer *, doublereal *);
extern logical return_(void);
/* $ Abstract */
/* Extract a subset of the data in a type 10 SPK segment into a new */
/* type 10 segment. */
/* $ 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 */
/* $ Abstract */
/* Parameter declarations for the generic segments subroutines. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAF Required Reading */
/* $ Keywords */
/* GENERIC SEGMENTS */
/* $ Particulars */
/* This include file contains the parameters used by the generic */
/* segments subroutines, SGxxxx. A generic segment is a */
/* generalization of a DAF array which places a particular structure */
/* on the data contained in the array, as described below. */
/* This file defines the mnemonics that are used for the index types */
/* allowed in generic segments as well as mnemonics for the meta data */
/* items which are used to describe a generic segment. */
/* A DAF generic segment contains several logical data partitions: */
/* 1) A partition for constant values to be associated with each */
/* data packet in the segment. */
/* 2) A partition for the data packets. */
/* 3) A partition for reference values. */
/* 4) A partition for a packet directory, if the segment contains */
/* variable sized packets. */
/* 5) A partition for a reference value directory. */
/* 6) A reserved partition that is not currently used. This */
/* partition is only for the use of the NAIF group at the Jet */
/* Propulsion Laboratory (JPL). */
/* 7) A partition for the meta data which describes the locations */
/* and sizes of other partitions as well as providing some */
/* additional descriptive information about the generic */
/* segment. */
/* +============================+ */
/* | Constants | */
/* +============================+ */
/* | Packet 1 | */
/* |----------------------------| */
/* | Packet 2 | */
/* |----------------------------| */
/* | . | */
/* | . | */
/* | . | */
/* |----------------------------| */
/* | Packet N | */
/* +============================+ */
/* | Reference Values | */
/* +============================+ */
/* | Packet Directory | */
/* +============================+ */
/* | Reference Directory | */
/* +============================+ */
/* | Reserved Area | */
/* +============================+ */
/* | Segment Meta Data | */
/* +----------------------------+ */
/* Only the placement of the meta data at the end of a generic */
/* segment is required. The other data partitions may occur in any */
/* order in the generic segment because the meta data will contain */
/* pointers to their appropriate locations within the generic */
/* segment. */
/* The meta data for a generic segment should only be obtained */
/* through use of the subroutine SGMETA. The meta data should not be */
/* written through any mechanism other than the ending of a generic */
/* segment begun by SGBWFS or SGBWVS using SGWES. */
/* $ Restrictions */
/* 1) If new reference index types are added, the new type(s) should */
/* be defined to be the consecutive integer(s) after the last */
/* defined reference index type used. In this way a value for */
/* the maximum allowed index type may be maintained. This value */
/* must also be updated if new reference index types are added. */
/* 2) If new meta data items are needed, mnemonics for them must be */
/* added to the end of the current list of mnemonics and before */
/* the NMETA mnemonic. In this way compatibility with files having */
/* a different, but smaller, number of meta data items may be */
/* maintained. See the description and example below. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* F.S. Turner (JPL) */
/* $ Literature_References */
/* Generic Segments Required Reading. */
/* DAF Required Reading. */
/* $ Version */
/* - SPICELIB Version 1.1.1, 28-JAN-2004 (NJB) */
/* Header update: equations for comptutations of packet indices */
/* for the cases of index types 0 and 1 were corrected. */
/* - SPICELIB Version 1.1.0, 25-09-98 (FST) */
/* Added parameter MNMETA, the minimum number of meta data items */
/* that must be present in a generic DAF segment. */
/* - SPICELIB Version 1.0.0, 04-03-95 (KRG) (WLT) */
/* -& */
/* Mnemonics for the type of reference value index. */
/* Two forms of indexing are provided: */
/* 1) An implicit form of indexing based on using two values, a */
/* starting value, which will have an index of 1, and a step */
/* size between reference values, which are used to compute an */
/* index and a reference value associated with a specified key */
/* value. See the descriptions of the implicit types below for */
/* the particular formula used in each case. */
/* 2) An explicit form of indexing based on a reference value for */
/* each data packet. */
/* Reference Index Type 0 */
/* ---------------------- */
/* Implied index. The index and reference value of a data packet */
/* associated with a specified key value are computed from the two */
/* generic segment reference values using the formula below. The two */
/* generic segment reference values, REF(1) and REF(2), represent, */
/* respectively, a starting value and a step size between reference */
/* values. The index of the data packet associated with a key value */
/* of VALUE is given by: */
/* / VALUE - REF(1) \ */
/* INDEX = 1 + INT | -------------------- | */
/* \ REF(2) / */
/* and the reference value associated with VALUE is given by: */
/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
/* Reference Index Type 1 */
/* ---------------------- */
/* Implied index. The index and reference value of a data packet */
/* associated with a specified key value are computed from the two */
/* generic segment reference values using the formula below. The two */
/* generic segment reference values, REF(1) and REF(2), represent, */
/* respectively, a starting value and a step size between reference */
/* values. The index of the data packet associated with a key value */
/* of VALUE is given by: */
/* / VALUE - REF(1) \ */
/* INDEX = 1 + INT | 0.5 + -------------------- | */
/* \ REF(2) / */
/* and the reference value associated with VALUE is given by: */
/* REFVAL = REF(1) + DBLE (INDEX-1) * REF(2) */
/* We get the larger index in the event that VALUE is halfway between */
/* X(I) and X(I+1), where X(I) = BUFFER(1) + DBLE (I-1) * REFDAT(2). */
/* Reference Index Type 2 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the last reference item */
/* that is strictly less than VALUE. The reference values must be in */
/* ascending order, REF(I) < REF(I+1). */
/* Reference Index Type 3 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the last reference item */
/* that is less than or equal to VALUE. The reference values must be */
/* in ascending order, REF(I) < REF(I+1). */
/* Reference Index Type 4 */
/* ---------------------- */
/* Explicit index. In this case the number of packets must equal the */
/* number of reference values. The index of the packet associated */
/* with a key value of VALUE is the index of the reference item */
/* that is closest to the value of VALUE. In the event of a "tie" */
/* the larger index is selected. The reference values must be in */
/* ascending order, REF(I) < REF(I+1). */
/* These parameters define the valid range for the index types. An */
/* index type code, MYTYPE, for a generic segment must satisfy the */
/* relation MNIDXT <= MYTYPE <= MXIDXT. */
/* The following meta data items will appear in all generic segments. */
/* Other meta data items may be added if a need arises. */
/* 1) CONBAS Base Address of the constants in a generic segment. */
/* 2) NCON Number of constants in a generic segment. */
/* 3) RDRBAS Base Address of the reference directory for a */
/* generic segment. */
/* 4) NRDR Number of items in the reference directory of a */
/* generic segment. */
/* 5) RDRTYP Type of the reference directory 0, 1, 2 ... for a */
/* generic segment. */
/* 6) REFBAS Base Address of the reference items for a generic */
/* segment. */
/* 7) NREF Number of reference items in a generic segment. */
/* 8) PDRBAS Base Address of the Packet Directory for a generic */
/* segment. */
/* 9) NPDR Number of items in the Packet Directory of a generic */
/* segment. */
/* 10) PDRTYP Type of the packet directory 0, 1, ... for a generic */
/* segment. */
/* 11) PKTBAS Base Address of the Packets for a generic segment. */
/* 12) NPKT Number of Packets in a generic segment. */
/* 13) RSVBAS Base Address of the Reserved Area in a generic */
/* segment. */
/* 14) NRSV Number of items in the reserved area of a generic */
/* segment. */
/* 15) PKTSZ Size of the packets for a segment with fixed width */
/* data packets or the size of the largest packet for a */
/* segment with variable width data packets. */
/* 16) PKTOFF Offset of the packet data from the start of a packet */
/* record. Each data packet is placed into a packet */
/* record which may have some bookkeeping information */
/* prepended to the data for use by the generic */
/* segments software. */
/* 17) NMETA Number of meta data items in a generic segment. */
/* Meta Data Item 1 */
/* ----------------- */
/* Meta Data Item 2 */
/* ----------------- */
/* Meta Data Item 3 */
/* ----------------- */
/* Meta Data Item 4 */
/* ----------------- */
/* Meta Data Item 5 */
/* ----------------- */
/* Meta Data Item 6 */
/* ----------------- */
/* Meta Data Item 7 */
/* ----------------- */
/* Meta Data Item 8 */
/* ----------------- */
/* Meta Data Item 9 */
/* ----------------- */
/* Meta Data Item 10 */
/* ----------------- */
/* Meta Data Item 11 */
/* ----------------- */
/* Meta Data Item 12 */
/* ----------------- */
/* Meta Data Item 13 */
/* ----------------- */
/* Meta Data Item 14 */
/* ----------------- */
/* Meta Data Item 15 */
/* ----------------- */
/* Meta Data Item 16 */
/* ----------------- */
/* If new meta data items are to be added to this list, they should */
/* be added above this comment block as described below. */
/* INTEGER NEW1 */
/* PARAMETER ( NEW1 = PKTOFF + 1 ) */
/* INTEGER NEW2 */
/* PARAMETER ( NEW2 = NEW1 + 1 ) */
/* INTEGER NEWEST */
/* PARAMETER ( NEWEST = NEW2 + 1 ) */
/* and then the value of NMETA must be changed as well to be: */
/* INTEGER NMETA */
/* PARAMETER ( NMETA = NEWEST + 1 ) */
/* Meta Data Item 17 */
/* ----------------- */
/* Maximum number of meta data items. This is always set equal to */
/* NMETA. */
/* Minimum number of meta data items that must be present in a DAF */
/* generic segment. This number is to remain fixed even if more */
/* meta data items are added for compatibility with old DAF files. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* SRCHAN I Handle of the SPK file with the source segment. */
/* SRCDSC I Descriptor for the source segment. */
/* DSTHAN I Handle of the SPK file for the destination segment. */
/* DSTDSC I Descriptor for the destination segment. */
/* DSTSID I Segment identifier for the new segment. */
/* $ Detailed_Input */
/* SRCHAN The handle of the SPK file containing the source segment. */
/* SRCDSC The SPK descriptor for the source segment. */
/* DSTHAN The handle of the SPK file containing the new segment. */
/* DSTDSC The SPK descriptor for the destination segment. It */
/* contains the desired start and stop times for the */
/* requested subset. */
/* DSTSID The segment identifier for the destination segment. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* None. */
/* $ Files */
/* See arguments SRCHAN, DSTHAN. */
/* $ Particulars */
/* This subroutine copies a subset of the data form one SPK segment */
/* to another. */
/* The exact structure of a segment of SPK type 10 is detailed in */
/* the SPK Required Reading. Please see this document for details. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* 1) We assume that the source descriptor actually describes a */
/* segment in the source SPK file containing the time coverage */
/* that is desired for the subsetting operation. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 30-JUN-1997 (KRG) */
/* -& */
/* $ Index_Entries */
/* subset type_10 spk segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* DAF ND and NI values for SPK files. */
/* The number of geophysical constants: */
/* The number of elements per two-line set: */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKS10", (ftnlen)6);
}
/* First, unpack the destination segment descriptor and set some */
/* local variables. */
dafus_(dstdsc, &c__2, &c__6, dtemp, itemp);
begtim = dtemp[0];
endtim = dtemp[1];
/* Get the constants for the input segment and send them to the */
/* output segment by beginning a fixed packet size segment. */
sgfcon_(srchan, srcdsc, &c__1, &c__8, consts);
sgbwfs_(dsthan, dstdsc, dstsid, &c__8, consts, &c__14, &c__4, dstsid_len);
if (failed_()) {
chkout_("SPKS10", (ftnlen)6);
return 0;
}
/* Get the beginning and ending indices for the packets we need for */
/* the destination segment. Note we need to get the preceding */
/* and succeeding packets (if there are any) corresponding to the */
/* start and end times of the output segments */
sgfrvi_(srchan, srcdsc, &begtim, &myref, &begidx, &found);
if (! found) {
etcal_(&begtim, time, (ftnlen)40);
setmsg_("An error has occurred while attempting to subset the a type"
" 10 SPK segment. The error occurred while attempting to loca"
"te a packet for the epoch #. There does not appear to be su"
"ch a packet. ", (ftnlen)192);
errch_("#", time, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22);
chkout_("SPKS10", (ftnlen)6);
return 0;
}
if (myref > begtim) {
/* Computing MAX */
i__1 = 1, i__2 = begidx - 1;
begidx = max(i__1,i__2);
}
sgfrvi_(srchan, srcdsc, &endtim, &myref, &endidx, &found);
if (! found) {
etcal_(&endtim, time, (ftnlen)40);
setmsg_("An error has occurred while attempting to subset the a type"
" 10 SPK segment. The error occurred while attempting to loca"
"te a packet for the epoch #. There does not appear to be su"
"ch a packet. ", (ftnlen)192);
errch_("#", time, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(CANNOTGETPACKET)", (ftnlen)22);
chkout_("SPKS10", (ftnlen)6);
return 0;
}
/* Get the total number of epochs. */
sgmeta_(srchan, srcdsc, &c__7, &nepoch);
if (myref < endtim) {
/* Computing MIN */
i__1 = nepoch, i__2 = endidx + 1;
endidx = min(i__1,i__2);
}
/* Now we get the data one record at a time from the source segment */
/* and write it out to the destination segment. */
i__1 = endidx;
for (i__ = begidx; i__ <= i__1; ++i__) {
sgfpkt_(srchan, srcdsc, &i__, &i__, packet, &dummy);
sgfref_(srchan, srcdsc, &i__, &i__, &myref);
sgwfpk_(dsthan, &c__1, packet, &c__1, &myref);
}
/* Now all we need to do is end the segment. */
sgwes_(dsthan);
chkout_("SPKS10", (ftnlen)6);
return 0;
} /* spks10_ */
/* $Procedure PCKW02 ( Write PCK segment, type 2 ) */
/* Subroutine */ int pckw02_(integer *handle, integer *body, char *frame,
doublereal *first, doublereal *last, char *segid, doublereal *intlen,
integer *n, integer *polydg, doublereal *cdata, doublereal *btime,
ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__, k;
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), dafps_(integer *, integer *, doublereal *,
integer *, doublereal *);
doublereal descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal ltime;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal rsize;
char etstr[40];
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
integer *, doublereal *, char *, ftnlen), dafena_(void);
extern logical failed_(void);
extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen,
ftnlen);
integer refcod, ninrec;
doublereal radius, numrec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
extern logical return_(void);
char netstr[40];
doublereal dcd[2];
integer icd[5];
doublereal mid;
/* $ Abstract */
/* Write a type 2 segment to a PCK binary file given */
/* the file handle, body, frame, time range covered by the */
/* segment, and the Chebyshev polynomial coefficeients. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* NAIF_IDS */
/* SPC */
/* PCK */
/* $ Keywords */
/* PCK */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of binary PCK file open for writing. */
/* BODY I NAIF code for ephemeris object. */
/* FRAME I Reference frame name. */
/* FIRST I Start time of interval covered by segment. */
/* LAST I End time of interval covered by segment. */
/* SEGID I Segment identifier. */
/* INTLEN I Length of time covered by logical record. */
/* N I Number of logical records in segment. */
/* POLYDG I Chebyshev polynomial degree. */
/* CDATA I Array of Chebyshev coefficients. */
/* BTIME I Begin time of first logical record. */
/* $ Detailed_Input */
/* HANDLE is the DAF handle of an PCK file to which a type 2 */
/* segment is to be added. The PCK file must be open */
/* for writing. */
/* BODY is the NAIF integer code for an ephemeris object */
/* whose orientation is described by the segment to */
/* be created. */
/* FRAME is the NAIF name for a reference frame relative to */
/* which the orientation information for BODY is */
/* specified. */
/* FIRST, */
/* LAST are, respectively, the start and stop times of */
/* the time interval over which the segment defines */
/* the orientation of body. */
/* SEGID is the segment identifier. A PCK segment */
/* identifier may contain up to 40 characters. */
/* INTLEN Length of time, in seconds, covered by each set of */
/* Chebyshev polynomial coefficients (each logical */
/* record). Each set of Chebyshev coefficents must */
/* cover this fixed time interval, INTLEN. */
/* N is the number of sets of Chebyshev polynomial */
/* coefficents (number of logical records) */
/* to be stored in the segment. There is one set */
/* of Chebyshev coefficients for each time period. */
/* POLYDG Degree of each set of Chebyshev polynomials. */
/* CDATA Array containing all the sets of Chebyshev */
/* polynomial coefficients to be contained in the */
/* segment of the PCK file. The coefficients are */
/* stored in CDATA in order as follows: */
/* the (degree + 1) coefficients for the first */
/* Euler angle of the first logical record */
/* the coefficients for the second Euler angle */
/* the coefficients for the third Euler angle */
/* the coefficients for the first Euler angle for */
/* the second logical record, ... */
/* and so on. */
/* BTIME Begin time (seconds past J2000 TDB) of first set */
/* of Chebyshev polynomial coefficients (first */
/* logical record). */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the number of sets of coefficients is not positive */
/* 'SPICE(NUMCOEFFSNOTPOS)' is signalled. */
/* 2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */
/* is signalled. */
/* 3) If the integer code for the reference frame is not recognized, */
/* 'SPICE(INVALIDREFFRAME)' is signalled. */
/* 4) If segment stop time is not greater then the begin time, */
/* 'SPICE(BADDESCRTIMES)' is signalled. */
/* 5) If the time of the first record is not greater than */
/* or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */
/* is signalled. */
/* 6) If the end time of the last record is not greater than */
/* or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */
/* signalled. */
/* $ Files */
/* A new type 2 PCK segment is written to the PCK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an PCK type 2 data segment to the designated */
/* PCK file, according to the format described in the PCK Required */
/* Reading. */
/* Each segment can contain data for only one body and reference */
/* frame. The Chebyshev polynomial degree and length of time covered */
/* by each logical record are also fixed. However, an arbitrary */
/* number of logical records of Chebyshev polynomial coefficients can */
/* be written in each segment. Minimizing the number of segments in */
/* a PCK file will help optimize how the SPICE system accesses the */
/* file. */
/* $ Examples */
/* Suppose that you have sets of Chebyshev polynomial coefficients */
/* in an array CDATA pertaining to the position of the moon (NAIF ID */
/* = 301) in the J2000 reference frame, and want to put these into a */
/* type 2 segment in an existing PCK file. The following code could */
/* be used to add one new type 2 segment. To add multiple segments, */
/* put the call to PCKW02 in a loop. */
/* C */
/* C First open the PCK file and get a handle for it. */
/* C */
/* CALL DAFOPW ( PCKNAM, HANDLE ) */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_PCK_TYPE_2_SEGMENT' */
/* C */
/* C Write the segment. */
/* CALL PCKW02 ( HANDLE, 301, 'J2000', */
/* . FIRST, LAST, SEGID, INTLEN, */
/* . N, POLYDG, CDATA, BTIME) */
/* C */
/* C Close the file. */
/* C */
/* CALL DAFCLS ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */
/* The calling sequence was corrected so that REF is */
/* a character string and BTIME contains only the start */
/* time of the first record. Comments updated, and new */
/* routine CHCKID is called to check segment identifier. */
/* - SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */
/* -& */
/* $ Index_Entries */
/* write pck type_2 data segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */
/* The calling sequence was corrected so that REF is */
/* a character string and BTIME contains only the start */
/* time of the first record. Comments updated, and new */
/* routine CHCKID is called to check segment identifier. */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* DTYPE is the PCK data type. */
/* NS is the size of a packed PCK segment descriptor. */
/* ND is the number of double precision components in an PCK */
/* segment descriptor. PCK uses ND = 2. */
/* NI is the number of integer components in an PCK segment */
/* descriptor. PCK uses NI = 5. */
/* SIDLEN is the maximum number of characters allowed in an */
/* PCK segment identifier. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PCKW02", (ftnlen)6);
}
/* The number of sets of coefficients must be positive. */
if (*n <= 0) {
setmsg_("The number of sets of Euler anglecoefficients is not positi"
"ve. N = #", (ftnlen)68);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The interval length must be positive. */
if (*intlen <= 0.) {
setmsg_("The interval length is not positive.N = #", (ftnlen)41);
errdp_("#", intlen, (ftnlen)1);
sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* Get the NAIF integer code for the reference frame. */
irfnum_(frame, &refcod, frame_len);
if (refcod == 0) {
setmsg_("The reference frame # is not supported.", (ftnlen)39);
errch_("#", frame, (ftnlen)1, frame_len);
sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The segment stop time must be greater than the begin time. */
if (*first > *last) {
setmsg_("The segment start time: # is greater than the segment end t"
"ime: #", (ftnlen)65);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(last, netstr, (ftnlen)40);
errch_("#", netstr, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The begin time of the first record must be less than or equal */
/* to the begin time of the segment. */
if (*first < *btime) {
setmsg_("The segment descriptor start time: # is less than the begin"
"ning time of the segment data: #", (ftnlen)91);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(btime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* The end time of the final record must be greater than or */
/* equal to the end time of the segment. */
ltime = *btime + *n * *intlen;
if (*last > ltime) {
setmsg_("The segment descriptor end time: # is greater than the end "
"time of the segment data: #", (ftnlen)86);
etcal_(last, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(<ime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* Now check the validity of the segment identifier. */
chckid_("PCK segment identifier", &c__40, segid, (ftnlen)22, segid_len);
if (failed_()) {
chkout_("PCKW02", (ftnlen)6);
return 0;
}
/* Store the start and end times to be associated */
/* with this segment. */
dcd[0] = *first;
dcd[1] = *last;
/* Create the integer portion of the descriptor. */
icd[0] = *body;
icd[1] = refcod;
icd[2] = 2;
/* Pack the segment descriptor. */
dafps_(&c__2, &c__5, dcd, icd, descr);
/* Begin a new segment of PCK type 2 form: */
/* Record 1 */
/* Record 2 */
/* ... */
/* Record N */
/* INIT ( initial epoch of first record ) */
/* INTLEN ( length of interval covered by each record ) */
/* RSIZE ( number of data elements in each record ) */
/* N ( number of records in segment ) */
/* Each record will have the form: */
/* MID ( midpoint of time interval ) */
/* RADIUS ( radius of time interval ) */
/* X coefficients, Y coefficients, Z coefficients */
dafbna_(handle, descr, segid, segid_len);
/* Calculate the number of entries in a record. */
ninrec = (*polydg + 1) * 3;
/* Fill segment with N records of data. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Calculate the midpoint and radius of the time of each */
/* record, and put that at the beginning of each record. */
radius = *intlen / 2;
mid = *btime + radius + (i__ - 1) * *intlen;
dafada_(&mid, &c__1);
dafada_(&radius, &c__1);
/* Put one set of coefficients into the segment. */
k = (i__ - 1) * ninrec + 1;
dafada_(&cdata[k - 1], &ninrec);
}
/* Store the initial epoch of the first record. */
dafada_(btime, &c__1);
/* Store the length of interval covered by each record. */
dafada_(intlen, &c__1);
/* Store the size of each record (total number of array elements). */
rsize = (doublereal) (ninrec + 2);
dafada_(&rsize, &c__1);
/* Store the number of records contained in the segment. */
numrec = (doublereal) (*n);
dafada_(&numrec, &c__1);
/* End this segment. */
dafena_();
chkout_("PCKW02", (ftnlen)6);
return 0;
} /* pckw02_ */
/* $Procedure SPKWSS ( SPK write segment summary ) */
/* Subroutine */ int spkwss_(integer *unit, char *segid, integer *segtgt,
integer *segcen, integer *segfrm, integer *segtyp, doublereal *segbtm,
doublereal *segetm, ftnlen segid_len)
{
/* Initialized data */
static char spktyp[80*21] = "Modified Difference Array "
" " "Fixed Width, Fixed Order"
" Chebyshev Polynomials: Pos " "Fixed"
" Width, Fixed Order Chebyshev Polynomials: Pos, Vel "
" " "TRW Elements (Space Telescope, TDRS) "
" " "Two Body Propagation Using Disc"
"rete States " "Type 6 "
" "
" " "Precession Conic Elements "
" " "Discrete States, Evenly Spaced, Lagran"
"ge Interpolation " "Discrete States, Un"
"evenly Spaced, Lagrange Interpolation "
"Two-Line Elements (Short Period) "
" " "Two-Line Elements (Long Period) "
" " "Discrete States, Evenly S"
"paced, Hermite Interpolation " "Discre"
"te States, Unevenly Spaced, Hermite Interpolation "
" " "Variable Width, Fixed order Chebyshev Polynomials: "
"Pos, Vel " "Two-Body with J2 precession "
" " "ISO elements "
" "
" " "Precessing Equinoctial Elements "
" " "Mex/Rosetta Hermite/Lagrange Interpolat"
"ion " "ESOC/DDID Piecewise "
"Interpolation "
"Fixed Width, Fixed Order Chebyshev Polynomials: Vel "
" " "Extended Modified Difference Array "
" ";
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
char body[32];
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
char frame[32];
extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
char lines[80*10];
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *,
ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen,
ftnlen);
extern logical failed_(void);
char begtim[32], endtim[32];
extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
char *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
char typdsc[80];
extern logical return_(void);
/* $ Abstract */
/* Write the segment summary for an SPK segment to a Fortran logical */
/* unit. */
/* $ 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* UNIT I The logical unit to use for writing the summary. */
/* SEGIDS I Segment ID for the segment in an SPK file. */
/* SEGTGT I Target body for the segment in an SPK file. */
/* SEGCEN I Center body for the segment in an SPK file. */
/* SEGFRM I Reference frame for the segment in an SPK file. */
/* SEGTYP I Ephemeris type for the segment in an SPK file. */
/* SEGBTM I Begin time (ET) for the segment in an SPK file. */
/* SEGETM I End time (ET) for the segment in an SPK file. */
/* $ Detailed_Input */
/* UNIT The Fortran logical unit to which the segment summary */
/* is written. */
/* SEGID Segment ID for a segment in an SPK file. */
/* SEGTGT Target body for a segment in an SPK file. This is the */
/* NAIF integer code for the target body. */
/* SEGCEN Center body for a segment in an SPK file. This is the */
/* NAIF integer code for the center body. */
/* SEGFRM Inertial reference frame for a segment in an SPK file. */
/* this is the NAIF integer code for the inertial reference */
/* frame. */
/* SEGTYP Ephemeris type for a segment in an SPK file. This is an */
/* integer code which represents the SPK segment data type. */
/* SEGBTM Begin time (ET) for a segment in an SPK file. */
/* SEGETM End time (ET) for a segment in an SPK file. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If an error occurs while writing to the logical unit, the error */
/* will be signaled by a routine called by this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine will format and display an SPK segment summary in a */
/* human compatible fashion. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* 1) This routine performs time conversions using ET2UTC, and */
/* therefore requires that a SPICE leapseconds kernel file be */
/* loaded into the SPICELIB kernel pool before being called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPACIT Version 4.0.0, 18-OCT-2012 (NJB) */
/* Updated to support SPK types 19, 20, and 21. */
/* - SPACIT Version 3.0.0, 28-AUG-2002 (NJB) */
/* Updated to support SPK type 18. Fixed typo in type 13 */
/* description. */
/* - Beta Version 2.1.0, 28-FEB-1997 (WLT) */
/* Added descriptions for types 4, 7, 10, 11, 12, 13, 15, 16 */
/* and 17. */
/* - Beta Version 2.0.0, 24-JAN-1996 (KRG) */
/* There have been several undocumented revisions of this */
/* subroutine to improve its display formats and fix display bugs. */
/* We are starting a new trend here, with the documentation of the */
/* changes to this version. Hopefully we will continue to do so. */
/* The changes to this version are: */
/* Calling a new subroutine to get reference frame names, to */
/* support the non-inertial frames software. */
/* Fixing some display inconsistencies when body, or frame */
/* names are not found. */
/* - Beta Version 1.0.0, 25-FEB-1993 (KRG) */
/* -& */
/* $ Index_Entries */
/* format and write an spk segment summary */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Set the value for the maximum output display width. */
/* Set the maximum length for the inertial reference frame name. */
/* Set the maximum length for a body name. */
/* Set the precision for fractions of seconds used for UTC times */
/* when converted from ET times. */
/* Set the length of a UTC time string. */
/* Set the maximum length of an SPK data type description. */
/* Set the maximum number of SPK data types. */
/* Set up some mnemonics for accessing the correct labels. */
/* Set the number of output lines. */
/* Local variables */
/* Initial Values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKWSS", (ftnlen)6);
}
/* Set up the line labels. */
s_copy(lines, " Segment ID : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 480, " UTC Start Time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 560, " UTC Stop Time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 640, " ET Start Time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 720, " ET Stop time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 80, " Target Body : Body #", (ftnlen)80, (ftnlen)26);
s_copy(lines + 160, " Center Body : Body #", (ftnlen)80, (ftnlen)26);
s_copy(lines + 240, " Reference frame: Frame #", (ftnlen)80, (ftnlen)27)
;
s_copy(lines + 320, " SPK Data Type : Type #", (ftnlen)80, (ftnlen)26);
s_copy(lines + 400, " Description : #", (ftnlen)80, (ftnlen)21);
/* Format segment ID. */
repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
ftnlen)80);
/* Convert the segment start and stop times from ET to UTC for */
/* human readability. */
et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
if (failed_()) {
chkout_("SPKWSS", (ftnlen)6);
return 0;
}
/* Format the UTC times. */
repmc_(lines + 480, "#", begtim, lines + 480, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
repmc_(lines + 560, "#", endtim, lines + 560, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
/* Convert the ET times into Calendar format. */
etcal_(segbtm, begtim, (ftnlen)32);
etcal_(segetm, endtim, (ftnlen)32);
if (failed_()) {
chkout_("SPKWSS", (ftnlen)6);
return 0;
}
/* Format the ET times. */
repmc_(lines + 640, "#", begtim, lines + 640, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
repmc_(lines + 720, "#", endtim, lines + 720, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
/* Format the target body and its name if we found it. */
bodc2n_(segtgt, body, &found, (ftnlen)32);
if (found) {
repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)4, (ftnlen)80);
repmi_(lines + 80, "#", segtgt, lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
} else {
repmi_(lines + 80, "#", segtgt, lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
}
/* Format the central body and its name if we found it. */
bodc2n_(segcen, body, &found, (ftnlen)32);
if (found) {
repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)4, (ftnlen)80);
repmi_(lines + 160, "#", segcen, lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 160, "#", body, lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
} else {
repmi_(lines + 160, "#", segcen, lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
}
/* Format the reference frame and its name if we found it. */
frmnam_(segfrm, frame, (ftnlen)32);
if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
repmc_(lines + 240, "#", "#, #", lines + 240, (ftnlen)80, (ftnlen)1, (
ftnlen)4, (ftnlen)80);
repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 240, "#", frame, lines + 240, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
} else {
repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
}
/* Format the SPK segment type and a description if we have one. */
if (*segtyp > 21 || *segtyp < 1) {
s_copy(typdsc, "No description for this type. Do you need a new tool"
"kit?", (ftnlen)80, (ftnlen)56);
} else {
s_copy(typdsc, spktyp + ((i__1 = *segtyp - 1) < 21 && 0 <= i__1 ?
i__1 : s_rnge("spktyp", i__1, "spkwss_", (ftnlen)400)) * 80, (
ftnlen)80, (ftnlen)80);
}
repmi_(lines + 320, "#", segtyp, lines + 320, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 400, "#", typdsc, lines + 400, (ftnlen)80, (ftnlen)1, (
ftnlen)80, (ftnlen)80);
/* Display the summary. */
writla_(&c__10, lines, unit, (ftnlen)80);
/* We were either successful or not on the previous write. In either */
/* event, we want to check out and return to the caller, so there is */
/* no need to check FAILED() here. */
chkout_("SPKWSS", (ftnlen)6);
return 0;
} /* spkwss_ */
/* $Procedure SPKW20 ( SPK, write segment, type 20 ) */
/* Subroutine */ int spkw20_(integer *handle, integer *body, integer *center,
char *frame, doublereal *first, doublereal *last, char *segid,
doublereal *intlen, integer *n, integer *polydg, doublereal *cdata,
doublereal *dscale, doublereal *tscale, doublereal *initjd,
doublereal *initfr, ftnlen frame_len, ftnlen segid_len)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
/* Local variables */
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
char *, ftnlen), dafps_(integer *, integer *, doublereal *,
integer *, doublereal *);
doublereal btime, descr[5];
extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
doublereal ltime;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
char etstr[40];
extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
integer *, doublereal *, char *, ftnlen), dafena_(void);
extern logical failed_(void);
extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen,
ftnlen);
integer refcod, ninrec;
extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen);
doublereal numrec;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
extern logical return_(void);
char netstr[40];
doublereal dcd[2];
extern doublereal j2000_(void);
integer icd[6];
extern doublereal spd_(void);
doublereal tol;
/* $ Abstract */
/* Write a type 20 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 */
/* TIME */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Abstract */
/* Declare parameters specific to SPK type 20. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* SPK */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 30-DEC-2013 (NJB) */
/* -& */
/* MAXDEG is the maximum allowed degree of the input */
/* Chebyshev expansions. If the value of MAXDEG is */
/* increased, the SPICELIB routine SPKPVN must be */
/* changed accordingly. In particular, the size of */
/* the record passed to SPKRnn and SPKEnn must be */
/* increased, and comments describing the record size */
/* must be changed. */
/* The record size requirement is */
/* MAXREC = 3 * ( MAXDEG + 3 ) */
/* TOLSCL is a tolerance scale factor (also called a */
/* "relative tolerance") used for time coverage */
/* bound checking. TOLSCL is unitless. TOLSCL */
/* produces a tolerance value via the formula */
/* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */
/* where FIRST and LAST are the coverage time bounds */
/* of a type 20 segment, expressed as seconds past */
/* J2000 TDB. */
/* The resulting parameter TOL is used as a tolerance */
/* for comparing the input segment descriptor time */
/* bounds to the first and last epoch covered by the */
/* sequence of time intervals defined by the inputs */
/* to SPKW20: */
/* INITJD */
/* INITFR */
/* INTLEN */
/* N */
/* Tolerance scale for coverage gap at the endpoints */
/* of the segment coverage interval: */
/* End of include file spk20.inc. */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I Handle of SPK file open for writing. */
/* BODY I NAIF code for ephemeris object. */
/* CENTER I NAIF code for the center of motion of the 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. */
/* INTLEN I Length of time covered by logical record (days). */
/* N I Number of logical records in segment. */
/* POLYDG I Chebyshev polynomial degree. */
/* CDATA I Array of Chebyshev coefficients and positions. */
/* DSCALE I Distance scale of data. */
/* TSCALE I Time scale of data. */
/* INITJD I Integer part of begin time (TDB Julian date) of */
/* first record. */
/* INITFR I Fractional part of begin time (TDB Julian date) of */
/* first record. */
/* MAXDEG P Maximum allowed degree of Chebyshev expansions. */
/* TOLSCL P Tolerance scale for coverage bound checking. */
/* $ Detailed_Input */
/* HANDLE is the DAF handle of an SPK file to which a type 20 */
/* segment is to be added. The SPK file must be open */
/* 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 the start and stop times of the time interval */
/* over which the segment defines the state of the */
/* object identified by BODY. */
/* SEGID is a segment identifier. An SPK segment identifier */
/* may contain up to 40 characters. */
/* INTLEN is the length of time, in TDB Julian days, covered */
/* by each set of Chebyshev polynomial coefficients */
/* (each logical record). */
/* N is the number of logical records to be stored in */
/* the segment. There is one logical record for each */
/* time period. Each logical record contains three */
/* sets of Chebyshev coefficients---one for each */
/* coordinate---and three position vector components. */
/* POLYDG is the degree of each set of Chebyshev */
/* polynomials, i.e. the number of Chebyshev */
/* coefficients per coordinate minus one. POLYDG must */
/* be less than or equal to the parameter MAXDEG. */
/* CDATA is an array containing all the sets of Chebyshev */
/* polynomial coefficients and position components to */
/* be placed in the new segment of the SPK file. */
/* There are three sets of coefficients and position */
/* components for each time interval covered by the */
/* segment. */
/* The coefficients and position components are */
/* stored in CDATA in order as follows: */
/* the (POLYDG + 1) coefficients for the first */
/* coordinate of the first logical record, */
/* followed by the X component of position at the */
/* first interval midpoint. The first coefficient */
/* is that of the constant term of the expansion. */
/* the coefficients for the second coordinate, */
/* followed by the Y component of position at the */
/* first interval midpoint. */
/* the coefficients for the third coordinate, */
/* followed by the Z component of position at the */
/* first interval midpoint. */
/* the coefficients for the first coordinate for */
/* the second logical record, followed by the X */
/* component of position at the second interval */
/* midpoint. */
/* and so on. */
/* The logical data records are stored contiguously: */
/* +----------+ */
/* | Record 1 | */
/* +----------+ */
/* | Record 2 | */
/* +----------+ */
/* ... */
/* +----------+ */
/* | Record N | */
/* +----------+ */
/* The contents of an individual record are: */
/* +--------------------------------------+ */
/* | Coeff set for X velocity component | */
/* +--------------------------------------+ */
/* | X position component | */
/* +--------------------------------------+ */
/* | Coeff set for Y velocity component | */
/* +--------------------------------------+ */
/* | Y position component | */
/* +--------------------------------------+ */
/* | Coeff set for Z velocity component | */
/* +--------------------------------------+ */
/* | Z position component | */
/* +--------------------------------------+ */
/* Each coefficient set has the structure: */
/* +--------------------------------------+ */
/* | Coefficient of T_0 | */
/* +--------------------------------------+ */
/* | Coefficient of T_1 | */
/* +--------------------------------------+ */
/* ... */
/* +--------------------------------------+ */
/* | Coefficient of T_POLYDG | */
/* +--------------------------------------+ */
/* Where T_n represents the Chebyshev polynomial */
/* of the first kind of degree n. */
/* DSCALE, */
/* TSCALE are, respectively, the distance scale of the input */
/* position and velocity data in km, and the time */
/* scale of the input velocity data in TDB seconds. */
/* For example, if the input distance data have units */
/* of astronomical units (AU), DSCALE should be set */
/* to the number of km in one AU. If the input */
/* velocity data have time units of Julian days, then */
/* TSCALE should be set to the number of seconds per */
/* Julian day (86400). */
/* INITJD is the integer part of the Julian ephemeris date */
/* of initial epoch of the first record. INITJD may */
/* be less than, equal to, or greater than the */
/* initial epoch. */
/* INITFR is the fractional part of the Julian ephemeris date */
/* of initial epoch of the first record. INITFR has */
/* units of Julian days. INITFR has magnitude */
/* strictly less than 1 day. The sum */
/* INITJD + INITFR */
/* equals the Julian ephemeris date of the initial */
/* epoch of the first record. */
/* $ Detailed_Output */
/* None. This routine writes data to an SPK file. */
/* $ Parameters */
/* The parameters described in this section are declared in the */
/* Fortran INCLUDE file spk20.inc */
/* MAXDEG is the maximum allowed degree of the input */
/* Chebyshev expansions. */
/* TOLSCL is a tolerance scale factor (also called a */
/* "relative tolerance") used for time coverage */
/* bound checking. TOLSCL is unitless. TOLSCL */
/* produces a tolerance value via the formula */
/* TOL = TOLSCL * MAX( ABS(FIRST), ABS(LAST) ) */
/* where FIRST and LAST are the coverage time bounds */
/* of a type 20 segment, expressed as seconds past */
/* J2000 TDB. */
/* The resulting parameter TOL is used as a tolerance */
/* for comparing the input segment descriptor time */
/* bounds to the first and last epoch covered by the */
/* sequence of time intervals defined by the inputs */
/* INITJD */
/* INITFR */
/* INTLEN */
/* N */
/* See the Exceptions section below for a description */
/* of the error check using this tolerance. */
/* $ Exceptions */
/* 1) If the number of sets of coefficients is not positive */
/* SPICE(INVALIDCOUNT) is signaled. */
/* 2) If the interval length is not positive, SPICE(INTLENNOTPOS) */
/* is signaled. */
/* 3) If the name of the reference frame is not recognized, */
/* SPICE(INVALIDREFFRAME) is signaled. */
/* 4) If segment stop time is not greater than or equal to */
/* the begin time, SPICE(BADDESCRTIMES) is signaled. */
/* 5) If the start time of the first record exceeds the descriptor */
/* begin time by more than a computed tolerance, or if the end */
/* time of the last record precedes the descriptor end time by */
/* more than a computed tolerance, the error SPICE(COVERAGEGAP) */
/* is signaled. See the Parameters section above for a */
/* description of the tolerance. */
/* 6) If the input degree POLYDG is less than 0 or greater than */
/* MAXDEG, the error SPICE(INVALIDDEGREE) is signaled. */
/* 7) If the last non-blank character of SEGID occurs past index */
/* 40, or if SEGID contains any nonprintable characters, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* 8) If either the distance or time scale is non-positive, the */
/* error SPICE(NONPOSITIVESCALE) will be signaled. */
/* $ Files */
/* A new type 20 SPK segment is written to the SPK file attached */
/* to HANDLE. */
/* $ Particulars */
/* This routine writes an SPK type 20 data segment to the designated */
/* SPK file, according to the format described in the SPK Required */
/* Reading. */
/* Each segment can contain data for only one target, central body, */
/* and reference frame. The Chebyshev polynomial degree and length */
/* of time covered by each logical record are also fixed. However, */
/* an arbitrary number of logical records of Chebyshev polynomial */
/* coefficients can be written in each segment. Minimizing the */
/* number of segments in an SPK file will help optimize how the */
/* SPICE system accesses the file. */
/* $ Examples */
/* Suppose that you have in an array CDATA sets of Chebyshev */
/* polynomial coefficients and position vectors representing the */
/* state of the moon (NAIF ID = 301), relative to the Earth-moon */
/* barycenter (NAIF ID = 3), in the J2000 reference frame, and you */
/* want to put these into a type 20 segment in an existing SPK file. */
/* The following code could be used to add one new type 20 segment. */
/* To add multiple segments, put the call to SPKW20 in a loop. */
/* C */
/* C First open the SPK file and get a handle for it. */
/* C */
/* CALL DAFOPW ( SPKNAM, HANDLE ) */
/* C */
/* C Create a segment identifier. */
/* C */
/* SEGID = 'MY_SAMPLE_SPK_TYPE_20_SEGMENT' */
/* C */
/* C Note that the interval length INTLEN has units */
/* C of Julian days. The start time of the first record */
/* C is expressed using two inputs: integer and fractional */
/* C portions of the Julian ephemeris date of the start */
/* C time. */
/* C */
/* C Write the segment. */
/* C */
/* CALL SPKW20 ( HANDLE, 301, 3, 'J2000', */
/* . FIRST, LAST, SEGID, INTLEN, */
/* . N, POLYDG, CDATA, DSCALE, */
/* . TSCALE, INITJD, INITFR ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DAFCLS ( HANDLE ) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* K.S. Zukor (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 17-JAN-2017 (NJB) (KSZ) */
/* -& */
/* $ Index_Entries */
/* write spk type_20 data segment */
/* -& */
/* SPICELIB functions */
/* Local Parameters */
/* DTYPE is the SPK data type. */
/* ND is the number of double precision components in an SPK */
/* segment descriptor. SPK uses ND = 2. */
/* NI is the number of integer components in an SPK segment */
/* descriptor. SPK uses NI = 6. */
/* NS is the size of a packed SPK segment descriptor. */
/* SIDLEN is the maximum number of characters allowed in an */
/* SPK segment identifier. */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKW20", (ftnlen)6);
/* The number of sets of coefficients must be positive. */
if (*n <= 0) {
setmsg_("The number of sets of coordinate coefficients is not positi"
"ve. N = # ", (ftnlen)69);
errint_("#", n, (ftnlen)1);
sigerr_("SPICE(INVALIDCOUNT)", (ftnlen)19);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Make sure that the degree of the interpolating polynomials is */
/* in range. */
if (*polydg < 0 || *polydg > 50) {
setmsg_("The interpolating polynomials have degree #; the valid degr"
"ee range is [0, #].", (ftnlen)78);
errint_("#", polydg, (ftnlen)1);
errint_("#", &c__50, (ftnlen)1);
sigerr_("SPICE(INVALIDDEGREE)", (ftnlen)20);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The interval length must be positive. */
if (*intlen <= 0.) {
setmsg_("The interval length is not positive.N = #", (ftnlen)41);
errdp_("#", intlen, (ftnlen)1);
sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19);
chkout_("SPKW20", (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_("SPKW20", (ftnlen)6);
return 0;
}
/* The segment stop time must be greater than or equal to the begin */
/* time. */
if (*first > *last) {
setmsg_("The segment start time: # (# TDB) is greater than the segme"
"nt end time: (# TDB).", (ftnlen)80);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
errdp_("#", first, (ftnlen)1);
etcal_(last, netstr, (ftnlen)40);
errch_("#", netstr, (ftnlen)1, (ftnlen)40);
errdp_("#", last, (ftnlen)1);
sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The distance and time scales must be positive. */
if (*dscale <= 0.) {
setmsg_("The distance scale is not positive.DSCALE = #", (ftnlen)45);
errdp_("#", dscale, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
if (*tscale <= 0.) {
setmsg_("The time scale is not positive.TSCALE = #", (ftnlen)41);
errdp_("#", tscale, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVESCALE)", (ftnlen)23);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The begin time of the first record must be less than or equal */
/* to the begin time of the segment. Convert the two-part input */
/* epoch to seconds past J2000 for the purpose of this check. */
btime = spd_() * (*initjd - j2000_() + *initfr);
ltime = btime + *n * *intlen * spd_();
/* Compute the tolerance to use for descriptor time bound checks. */
/* Computing MAX */
d__1 = abs(btime), d__2 = abs(ltime);
tol = max(d__1,d__2) * 1e-13;
if (*first < btime - tol) {
setmsg_("The segment descriptor start time # is too much less than t"
"he beginning time of the segment data # (in seconds past J20"
"00: #). The difference is # seconds; the tolerance is # seco"
"nds.", (ftnlen)183);
etcal_(first, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(&btime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
errdp_("#", first, (ftnlen)1);
d__1 = btime - *first;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &tol, (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* The end time of the final record must be greater than or */
/* equal to the end time of the segment. */
if (*last > ltime + tol) {
setmsg_("The segment descriptor end time # is too much greater than "
"the end time of the segment data # (in seconds past J2000: #"
"). The difference is # seconds; the tolerance is # seconds.",
(ftnlen)178);
etcal_(last, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
etcal_(<ime, etstr, (ftnlen)40);
errch_("#", etstr, (ftnlen)1, (ftnlen)40);
errdp_("#", last, (ftnlen)1);
d__1 = *last - ltime;
errdp_("#", &d__1, (ftnlen)1);
errdp_("#", &tol, (ftnlen)1);
sigerr_("SPICE(COVERAGEGAP)", (ftnlen)18);
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Now check the validity of the segment identifier. */
chckid_("SPK segment identifier", &c__40, segid, (ftnlen)22, segid_len);
if (failed_()) {
chkout_("SPKW20", (ftnlen)6);
return 0;
}
/* Store the start and end times to be associated */
/* with this segment. */
dcd[0] = *first;
dcd[1] = *last;
/* Create the integer portion of the descriptor. */
icd[0] = *body;
icd[1] = *center;
icd[2] = refcod;
icd[3] = 20;
/* Pack the segment descriptor. */
dafps_(&c__2, &c__6, dcd, icd, descr);
/* Begin a new segment of SPK type 20 form: */
/* Record 1 */
/* Record 2 */
/* ... */
/* Record N */
/* DSCALE ( distance scale in km ) */
/* TSCALE ( time scale in seconds ) */
/* INITJD ( integer part of initial epoch of first record, */
/* expressed as a TDB Julian date ) */
/* INITFR ( fractional part of initial epoch, in units of */
/* TDB Julian days ) */
/* INTLEN ( length of interval covered by each record, in */
/* units of TDB Julian days ) */
/* RSIZE ( number of data elements in each record ) */
/* N ( number of records in segment ) */
/* Each record will have the form: */
/* X coefficients */
/* X position component at interval midpoint */
/* Y coefficients */
/* Y position component at interval midpoint */
/* Z coefficients */
/* Z position component at interval midpoint */
dafbna_(handle, descr, segid, segid_len);
/* Calculate the number of entries in a record. */
ninrec = (*polydg + 2) * 3;
/* Fill segment with N records of data. */
i__1 = *n * ninrec;
dafada_(cdata, &i__1);
/* Store the distance and time scales. */
dafada_(dscale, &c__1);
dafada_(tscale, &c__1);
/* Store the integer and fractional parts of the initial epoch of */
/* the first record. */
dafada_(initjd, &c__1);
dafada_(initfr, &c__1);
/* Store the length of interval covered by each record. */
dafada_(intlen, &c__1);
/* Store the size of each record (total number of array elements). */
/* Note that this size is smaller by 2 than the size of a type 2 */
/* record of the same degree, since the record coverage midpoint */
/* and radius are not stored. */
d__1 = (doublereal) ninrec;
dafada_(&d__1, &c__1);
/* Store the number of records contained in the segment. */
numrec = (doublereal) (*n);
dafada_(&numrec, &c__1);
/* End this segment. */
dafena_();
chkout_("SPKW20", (ftnlen)6);
return 0;
} /* spkw20_ */
/* $Procedure PCKWSS ( PCK write segment summary ) */
/* Subroutine */ int pckwss_(integer *unit, char *segid, integer *segbod,
integer *segfrm, integer *segtyp, doublereal *segbtm, doublereal *
segetm, ftnlen segid_len)
{
/* Initialized data */
static char pcktyp[80*3] = "***Not Used*** "
" " "Fixed Width, Fixed Order "
"Chebyshev Polynomials: Angles " "Variab"
"le Width Chebyshev Polynomials Angles (in degrees!!!) "
" ";
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer,
char *, integer);
/* Local variables */
static char body[32];
extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
static char frame[32];
extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
static char lines[80*9];
static logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *,
ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen,
ftnlen);
extern logical failed_(void);
static char begtim[32], endtim[32];
extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
char *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
static char typdsc[80];
extern logical return_(void);
/* $ Abstract */
/* Write the segment summary for a PCK segment to a Fortran logical */
/* unit. */
/* $ 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 */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* UNIT I The logical unit to use for writing the summary. */
/* SEGIDS I Segment ID for the segment in a PCK file. */
/* SEGBOD I Body for the segment in a PCK file. */
/* SEGFRM I Reference frame for the segment in a PCK file. */
/* SEGTYP I Ephemeris type for the segment in a PCK file. */
/* SEGBTM I Begin time (ET) for the segment in a PCK file. */
/* SEGETM I End time (ET) for the segment in a PCK file. */
/* $ Detailed_Input */
/* UNIT The Fortran logical unit to which the segment summary */
/* is written. */
/* SEGID Segment ID for a segment in a PCK file. */
/* SEGBOD Body for a segment in a PCK file. This is the */
/* NAIF integer code for the body. */
/* SEGFRM Inertial reference frame for a segment in a PCK file. */
/* this is the NAIF integer code for the inertial reference */
/* frame. */
/* SEGTYP Ephemeris type for a segment in a PCK file. This is an */
/* integer code which represents the PCK segment data type. */
/* SEGBTM Begin time (ET) for a segment in a PCK file. */
/* SEGETM End time (ET) for a segment in a PCK file. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If an error occurs while writing to the logical unit, the error */
/* will be signalled by a routine called by this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine will format and display a PCK segment summary in a */
/* human compatible fashion. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* 1) This routine performs time conversions using ET2UTC, and */
/* therefore requires that a SPICE leapseconds kernel file be */
/* loaded into the SPICELIB kernel pool before being called. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - Beta Version 2.1.0, 17-May-2001 (WLT) (20 years in CA today!) */
/* Added a description for type 03 PCK segments. */
/* - Beta Version 2.0.0, 24-JAN-1996 (KRG) */
/* There have been several undocumented revisions of this */
/* subroutine to improve its display formats and fix display bugs. */
/* We are starting a new trend here, with the documentation of the */
/* changes to this version. Hopefully we will continue to do so. */
/* The changes to this version are: */
/* Calling a new subroutien to get reference frame names, to */
/* support the non-inertial frames software. */
/* Fixing some display inconsistencies when body, or frame */
/* names are not found. */
/* - Beta Version 1.0.0, 25-FEB-1993 (KRG) */
/* -& */
/* $ Index_Entries */
/* format and write a pck segment summary */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Set the value for the maximum output display width. */
/* Set the maximum length for the inertial reference frame name. */
/* Set the maximum length for a body name. */
/* Set the precision for fractions of seconds used for UTC times */
/* when converted from ET times. */
/* Set the length of a UTC time string. */
/* Set the maximum length of an PCK data type description. */
/* Set the maximum number of PCK data types. */
/* Set up some mnemonics for accessing the correct labels. */
/* Set the number of output lines. */
/* Local variables */
/* Save everything to keep configuration control happy. */
/* Initial Values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("PCKWSS", (ftnlen)6);
}
/* Set up the line labels. */
s_copy(lines, " Segment ID : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 400, " UTC Start time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 480, " UTC Stop time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 560, " ET Start time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 640, " ET Stop time : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 80, " Body : Body #", (ftnlen)80, (ftnlen)26);
s_copy(lines + 160, " Reference frame: Frame #", (ftnlen)80, (ftnlen)27)
;
s_copy(lines + 240, " PCK Data Type : #", (ftnlen)80, (ftnlen)21);
s_copy(lines + 320, " Description : #", (ftnlen)80, (ftnlen)21);
/* Format the segment ID. */
repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
ftnlen)80);
/* Convert the segment start and stop times from ET to UTC for */
/* human readability. */
et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
if (failed_()) {
chkout_("PCKWSS", (ftnlen)6);
return 0;
}
/* Format the UTC times. */
repmc_(lines + 400, "#", begtim, lines + 400, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
repmc_(lines + 480, "#", endtim, lines + 480, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
/* Convert the ET times into Calendar format. */
etcal_(segbtm, begtim, (ftnlen)32);
etcal_(segetm, endtim, (ftnlen)32);
if (failed_()) {
chkout_("PCKWSS", (ftnlen)6);
return 0;
}
/* Format the ET times. */
repmc_(lines + 560, "#", begtim, lines + 560, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
repmc_(lines + 640, "#", endtim, lines + 640, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
/* Format the body and its name if we found it. */
bodc2n_(segbod, body, &found, (ftnlen)32);
if (found) {
repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)4, (ftnlen)80);
repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
} else {
repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
}
/* Format the inertial reference frame and its name if we found it. */
frmnam_(segfrm, frame, (ftnlen)32);
if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)4, (ftnlen)80);
repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 160, "#", frame, lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)32, (ftnlen)80);
} else {
repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
}
/* Format the PCK segment type and a description if we have one. */
/* The reason SEGTYP >= 2 is that this routine works on binary */
/* PCK files, and their segment types begin with type 2. Type 1 is */
/* considered to be the text PCK files. */
if (*segtyp > 3 || *segtyp < 2) {
s_copy(typdsc, "No description for this type. Do you need a new tool"
"kit?", (ftnlen)80, (ftnlen)56);
} else {
s_copy(typdsc, pcktyp + ((i__1 = *segtyp - 1) < 3 && 0 <= i__1 ? i__1
: s_rnge("pcktyp", i__1, "pckwss_", (ftnlen)352)) * 80, (
ftnlen)80, (ftnlen)80);
}
repmi_(lines + 240, "#", segtyp, lines + 240, (ftnlen)80, (ftnlen)1, (
ftnlen)80);
repmc_(lines + 320, "#", typdsc, lines + 320, (ftnlen)80, (ftnlen)1, (
ftnlen)80, (ftnlen)80);
/* Display the summary. */
writla_(&c__9, lines, unit, (ftnlen)80);
/* We were either successful or not on the previous write. In either */
/* event, we want to check out and return to the caller, so there is */
/* no need to check FAILED() here. */
chkout_("PCKWSS", (ftnlen)6);
return 0;
} /* pckwss_ */
