/* $Procedure STCF01 (STAR catalog type 1, find stars in RA-DEC box) */ /* Subroutine */ int stcf01_(char *catnam, doublereal *westra, doublereal * eastra, doublereal *sthdec, doublereal *nthdec, integer *nstars, ftnlen catnam_len) { /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); doublereal ramin; extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen, ftnlen); doublereal ramax; extern /* Subroutine */ int repmd_(char *, char *, doublereal *, integer * , char *, ftnlen, ftnlen, ftnlen); logical error; char query[512], qrytm1[512], qrytm2[512]; doublereal decmin; extern /* Subroutine */ int ekfind_(char *, integer *, logical *, char *, ftnlen, ftnlen); doublereal decmax; extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen); char errmsg[512]; extern /* Subroutine */ int setmsg_(char *, ftnlen); extern logical return_(void); extern doublereal dpr_(void); /* $ Abstract */ /* Search through a type 1 star catalog and return the number of */ /* stars within a specified RA - DEC rectangle. */ /* $ 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 */ /* EK */ /* $ Keywords */ /* None. */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* CATNAM I Catalog table name. */ /* WESTRA I Western most right ascension in radians. */ /* EASTRA I Eastern most right ascension in radians. */ /* STHDEC I Southern most declination in radians. */ /* NTHDEC I Northern most declination in radians. */ /* NSTARS O Number of stars found. */ /* $ Detailed_Input */ /* CATNAM is name of the catalog data table. This name is */ /* returned by the catalog loader routine STCL01. */ /* WESTRA are right ascension and declination constraints */ /* EASTRA giving the western, eastern, southern and northern */ /* STHDEC boundaries of a search rectangle as follows: */ /* NTHDEC */ /* RA BETWEEN WESTRA AND EASTRA and */ /* DEC BETWEEN STHDEC AND NTHDEC */ /* where RA and DEC are the right ascension and */ /* declination of a star. WESTRA always represents */ /* "west" side of this rectangle and EASTRA -- the */ /* "east" side. STHDEC represents the "south" side */ /* of the rectangle, NTHDEC represents the "north" */ /* side of the rectangle. */ /* For an observer standing on the surface */ /* of the earth at the equator, the west side of the */ /* rectangle ( the side associated with WESTRA) rises */ /* first. The east side (the side associated with */ /* EASTRA) rises last. All meridians that rise between */ /* the rising of the west and east edges of the */ /* rectangle cross through the RA-DEC rectangle. */ /* To specify the 6 degrees wide RA-DEC */ /* square centered on the celestical equator that */ /* has western most right ascension of 357 degrees, */ /* use the following values for WESTRA, EASTRA, STHDEC, */ /* and NTHDEC (we multiply the angles by the SPICELIB */ /* function RPD to convert degrees to radians). */ /* WESTRA = 357.0D0 * RPD() */ /* EASTRA = 3.0D0 * RPD() */ /* STHDEC = -3.0D0 * RPD() */ /* DEXMAX = 3.0D0 * RPD() */ /* To specify a 5 degree wide RA-DEC square that has */ /* western most right ascension 10 degrees and */ /* eastern most right ascension 15 degrees and southern */ /* most declination of 45 degrees, assign the following */ /* values to WESTRA, EASTRA, STHDEC and NTHDEC. */ /* WESTRA = 10.0D0 * RPD() */ /* EASTRA = 15.0D0 * RPD() */ /* STHDEC = 45.0D0 * RPD() */ /* DEXMAX = 50.0D0 * RPD() */ /* All RA and DECS should be in radians and relative */ /* to the J2000 inertial frame. */ /* All Right Ascension values should be in the */ /* interval [0, 2*pi ). This routine does */ /* not "fold" Right Ascension values into the this */ /* interval. For example if you request stars in */ /* whose right ascensions lie between 3*pi and 4*pi */ /* no stars will be found. */ /* All Declination values should be in the interval */ /* [-pi,pi]. */ /* $ Detailed_Output */ /* NSTARS is number of catalog stars found within the */ /* specified RA - DEC rectangle. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If no star catalog has been loaded, an error will be */ /* signalled by a routine in the call tree of this routine. */ /* 2) If the catalog query fails for any reason then */ /* the error 'SPICE(QUERYFAILURE)'is signalled. */ /* $ Files */ /* This routine searches for stars within SPICE type 1 star catalog */ /* files that have been loaded by calls to the STCL01 routine and */ /* that contain that catalog data table named CATNAM. */ /* SPICE type 1 star catalog files MUST contain a single data table. */ /* It can occupy a single segment or it can spread across multiple */ /* segments. This table MUST include the following columns: */ /* column name data type units */ /* ------------------------------------------------------- */ /* RA DOUBLE PRECISION DEGREES */ /* DEC DOUBLE PRECISION DEGREES */ /* RA_SIGMA DOUBLE PRECISION DEGREES */ /* DEC_SIGMA DOUBLE PRECISION DEGREES */ /* CATALOG_NUMBER INTEGER */ /* SPECTRAL_TYPE CHARACTER*(4) */ /* VISUAL_MAGNITUDE DOUBLE PRECISION */ /* Nulls are not allowed in any of the columns. */ /* Other columns can also be present in the table but their data */ /* will NOT be accessible through STCF01 and STCG01 -- */ /* the interface used to access data in the catalog. Note */ /* that the names and attributes of these additional columns */ /* must be identical for all segments containing this table. */ /* $ Particulars */ /* This routine is intended to be a part of the user interface to */ /* the SPICE type 1 star catalog. It allows the caller to find all */ /* stars within a specified RA - DEC rectangle in the SPICE */ /* EK type 1 star catalog files loaded by STCL01. This */ /* subroutine MUST NOT be called before a catalog file has */ /* been loaded. */ /* Other routines in the SPICE type 1 star catalog access */ /* family are: */ /* STCL01 load the catalog file and make its data */ /* available for search and retrieval. */ /* STCG01 retrieve position and characteristics for */ /* a specified star in the set found by this */ /* routine. */ /* $ Examples */ /* In the following code fragment, STCF01 is used to find */ /* all stars within a specified RA - DEC rectangle in a SPICE */ /* EK type 1 star catalog. */ /* C */ /* C Load catalog file. */ /* C */ /* CALL STCL01 ( CATFN, TABNAM, HANDLE ) */ /* C */ /* C Search through the loaded catalog. */ /* C */ /* CALL STCF01 ( TABNAM, WESTRA, EASTRA, */ /* . STHDEC, NTHDEC, NSTARS ) */ /* C */ /* C Retrieve data for every star found. */ /* C */ /* DO I = 1, NSTARS */ /* CALL STCG01 ( I, RA, DEC, RASIG, DECSIG, */ /* . CATNUM, SPTYPE, VMAG ) */ /* END DO */ /* $ Restrictions */ /* 1) The catalog file STCF01 searches through MUST be loaded */ /* by STCL01 before STCF01 is called. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* B.V. Semenov (JPL) */ /* $ Version */ /* - SPICELIB Version 1.0.0, 15-MAY-1996 (BVS) */ /* -& */ /* $ Index_Entries */ /* find stars in RA-DEC rectangle in type 1 star catalog */ /* -& */ /* SPICELIB functions */ /* Local parameters. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("STCF01", (ftnlen)6); } /* Query templates. */ s_copy(qrytm1, "SELECT RA, DEC, RA_SIGMA, DEC_SIGMA,CATALOG_NUMBER, SPEC" "TRAL_TYPE, VISUAL_MAGNITUDE FROM # WHERE ( RA BETWEEN # AND # )" " AND ( DEC BETWEEN # AND # ) ", (ftnlen)512, (ftnlen)149); s_copy(qrytm2, "SELECT RA, DEC, RA_SIGMA, DEC_SIGMA,CATALOG_NUMBER, SPEC" "TRAL_TYPE, VISUAL_MAGNITUDE FROM # WHERE ( ( RA BETWEEN # AND 36" "0 ) OR ( RA BETWEEN 0 AND # ) ) AND ( DEC BETWEEN # A" "ND # ) ", (ftnlen)512, (ftnlen)191); /* Choose query template to be used. */ if (*westra <= *eastra) { s_copy(query, qrytm1, (ftnlen)512, (ftnlen)512); } else { s_copy(query, qrytm2, (ftnlen)512, (ftnlen)512); } /* Convert angles in radians to angles in degrees. */ ramin = *westra * dpr_(); ramax = *eastra * dpr_(); decmin = *sthdec * dpr_(); decmax = *nthdec * dpr_(); /* Construct query using inputs and chosen template. */ repmc_(query, "#", catnam, query, (ftnlen)512, (ftnlen)1, catnam_len, ( ftnlen)512); repmd_(query, "#", &ramin, &c__15, query, (ftnlen)512, (ftnlen)1, (ftnlen) 512); repmd_(query, "#", &ramax, &c__15, query, (ftnlen)512, (ftnlen)1, (ftnlen) 512); repmd_(query, "#", &decmin, &c__15, query, (ftnlen)512, (ftnlen)1, ( ftnlen)512); repmd_(query, "#", &decmax, &c__15, query, (ftnlen)512, (ftnlen)1, ( ftnlen)512); /* Submit query and get number of stars. Check for */ /* errors in QUERY. */ ekfind_(query, nstars, &error, errmsg, (ftnlen)512, (ftnlen)512); if (error) { setmsg_("Error querying type 1 star catalog. Error message: # ", ( ftnlen)53); errch_("#", errmsg, (ftnlen)1, (ftnlen)512); sigerr_("SPICE(QUERYFAILURE)", (ftnlen)19); chkout_("STCF01", (ftnlen)6); return 0; } chkout_("STCF01", (ftnlen)6); return 0; } /* stcf01_ */
/* $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 SPKW15 ( SPK, write a type 15 segment ) */ /* Subroutine */ int spkw15_(integer *handle, integer *body, integer *center, char *frame, doublereal *first, doublereal *last, char *segid, doublereal *epoch, doublereal *tp, doublereal *pa, doublereal *p, doublereal *ecc, doublereal *j2flg, doublereal *pv, doublereal *gm, doublereal *j2, doublereal *radius, ftnlen frame_len, ftnlen segid_len) { /* System generated locals */ integer i__1; /* Local variables */ extern /* Subroutine */ int vhat_(doublereal *, doublereal *); doublereal mypa[3]; extern doublereal vdot_(doublereal *, doublereal *), vsep_(doublereal *, doublereal *); extern /* Subroutine */ int vequ_(doublereal *, doublereal *); doublereal mytp[3]; integer i__; doublereal angle; extern /* Subroutine */ int chkin_(char *, ftnlen); doublereal descr[5]; integer value; extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen); extern logical vzero_(doublereal *); extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_( integer *, doublereal *, char *, ftnlen), dafena_(void); extern logical failed_(void); doublereal record[16]; extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), spkpds_(integer *, integer *, char *, integer *, doublereal *, doublereal *, doublereal *, ftnlen); extern logical return_(void); extern doublereal dpr_(void); doublereal dot; /* $ Abstract */ /* Write an SPK segment of type 15 given a type 15 data record. */ /* $ 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 */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle of an SPK file open for writing. */ /* BODY I Body code for ephemeris object. */ /* CENTER I Body code for the center of motion of the body. */ /* FRAME I The reference frame of the states. */ /* FIRST I First valid time for which states can be computed. */ /* LAST I Last valid time for which states can be computed. */ /* SEGID I Segment identifier. */ /* EPOCH I Epoch of the periapse. */ /* TP I Trajectory pole vector. */ /* PA I Periapsis vector. */ /* P I Semi-latus rectum. */ /* ECC I Eccentricity. */ /* J2FLG I J2 processing flag. */ /* PV I Central body pole vector. */ /* GM I Central body GM. */ /* J2 I Central body J2. */ /* RADIUS I Equatorial radius of central body. */ /* $ Detailed_Input */ /* HANDLE is the file handle of an SPK file that has been */ /* opened for writing. */ /* BODY is the NAIF ID for the body whose states are */ /* to be recorded in an SPK file. */ /* CENTER is the NAIF ID for the center of motion associated */ /* with BODY. */ /* FRAME is the reference frame that states are referenced to, */ /* for example 'J2000'. */ /* FIRST are the bounds on the ephemeris times, expressed as */ /* LAST seconds past J2000. */ /* SEGID is the segment identifier. An SPK segment identifier */ /* may contain up to 40 characters. */ /* EPOCH is the epoch of the orbit elements at periapse */ /* in ephemeris seconds past J2000. */ /* TP is a vector parallel to the angular momentum vector */ /* of the orbit at epoch expressed relative to FRAME. A */ /* unit vector parallel to TP will be stored in the */ /* output segment. */ /* PA is a vector parallel to the position vector of the */ /* trajectory at periapsis of EPOCH expressed relative */ /* to FRAME. A unit vector parallel to PA will be */ /* stored in the output segment. */ /* P is the semi-latus rectum--- p in the equation: */ /* r = p/(1 + ECC*COS(Nu)) */ /* ECC is the eccentricity. */ /* J2FLG is the J2 processing flag describing what J2 */ /* corrections are to be applied when the orbit is */ /* propagated. */ /* All J2 corrections are applied if the value of J2FLG */ /* 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. */ /* PV is a vector parallel to the north pole vector of the */ /* central body expressed relative to FRAME. A unit */ /* vector parallel to PV will be stored in the output */ /* segment. */ /* GM is the central body GM. */ /* J2 is the central body J2 (dimensionless). */ /* RADIUS is the equatorial radius of the central body. */ /* Units are radians, km, seconds. */ /* $ Detailed_Output */ /* None. A type 15 segment is written to the file attached */ /* to HANDLE. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If the eccentricity is less than zero, the error */ /* 'SPICE(BADECCENTRICITY)' will be signaled. */ /* 2) If the semi-latus rectum is 0, the error */ /* 'SPICE(BADLATUSRECTUM)' is signaled. */ /* 3) If the pole vector, trajectory pole vector or periapsis vector */ /* have zero length, the error 'SPICE(BADVECTOR)' is signaled. */ /* 4) If the trajectory pole vector and the periapsis vector are */ /* not orthogonal, the error 'SPICE(BADINITSTATE)' is signaled. */ /* The test for orthogonality is very crude. The routine simply */ /* checks that 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 capacity. */ /* 5) If the mass of the central body is non-positive, the error */ /* 'SPICE(NONPOSITIVEMASS)' is signaled. */ /* 6) If the radius of the central body is negative, the error */ /* 'SPICE(BADRADIUS)' is signaled. */ /* 7) If the segment identifier has more than 40 non-blank characters */ /* the error 'SPICE(SEGIDTOOLONG)' is signaled. */ /* 8) If the segment identifier contains non-printing characters */ /* the error 'SPICE(NONPRINTABLECHARS)' is signaled. */ /* 9) If there are inconsistencies in the BODY, CENTER, FRAME or */ /* FIRST and LAST times, the problem will be diagnosed by */ /* a routine in the call tree of this routine. */ /* $ Files */ /* A new type 15 SPK segment is written to the SPK file attached */ /* to HANDLE. */ /* $ Particulars */ /* This routine writes an SPK type 15 data segment to the open SPK */ /* file according to the format described in the type 15 section of */ /* the SPK Required Reading. The SPK file must have been opened with */ /* write access. */ /* This routine is provided to provide direct support for the MASL */ /* precessing orbit formulation. */ /* $ Examples */ /* Suppose that at time EPOCH you have the J2000 periapsis */ /* state of some object relative to some central body and would */ /* like to create a type 15 SPK segment to model the motion of */ /* the object using simple regression and precession of the */ /* line of nodes and apsides. The following code fragment */ /* illustrates how you can prepare such a segment. We shall */ /* assume that you have in hand the J2000 direction of the */ /* central body's pole vector, its GM, J2 and equatorial */ /* radius. In addition we assume that you have opened an SPK */ /* file for write access and that it is attached to HANDLE. */ /* (If your state is at an epoch other than periapse the */ /* fragment below will NOT produce a "correct" type 15 segment */ /* for modeling the motion of your object.) */ /* C */ /* C First we get the osculating elements. */ /* C */ /* CALL OSCELT ( STATE, EPOCH, GM, ELTS ) */ /* C */ /* C From these collect the eccentricity and semi-latus rectum. */ /* C */ /* ECC = ELTS ( 2 ) */ /* P = ELTS ( 1 ) * ( 1.0D0 + ECC ) */ /* C */ /* C Next get the trajectory pole vector and the */ /* C periapsis vector. */ /* C */ /* CALL UCRSS ( STATE(1), STATE(4), TP ) */ /* CALL VHAT ( STATE(1), PA ) */ /* C */ /* C Enable both J2 corrections. */ /* C */ /* J2FLG = 0.0D0 */ /* C */ /* C Now add the segment. */ /* C */ /* CALL SPKW15 ( HANDLE, BODY, CENTER, FRAME, FIRST, LAST, */ /* . SEGID, EPOCH, TP, PA, P, ECC, */ /* . J2FLG, PV, GM, J2, RADIUS ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* W.L. Taber (JPL) */ /* $ Version */ /* - SPICELIB Version 2.0.0, 29-MAY-2012 (NJB) */ /* Input vectors that nominally have unit length */ /* are mapped to local copies that actually do */ /* have unit length. The applicable inputs are TP, PA, */ /* and PV. The Detailed Input header section was updated */ /* to reflect the change. */ /* Some typos in error messages were corrected. */ /* - SPICELIB Version 1.0.0, 28-NOV-1994 (WLT) */ /* -& */ /* $ Index_Entries */ /* Write a type 15 spk segment */ /* -& */ /* SPICELIB Functions */ /* Local Variables */ /* Segment descriptor size */ /* Segment identifier size */ /* SPK data type */ /* Range of printing characters */ /* Number of items in a segment */ /* Standard SPICE error handling. */ if (return_()) { return 0; } chkin_("SPKW15", (ftnlen)6); /* Fetch the various entities from the inputs and put them into */ /* the data record, first the epoch. */ record[0] = *epoch; /* Convert TP and PA to unit vectors. */ vhat_(pa, mypa); vhat_(tp, mytp); /* The trajectory pole vector. */ vequ_(mytp, &record[1]); /* The periapsis vector. */ vequ_(mypa, &record[4]); /* Semi-latus rectum ( P in the P/(1 + ECC*COS(Nu) ), */ /* and eccentricity. */ record[7] = *p; record[8] = *ecc; /* J2 processing flag. */ record[9] = *j2flg; /* Central body pole vector. */ vhat_(pv, &record[10]); /* The central mass, J2 and radius of the central body. */ record[13] = *gm; record[14] = *j2; record[15] = *radius; /* Check all the inputs here for obvious failures. It's much */ /* better to check them now and quit than it is to get a bogus */ /* segment into an SPK file and diagnose it later. */ 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_("SPKW15", (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_("SPKW15", (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_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(tp)) { setmsg_("The trajectory pole vector supplied to SPKW15 had length ze" "ro. The most likely cause of this problem is an uninitialize" "d vector.", (ftnlen)128); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(pa)) { setmsg_("The periapse vector supplied to SPKW15 had length zero. The" " most likely cause of this problem is an uninitialized vecto" "r.", (ftnlen)121); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (vzero_(pv)) { setmsg_("The central pole vector supplied to SPKW15 had length zero." " The most likely cause of this problem is an uninitialized v" "ector. ", (ftnlen)126); sigerr_("SPICE(BADVECTOR)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } else if (*radius < 0.) { setmsg_("The central body radius was negative. It must be zero or po" "sitive. The value supplied was #. ", (ftnlen)94); errdp_("#", radius, (ftnlen)1); sigerr_("SPICE(BADRADIUS)", (ftnlen)16); chkout_("SPKW15", (ftnlen)6); return 0; } /* 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_(mypa, mytp); if (abs(dot) > 1e-5) { angle = vsep_(pa, tp) * dpr_(); setmsg_("The periapsis and trajectory pole vectors are not orthogona" "l. The angle between them is # degrees. ", (ftnlen)99); errdp_("#", &angle, (ftnlen)1); sigerr_("SPICE(BADINITSTATE)", (ftnlen)19); chkout_("SPKW15", (ftnlen)6); return 0; } /* Make sure the segment identifier is not too long. */ if (lastnb_(segid, segid_len) > 40) { setmsg_("Segment identifier contains more than 40 characters.", ( ftnlen)52); sigerr_("SPICE(SEGIDTOOLONG)", (ftnlen)19); chkout_("SPKW15", (ftnlen)6); return 0; } /* Make sure it has only printing characters. */ i__1 = lastnb_(segid, segid_len); for (i__ = 1; i__ <= i__1; ++i__) { value = *(unsigned char *)&segid[i__ - 1]; if (value < 32 || value > 126) { setmsg_("The segment identifier contains the nonprintable charac" "ter having ascii code #.", (ftnlen)79); errint_("#", &value, (ftnlen)1); sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24); chkout_("SPKW15", (ftnlen)6); return 0; } } /* All of the obvious checks have been performed on the input */ /* record. Create the segment descriptor. (FIRST and LAST are */ /* checked by SPKPDS as well as consistency between BODY and CENTER). */ spkpds_(body, center, frame, &c__15, first, last, descr, frame_len); if (failed_()) { chkout_("SPKW15", (ftnlen)6); return 0; } /* Begin a new segment. */ dafbna_(handle, descr, segid, segid_len); if (failed_()) { chkout_("SPKW15", (ftnlen)6); return 0; } dafada_(record, &c__16); if (! failed_()) { dafena_(); } chkout_("SPKW15", (ftnlen)6); return 0; } /* spkw15_ */