/* $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 ETCAL ( Convert ET to Calendar format ) */
/* Subroutine */ int etcal_(doublereal *et, char *string, ftnlen string_len)
{
/* Initialized data */
static logical first = TRUE_;
static integer extra[12] = { 0,0,1,1,1,1,1,1,1,1,1,1 };
static integer dpjan0[12] = { 0,31,59,90,120,151,181,212,243,273,304,334 }
;
static integer dpbegl[12] = { 0,31,60,91,121,152,182,213,244,274,305,335 }
;
static char months[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL"
"AUG" "SEP" "OCT" "NOV" "DEC";
/* System generated locals */
address a__1[12];
integer i__1, i__2, i__3[12];
doublereal d__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double d_int(doublereal *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
/* Local variables */
static integer dn2000;
static doublereal dp2000, frac;
static char date[180];
static doublereal remd, secs;
static integer year, mins;
static char dstr[16], hstr[16], mstr[16], sstr[16], ystr[16];
static doublereal halfd, q;
static integer tsecs, dofyr, month, hours;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
static doublereal mynum;
static integer bh, bm, iq;
static doublereal secspd;
static char messge[16];
static integer offset;
static doublereal dmnint;
static logical adjust;
static integer daynum;
extern integer intmin_(void), intmax_(void);
extern /* Subroutine */ int dpstrf_(doublereal *, integer *, char *, char
*, ftnlen, ftnlen);
static doublereal dmxint, mydnom;
extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *,
ftnlen, ftnlen, ftnlen);
extern integer lstlti_(integer *, integer *, integer *);
extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
static integer yr1, yr4;
static char era[16];
static integer day, rem;
extern doublereal spd_(void);
static integer yr100, yr400;
/* $ Abstract */
/* Convert from an ephemeris epoch measured in seconds past */
/* the epoch of J2000 to a calendar string format using a */
/* formal calendar free of leapseconds. */
/* $ 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 */
/* TIME */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Ephemeris time measured in seconds past J2000. */
/* STRING O A standard calendar representation of ET. */
/* $ Detailed_Input */
/* ET is an epoch measured in ephemeris seconds */
/* past the epoch of J2000. */
/* $ Detailed_Output */
/* STRING is a calendar string representing the input ephemeris */
/* epoch. This string is based upon extending the */
/* Gregorian Calendar backward and forward indefinitely */
/* keeping the same rules for determining leap years. */
/* Moreover, there is no accounting for leapseconds. */
/* To be sure that all of the date can be stored in */
/* STRING, it should be declared to have length at */
/* least 48 characters. */
/* The string will have the following format */
/* year (era) mon day hr:mn:sc.sss */
/* Where: */
/* year --- is the year */
/* era --- is the chronological era associated with */
/* the date. For years after 999 A.D. */
/* the era is omitted. For years */
/* between 1 A.D. and 999 A.D. (inclusive) */
/* era is the string 'A.D.' For epochs */
/* before 1 A.D. Jan 1 00:00:00, era is */
/* given as 'B.C.' and the year is converted */
/* to years before the "Christian Era". */
/* The last B.C. epoch is */
/* 1 B.C. DEC 31 23:59:59.999 */
/* The first A.D. epoch (which occurs .001 */
/* seconds after the last B.C. epoch) is: */
/* 1 A.D. JAN 1 00:00:00.000 */
/* Note: there is no year 0 A.D. or 0 B.C. */
/* mon --- is a 3-letter abbreviation for the month */
/* in all capital letters. */
/* day --- is the day of the month */
/* hr --- is the hour of the day (between 0 and 23) */
/* leading zeros are added to hr if the */
/* numeric value is less than 10. */
/* mn --- is the minute of the hour (0 to 59) */
/* leading zeros are added to mn if the */
/* numeric value is less than 10. */
/* sc.sss is the second of the minute to 3 decimal */
/* places ( 0 to 59.999). Leading zeros */
/* are added if the numeric value is less */
/* than 10. Seconds are truncated, not */
/* rounded. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* 1) If the input ET is so large that the corresponding */
/* number of days since 1 A.D. Jan 1, 00:00:00 is */
/* within 1 of overflowing or underflowing an integer, */
/* ET will not be converted to the correct string */
/* representation rather, the string returned will */
/* state that the epoch was before or after the day */
/* that is INTMIN +1 or INTMAX - 1 days after */
/* 1 A.D. Jan 1, 00:00:00. */
/* 2) If the output string is not sufficiently long to hold */
/* the full date, it will be truncated on the right. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This is an error free routine for converting ephemeris epochs */
/* represented as seconds past the J2000 epoch to formal */
/* calendar strings based upon the Gregorian Calendar. This formal */
/* time is often useful when one needs a human recognizable */
/* form of an ephemeris epoch. There is no accounting for leap */
/* seconds in the output times produced. */
/* Note: The calendar epochs produced are not the same as the */
/* UTC calendar epochs that correspond to ET. The strings */
/* produced by this routine may vary from the corresponding */
/* UTC epochs by more than 1 minute. */
/* This routine can be used in creating error messages or */
/* in routines and programs in which one prefers to report */
/* times without employing leapseconds to produce exact UTC */
/* epochs. */
/* $ Examples */
/* Suppose you wish to report that no data is */
/* available at a particular ephemeris epoch ET. The following */
/* code shows how you might accomplish this task. */
/* CALL DPSTRF ( ET, 6, 'F', ETSTR ) */
/* CALL ETCAL ( ET, STRING ) */
/* E1 = RTRIM ( STRING ) */
/* E2 = RTRIM ( ETSTR ) */
/* WRITE (*,*) 'There is no data available for the body ' */
/* WRITE (*,*) 'at requested time: ' */
/* WRITE (*,*) ' ', STRING(1:E1), ' (', ETSTR(1:E2), ')' */
/* $ Restrictions */
/* One must keep in mind when using this routine that */
/* ancient times are not based upon the Gregorian */
/* calendar. For example the 0 point of the Julian */
/* Date system is 4713 B.C. Jan 1, 12:00:00 on the Julian */
/* Calendar. If one formalized the Gregorian calendar */
/* and extended it indefinitely, the zero point of the Julian */
/* date system corresponds to 4714 B.C. NOV 24 12:00:00 on */
/* the Gregorian calendar. There are several reasons for this. */
/* Leap years in the Julian calendar occur every */
/* 4 years (including *all* centuries). Moreover, the */
/* Gregorian calendar "effectively" begins on 15 Oct, 1582 A.D. */
/* which is 5 Oct, 1582 A.D. in the Julian Calendar. */
/* Therefore you must be careful in your interpretation */
/* of ancient dates produced by this routine. */
/* $ Literature_References */
/* 1. "From Sundial to Atomic Clocks---Understanding Time and */
/* Frequency" by James Jespersen and Jane Fitz-Randolph */
/* Dover Publications, Inc. New York (1982). */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* $ Version */
/* - SPICELIB Version 2.2.0, 05-MAR-1998 (WLT) */
/* The documentation concerning the appearance of the output */
/* time string was corrected so that it does not suggest */
/* a comma is inserted after the day of the month. The */
/* comma was removed from the output string in Version 2.0.0 */
/* (see the note below) but the documentation was not upgraded */
/* accordingly. */
/* - SPICELIB Version 2.1.0, 20-MAY-1996 (WLT) */
/* Two arrays that were initialized but never used were */
/* removed. */
/* - SPICELIB Version 2.0.0, 16-AUG-1995 (KRG) */
/* If the day number was less than 10, the spacing was off for */
/* the rest of the time by one space, that for the "tens" digit. */
/* This has been fixed by using a leading zero when the number of */
/* days is < 10. */
/* Also, the comma that appeared between the month/day/year */
/* and the hour:minute:seconds tokens has been removed. This was */
/* done in order to make the calendar date format of ETCAL */
/* consistent with the calendar date format of ET2UTC. */
/* - SPICELIB Version 1.0.0, 14-DEC-1993 (WLT) */
/* -& */
/* $ Index_Entries */
/* Convert ephemeris time to a formal calendar date */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.1.0, 20-MAY-1996 (WLT) */
/* Two arrays that were initialized but never used were */
/* removed. */
/* - SPICELIB Version 2.0.0, 16-AUG-1995 (KRG) */
/* If the day number was less than 10, the spacing was off for */
/* the rest of the time by one space, that for the "tens" digit. */
/* This has been fixed byusing a leading zero when the number of */
/* days is < 10. */
/* Also, the comma that appeared between the month/day/year */
/* and the hour:minute:seconds tokens has been removed. This was */
/* done in order to make the calendar date format of ETCAL */
/* consistent with the calendar date format of ET2UTC. */
/* - SPICELIB Version 1.0.0, 14-DEC-1993 (WLT) */
/* -& */
/* Spicelib Functions. */
/* We declare the variables that contain the number of days in */
/* 400 years, 100 years, 4 years and 1 year. */
/* The following integers give the number of days during the */
/* associated month of a non-leap year. */
/* The integers that follow give the number of days in a normal */
/* year that precede the first of the month. */
/* The integers that follow give the number of days in a leap */
/* year that precede the first of the month. */
/* The variables below hold the components of the output string */
/* before they are put together. */
/* We will construct our string using the local variable DATE */
/* and transfer the results to the output STRING when we are */
/* done. */
/* MONTHS contains 3-letter abbreviations for the months of the year */
/* The array EXTRA contains the number of additional days that */
/* appear before the first of a month during a leap year (as opposed */
/* to a non-leap year). */
/* DPJAN0(I) gives the number of days that occur before the I'th */
/* month of a normal year. */
/* Definitions of statement functions. */
/* The number of days elapsed since Jan 1, of year 1 A.D. to */
/* Jan 1 of YEAR is given by: */
/* The number of leap days in a year is given by: */
/* To compute the day of the year we */
/* look up the number of days to the beginning of the month, */
/* add on the number leap days that occurred prior to that */
/* time */
/* add on the number of days into the month */
/* The number of days since 1 Jan 1 A.D. is given by: */
if (first) {
first = FALSE_;
halfd = spd_() / 2.;
secspd = spd_();
dn2000 = (c__2000 - 1) * 365 + (c__2000 - 1) / 4 - (c__2000 - 1) /
100 + (c__2000 - 1) / 400 + (dpjan0[(i__1 = c__1 - 1) < 12 &&
0 <= i__1 ? i__1 : s_rnge("dpjan0", i__1, "etcal_", (ftnlen)
571)] + extra[(i__2 = c__1 - 1) < 12 && 0 <= i__2 ? i__2 :
s_rnge("extra", i__2, "etcal_", (ftnlen)571)] * ((c__2000 / 4
<< 2) / c__2000 - c__2000 / 100 * 100 / c__2000 + c__2000 /
400 * 400 / c__2000) + c__1) - 1;
dmxint = (doublereal) intmax_();
dmnint = (doublereal) intmin_();
}
/* Now we "in-line" compute the following call. */
/* call rmaind ( et + halfd, secspd, dp2000, secs ) */
/* because we can't make a call to rmaind. */
/* The reader may wonder why we use et + halfd. The value */
/* et is seconds past the ephemeris epoch of J2000 which */
/* is at 2000 Jan 1, 12:00:00. We want to compute days past */
/* 2000 Jan 1, 00:00:00. The seconds past THAT epoch is et + halfd. */
/* We add on 0.0005 seconds so that the string produced will be */
/* rounded to the nearest millisecond. */
mydnom = secspd;
mynum = *et + halfd;
d__1 = mynum / mydnom;
q = d_int(&d__1);
remd = mynum - q * mydnom;
if (remd < 0.) {
q += -1.;
remd += mydnom;
}
secs = remd;
dp2000 = q;
/* Do something about the problem when ET is vastly */
/* out of range. (Day number outside MAX and MIN integer). */
if (dp2000 + dn2000 < dmnint + 1) {
dp2000 = dmnint - dn2000 + 1;
s_copy(messge, "Epoch before ", (ftnlen)16, (ftnlen)13);
secs = 0.;
} else if (dp2000 + dn2000 > dmxint - 1) {
dp2000 = dmxint - dn2000 - 1;
s_copy(messge, "Epoch after ", (ftnlen)16, (ftnlen)12);
secs = 0.;
} else {
s_copy(messge, " ", (ftnlen)16, (ftnlen)1);
}
/* Compute the number of days since 1 .A.D. Jan 1, 00:00:00. */
/* From the tests in the previous IF-ELSE IF-ELSE block this */
/* addition is guaranteed not to overflow. */
daynum = (integer) (dp2000 + (doublereal) dn2000);
/* If the number of days is negative, we need to do a little */
/* work so that we can represent the date in the B.C. era. */
/* We add enough multiples of 400 years so that the year will */
/* be positive and then we subtract off the appropriate multiple */
/* of 400 years later. */
if (daynum < 0) {
/* Since we can't make the call below and remain */
/* error free, we compute it ourselves. */
/* call rmaini ( daynum, dp400y, offset, daynum ) */
iq = daynum / 146097;
rem = daynum - iq * 146097;
if (rem < 0) {
--iq;
rem += 146097;
}
offset = iq;
daynum = rem;
adjust = TRUE_;
} else {
adjust = FALSE_;
}
/* Next we compute the year. Divide out multiples of 400, 100 */
/* 4 and 1 year. Finally combine these to get the correct */
/* value for year. (Note this is all integer arithmetic.) */
/* Recall that DP1Y = 365 */
/* DP4Y = 4*DPY + 1 */
/* DP100Y = 25*DP4Y - 1 */
/* DP400Y = 4*DP100Y + 1 */
yr400 = daynum / 146097;
rem = daynum - yr400 * 146097;
/* Computing MIN */
i__1 = 3, i__2 = rem / 36524;
yr100 = min(i__1,i__2);
rem -= yr100 * 36524;
/* Computing MIN */
i__1 = 24, i__2 = rem / 1461;
yr4 = min(i__1,i__2);
rem -= yr4 * 1461;
/* Computing MIN */
i__1 = 3, i__2 = rem / 365;
yr1 = min(i__1,i__2);
rem -= yr1 * 365;
dofyr = rem + 1;
year = yr400 * 400 + yr100 * 100 + (yr4 << 2) + yr1 + 1;
/* Get the month, and day of month (depending upon whether */
/* we have a leap year or not). */
if ((year / 4 << 2) / year - year / 100 * 100 / year + year / 400 * 400 /
year == 0) {
month = lstlti_(&dofyr, &c__12, dpjan0);
day = dofyr - dpjan0[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 :
s_rnge("dpjan0", i__1, "etcal_", (ftnlen)698)];
} else {
month = lstlti_(&dofyr, &c__12, dpbegl);
day = dofyr - dpbegl[(i__1 = month - 1) < 12 && 0 <= i__1 ? i__1 :
s_rnge("dpbegl", i__1, "etcal_", (ftnlen)701)];
}
/* If we had to adjust the year to make it positive, we now */
/* need to correct it and then convert it to a B.C. year. */
if (adjust) {
year += offset * 400;
year = -year + 1;
s_copy(era, " B.C. ", (ftnlen)16, (ftnlen)6);
} else {
/* If the year is less than 1000, we can't just write it */
/* out. We need to add the era. If we don't do this */
/* the dates look very confusing. */
if (year < 1000) {
s_copy(era, " A.D. ", (ftnlen)16, (ftnlen)6);
} else {
s_copy(era, " ", (ftnlen)16, (ftnlen)1);
}
}
/* Convert Seconds to Hours, Minute and Seconds. */
/* We work with thousandths of a second in integer arithmetic */
/* so that all of the truncation work with seconds will already */
/* be done. (Note that we already know that SECS is greater than */
/* or equal to zero so we'll have no problems with HOURS, MINS */
/* or SECS becoming negative.) */
tsecs = (integer) (secs * 1e3);
frac = secs - (doublereal) tsecs;
hours = tsecs / 3600000;
tsecs -= hours * 3600000;
mins = tsecs / 60000;
tsecs -= mins * 60000;
secs = (doublereal) tsecs / 1e3;
/* We round seconds if we can do so without getting seconds to be */
/* bigger than 60. */
if (secs + 5e-4 < 60.) {
secs += 5e-4;
}
/* Finally, get the components of our date string. */
intstr_(&year, ystr, (ftnlen)16);
if (day >= 10) {
intstr_(&day, dstr, (ftnlen)16);
} else {
s_copy(dstr, "0", (ftnlen)16, (ftnlen)1);
intstr_(&day, dstr + 1, (ftnlen)15);
}
/* We want to zero pad the hours minutes and seconds. */
if (hours < 10) {
bh = 2;
} else {
bh = 1;
}
if (mins < 10) {
bm = 2;
} else {
bm = 1;
}
s_copy(mstr, "00", (ftnlen)16, (ftnlen)2);
s_copy(hstr, "00", (ftnlen)16, (ftnlen)2);
s_copy(sstr, " ", (ftnlen)16, (ftnlen)1);
/* Now construct the string components for hours, minutes and */
/* seconds. */
secs = (integer) (secs * 1e3) / 1e3;
intstr_(&hours, hstr + (bh - 1), 16 - (bh - 1));
intstr_(&mins, mstr + (bm - 1), 16 - (bm - 1));
dpstrf_(&secs, &c__6, "F", sstr, (ftnlen)1, (ftnlen)16);
/* The form of the output for SSTR has a leading blank followed by */
/* the first significant digit. If a decimal point is in the */
/* third slot, then SSTR is of the form ' x.xxxxx' and we need */
/* to insert a leading zero. */
if (*(unsigned char *)&sstr[2] == '.') {
*(unsigned char *)sstr = '0';
}
/* We don't want any leading spaces in SSTR, (HSTR and MSTR don't */
/* have leading spaces by construction. */
ljust_(sstr, sstr, (ftnlen)16, (ftnlen)16);
/* Now form the date string, squeeze out extra spaces and */
/* left justify the whole thing. */
/* Writing concatenation */
i__3[0] = 16, a__1[0] = messge;
i__3[1] = 16, a__1[1] = ystr;
i__3[2] = 16, a__1[2] = era;
i__3[3] = 3, a__1[3] = months + ((i__1 = month - 1) < 12 && 0 <= i__1 ?
i__1 : s_rnge("months", i__1, "etcal_", (ftnlen)810)) * 3;
i__3[4] = 1, a__1[4] = " ";
i__3[5] = 3, a__1[5] = dstr;
i__3[6] = 1, a__1[6] = " ";
i__3[7] = 2, a__1[7] = hstr;
i__3[8] = 1, a__1[8] = ":";
i__3[9] = 2, a__1[9] = mstr;
i__3[10] = 1, a__1[10] = ":";
i__3[11] = 6, a__1[11] = sstr;
s_cat(date, a__1, i__3, &c__12, (ftnlen)180);
cmprss_(" ", &c__1, date, date, (ftnlen)1, (ftnlen)180, (ftnlen)180);
ljust_(date, date, (ftnlen)180, (ftnlen)180);
s_copy(string, date, string_len, (ftnlen)180);
return 0;
} /* etcal_ */
/* $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_ */
