/* DECK DLGAMS */
/* Subroutine */ int dlgams_(doublereal *x, doublereal *dlgam, doublereal *
sgngam)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double d_int(doublereal *), d_mod(doublereal *, doublereal *);
/* Local variables */
integer int__;
extern doublereal dlngam_(doublereal *);
/* ***BEGIN PROLOGUE DLGAMS */
/* ***PURPOSE Compute the logarithm of the absolute value of the Gamma */
/* function. */
/* ***LIBRARY SLATEC (FNLIB) */
/* ***CATEGORY C7A */
/* ***TYPE DOUBLE PRECISION (ALGAMS-S, DLGAMS-D) */
/* ***KEYWORDS ABSOLUTE VALUE OF THE LOGARITHM OF THE GAMMA FUNCTION, */
/* FNLIB, SPECIAL FUNCTIONS */
/* ***AUTHOR Fullerton, W., (LANL) */
/* ***DESCRIPTION */
/* DLGAMS(X,DLGAM,SGNGAM) calculates the double precision natural */
/* logarithm of the absolute value of the Gamma function for */
/* double precision argument X and stores the result in double */
/* precision argument DLGAM. */
/* ***REFERENCES (NONE) */
/* ***ROUTINES CALLED DLNGAM */
/* ***REVISION HISTORY (YYMMDD) */
/* 770701 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890531 REVISION DATE from Version 3.2 */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* ***END PROLOGUE DLGAMS */
/* ***FIRST EXECUTABLE STATEMENT DLGAMS */
*dlgam = dlngam_(x);
*sgngam = 1.;
if (*x > 0.) {
return 0;
}
d__1 = -d_int(x);
int__ = (integer) (d_mod(&d__1, &c_b2) + .1);
if (int__ == 0) {
*sgngam = -1.;
}
return 0;
} /* dlgams_ */
/* $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_ */
/* Subroutine */ int step2lon_(doublereal *xsta, doublereal *t, doublereal *
xcorsta)
{
/* Initialized data */
static doublereal datdi[45] /* was [9][5] */ = { 0.,0.,0.,1.,0.,.47,.23,
.16,.07,0.,2.,0.,0.,0.,-.2,-.12,-.11,-.05,1.,0.,-1.,0.,0.,-.11,
-.08,-.09,-.04,2.,0.,0.,0.,0.,-.13,-.11,-.15,-.07,2.,0.,0.,1.,0.,
-.05,-.05,-.06,-.03 };
/* System generated locals */
doublereal d__1, d__2, d__3;
/* Builtin functions */
double sqrt(doublereal), d_mod(doublereal *, doublereal *), cos(
doublereal), sin(doublereal);
/* Local variables */
static doublereal h__;
static integer i__, j;
static doublereal p, s, de, dn, dr, pr, ps, zns, rsta, cosla, sinla,
thetaf, cosphi, dn_tot__, sinphi, dr_tot__, deg2rad;
/* + */
/* - - - - - - - - - - - */
/* S T E P 2 L O N */
/* - - - - - - - - - - - */
/* This routine is part of the International Earth Rotation and */
/* Reference Systems Service (IERS) Conventions software collection. */
/* This subroutine gives the in-phase and out-of-phase corrections */
/* induced by mantle anelasticity in the long period band. */
/* In general, Class 1, 2, and 3 models represent physical effects that */
/* act on geodetic parameters while canonical models provide lower-level */
/* representations or basic computations that are used by Class 1, 2, or */
/* 3 models. */
/* Status: Class 1 */
/* Class 1 models are those recommended to be used a priori in the */
/* reduction of raw space geodetic data in order to determine */
/* geodetic parameter estimates. */
/* Class 2 models are those that eliminate an observational */
/* singularity and are purely conventional in nature. */
/* Class 3 models are those that are not required as either Class */
/* 1 or 2. */
/* Canonical models are accepted as is and cannot be classified as a */
/* Class 1, 2, or 3 model. */
/* Given: */
/* XSTA d(3) Geocentric position of the IGS station (Note 1) */
/* T d Centuries since J2000 */
/* Returned: */
/* XCORSTA d(3) In phase and out of phase station corrections */
/* for diurnal band (Note 2) */
/* Notes: */
/* 1) The IGS station is in ITRF co-rotating frame. All coordinates are */
/* expressed in meters. */
/* 2) All coordinates are expressed in meters. */
/* Test case: */
/* given input: XSTA(1) = 4075578.385D0 meters */
/* XSTA(2) = 931852.890D0 meters */
/* XSTA(3) = 4801570.154D0 meters */
/* T = 0.1059411362080767D0 Julian centuries */
/* expected output: XCORSTA(1) = -0.9780962849562107762D-04 meters */
/* XCORSTA(2) = -0.2236349699932734273D-04 meters */
/* XCORSTA(3) = 0.3561945821351565926D-03 meters */
/* References: */
/* Mathews, P. M., Dehant, V., and Gipson, J. M., 1997, ''Tidal station */
/* displacements," J. Geophys. Res., 102(B9), pp. 20,469-20,477 */
/* Petit, G. and Luzum, B. (eds.), IERS Conventions (2010), */
/* IERS Technical Note No. 36, BKG (2010) */
/* Revisions: */
/* 1996 March 23 V. Dehant Original code */
/* 2009 August 07 B.E. Stetzler Initial standardization of code */
/* and found unnecessary variables tau */
/* and fhr */
/* 2009 August 07 B.E. Stetzler Provided a test case */
/* 2009 August 07 B.E. Stetzler Capitalized all variables for */
/* Fortran 77 compatibility */
/* 2010 October 20 B.E. Stetzler Input T corrected to be number of */
/* centuries since J2000 */
/* ----------------------------------------------------------------------- */
/* Parameter adjustments */
--xcorsta;
--xsta;
/* Function Body */
deg2rad = .017453292519943295;
/* Compute the phase angles in degrees. */
s = ((*t * 1.85139e-6 - .0014663889) * *t + 481267.88194) * *t +
218.31664563;
pr = (((*t * 7e-9 + 2.1e-8) * *t + 3.08889e-4) * *t + 1.396971278) * *t;
s += pr;
h__ = (((*t * -6.54e-9 + 2e-8) * *t + 3.0322222e-4) * *t + 36000.7697489)
* *t + 280.46645;
p = (((*t * 5.263e-8 - 1.24991e-5) * *t - .01032172222) * *t +
4069.01363525) * *t + 83.35324312;
zns = (((*t * 1.65e-8 - 2.13944e-6) * *t - .00207561111) * *t +
1934.13626197) * *t + 234.95544499;
ps = (((*t * -3.34e-9 - 1.778e-8) * *t + 4.5688889e-4) * *t +
1.71945766667) * *t + 282.93734098;
/* Computing 2nd power */
d__1 = xsta[1];
/* Computing 2nd power */
d__2 = xsta[2];
/* Computing 2nd power */
d__3 = xsta[3];
rsta = sqrt(d__1 * d__1 + d__2 * d__2 + d__3 * d__3);
sinphi = xsta[3] / rsta;
/* Computing 2nd power */
d__1 = xsta[1];
/* Computing 2nd power */
d__2 = xsta[2];
cosphi = sqrt(d__1 * d__1 + d__2 * d__2) / rsta;
cosla = xsta[1] / cosphi / rsta;
sinla = xsta[2] / cosphi / rsta;
/* Reduce angles to between the range 0 and 360. */
s = d_mod(&s, &c_b2);
/* TAU = DMOD(TAU,360D0) */
h__ = d_mod(&h__, &c_b2);
p = d_mod(&p, &c_b2);
zns = d_mod(&zns, &c_b2);
ps = d_mod(&ps, &c_b2);
dr_tot__ = 0.;
dn_tot__ = 0.;
for (i__ = 1; i__ <= 3; ++i__) {
xcorsta[i__] = 0.;
/* L99: */
}
for (j = 1; j <= 5; ++j) {
thetaf = (datdi[j * 9 - 9] * s + datdi[j * 9 - 8] * h__ + datdi[j * 9
- 7] * p + datdi[j * 9 - 6] * zns + datdi[j * 9 - 5] * ps) *
deg2rad;
/* Computing 2nd power */
d__1 = sinphi;
/* Computing 2nd power */
d__2 = sinphi;
dr = datdi[j * 9 - 4] * (d__1 * d__1 * 3. - 1.) / 2. * cos(thetaf) +
datdi[j * 9 - 2] * (d__2 * d__2 * 3. - 1.) / 2. * sin(thetaf);
dn = datdi[j * 9 - 3] * (cosphi * sinphi * 2.) * cos(thetaf) + datdi[
j * 9 - 1] * (cosphi * sinphi * 2.) * sin(thetaf);
de = 0.;
dr_tot__ += dr;
dn_tot__ += dn;
xcorsta[1] = xcorsta[1] + dr * cosla * cosphi - de * sinla - dn *
sinphi * cosla;
xcorsta[2] = xcorsta[2] + dr * sinla * cosphi + de * cosla - dn *
sinphi * sinla;
xcorsta[3] = xcorsta[3] + dr * sinphi + dn * cosphi;
/* L98: */
}
for (i__ = 1; i__ <= 3; ++i__) {
xcorsta[i__] /= 1e3;
/* L97: */
}
return 0;
/* Finished. */
/* +---------------------------------------------------------------------- */
/* Copyright (C) 2008 */
/* IERS Conventions Center */
/* ================================== */
/* IERS Conventions Software License */
/* ================================== */
/* NOTICE TO USER: */
/* BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS */
/* WHICH APPLY TO ITS USE. */
/* 1. The Software is provided by the IERS Conventions Center ("the */
/* Center"). */
/* 2. Permission is granted to anyone to use the Software for any */
/* purpose, including commercial applications, free of charge, */
/* subject to the conditions and restrictions listed below. */
/* 3. You (the user) may adapt the Software and its algorithms for your */
/* own purposes and you may distribute the resulting "derived work" */
/* to others, provided that the derived work complies with the */
/* following requirements: */
/* a) Your work shall be clearly identified so that it cannot be */
/* mistaken for IERS Conventions software and that it has been */
/* neither distributed by nor endorsed by the Center. */
/* b) Your work (including source code) must contain descriptions of */
/* how the derived work is based upon and/or differs from the */
/* original Software. */
/* c) The name(s) of all modified routine(s) that you distribute */
/* shall be changed. */
/* d) The origin of the IERS Conventions components of your derived */
/* work must not be misrepresented; you must not claim that you */
/* wrote the original Software. */
/* e) The source code must be included for all routine(s) that you */
/* distribute. This notice must be reproduced intact in any */
/* source distribution. */
/* 4. In any published work produced by the user and which includes */
/* results achieved by using the Software, you shall acknowledge */
/* that the Software was used in obtaining those results. */
/* 5. The Software is provided to the user "as is" and the Center makes */
/* no warranty as to its use or performance. The Center does not */
/* and cannot warrant the performance or results which the user may */
/* obtain by using the Software. The Center makes no warranties, */
/* express or implied, as to non-infringement of third party rights, */
/* merchantability, or fitness for any particular purpose. In no */
/* event will the Center be liable to the user for any consequential, */
/* incidental, or special damages, including any lost profits or lost */
/* savings, even if a Center representative has been advised of such */
/* damages, or for any claim by any third party. */
/* Correspondence concerning IERS Conventions software should be */
/* addressed as follows: */
/* Gerard Petit */
/* Internet email: gpetit[at]bipm.org */
/* Postal address: IERS Conventions Center */
/* Time, frequency and gravimetry section, BIPM */
/* Pavillon de Breteuil */
/* 92312 Sevres FRANCE */
/* or */
/* Brian Luzum */
/* Internet email: brian.luzum[at]usno.navy.mil */
/* Postal address: IERS Conventions Center */
/* Earth Orientation Department */
/* 3450 Massachusetts Ave, NW */
/* Washington, DC 20392 */
/* ----------------------------------------------------------------------- */
} /* step2lon_ */
/* $Procedure DPSPCE ( Propagate a two line element set for deep space ) */
/* Subroutine */ int dpspce_(doublereal *time, doublereal *geophs, doublereal
*elems, doublereal *state)
{
/* Initialized data */
static logical doinit = TRUE_;
static logical first = TRUE_;
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
double pow_dd(doublereal *, doublereal *), cos(doublereal), sqrt(
doublereal), sin(doublereal), d_mod(doublereal *, doublereal *),
atan2(doublereal, doublereal);
/* Local variables */
static doublereal coef, eeta, aodp, delo, capu, uang, xmdf, xinc, xmam,
aynl, elsq, temp;
static logical cont;
static doublereal rdot, cosu, sinu, coef1, t2cof, temp1, temp2, temp3,
temp4, temp5, cos2u, temp6;
extern /* Subroutine */ int zzdpinit_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *);
static doublereal sin2u, a, e;
static integer i__;
static doublereal m[3], n[3], s, u[3], v[3], betal, scale, betao;
extern /* Subroutine */ int chkin_(char *, ftnlen);
static doublereal epoch, ecose, aycof, esine, a3ovk2, tempa, tempe, bstar,
cosio, xincl, etasq, rfdot, sinio, a1, rdotk, c1, c2, cosuk, c4,
qoms24, sinuk, templ, x1m5th, x1mth2, x3thm1, x7thm1, psisq,
xinck, xlcof, xmdot, xnode, xnodp;
extern doublereal twopi_(void);
static doublereal s4;
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
static doublereal betao2, theta2, ae, xhdot1, ao, em, eo, qoms2t, pl,
omgadf, rk, qo, uk, so;
extern doublereal halfpi_(void);
static doublereal xl, xn, omegao;
extern /* Subroutine */ int latrec_(doublereal *, doublereal *,
doublereal *, doublereal *);
static doublereal perige, xnodcf, xnoddf, tsince, xnodek, omgdot, rfdotk,
xnodeo;
extern /* Subroutine */ int chkout_(char *, ftnlen);
static doublereal ck2, lstelm[10], ck4, cosepw, sinepw, xkmper, xnodot,
lstphs[8];
extern logical return_(void);
static doublereal pinvsq, xj2, xj3, xj4, eta, axn, xke, ayn, epw, tsi,
xll, xmo, xno, tsq, xlt, del1;
extern /* Subroutine */ int zzdpsec_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
static doublereal pio2;
extern /* Subroutine */ int zzdpper_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *);
static doublereal pix2;
/* $ Abstract */
/* This routine propagates NORAD two-line element data for */
/* earth orbiting deep space vehicles (a vehicle with an */
/* orbital period more than 225 minutes). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* EPHEMERIS */
/* TWO LINE ELEMENTS */
/* DEEP SPACE PROPAGATOR */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* TIME I Time for state evaluation in seconds past ephemeris */
/* epoch J2000. */
/* GEOPHS I The array of geophysical constants */
/* ELEMS I Array of orbit elements */
/* STATE O State vector at TIME */
/* $ Detailed_Input */
/* TIME is the epoch in seconds past ephemeris epoch J2000 */
/* to produced a state from the input elements. */
/* GEOPHS is a collection of 8 geophysical constants needed */
/* for computing a state. The order of these */
/* constants must be: */
/* GEOPHS(1) = J2 gravitational harmonic for earth */
/* GEOPHS(2) = J3 gravitational harmonic for earth */
/* GEOPHS(3) = J4 gravitational harmonic for earth */
/* These first three constants are dimensionless. */
/* GEOPHS(4) = KE: Square root of the GM for earth where */
/* GM is expressed in earth radii cubed per */
/* minutes squared. */
/* GEOPHS(5) = QO: Low altitude bound for atmospheric */
/* model in km. */
/* GEOPHS(6) = SO: High altitude bound for atmospheric */
/* model in km. */
/* GEOPHS(7) = RE: Equatorial radius of the earth in km. */
/* GEOPHS(8) = AE: Distance units/earth radius */
/* (normally 1) */
/* Below are currently recommended values for these */
/* items: */
/* J2 = 1.082616D-3 */
/* J3 = -2.53881D-6 */
/* J4 = -1.65597D-6 */
/* The next item is the square root of GM for the */
/* earth given in units of earth-radii**1.5/Minute */
/* KE = 7.43669161D-2 */
/* The next two items define the top and */
/* bottom of the atmospheric drag model */
/* used by the type 10 ephemeris type. */
/* Don't adjust these unless you understand */
/* the full implications of such changes. */
/* QO = 120.0D0 */
/* SO = 78.0D0 */
/* The ER value is the equatorial radius in km */
/* of the earth as used by NORAD. */
/* ER = 6378.135D0 */
/* The value of AE is the number of */
/* distance units per earth radii used by */
/* the NORAD state propagation software. */
/* The value is 1 unless you've got */
/* a very good understanding of the NORAD */
/* routine SGP4 and the affect of changing */
/* this value.. */
/* AE = 1.0D0 */
/* ELEMS is an array containing two-line element data */
/* as prescribed below. The elements XNDD6O and BSTAR */
/* must have been scaled by the proper exponent stored */
/* in the two line elements set. Moreover, the */
/* various items must be converted to the units shown */
/* here. */
/* ELEMS ( 1 ) = XNDT2O in radians/minute**2 */
/* ELEMS ( 2 ) = XNDD6O in radians/minute**3 */
/* ELEMS ( 3 ) = BSTAR */
/* ELEMS ( 4 ) = XINCL in radians */
/* ELEMS ( 5 ) = XNODEO in radians */
/* ELEMS ( 6 ) = EO */
/* ELEMS ( 7 ) = OMEGAO in radians */
/* ELEMS ( 8 ) = XMO in radians */
/* ELEMS ( 9 ) = XNO in radians/minute */
/* ELEMS ( 10 ) = EPOCH of the elements in seconds */
/* past ephemeris epoch J2000. */
/* $ Detailed_Output */
/* STATE A 6 vector containing the X, Y, Z, Vx, Vy, Vz */
/* coordinates in the inertial frame (double */
/* precision). */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This subroutine is an extensive rewrite of the SDP4 */
/* routine as described in the Spacetrack 3 report. All common */
/* blocks were removed and all variables are explicitly defined. */
/* The removal of common blocks causes the set of routines to */
/* execute slower than the original version of SDP4. However the */
/* stability improves especially as concerns memory and */
/* expanded internal documentation. */
/* Trivial or redundant variables have been eliminated. */
/* R removed, occurrence replaced with RK */
/* E6A renamed TOL */
/* THETA4 removed, relevant equation recast in Horner's form */
/* i.e. something like x^4 + x^2 -> x^2 ( x^2 + 1 ) */
/* U renamed UANG, U is now a euclidean 3 vector. */
/* Ux,Uy,Uz removed, replaced with 3-vector U */
/* Vx,Vy,Vz removed, replaced with 3-vector V */
/* OMEGAQ removed, usage replaced with OMEGAO */
/* OMGDT removed, same variable as OMGDOT, so all occurrences */
/* replaced with OMGDOT */
/* SSL,SSG replaced with the 5-vector SSX */
/* SSH,SSE */
/* SSI */
/* Three functions present in the original Spacetrack report, ACTAN, */
/* FMOD2P and THETAG, have been either replaced with an intrinsic */
/* FORTRAN function (ACTAN -> DATAN2, FMOD2P -> DMOD) or recoded */
/* using SPICELIB calls (THETAG). */
/* The code at the end of this subroutine which calculates */
/* orientation vectors, was replaced with a set of calls to */
/* SPICELIB vector routines. */
/* A direct comparison of output from the original Spacetrack 3 code */
/* and these NAIF routines for the same elements and time parameters */
/* will produce unacceptably different results. */
/* $ Examples */
/* C--- Load the geophysical constants kernel and the leapsecond */
/* kernel */
/* CALL FURNSH( '/Users/ewright/lib/geophysical.ker' ) */
/* CALL FURNSH( '/kernels/gen/lsk/naif0008.tls' ) */
/* C--- Define a vehicle element array, TDRS 4 Geosynch */
/* LINES( 1 ) = '1 19883U 89021B 97133.05943164 -.00000277 ' */
/* .// '00000-0 10000-3 0 3315' */
/* LINES( 2 ) = '2 19883 0.5548 86.7278 0001786 312.2904 ' */
/* .// '172.2391 1.00269108202415' */
/* C--- Identify the earliest first year for the elements */
/* FRSTYR = 1988 */
/* C--- Parse the elements to something SPICE can use */
/* CALL GETELM ( FRSTYR, LINES, EPOCH, ELEMS ) */
/* C--- Final time past epoch, 1400 mins (in seconds) */
/* TF = 1440.D0 * 60.D0 */
/* C--- Step size for elements output 360 mins (in seconds) */
/* DELT = 360.D0 * 60.D0 */
/* C--- Start time keyed off epoch */
/* TIME = EPOCH - 2.D0 * DELT */
/* DO WHILE ( DABS(TIME - EPOCH) .LE. DABS(TF) ) */
/* CALL DPSPCE ( TIME, GEOPHS, ELEMS, STATE ) */
/* WRITE(*, FMT ='(7F17.8)' ) (TIME-EPOCH)/60.D0, */
/* . (STATE(I),I=1,6) */
/* TIME = TIME + DELT */
/* END DO */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* Hoots, Felix R., Ronald L. Roehrich (31 December 1988). "Models */
/* for Propagation of NORAD Element Sets". United States Department */
/* of Defense Spacetrack Report (3). */
/* $ Author_and_Institution */
/* E.D. Wright (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 23-JAN-2013 (EDW) */
/* Corrected initialization block error. The ZZDPINIT call */
/* causes a side-effect required for each DPSPCE call. */
/* The ZZDPINIT call now occurs outside the initialization */
/* block. Note from designer, side-effects are bad. */
/* Added proper citation for Hoots paper. */
/* - SPICELIB Version 1.2.2, 22-AUG-2006 (EDW) */
/* Replaced references to LDPOOL with references */
/* to FURNSH. */
/* - SPICELIB Version 1.2.1, DEC-27-2000 (EDW) */
/* Corrected error in header documentation. Horner's Rule */
/* not Butcher's. */
/* - SPICELIB Version 1.2.0, MAR-24-1999 (EDW) */
/* Documentation expanded to include modifications made */
/* to private routines. Some english errors corrected. */
/* Alphabetized variable declaration lists. */
/* Temporary variable TEMP removed. OMGDOT argument added to */
/* ZZDPSEC call. */
/* - SPICELIB Version 1.1.0, OCT-05-1998 (WLT) */
/* Forced initialization section until we can figure out */
/* why it doesn't work on SUNs. */
/* - SPICELIB Version 1.0.1, MAR-11-1998 (EDW) */
/* Corrected error in header describing GEOPHS array. */
/* - SPICELIB Version 1.0.0, NOV-11-1998 (EDW) */
/* -& */
/* $ Index_Entries */
/* NORAD two line elements deep space evaluator */
/* -& */
/* Local variables */
/* Define parameters for convergence tolerance and the value for 2/3, */
/* 0 and 1. */
/* The geophysical Quantities */
/* Elements */
/* Other quantities */
/* SPICELIB routines */
/* Save everything. */
/* Set initialization flags */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DPSPCE", (ftnlen)6);
}
/* If this is the very first time into this routine, set these */
/* values. */
if (first) {
pix2 = twopi_();
pio2 = halfpi_();
first = FALSE_;
}
/* If initialization flag is FALSE, then this is not the first */
/* call to this routine. Check the stuff. */
if (! doinit) {
/* Check whether the current and last constants and elements */
/* match. If not, we need to reinitialize everything */
/* since the propagation is dependent on the value of these */
/* arrays. */
for (i__ = 1; i__ <= 8; ++i__) {
if (lstphs[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge(
"lstphs", i__1, "dpspce_", (ftnlen)547)] != geophs[(i__2 =
i__ - 1) < 8 && 0 <= i__2 ? i__2 : s_rnge("geophs", i__2,
"dpspce_", (ftnlen)547)]) {
doinit = TRUE_;
}
}
for (i__ = 1; i__ <= 10; ++i__) {
if (lstelm[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge(
"lstelm", i__1, "dpspce_", (ftnlen)556)] != elems[(i__2 =
i__ - 1) < 10 && 0 <= i__2 ? i__2 : s_rnge("elems", i__2,
"dpspce_", (ftnlen)556)]) {
doinit = TRUE_;
}
}
}
/* Initialization block. Always called on the initial entry and */
/* anytime the geophysical or elements array changes. */
if (doinit) {
doinit = FALSE_;
/* Retrieve the geophysical constants from the GEOPHS array */
xj2 = geophs[0];
xj3 = geophs[1];
xj4 = geophs[2];
xke = geophs[3];
qo = geophs[4];
so = geophs[5];
xkmper = geophs[6];
ae = geophs[7];
/* Save the geophysical constants for later comparison */
for (i__ = 1; i__ <= 8; ++i__) {
lstphs[(i__1 = i__ - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("lstphs",
i__1, "dpspce_", (ftnlen)590)] = geophs[(i__2 = i__ - 1)
< 8 && 0 <= i__2 ? i__2 : s_rnge("geophs", i__2, "dpspce_"
, (ftnlen)590)];
}
/* Unpack the elements array. */
bstar = elems[2];
xincl = elems[3];
xnodeo = elems[4];
eo = elems[5];
omegao = elems[6];
xmo = elems[7];
xno = elems[8];
epoch = elems[9];
/* Save the elements for later comparison */
for (i__ = 1; i__ <= 10; ++i__) {
lstelm[(i__1 = i__ - 1) < 10 && 0 <= i__1 ? i__1 : s_rnge("lstelm"
, i__1, "dpspce_", (ftnlen)610)] = elems[(i__2 = i__ - 1)
< 10 && 0 <= i__2 ? i__2 : s_rnge("elems", i__2, "dpspce_"
, (ftnlen)610)];
}
/* Set common variables, the init flag and calculate the */
/* WGS-72 physical and geopotential constants */
/* CK2 = 0.5 * J2 * AE^2 */
/* CK4 = -0.375 * J4 * AE^4 */
/* These are values calculated only once and then saved for */
/* future access. */
/* Computing 2nd power */
d__1 = ae;
ck2 = xj2 * .5 * (d__1 * d__1);
/* Computing 4th power */
d__1 = ae, d__1 *= d__1;
ck4 = xj4 * -.375 * (d__1 * d__1);
/* Computing 4th power */
d__1 = (qo - so) * ae / xkmper, d__1 *= d__1;
qoms2t = d__1 * d__1;
s = ae * (so / xkmper + 1.);
/* Recover original mean motion (XNODP) and semimajor axis (AODP) */
/* from input elements */
d__1 = xke / xno;
a1 = pow_dd(&d__1, &c_b19);
cosio = cos(xincl);
/* Computing 2nd power */
d__1 = cosio;
theta2 = d__1 * d__1;
x3thm1 = theta2 * 3. - 1.;
/* Computing 2nd power */
d__1 = eo;
betao2 = 1. - d__1 * d__1;
betao = sqrt(betao2);
/* Computing 2nd power */
d__1 = a1;
del1 = ck2 * 1.5 * x3thm1 / (d__1 * d__1 * betao * betao2);
ao = a1 * (1. - del1 * (del1 * (del1 * 1.654320987654321 + 1.) +
.33333333333333331));
/* Computing 2nd power */
d__1 = ao;
delo = ck2 * 1.5 * x3thm1 / (d__1 * d__1 * betao * betao2);
xnodp = xno / (delo + 1.);
aodp = ao / (1. - delo);
/* For perigee below 156 km, the values of S and QOMS2T are */
/* altered */
s4 = s;
qoms24 = qoms2t;
perige = (aodp * (1. - eo) - ae) * xkmper;
if (perige < 156.) {
s4 = perige - 78.;
if (perige > 98.) {
/* Computing 4th power */
d__1 = (120. - s4) * ae / xkmper, d__1 *= d__1;
qoms24 = d__1 * d__1;
s4 = s4 / xkmper + ae;
} else {
s4 = 20.;
}
}
/* Computing 2nd power */
d__1 = aodp;
/* Computing 2nd power */
d__2 = betao2;
pinvsq = 1. / (d__1 * d__1 * (d__2 * d__2));
tsi = 1. / (aodp - s4);
eta = aodp * eo * tsi;
/* Computing 2nd power */
d__1 = eta;
etasq = d__1 * d__1;
eeta = eo * eta;
psisq = (d__1 = 1. - etasq, abs(d__1));
/* Computing 4th power */
d__1 = tsi, d__1 *= d__1;
coef = qoms24 * (d__1 * d__1);
coef1 = coef / pow_dd(&psisq, &c_b20);
c2 = coef1 * xnodp * (aodp * (etasq * 1.5 + 1. + eeta * (etasq + 4.))
+ ck2 * .75 * tsi / psisq * x3thm1 * (etasq * 3. * (etasq +
8.) + 8.));
c1 = bstar * c2;
sinio = sin(xincl);
/* Computing 3rd power */
d__1 = ae;
a3ovk2 = -xj3 / ck2 * (d__1 * (d__1 * d__1));
x1mth2 = 1. - theta2;
c4 = xnodp * 2. * coef1 * aodp * betao2 * (eta * (etasq * .5 + 2.) +
eo * (etasq * 2. + .5) - ck2 * 2. * tsi / (aodp * psisq) * (
x3thm1 * -3. * (1. - eeta * 2. + etasq * (1.5 - eeta * .5)) +
x1mth2 * .75 * (etasq * 2. - eeta * (etasq + 1.)) * cos(
omegao * 2.)));
temp1 = ck2 * 3. * pinvsq * xnodp;
temp2 = temp1 * ck2 * pinvsq;
temp3 = ck4 * 1.25 * pinvsq * pinvsq * xnodp;
xmdot = xnodp + temp1 * .5 * betao * x3thm1 + temp2 * .0625 * betao *
(theta2 * (theta2 * 137. - 78.) + 13.);
x1m5th = 1. - theta2 * 5.;
omgdot = temp1 * -.5 * x1m5th + temp2 * .0625 * (theta2 * (theta2 *
395. - 114.) + 7.) + temp3 * (theta2 * (theta2 * 49. - 36.) +
3.);
xhdot1 = -temp1 * cosio;
xnodot = xhdot1 + (temp2 * .5 * (4. - theta2 * 19.) + temp3 * 2. * (
3. - theta2 * 7.)) * cosio;
xnodcf = betao2 * 3.5 * xhdot1 * c1;
t2cof = c1 * 1.5;
xlcof = a3ovk2 * .125 * sinio * (cosio * 5. + 3.) / (cosio + 1.);
aycof = a3ovk2 * .25 * sinio;
x7thm1 = theta2 * 7. - 1.;
}
zzdpinit_(&aodp, &xmdot, &omgdot, &xnodot, &xnodp, elems);
/* Get the time since the EPOCH in minutes. */
tsince = (*time - epoch) / 60.;
/* Update for secular gravity and atmospheric drag */
xmdf = xmo + xmdot * tsince;
omgadf = omegao + omgdot * tsince;
xnoddf = xnodeo + xnodot * tsince;
tsq = tsince * tsince;
xnode = xnoddf + xnodcf * tsq;
tempa = 1. - c1 * tsince;
tempe = bstar * c4 * tsince;
templ = t2cof * tsq;
xn = xnodp;
/* Calculate the secular terms. */
zzdpsec_(&xmdf, &omgadf, &xnode, &em, &xinc, &xn, &tsince, elems, &omgdot)
;
d__1 = xke / xn;
/* Computing 2nd power */
d__2 = tempa;
a = pow_dd(&d__1, &c_b19) * (d__2 * d__2);
e = em - tempe;
xmam = xmdf + xnodp * templ;
/* Calculate the periodic terms. */
zzdpper_(&tsince, &e, &xinc, &omgadf, &xnode, &xmam);
xl = xmam + omgadf + xnode;
xn = xke / pow_dd(&a, &c_b22);
/* Long period periodics */
axn = e * cos(omgadf);
/* Computing 2nd power */
d__1 = e;
temp = 1. / (a * (1. - d__1 * d__1));
xll = temp * xlcof * axn;
aynl = temp * aycof;
xlt = xl + xll;
ayn = e * sin(omgadf) + aynl;
/* Solve Kepler's equation */
/* U = EPW - AXN * SIN(EPW) + AYN * COS(EPW) */
/* Where */
/* AYN = E * SIN(OMEGA) + AYNL */
/* AXN = E * COS(OMEGA) */
/* And */
/* AYNL = -0.50D0 * SINIO * AE * J3 / (J2 * A * (1.0D0 - E^2)) */
/* Get the mod division of CAPU with 2 Pi */
d__1 = xlt - xnode;
capu = d_mod(&d__1, &pix2);
if (capu < 0.) {
capu += pix2;
}
/* Set initial states for the Kepler solution */
epw = capu;
cont = TRUE_;
while(cont) {
temp2 = epw;
sinepw = sin(temp2);
cosepw = cos(temp2);
temp3 = axn * sinepw;
temp4 = ayn * cosepw;
temp5 = axn * cosepw;
temp6 = ayn * sinepw;
epw = (capu - temp4 + temp3 - temp2) / (1. - temp5 - temp6) + temp2;
/* Test for convergence against the defined tolerance */
if ((d__1 = epw - temp2, abs(d__1)) <= 1e-6) {
cont = FALSE_;
}
}
/* Short period preliminary quantities */
ecose = temp5 + temp6;
esine = temp3 - temp4;
elsq = axn * axn + ayn * ayn;
temp = 1. - elsq;
pl = a * temp;
rk = a * (1. - ecose);
temp1 = 1. / rk;
rdot = xke * sqrt(a) * esine * temp1;
rfdot = xke * sqrt(pl) * temp1;
temp2 = a * temp1;
betal = sqrt(temp);
temp3 = 1. / (betal + 1.);
cosu = temp2 * (cosepw - axn + ayn * esine * temp3);
sinu = temp2 * (sinepw - ayn - axn * esine * temp3);
/* Compute the angle from the x-axis of the point ( COSU, SINU ) */
if (sinu != 0. || cosu != 0.) {
uang = atan2(sinu, cosu);
if (uang < 0.) {
uang += pix2;
}
} else {
uang = 0.;
}
sin2u = sinu * 2. * cosu;
cos2u = cosu * 2. * cosu - 1.;
temp1 = ck2 * (1. / pl);
temp2 = temp1 * (1. / pl);
/* Update for short periodics */
rk = rk * (1. - temp2 * 1.5 * betal * x3thm1) + temp1 * .5 * x1mth2 *
cos2u;
uk = uang - temp2 * .25 * x7thm1 * sin2u;
xnodek = xnode + temp2 * 1.5 * cosio * sin2u;
xinck = xinc + temp2 * 1.5 * cosio * sinio * cos2u;
rdotk = rdot - xn * temp1 * x1mth2 * sin2u;
rfdotk = rfdot + xn * temp1 * (x1mth2 * cos2u + x3thm1 * 1.5);
/* Orientation vectors are calculated by */
/* U = M sin(uk) + N cos(uk) */
/* V = M cos(uk) - N sin(uk) */
/* Where M and N are euclidean 3 vectors */
/* M = (-sin(xnodek)cos(xinck), cos(xnodek)cos(xinck), sin(xinck) ) */
/* N = ( cos(xnodek), sin(xnodek) , 0 ) */
sinuk = sin(uk);
cosuk = cos(uk);
/* Use LATREC to generate M and N. M is a latitude to rectangle */
/* conversion of a unit vector where PI/2 + XNODEK is the longitude */
d__1 = pio2 + xnodek;
latrec_(&c_b23, &d__1, &xinck, m);
latrec_(&c_b23, &xnodek, &c_b25, n);
/* Sum the components to obtain U and V */
vlcom_(&sinuk, m, &cosuk, n, u);
d__1 = -sinuk;
vlcom_(&cosuk, m, &d__1, n, v);
/* Determine the position and velocity then pack the STATE vector */
/* with value scaled to KM and KPS. */
/* R = RK U + 0 V */
/* V = RKDOT U + RK RFDOT V */
scale = xkmper / ae;
d__1 = rk * scale;
vlcom_(&d__1, u, &c_b25, v, state);
/* Now scale to KPS for the velocity component */
scale /= 60.;
d__1 = rdotk * scale;
d__2 = rfdotk * scale;
vlcom_(&d__1, u, &d__2, v, &state[3]);
/* All done now.... */
chkout_("DPSPCE", (ftnlen)6);
return 0;
} /* dpspce_ */
/* $Procedure CONICS ( Determine state from conic elements ) */
/* Subroutine */ int conics_(doublereal *elts, doublereal *et, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double cos(doublereal), sin(doublereal), sqrt(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal cnci, argp, snci, cosi, sini, cosn, sinn;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
doublereal cosw, sinw, n, v;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal lnode;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal m0;
extern doublereal twopi_(void);
doublereal t0;
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal dt, rp, mu, basisp[3], period, basisq[3];
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
doublereal pstate[6], ainvrs;
extern /* Subroutine */ int setmsg_(char *, ftnlen);
extern logical return_(void);
doublereal ecc, inc;
/* $ Abstract */
/* Determine the state (position, velocity) of an orbiting body */
/* from a set of elliptic, hyperbolic, or parabolic orbital */
/* elements. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* CONIC */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ELTS I Conic elements. */
/* ET I Input time. */
/* STATE O State of orbiting body at ET. */
/* $ Detailed_Input */
/* ELTS are conic elements describing the orbit of a body */
/* around a primary. The elements are, in order: */
/* RP Perifocal distance. */
/* ECC Eccentricity. */
/* INC Inclination. */
/* LNODE Longitude of the ascending node. */
/* ARGP Argument of periapse. */
/* M0 Mean anomaly at epoch. */
/* T0 Epoch. */
/* MU Gravitational parameter. */
/* Units are km, rad, rad/sec, km**3/sec**2. The epoch */
/* is given in ephemeris seconds past J2000. The same */
/* elements are used to describe all three types */
/* (elliptic, hyperbolic, and parabolic) of conic orbit. */
/* ET is the time at which the state of the orbiting body */
/* is to be determined, in ephemeris seconds J2000. */
/* $ Detailed_Output */
/* STATE is the state (position and velocity) of the body at */
/* time ET. Components are x, y, z, dx/dt, dy/dt, dz/dt. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity supplied is less than 0, the error */
/* 'SPICE(BADECCENTRICITY)' is signalled. */
/* 2) If a non-positive periapse distance is supplied, the error */
/* 'SPICE(BADPERIAPSEVALUE)' is signalled. */
/* 3) If a non-positive value for the attracting mass is supplied, */
/* the error 'SPICE(BADGM)', is signalled. */
/* 4) Errors such as an out of bounds value for ET are diagnosed */
/* by routines called by this routine. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* Let VINIT contain the initial state of a spacecraft relative to */
/* the center of a planet at epoch ET, and let GM be the gravitation */
/* parameter of the planet. The call */
/* CALL OSCELT ( VINIT, ET, GM, ELTS ) */
/* produces a set of osculating elements describing the nominal */
/* orbit that the spacecraft would follow in the absence of all */
/* other bodies in the solar system and non-gravitational forces */
/* on the spacecraft. */
/* Now let STATE contain the state of the same spacecraft at some */
/* other epoch, LATER. The difference between this state and the */
/* state predicted by the nominal orbit at the same epoch can be */
/* computed as follows. */
/* CALL CONICS ( ELTS, LATER, NOMINAL ) */
/* CALL VSUBG ( NOMINAL, STATE, 6, DIFF ) */
/* WRITE (*,*) 'Perturbation in x, dx/dt = ', DIFF(1), DIFF(4) */
/* WRITE (*,*) ' y, dy/dt = ', DIFF(2), DIFF(5) */
/* WRITE (*,*) ' z, dz/dt = ', DIFF(3), DIFF(6) */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* [1] Roger Bate, Fundamentals of Astrodynamics, Dover, 1971. */
/* $ Author_and_Institution */
/* I.M. Underwood (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 4.0.0, 26-MAR-1998 (WLT) */
/* There was a coding error in the computation of the mean */
/* anomaly in the parabolic case. This problem has been */
/* corrected. */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* An error in the hyperbolic state generation was corrected. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* state from conic elements */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 3.0.1, 15-OCT-1996 (WLT) */
/* Corrected a typo in the description of the units associated */
/* with the input elements. */
/* - SPICELIB Version 3.0.0, 12-NOV-1992 (WLT) */
/* The routine was re-written to make use of NAIF's universal */
/* variables formulation for state propagation (PROP2B). As */
/* a result, several problems were simultaneously corrected. */
/* A major bug was fixed that caused improper state evaluations */
/* for ET's that precede the epoch of the elements in the */
/* elliptic case. */
/* A danger of non-convergence in the solution of Kepler's */
/* equation has been eliminated. */
/* In addition to this reformulation of CONICS checks were */
/* installed that ensure the elements supplied are physically */
/* meaningful. Eccentricity must be non-negative. The */
/* distance at periapse and central mass must be positive. If */
/* not errors are signalled. */
/* These changes were prompted by the discovery that the old */
/* formulation had a severe bug for elliptic orbits and epochs */
/* prior to the epoch of the input elements, and by the discovery */
/* that the time of flight routines had problems with convergence. */
/* - SPICELIB Version 2.0.0, 19-APR-1991 (WLT) */
/* The original version of the routine had a bug in that */
/* it attempted to restrict the hyperbolic anomaly to */
/* the interval 0 to 2*PI. This has been fixed. */
/* - Beta Version 1.0.1, 27-JAN-1989 (IMU) */
/* Examples section completed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* The only real work required by this routine is the construction */
/* of a preliminary state vector from the input elements. Once this */
/* is in hand, we can simply let the routine PROP2B do the real */
/* work, free from the instabilities inherent in the classical */
/* elements formulation of two-body motion. */
/* To do this we shall construct a basis of vectors that lie in the */
/* plane of the orbit. The first vector P shall point towards the */
/* position of the orbiting body at periapse. The second */
/* vector Q shall point along the velocity vector of the body at */
/* periapse. */
/* The only other consideration is determining an epoch, TP, of */
/* this state and the delta time ET - TP. */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("CONICS", (ftnlen)6);
}
/* Unpack the element vector. */
rp = elts[0];
ecc = elts[1];
inc = elts[2];
lnode = elts[3];
argp = elts[4];
m0 = elts[5];
t0 = elts[6];
mu = elts[7];
/* Handle all of the exceptions first. */
if (ecc < 0.) {
setmsg_("The eccentricity supplied was negative. Only positive value"
"s are meaningful. The value was #", (ftnlen)93);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (rp <= 0.) {
setmsg_("The value of periapse range supplied was non-positive. Onl"
"y positive values are allowed. The value supplied was #. ", (
ftnlen)117);
errdp_("#", &rp, (ftnlen)1);
sigerr_("SPICE(BADPERIAPSEVALUE)", (ftnlen)23);
chkout_("CONICS", (ftnlen)6);
return 0;
}
if (mu <= 0.) {
setmsg_("The value of GM supplied was non-positive. Only positive v"
"alues are allowed. The value supplied was #. ", (ftnlen)105);
errdp_("#", &mu, (ftnlen)1);
sigerr_("SPICE(BADGM)", (ftnlen)12);
chkout_("CONICS", (ftnlen)6);
return 0;
}
/* First construct the orthonormal basis vectors that span the orbit */
/* plane. */
cosi = cos(inc);
sini = sin(inc);
cosn = cos(lnode);
sinn = sin(lnode);
cosw = cos(argp);
sinw = sin(argp);
snci = sinn * cosi;
cnci = cosn * cosi;
basisp[0] = cosn * cosw - snci * sinw;
basisp[1] = sinn * cosw + cnci * sinw;
basisp[2] = sini * sinw;
basisq[0] = -cosn * sinw - snci * cosw;
basisq[1] = -sinn * sinw + cnci * cosw;
basisq[2] = sini * cosw;
/* Next construct the state at periapse. */
/* The position at periapse is just BASISP scaled by the distance */
/* at periapse. */
/* The velocity must be constructed so that we can get an orbit */
/* of this shape. Recall that the magnitude of the specific angular */
/* momentum vector is given by DSQRT ( MU*RP*(1+ECC) ) */
/* The velocity will be given by V * BASISQ. But we must have the */
/* magnitude of the cross product of position and velocity be */
/* equal to DSQRT ( MU*RP*(1+ECC) ). So we must have */
/* RP*V = DSQRT( MU*RP*(1+ECC) ) */
/* so that: */
v = sqrt(mu * (ecc + 1.) / rp);
vscl_(&rp, basisp, pstate);
vscl_(&v, basisq, &pstate[3]);
/* Finally compute DT the elapsed time since the epoch of periapse. */
/* Ellipses first, since they are the most common. */
if (ecc < 1.) {
/* Recall that: */
/* N ( mean motion ) is given by DSQRT( MU / A**3 ). */
/* But since, A = RP / ( 1 - ECC ) ... */
ainvrs = (1. - ecc) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
period = twopi_() / n;
/* In general the mean anomaly is given by */
/* M = (T - TP) * N */
/* Where TP is the time of periapse passage. M0 is the mean */
/* anomaly at time T0 so that */
/* Thus */
/* M0 = ( T0 - TP ) * N */
/* So TP = T0-M0/N hence the time since periapse at time ET */
/* is given by ET - T0 + M0/N. Finally, since elliptic orbits are */
/* periodic, we can mod this value by the period of the orbit. */
d__1 = *et - t0 + m0 / n;
dt = d_mod(&d__1, &period);
/* Hyperbolas next. */
} else if (ecc > 1.) {
/* Again, recall that: */
/* N ( mean motion ) is given by DSQRT( MU / |A**3| ). */
/* But since, |A| = RP / ( ECC - 1 ) ... */
ainvrs = (ecc - 1.) / rp;
n = sqrt(mu * ainvrs) * ainvrs;
dt = *et - t0 + m0 / n;
/* Finally, parabolas. */
} else {
n = sqrt(mu / (rp * 2.)) / rp;
dt = *et - t0 + m0 / n;
}
/* Now let PROP2B do the work of propagating the state. */
prop2b_(&mu, pstate, &dt, state);
chkout_("CONICS", (ftnlen)6);
return 0;
} /* conics_ */
/* in the file mcidas/data/license.txt */
/* Subroutine */ int solarp_(integer *jday, integer *jtime, real *gha, real *
dec, real *xlat, real *xlon)
{
/* Initialized data */
static integer init = 0;
/* System generated locals */
real r__1, r__2;
doublereal d__1;
/* Builtin functions */
double sin(doublereal), cos(doublereal), sqrt(doublereal), atan2(
doublereal, doublereal), d_mod(doublereal *, doublereal *), r_mod(
real *, real *);
/* Local variables */
static integer i__;
static real pi, px, py, pz, qx, qy, qz, xs, ys, zs, sha;
static doublereal xha;
static real cand;
static doublereal raha;
static real cinc, sand;
static integer iday;
static real cper, sinc, slra, xmmc, sper;
extern real flalo_(integer *);
static real rdpdg;
extern real ftime_(integer *);
static real xfact;
static integer irayd, iepyd;
static real ptime;
static doublereal ecanm1;
static real oeccen;
static doublereal ecanom;
static real asnode;
extern real geolat_(real *, integer *);
static doublereal diftim;
extern doublereal timdif_(integer *, integer *, integer *, integer *);
static real oincli, perhel, xomega, yomega;
static integer irahms, iephms;
static real epsiln, solsid;
static doublereal xmanom;
/* *** $Id: solarp.f,v 1.1 2001/04/16 20:59:07 daves Exp $ *** */
/* SOLARP MOSHER 1074 WINLIB Z HOUR ANGLE AND SOLAR DECL FOR DAY-TIME */
/* $ SUBROUTINE SOLARP(JDAY, JTIME, GHA, DEC, XLAT, XLON) (DAS) */
/* $ COMPUTES GREENWICH HOUR ANGLE AND DECLINATION OF SUN */
/* $ JDAY = (I) INPUT SATELLITE/YEAR/DAY */
/* $ JTIME = (I) INPUT HOUR/MINUTE/SECOND */
/* $ GHA = (R) OUTPUT GREENWICH HOUR ANGLE */
/* $ DEC = (R) OUTPUT DECLINATION */
/* $ XLAT = (R) OUTPUT LATITUDE OF SUN POSITION */
/* $ XLON = (R) OUTPUT LONGITUDE OF SUN POSITION */
/* $$ SOLARP = COMPUTATION, NAVIGATION */
/* ORBITAL CONSTANTS */
/* IEPYD = EPOCH YEAR-DAY */
/* IEPHMS = EPOCH HOUR-MINUTE-SECOND */
/* OECCEN = ECCENTRICITY OF EARTH ORBIT */
/* OINCLI = INCLINATION TO CELESTIAL EQUATOR */
/* PERHEL = PERIHELION */
/* ASNODE = ASCENDING NODE */
/* XMANOM = MEAN ANOMOLY */
/* XMMC = MEAN MOTION CONSTANT */
/* SHA = CELESTIAL HOUR ANGLE */
/* IRAYD = YYDDD WHEN CELESTIAL COOR. SYS. COINCIDES WITH EARTH COO */
/* IRAHMS = HHMMSS WHEN CELESTIAL COOR. SYS. COINCIDES WITH EARTH COO */
/* REAL*8 DABS,DMOD,DSQRT,DSIN,DCOS,DATAN2 */
if (init != 0) {
goto L1;
}
init = 1;
pi = 3.14159265f;
rdpdg = pi / 180.f;
solsid = 1.00273791f;
iepyd = 74004;
iephms = 0;
oeccen = .016722f;
oincli = rdpdg * flalo_(&c_b3);
perhel = rdpdg * flalo_(&c_b4) + pi;
asnode = rdpdg * flalo_(&c__0);
xmmc = 1.1945902048611111e-5f;
sha = 100.26467f;
irayd = 74001;
irahms = 0;
sinc = sin(oincli);
cinc = cos(oincli);
sper = sin(perhel);
cper = cos(perhel);
sand = sin(asnode);
cand = cos(asnode);
px = cper * cand - sper * sand * cinc;
py = cper * sand + sper * cand * cinc;
pz = sper * sinc;
qx = -sper * cand - cper * sand * cinc;
qy = -sper * sand + cper * cand * cinc;
qz = cper * sinc;
L1:
iday = *jday % 100000;
ptime = ftime_(jtime);
diftim = timdif_(&iepyd, &iephms, &iday, jtime);
xmanom = xmmc * diftim;
ecanm1 = xmanom;
epsiln = 1e-8f;
for (i__ = 1; i__ <= 20; ++i__) {
ecanom = xmanom + oeccen * sin(ecanm1);
if ((d__1 = ecanom - ecanm1, abs(d__1)) < epsiln) {
goto L3;
}
/* L2: */
ecanm1 = ecanom;
}
L3:
xomega = cos(ecanom) - oeccen;
/* Computing 2nd power */
r__1 = oeccen;
yomega = sqrt(1.f - r__1 * r__1) * sin(ecanom);
/* Computing 2nd power */
r__1 = xomega;
/* Computing 2nd power */
r__2 = yomega;
xfact = 1.f / sqrt(r__1 * r__1 + r__2 * r__2);
xomega *= xfact;
yomega *= xfact;
xs = xomega * px + yomega * qx;
ys = xomega * py + yomega * qy;
zs = xomega * pz + yomega * qz;
slra = atan2(ys, xs) / rdpdg;
raha = timdif_(&irayd, &irahms, &iday, jtime) * solsid / 4.f;
*gha = ptime * 15.f;
xha = 360.f - sha - raha + slra + *gha;
*gha = d_mod(&xha, &c_b8);
*gha = 360.f - *gha - 2.f;
/* Computing 2nd power */
r__1 = xs;
/* Computing 2nd power */
r__2 = ys;
*dec = atan2(zs, sqrt(r__1 * r__1 + r__2 * r__2)) / rdpdg;
r__1 = *dec * rdpdg;
*xlat = geolat_(&r__1, &c__1) / rdpdg;
*xlon = -(*gha) - ptime * 15.f + 720.f;
*xlon = r_mod(xlon, &c_b10);
return 0;
} /* solarp_ */
/* DECK DXLEGF */
/* Subroutine */ int dxlegf_(doublereal *dnu1, integer *nudiff, integer *mu1,
integer *mu2, doublereal *theta, integer *id, doublereal *pqa,
integer *ipqa, integer *ierror)
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer i__, l;
static doublereal x, sx, pi2, dnu2;
extern /* Subroutine */ int dxred_(doublereal *, integer *, integer *),
dxset_(integer *, integer *, doublereal *, integer *, integer *),
dxpmu_(doublereal *, doublereal *, integer *, integer *,
doublereal *, doublereal *, doublereal *, integer *, doublereal *,
integer *, integer *), dxqmu_(doublereal *, doublereal *,
integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, integer *, integer *), dxqnu_(doublereal
*, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, integer *, integer *),
xermsg_(char *, char *, char *, integer *, integer *, ftnlen,
ftnlen, ftnlen), dxpnrm_(doublereal *, doublereal *, integer *,
integer *, doublereal *, integer *, integer *), dxpmup_(
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *), dxpqnu_(doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
integer *);
/* ***BEGIN PROLOGUE DXLEGF */
/* ***PURPOSE Compute normalized Legendre polynomials and associated */
/* Legendre functions. */
/* ***LIBRARY SLATEC */
/* ***CATEGORY C3A2, C9 */
/* ***TYPE DOUBLE PRECISION (XLEGF-S, DXLEGF-D) */
/* ***KEYWORDS LEGENDRE FUNCTIONS */
/* ***AUTHOR Smith, John M., (NBS and George Mason University) */
/* ***DESCRIPTION */
/* DXLEGF: Extended-range Double-precision Legendre Functions */
/* A feature of the DXLEGF subroutine for Legendre functions is */
/* the use of extended-range arithmetic, a software extension of */
/* ordinary floating-point arithmetic that greatly increases the */
/* exponent range of the representable numbers. This avoids the */
/* need for scaling the solutions to lie within the exponent range */
/* of the most restrictive manufacturer's hardware. The increased */
/* exponent range is achieved by allocating an integer storage */
/* location together with each floating-point storage location. */
/* The interpretation of the pair (X,I) where X is floating-point */
/* and I is integer is X*(IR**I) where IR is the internal radix of */
/* the computer arithmetic. */
/* This subroutine computes one of the following vectors: */
/* 1. Legendre function of the first kind of negative order, either */
/* a. P(-MU1,NU,X), P(-MU1-1,NU,X), ..., P(-MU2,NU,X) or */
/* b. P(-MU,NU1,X), P(-MU,NU1+1,X), ..., P(-MU,NU2,X) */
/* 2. Legendre function of the second kind, either */
/* a. Q(MU1,NU,X), Q(MU1+1,NU,X), ..., Q(MU2,NU,X) or */
/* b. Q(MU,NU1,X), Q(MU,NU1+1,X), ..., Q(MU,NU2,X) */
/* 3. Legendre function of the first kind of positive order, either */
/* a. P(MU1,NU,X), P(MU1+1,NU,X), ..., P(MU2,NU,X) or */
/* b. P(MU,NU1,X), P(MU,NU1+1,X), ..., P(MU,NU2,X) */
/* 4. Normalized Legendre polynomials, either */
/* a. PN(MU1,NU,X), PN(MU1+1,NU,X), ..., PN(MU2,NU,X) or */
/* b. PN(MU,NU1,X), PN(MU,NU1+1,X), ..., PN(MU,NU2,X) */
/* where X = COS(THETA). */
/* The input values to DXLEGF are DNU1, NUDIFF, MU1, MU2, THETA, */
/* and ID. These must satisfy */
/* DNU1 is DOUBLE PRECISION and greater than or equal to -0.5; */
/* NUDIFF is INTEGER and non-negative; */
/* MU1 is INTEGER and non-negative; */
/* MU2 is INTEGER and greater than or equal to MU1; */
/* THETA is DOUBLE PRECISION and in the half-open interval (0,PI/2]; */
/* ID is INTEGER and equal to 1, 2, 3 or 4; */
/* and additionally either NUDIFF = 0 or MU2 = MU1. */
/* If ID=1 and NUDIFF=0, a vector of type 1a above is computed */
/* with NU=DNU1. */
/* If ID=1 and MU1=MU2, a vector of type 1b above is computed */
/* with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1. */
/* If ID=2 and NUDIFF=0, a vector of type 2a above is computed */
/* with NU=DNU1. */
/* If ID=2 and MU1=MU2, a vector of type 2b above is computed */
/* with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1. */
/* If ID=3 and NUDIFF=0, a vector of type 3a above is computed */
/* with NU=DNU1. */
/* If ID=3 and MU1=MU2, a vector of type 3b above is computed */
/* with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1. */
/* If ID=4 and NUDIFF=0, a vector of type 4a above is computed */
/* with NU=DNU1. */
/* If ID=4 and MU1=MU2, a vector of type 4b above is computed */
/* with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1. */
/* In each case the vector of computed Legendre function values */
/* is returned in the extended-range vector (PQA(I),IPQA(I)). The */
/* length of this vector is either MU2-MU1+1 or NUDIFF+1. */
/* Where possible, DXLEGF returns IPQA(I) as zero. In this case the */
/* value of the Legendre function is contained entirely in PQA(I), */
/* so it can be used in subsequent computations without further */
/* consideration of extended-range arithmetic. If IPQA(I) is nonzero, */
/* then the value of the Legendre function is not representable in */
/* floating-point because of underflow or overflow. The program that */
/* calls DXLEGF must test IPQA(I) to ensure correct usage. */
/* IERROR is an error indicator. If no errors are detected, IERROR=0 */
/* when control returns to the calling routine. If an error is detected, */
/* IERROR is returned as nonzero. The calling routine must check the */
/* value of IERROR. */
/* If IERROR=210 or 211, invalid input was provided to DXLEGF. */
/* If IERROR=201,202,203, or 204, invalid input was provided to DXSET. */
/* If IERROR=205 or 206, an internal consistency error occurred in */
/* DXSET (probably due to a software malfunction in the library routine */
/* I1MACH). */
/* If IERROR=207, an overflow or underflow of an extended-range number */
/* was detected in DXADJ. */
/* If IERROR=208, an overflow or underflow of an extended-range number */
/* was detected in DXC210. */
/* ***SEE ALSO DXSET */
/* ***REFERENCES Olver and Smith, Associated Legendre Functions on the */
/* Cut, J Comp Phys, v 51, n 3, Sept 1983, pp 502--518. */
/* Smith, Olver and Lozier, Extended-Range Arithmetic and */
/* Normalized Legendre Polynomials, ACM Trans on Math */
/* Softw, v 7, n 1, March 1981, pp 93--105. */
/* ***ROUTINES CALLED DXPMU, DXPMUP, DXPNRM, DXPQNU, DXQMU, DXQNU, DXRED, */
/* DXSET, XERMSG */
/* ***REVISION HISTORY (YYMMDD) */
/* 820728 DATE WRITTEN */
/* 890126 Revised to meet SLATEC CML recommendations. (DWL and JMS) */
/* 901019 Revisions to prologue. (DWL and WRB) */
/* 901106 Changed all specific intrinsics to generic. (WRB) */
/* Corrected order of sections in prologue and added TYPE */
/* section. (WRB) */
/* CALLs to XERROR changed to CALLs to XERMSG. (WRB) */
/* 920127 Revised PURPOSE section of prologue. (DWL) */
/* ***END PROLOGUE DXLEGF */
/* ***FIRST EXECUTABLE STATEMENT DXLEGF */
/* Parameter adjustments */
--ipqa;
--pqa;
/* Function Body */
*ierror = 0;
dxset_(&c__0, &c__0, &c_b4, &c__0, ierror);
if (*ierror != 0) {
return 0;
}
pi2 = atan(1.) * 2.;
/* ZERO OUTPUT ARRAYS */
l = *mu2 - *mu1 + *nudiff + 1;
i__1 = l;
for (i__ = 1; i__ <= i__1; ++i__) {
pqa[i__] = 0.;
/* L290: */
ipqa[i__] = 0;
}
/* CHECK FOR VALID INPUT VALUES */
if (*nudiff < 0) {
goto L400;
}
if (*dnu1 < -.5) {
goto L400;
}
if (*mu2 < *mu1) {
goto L400;
}
if (*mu1 < 0) {
goto L400;
}
if (*theta <= 0. || *theta > pi2) {
goto L420;
}
if (*id < 1 || *id > 4) {
goto L400;
}
if (*mu1 != *mu2 && *nudiff > 0) {
goto L400;
}
/* IF DNU1 IS NOT AN INTEGER, NORMALIZED P(MU,DNU,X) */
/* CANNOT BE CALCULATED. IF DNU1 IS AN INTEGER AND */
/* MU1.GT.DNU2 THEN ALL VALUES OF P(+MU,DNU,X) AND */
/* NORMALIZED P(MU,NU,X) WILL BE ZERO. */
dnu2 = *dnu1 + *nudiff;
if (*id == 3 && d_mod(dnu1, &c_b9) != 0.) {
goto L295;
}
if (*id == 4 && d_mod(dnu1, &c_b9) != 0.) {
goto L400;
}
if ((*id == 3 || *id == 4) && (doublereal) (*mu1) > dnu2) {
return 0;
}
L295:
x = cos(*theta);
sx = 1. / sin(*theta);
if (*id == 2) {
goto L300;
}
if (*mu2 - *mu1 <= 0) {
goto L360;
}
/* FIXED NU, VARIABLE MU */
/* CALL DXPMU TO CALCULATE P(-MU1,NU,X),....,P(-MU2,NU,X) */
dxpmu_(dnu1, &dnu2, mu1, mu2, theta, &x, &sx, id, &pqa[1], &ipqa[1],
ierror);
if (*ierror != 0) {
return 0;
}
goto L380;
L300:
if (*mu2 == *mu1) {
goto L320;
}
/* FIXED NU, VARIABLE MU */
/* CALL DXQMU TO CALCULATE Q(MU1,NU,X),....,Q(MU2,NU,X) */
dxqmu_(dnu1, &dnu2, mu1, mu2, theta, &x, &sx, id, &pqa[1], &ipqa[1],
ierror);
if (*ierror != 0) {
return 0;
}
goto L390;
/* FIXED MU, VARIABLE NU */
/* CALL DXQNU TO CALCULATE Q(MU,DNU1,X),....,Q(MU,DNU2,X) */
L320:
dxqnu_(dnu1, &dnu2, mu1, theta, &x, &sx, id, &pqa[1], &ipqa[1], ierror);
if (*ierror != 0) {
return 0;
}
goto L390;
/* FIXED MU, VARIABLE NU */
/* CALL DXPQNU TO CALCULATE P(-MU,DNU1,X),....,P(-MU,DNU2,X) */
L360:
dxpqnu_(dnu1, &dnu2, mu1, theta, id, &pqa[1], &ipqa[1], ierror);
if (*ierror != 0) {
return 0;
}
/* IF ID = 3, TRANSFORM P(-MU,NU,X) VECTOR INTO */
/* P(MU,NU,X) VECTOR. */
L380:
if (*id == 3) {
dxpmup_(dnu1, &dnu2, mu1, mu2, &pqa[1], &ipqa[1], ierror);
}
if (*ierror != 0) {
return 0;
}
/* IF ID = 4, TRANSFORM P(-MU,NU,X) VECTOR INTO */
/* NORMALIZED P(MU,NU,X) VECTOR. */
if (*id == 4) {
dxpnrm_(dnu1, &dnu2, mu1, mu2, &pqa[1], &ipqa[1], ierror);
}
if (*ierror != 0) {
return 0;
}
/* PLACE RESULTS IN REDUCED FORM IF POSSIBLE */
/* AND RETURN TO MAIN PROGRAM. */
L390:
i__1 = l;
for (i__ = 1; i__ <= i__1; ++i__) {
dxred_(&pqa[i__], &ipqa[i__], ierror);
if (*ierror != 0) {
return 0;
}
/* L395: */
}
return 0;
/* ***** ERROR TERMINATION ***** */
L400:
xermsg_("SLATEC", "DXLEGF", "DNU1, NUDIFF, MU1, MU2, or ID not valid", &
c__210, &c__1, (ftnlen)6, (ftnlen)6, (ftnlen)39);
*ierror = 210;
return 0;
L420:
xermsg_("SLATEC", "DXLEGF", "THETA out of range", &c__211, &c__1, (ftnlen)
6, (ftnlen)6, (ftnlen)18);
*ierror = 211;
return 0;
} /* dxlegf_ */
/* $Procedure SPKE15 ( Evaluate a type 15 SPK data record) */
/* Subroutine */ int spke15_(doublereal *et, doublereal *recin, doublereal *
state)
{
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), d_mod(doublereal *, doublereal *), d_sign(
doublereal *, doublereal *);
/* Local variables */
doublereal near__, dmdt;
extern /* Subroutine */ int vscl_(doublereal *, doublereal *, doublereal *
);
extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *,
doublereal *);
extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
integer j2flg;
doublereal p, angle, dnode, z__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal epoch, speed, dperi, theta, manom;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
errdp_(char *, doublereal *, ftnlen), vcrss_(doublereal *,
doublereal *, doublereal *);
extern doublereal twopi_(void);
extern logical vzero_(doublereal *);
extern /* Subroutine */ int vrotv_(doublereal *, doublereal *, doublereal
*, doublereal *);
doublereal oneme2, state0[6];
extern /* Subroutine */ int prop2b_(doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal pa[3], gm, ta, dt;
extern doublereal pi_(void);
doublereal tp[3], pv[3], cosinc;
extern /* Subroutine */ int sigerr_(char *, ftnlen), vhatip_(doublereal *)
, chkout_(char *, ftnlen), vsclip_(doublereal *, doublereal *),
setmsg_(char *, ftnlen);
doublereal tmpsta[6], oj2;
extern logical return_(void);
doublereal ecc;
extern doublereal dpr_(void);
doublereal dot, rpl, k2pi;
/* $ Abstract */
/* Evaluates a single SPK data record from a segment of type 15 */
/* (Precessing Conic Propagation). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPK */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ET I Target epoch. */
/* RECIN I Data record. */
/* STATE O State (position and velocity). */
/* $ Detailed_Input */
/* ET is a target epoch, specified as ephemeris seconds past */
/* J2000, at which a state vector is to be computed. */
/* RECIN is a data record which, when evaluated at epoch ET, */
/* will give the state (position and velocity) of some */
/* body, relative to some center, in some inertial */
/* reference frame. */
/* The structure of RECIN is: */
/* RECIN(1) epoch of periapsis */
/* in ephemeris seconds past J2000. */
/* RECIN(2)-RECIN(4) unit trajectory pole vector */
/* RECIN(5)-RECIN(7) unit periapsis vector */
/* RECIN(8) semi-latus rectum---p in the */
/* equation: */
/* r = p/(1 + ECC*COS(Nu)) */
/* RECIN(9) eccentricity */
/* RECIN(10) J2 processing flag describing */
/* what J2 corrections are to be */
/* applied when the orbit is */
/* propagated. */
/* All J2 corrections are applied */
/* if this flag has a value that */
/* is not 1,2 or 3. */
/* If the value of the flag is 3 */
/* no corrections are done. */
/* If the value of the flag is 1 */
/* no corrections are computed for */
/* the precession of the line */
/* of apsides. However, regression */
/* of the line of nodes is */
/* performed. */
/* If the value of the flag is 2 */
/* no corrections are done for */
/* the regression of the line of */
/* nodes. However, precession of the */
/* line of apsides is performed. */
/* Note that J2 effects are computed */
/* only if the orbit is elliptic and */
/* does not intersect the central */
/* body. */
/* RECIN(11)-RECIN(13) unit central body pole vector */
/* RECIN(14) central body GM */
/* RECIN(15) central body J2 */
/* RECIN(16) central body radius */
/* Units are radians, km, seconds */
/* $ Detailed_Output */
/* STATE is the state produced by evaluating RECIN at ET. */
/* Units are km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Files */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity is less than zero, the error */
/* 'SPICE(BADECCENTRICITY)' will be signalled. */
/* 2) If the semi-latus rectum is non-positive, the error */
/* 'SPICE(BADLATUSRECTUM)' is signalled. */
/* 3) If the pole vector, trajectory pole vector or periapsis vector */
/* has zero length, the error 'SPICE(BADVECTOR)' is signalled. */
/* 4) If the trajectory pole vector and the periapsis vector are */
/* not orthogonal, the error 'SPICE(BADINITSTATE)' is */
/* signalled. The test for orthogonality is very crude. The */
/* routine simply checks that the absolute value of the dot */
/* product of the unit vectors parallel to the trajectory pole */
/* and periapse vectors is less than 0.00001. This check is */
/* intended to catch blunders, not to enforce orthogonality to */
/* double precision tolerance. */
/* 5) If the mass of the central body is non-positive, the error */
/* 'SPICE(NONPOSITIVEMASS)' is signalled. */
/* 6) If the radius of the central body is negative, the error */
/* 'SPICE(BADRADIUS)' is signalled. */
/* $ Particulars */
/* This algorithm applies J2 corrections for precessing the */
/* node and argument of periapse for an object orbiting an */
/* oblate spheroid. */
/* Note the effects of J2 are incorporated only for elliptic */
/* orbits that do not intersect the central body. */
/* While the derivation of the effect of the various harmonics */
/* of gravitational field are beyond the scope of this header */
/* the effect of the J2 term of the gravity model are as follows */
/* The line of node precesses. Over one orbit average rate of */
/* precession, DNode/dNu, is given by */
/* 3 J2 */
/* dNode/dNu = - ----------------- DCOS( inc ) */
/* 2 (P/RPL)**2 */
/* (Since this is always less than zero for oblate spheroids, this */
/* should be called regression of nodes.) */
/* The line of apsides precesses. The average rate of precession */
/* DPeri/dNu is given by */
/* 3 J2 */
/* dPeri/dNu = ----------------- ( 5*DCOS ( inc ) - 1 ) */
/* 2 (P/RPL)**2 */
/* Details of these formulae are given in the Battin's book (see */
/* literature references below). */
/* It is assumed that this routine is used in conjunction with */
/* the routine SPKR15 as shown here: */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECIN ) */
/* CALL SPKE15 ( ET, RECIN, STATE ) */
/* where it is known in advance that the HANDLE, DESCR pair points */
/* to a type 15 data segment. */
/* $ Examples */
/* The SPKEnn routines are almost always used in conjunction with */
/* the corresponding SPKRnn routines, which read the records from */
/* SPK files. */
/* The data returned by the SPKRnn routine is in its rawest form, */
/* taken directly from the segment. As such, it will be meaningless */
/* to a user unless he/she understands the structure of the data type */
/* completely. Given that understanding, however, the SPKRnn */
/* routines might be used to examine raw segment data before */
/* evaluating it with the SPKEnn routines. */
/* C */
/* C Get a segment applicable to a specified body and epoch. */
/* C */
/* CALL SPKSFS ( BODY, ET, HANDLE, DESCR, IDENT, FOUND ) */
/* C */
/* C Look at parts of the descriptor. */
/* C */
/* CALL DAFUS ( DESCR, 2, 6, DCD, ICD ) */
/* CENTER = ICD( 2 ) */
/* REF = ICD( 3 ) */
/* TYPE = ICD( 4 ) */
/* IF ( TYPE .EQ. 15 ) THEN */
/* CALL SPKR15 ( HANDLE, DESCR, ET, RECORD ) */
/* . */
/* . Look at the RECORD data. */
/* . */
/* CALL SPKE15 ( ET, RECORD, STATE ) */
/* . */
/* . Check out the evaluated state. */
/* . */
/* END IF */
/* $ Restrictions */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* S. Schlaifer (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* [1] `Fundamentals of Celestial Mechanics', Second Edition 1989 */
/* by J.M.A. Danby; Willman-Bell, Inc., P.O. Box 35025 */
/* Richmond Virginia; pp 345-347. */
/* [2] `Astronautical Guidance', by Richard H. Battin. 1964 */
/* McGraw-Hill Book Company, San Francisco. pp 199 */
/* $ Version */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* $ Index_Entries */
/* evaluate type_15 spk segment */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VHAT, VROTV, and VSCL calls. */
/* - SPICELIB Version 1.1.0, 29-FEB-1996 (KRG) */
/* The declaration for the SPICELIB function PI is now */
/* preceded by an EXTERNAL statement declaring PI to be an */
/* external function. This removes a conflict with any */
/* compilers that have a PI intrinsic function. */
/* - SPICELIB Version 1.0.0, 15-NOV-1994 (WLT) (SS) */
/* -& */
/* SPICELIB Functions */
/* Local Variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKE15", (ftnlen)6);
/* Fetch the various entities from the input record, first the epoch. */
epoch = recin[0];
/* The trajectory pole vector. */
vequ_(&recin[1], tp);
/* The periapsis vector. */
vequ_(&recin[4], pa);
/* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */
/* and eccentricity. */
p = recin[7];
ecc = recin[8];
/* J2 processing flag. */
j2flg = (integer) recin[9];
/* Central body pole vector. */
vequ_(&recin[10], pv);
/* The central mass, J2 and radius of the central body. */
gm = recin[13];
oj2 = recin[14];
rpl = recin[15];
/* Check all the inputs here for obvious failures. Yes, perhaps */
/* this is overkill. However, there is a lot more computation */
/* going on in this routine so that the small amount of overhead */
/* here should not be significant. */
if (p <= 0.) {
setmsg_("The semi-latus rectum supplied to the SPK type 15 evaluator"
" was non-positive. This value must be positive. The value s"
"upplied was #.", (ftnlen)133);
errdp_("#", &p, (ftnlen)1);
sigerr_("SPICE(BADLATUSRECTUM)", (ftnlen)21);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (ecc < 0.) {
setmsg_("The eccentricity supplied for a type 15 segment is negative"
". It must be non-negative. The value supplied to the type 1"
"5 evaluator was #. ", (ftnlen)138);
errdp_("#", &ecc, (ftnlen)1);
sigerr_("SPICE(BADECCENTRICITY)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (gm <= 0.) {
setmsg_("The mass supplied for the central body of a type 15 segment"
" was non-positive. Masses must be positive. The value suppl"
"ied was #. ", (ftnlen)130);
errdp_("#", &gm, (ftnlen)1);
sigerr_("SPICE(NONPOSITIVEMASS)", (ftnlen)22);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(tp)) {
setmsg_("The trajectory pole vector supplied to SPKE15 had length ze"
"ro. The most likely cause of this problem is a corrupted SPK"
" (ephemeris) file. ", (ftnlen)138);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pa)) {
setmsg_("The periapse vector supplied to SPKE15 had length zero. The"
" most likely cause of this problem is a corrupted SPK (ephem"
"eris) file. ", (ftnlen)131);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (vzero_(pv)) {
setmsg_("The central pole vector supplied to SPKE15 had length zero."
" The most likely cause of this problem is a corrupted SPK (e"
"phemeris) file. ", (ftnlen)135);
sigerr_("SPICE(BADVECTOR)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
} else if (rpl < 0.) {
setmsg_("The central body radius was negative. It must be zero or po"
"sitive. The value supplied was #. ", (ftnlen)94);
errdp_("#", &rpl, (ftnlen)1);
sigerr_("SPICE(BADRADIUS)", (ftnlen)16);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Convert TP, PV and PA to unit vectors. */
/* (It won't hurt to polish them up a bit here if they are already */
/* unit vectors.) */
vhatip_(pa);
vhatip_(tp);
vhatip_(pv);
/* One final check. Make sure the pole and periapse vectors are */
/* orthogonal. (We will use a very crude check but this should */
/* rule out any obvious errors.) */
dot = vdot_(pa, tp);
if (abs(dot) > 1e-5) {
angle = vsep_(pa, tp) * dpr_();
setmsg_("The periapsis and trajectory pole vectors are not orthogona"
"l. The anglebetween them is # degrees. ", (ftnlen)98);
errdp_("#", &angle, (ftnlen)1);
sigerr_("SPICE(BADINITSTATE)", (ftnlen)19);
chkout_("SPKE15", (ftnlen)6);
return 0;
}
/* Compute the distance and speed at periapse. */
near__ = p / (ecc + 1.);
speed = sqrt(gm / p) * (ecc + 1.);
/* Next get the position at periapse ... */
vscl_(&near__, pa, state0);
/* ... and the velocity at periapsis. */
vcrss_(tp, pa, &state0[3]);
vsclip_(&speed, &state0[3]);
/* Determine the elapsed time from periapse to the requested */
/* epoch and propagate the state at periapsis to the epoch of */
/* interest. */
/* Note that we are making use of the following fact. */
/* If R is a rotation, then the states obtained by */
/* the following blocks of code are mathematically the */
/* same. (In reality they may differ slightly due to */
/* roundoff.) */
/* Code block 1. */
/* CALL MXV ( R, STATE0, STATE0 ) */
/* CALL MXV ( R, STATE0(4), STATE0(4) ) */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* Code block 2. */
/* CALL PROP2B( GM, STATE0, DT, STATE ) */
/* CALL MXV ( R, STATE, STATE ) */
/* CALL MXV ( R, STATE(4), STATE(4) ) */
/* This allows us to first compute the propagation of our initial */
/* state and then if needed perform the precession of the line */
/* of nodes and apsides by simply precessing the resulting state. */
dt = *et - epoch;
prop2b_(&gm, state0, &dt, state);
/* If called for, handle precession needed due to the J2 term. Note */
/* that the motion of the lines of nodes and apsides is formulated */
/* in terms of the true anomaly. This means we need the accumulated */
/* true anomaly in order to properly transform the state. */
if (j2flg != 3 && oj2 != 0. && ecc < 1. && near__ > rpl) {
/* First compute the change in mean anomaly since periapsis. */
/* Computing 2nd power */
d__1 = ecc;
oneme2 = 1. - d__1 * d__1;
dmdt = oneme2 / p * sqrt(gm * oneme2 / p);
manom = dmdt * dt;
/* Next compute the angle THETA such that THETA is between */
/* -pi and pi and such than MANOM = THETA + K*2*pi for */
/* some integer K. */
d__1 = twopi_();
theta = d_mod(&manom, &d__1);
if (abs(theta) > pi_()) {
d__1 = twopi_();
theta -= d_sign(&d__1, &theta);
}
k2pi = manom - theta;
/* We can get the accumulated true anomaly from the propagated */
/* state theta and the accumulated mean anomaly prior to this */
/* orbit. */
ta = vsep_(pa, state);
ta = d_sign(&ta, &theta);
ta += k2pi;
/* Determine how far the line of nodes and periapsis have moved. */
cosinc = vdot_(pv, tp);
/* Computing 2nd power */
d__1 = rpl / p;
z__ = ta * 1.5 * oj2 * (d__1 * d__1);
dnode = -z__ * cosinc;
/* Computing 2nd power */
d__1 = cosinc;
dperi = z__ * (d__1 * d__1 * 2.5 - .5);
/* Precess the periapsis by rotating the state vector about the */
/* trajectory pole */
if (j2flg != 1) {
vrotv_(state, tp, &dperi, tmpsta);
vrotv_(&state[3], tp, &dperi, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* Regress the line of nodes by rotating the state */
/* about the pole of the central body. */
if (j2flg != 2) {
vrotv_(state, pv, &dnode, tmpsta);
vrotv_(&state[3], pv, &dnode, &tmpsta[3]);
moved_(tmpsta, &c__6, state);
}
/* We could perform the rotations above in the other order, */
/* but we would also have to rotate the pole before precessing */
/* the line of apsides. */
}
/* That's all folks. Check out and return. */
chkout_("SPKE15", (ftnlen)6);
return 0;
} /* spke15_ */
/* $Procedure EQNCPV (Equinoctial Elements to position and velocity) */
/* Subroutine */ int eqncpv_(doublereal *et, doublereal *epoch, doublereal *
eqel, doublereal *rapol, doublereal *decpol, doublereal *state)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal), sin(doublereal), cos(doublereal), d_mod(
doublereal *, doublereal *);
/* Local variables */
doublereal nfac, node, mldt, temp[3], a, b, h__, k, l, eecan, p, q, r__;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal dlpdt, prate;
extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
doublereal xhold[6];
extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
doublereal trans[9] /* was [3][3] */;
extern doublereal twopi_(void);
doublereal x1, y1;
extern /* Subroutine */ int vlcom3_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
doublereal ca, cd, cf, di, cn, ra, sa, rb, sd, dt, sf, ml, dx, dy, vf[3],
vg[3], sn, nodedt;
extern doublereal kepleq_(doublereal *, doublereal *, doublereal *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen);
static doublereal pi2;
doublereal dx1, dy1;
extern logical return_(void);
doublereal ecc, can, dlp, san;
extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
;
/* $ Abstract */
/* Compute the state (position and velocity of an object whose */
/* trajectory is described via equinoctial elements relative to some */
/* fixed plane (usually the equatorial plane of some planet). */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* EPHEMERIS */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ET I Epoch in seconds past J2000 to find state */
/* EPOCH I Epoch of elements in seconds past J2000 */
/* EQEL I Array of equinoctial elements */
/* RAPOL I Right Ascension of the pole of the reference plane */
/* DECPOL I Declination of the pole of the reference plane */
/* STATE O State of the object described by EQEL. */
/* $ Detailed_Input */
/* ET is the epoch (ephemeris time) at which the state */
/* of the target body is to be computed. ET is measured */
/* in seconds past the J2000 epoch. */
/* EPOCH is the epoch of the equinoctial elements in seconds */
/* past the J2000 epoch. */
/* EQEL is an array of 9 double precision numbers that */
/* are the equinoctial elements for some orbit expressed */
/* relative to the equatorial frame of the central body. */
/* (The z-axis of the equatorial frame is the direction */
/* of the pole of the central body relative to some */
/* inertial frame. The x-axis is given by the cross */
/* product of the Z-axis of the inertial frame */
/* with the direction of the pole of the central body. */
/* The Y-axis completes a right handed frame. */
/* (If the z-axis of the equatorial frame is aligned */
/* with the z-axis of the inertial frame, then the */
/* x-axis of the equatorial frame will be located at */
/* 90 degrees + RAPOL in the inertial frame.) */
/* The specific arrangement of the elements is spelled */
/* out below. The following terms are used in the */
/* discussion of elements of EQEL */
/* INC --- inclination of the orbit */
/* ARGP --- argument of periapse */
/* NODE --- longitude of the ascending node */
/* E --- eccentricity of the orbit */
/* EQEL(1) is the semi-major axis (A) of the orbit in km. */
/* EQEL(2) is the value of H at the specified epoch. */
/* ( E*SIN(ARGP+NODE) ). */
/* EQEL(3) is the value of K at the specified epoch */
/* ( E*COS(ARGP+NODE) ). */
/* EQEL(4) is the mean longitude (MEAN0+ARGP+NODE)at */
/* the epoch of the elements measured in radians. */
/* EQEL(5) is the value of P (TAN(INC/2)*SIN(NODE))at */
/* the specified epoch. */
/* EQEL(6) is the value of Q (TAN(INC/2)*COS(NODE))at */
/* the specified epoch. */
/* EQEL(7) is the rate of the longitude of periapse */
/* (dARGP/dt + dNODE/dt ) at the epoch of */
/* the elements. This rate is assumed to hold */
/* for all time. The rate is measured in */
/* radians per second. */
/* EQEL(8) is the derivative of the mean longitude */
/* ( dM/dt + dARGP/dt + dNODE/dt ). This */
/* rate is assumed to be constant and is */
/* measured in radians/second. */
/* EQEL(9) is the rate of the longitude of the ascending */
/* node ( dNODE/dt). This rate is measured */
/* in radians per second. */
/* RAPOL Right Ascension of the pole of the reference plane */
/* with respect to some inertial frame (measured in */
/* radians). */
/* DECPOL Declination of the pole of the reference plane */
/* with respect to some inertial frame (measured in */
/* radians). */
/* $ Detailed_Output */
/* STATE State of the object described by EQEL relative to the */
/* inertial frame used to define RAPOL and DECPOL. Units */
/* are in km and km/sec. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the eccentricity corresponding to the input elements is */
/* greater than 0.9, the error SPICE(ECCOUTOFRANGE) is signalled. */
/* 2) If the semi-major axis of the elements is non-positive, the */
/* error SPICE(BADSEMIAXIS) is signalled. */
/* $ Files */
/* None. */
/* $ Particulars */
/* This routine evaluates the input equinoctial elements for */
/* the specified epoch and return the corresponding state. */
/* This routine was adapted from a routine provided by */
/* Bob Jacobson of the Planetary Dynamics Group of */
/* the Navigation and Flight Mechanics Section at JPL. */
/* $ Examples */
/* Suppose you have classical elements and rates of */
/* change of the ascending node and argument of periapse */
/* for some satellite of the earth. */
/* By transforming the classical elements */
/* this routine can be used to compute the state of the */
/* object at an arbitrary epoch. The code below illustrates */
/* how you might do this. */
/* The table below illustrates the meanings of the various */
/* variables used in the discussion below. */
/* Variable Meaning */
/* -------- ---------------------------------- */
/* A Semi-major axis in km */
/* ECC Eccentricity of orbit */
/* INC Inclination of orbit */
/* NODE Longitude of the ascending node at epoch */
/* OMEGA Argument of periapse at epoch */
/* M Mean anomaly at epoch */
/* DMDT Mean anomaly rate in radians/second */
/* DNODE Rate of change of longitude of ascending node */
/* in radians/second */
/* DARGP Rate of change of argument of periapse in */
/* radians/second */
/* EPOCH is the epoch of the elements in seconds past */
/* the J2000 epoch. */
/* EQEL(1) = A */
/* EQEL(2) = ECC * DSIN ( OMEGA + NODE ) */
/* EQEL(3) = ECC * DCOS ( OMEGA + NODE ) */
/* EQEL(4) = M + OMEGA + NODE */
/* EQEL(5) = TAN(INC/2.0D0) * DSIN(NODE) */
/* EQEL(6) = TAN(INC/2.0D0) * DCOS(NODE) */
/* EQEL(7) = DARGP */
/* EQEL(8) = DARGP + DMDT + DNODE */
/* EQEL(9) = DNODE */
/* We shall compute the state of the satellite in the */
/* pole and equator reference system. */
/* RAPOL = -HALFPI() */
/* DECPOL = HALFPI() */
/* Now compute the state at the desired epoch ET. */
/* CALL EQNCPV ( ET, EPOCH, EQEL, RAPOL, DECPOL, STATE ) */
/* $ Restrictions */
/* The equinoctial elements used by this routine are taken */
/* from "Tangent" formulation of equinoctial elements */
/* p = Tan(inclination/2) * Sin(R.A. of ascending node) */
/* q = Tan(inclination/2) * Cos(R.A. of ascending node) */
/* Other formulations use Sine instead of Tangent. We shall */
/* call these the "Sine" formulations. */
/* p = Sin(inclination/2) * Sin(R.A. of ascending node) */
/* q = Sin(inclination/2) * Cos(R.A. of ascending node) */
/* If you have equinoctial elements from this alternative */
/* formulation you should replace p and q by the */
/* expressions below. */
/* P = P / DSQRT ( 1.0D0 - P*P - Q*Q ) */
/* Q = Q / DSQRT ( 1.0D0 - P*P - Q*Q ) */
/* This will convert the Sine formulation to the Tangent formulation. */
/* $ Literature_References */
/* JPL Engineering Memorandum 314-513 "Optical Navigation Program */
/* Mathematical Models" by William M. Owen, Jr. and Robin M Vaughan */
/* August 9, 1991 */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* R.A. Jacobson (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */
/* Removed "C$" marker from text in the header. */
/* - SPICELIB Version 1.0.1, 31-JAN-2008 (BVS) */
/* Removed non-standard header section heading */
/* 'Declarations_of_external_functions'. */
/* - SPICELIB Version 1.0.0, 8-JAN-1997 (WLT) */
/* -& */
/* $ Index_Entries */
/* Compute a state from equinoctial elements */
/* -& */
/* SPICELIB Functions. */
/* LOCAL VARIABLES */
/* Constants computed on first pass */
/* Standard SPICE exception handling code. */
if (return_()) {
return 0;
}
chkin_("EQNCPV", (ftnlen)6);
/* The first time through this routine we fetch the various */
/* constants we need for this routine. */
if (first) {
first = FALSE_;
pi2 = twopi_();
}
/* Take care of the various errors that can arise with the */
/* input elements. */
if (eqel[0] <= 0.) {
setmsg_("The semi-major axis supplied to EQNCPV was non-positive. Th"
"e value is required to be positive by this routine. The valu"
"e supplied was #. ", (ftnlen)137);
errdp_("#", eqel, (ftnlen)1);
sigerr_("SPICE(BADSEMIAXIS)", (ftnlen)18);
chkout_("EQNCPV", (ftnlen)6);
return 0;
}
ecc = sqrt(eqel[1] * eqel[1] + eqel[2] * eqel[2]);
if (ecc > .9) {
setmsg_("The routine EQNCPV can reliably evaluate states from equino"
"ctial elements if the eccentricity of the orbit associated w"
"ith the elements is less than 0.9. The eccentricity associa"
"ted with the elements supplies is #. The values of H and K "
"are: # and # respectively. ", (ftnlen)266);
errdp_("#", &ecc, (ftnlen)1);
errdp_("#", &eqel[1], (ftnlen)1);
errdp_("#", &eqel[2], (ftnlen)1);
sigerr_("SPICE(ECCOUTOFRANGE)", (ftnlen)20);
chkout_("EQNCPV", (ftnlen)6);
return 0;
}
/* Form the transformation from planetary equator to the inertial */
/* reference frame. */
sa = sin(*rapol);
ca = cos(*rapol);
sd = sin(*decpol);
cd = cos(*decpol);
trans[0] = -sa;
trans[3] = -ca * sd;
trans[6] = ca * cd;
trans[1] = ca;
trans[4] = -sa * sd;
trans[7] = sa * cd;
trans[2] = 0.;
trans[5] = cd;
trans[8] = sd;
/* Compute the offset of the input epoch (ET) from the */
/* epoch of the elements. */
dt = *et - *epoch;
/* Obtain the elements, rates, and other parameters. First get */
/* the semi-major axis. */
a = eqel[0];
/* Recall that H and K at the epoch of the elements are in */
/* EQEL(2) and EQEL(3) respectively. */
/* H_0 = E*Sin(ARGP_0 + NODE_0 ) */
/* K_0 = E*Cos(ARGP_0 + NODE_0 ) */
/* The values of H and K at the epoch of interest is */
/* H_dt = E*Sin(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */
/* K_dt = E*Cos(ARGP_0 + NODE_0 + dt*d(ARGP+NODE)/dt ) */
/* But using the identities Sin(A+B) = Sin(A)Cos(B) + Sin(B)Cos(A) */
/* Cos(A+B) = Cos(A)Cos(B) - Sin(A)Sin(B) */
/* We can re-write the expression for H_dt and K_dt as */
/* H_dt = E*Sin(ARGP_0 + NODE_0 )Cos(dt*d(ARGP+NODE)/dt ) */
/* + E*Cos(ARGP_0 + NODE_0 )Sin(dt*d(ARGP+NODE)/dt ) */
/* = H_0 * Cos(dt*d(ARGP+NODE)/dt ) */
/* + K_0 * Sin(dt*d(ARGP+NODE)/dt ) */
/* and */
/* K_dt = E*Cos(ARGP_0 + NODE_0)Cos(dt*d(ARGP+NODE)/dt) */
/* - E*Sin(ARGP_0 + NODE_0)Sin(dt*d(ARGP+NODE)/dt) */
/* = K_0 * Cos(dt*d(ARGP+NODE)/dt) */
/* - H_0 * Sin(dt*d(ARGP+NODE)/dt) */
/* Thus we can easily compute H and K at the current epoch. */
/* Recall that the derivative of the longitude of periapse is */
/* in entry 7 of EQEL. */
dlpdt = eqel[6];
dlp = dt * dlpdt;
can = cos(dlp);
san = sin(dlp);
h__ = eqel[1] * can + eqel[2] * san;
k = eqel[2] * can - eqel[1] * san;
/* The mean longitude at epoch is in the 4th element of EQEL. */
l = eqel[3];
/* The values for P and Q at epoch are stored in entries 5 and 6 */
/* of the array EQEL. Recall that */
/* P_0 = TAN(INC/2)*SIN(NODE_0) */
/* Q_0 = TAN(INC/2)*COS(NODE_0) */
/* We need P and Q offset from the initial epoch by DT. */
/* P = TAN(INC/2)*SIN(NODE_0 + dt*dNODE/dt) */
/* Q = TAN(INC/2)*COS(NODE_0 + dt*dNODE/dt) */
/* Applying the same identities as we did before we have */
/* P = P_0 * Cos( dt*dNODE/dt ) + Q_0 * Sin( dt*dNODE/dt ) */
/* Q = Q_0 * Cos( dt*dNODE/dt ) - P_0 * Sin( dt*dNODE/dt ) */
nodedt = eqel[8];
node = dt * nodedt;
cn = cos(node);
sn = sin(node);
p = eqel[4] * cn + eqel[5] * sn;
q = eqel[5] * cn - eqel[4] * sn;
mldt = eqel[7];
/* We compute the rate of change of the argument of periapse */
/* by taking the difference between the rate of the longitude */
/* of periapse and the rate of the node. */
prate = dlpdt - nodedt;
/* Form Broucke's beta parameter */
b = sqrt(1. - h__ * h__ - k * k);
b = 1. / (b + 1.);
/* Construct the coordinate axes */
di = 1. / (p * p + 1. + q * q);
vf[0] = (1. - p * p + q * q) * di;
vf[1] = p * 2. * q * di;
vf[2] = p * -2. * di;
vg[0] = p * 2. * q * di;
vg[1] = (p * p + 1. - q * q) * di;
vg[2] = q * 2. * di;
/* Compute the mean longitude */
d__1 = mldt * dt;
ml = l + d_mod(&d__1, &pi2);
/* Obtain the eccentric longitude from Kepler's equation */
eecan = kepleq_(&ml, &h__, &k);
/* Trigonometric functions of the eccentric longitude */
sf = sin(eecan);
cf = cos(eecan);
/* Position in the orbit plane */
/* Computing 2nd power */
d__1 = h__;
x1 = a * ((1. - b * (d__1 * d__1)) * cf + (h__ * k * b * sf - k));
/* Computing 2nd power */
d__1 = k;
y1 = a * ((1. - b * (d__1 * d__1)) * sf + (h__ * k * b * cf - h__));
/* Radial distance and functions of the radial distance */
rb = h__ * sf + k * cf;
r__ = a * (1. - rb);
ra = mldt * a * a / r__;
/* Velocity in the orbit plane */
dx1 = ra * (-sf + h__ * b * rb);
dy1 = ra * (cf - k * b * rb);
/* Correction factor for periapsis rate */
nfac = 1. - dlpdt / mldt;
/* Include precession in velocity */
dx = nfac * dx1 - prate * y1;
dy = nfac * dy1 + prate * x1;
/* Form the planetary mean equator position vector */
vlcom_(&x1, vf, &y1, vg, xhold);
/* Form the planetary mean equator velocity vector */
temp[0] = -nodedt * xhold[1];
temp[1] = nodedt * xhold[0];
temp[2] = 0.;
vlcom3_(&c_b13, temp, &dx, vf, &dy, vg, &xhold[3]);
/* Transform to an inertial state vector */
mxv_(trans, xhold, state);
mxv_(trans, &xhold[3], &state[3]);
chkout_("EQNCPV", (ftnlen)6);
return 0;
} /* eqncpv_ */
