示例#1
0
/* $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, &cent, &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_ */
示例#2
0
文件: zzspkap1.c 项目: msanrivo/coft
/* $Procedure ZZSPKAP1 ( S/P Kernel, apparent state ) */
/* Subroutine */ int zzspkap1_(integer *targ, doublereal *et, char *ref, 
	doublereal *sobs, char *abcorr, doublereal *starg, doublereal *lt, 
	ftnlen ref_len, ftnlen abcorr_len)
{
    /* Initialized data */

    static logical first = TRUE_;
    static char flags[5*9] = "NONE " "LT   " "LT+S " "CN   " "CN+S " "XLT  " 
	    "XLT+S" "XCN  " "XCN+S";
    static char prvcor[5] = "     ";

    /* System generated locals */
    integer i__1;
    doublereal d__1;

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    char corr[5];
    extern /* Subroutine */ int zzspksb1_(integer *, doublereal *, char *, 
	    doublereal *, ftnlen);
    static logical xmit;
    extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
    integer i__, refid;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen), moved_(doublereal *, integer *, doublereal *);
    static logical usecn;
    doublereal sapos[3];
    extern /* Subroutine */ int vsubg_(doublereal *, doublereal *, integer *, 
	    doublereal *);
    static logical uselt;
    extern doublereal vnorm_(doublereal *), clight_(void);
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
    extern /* Subroutine */ int stelab_(doublereal *, doublereal *, 
	    doublereal *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), 
	    stlabx_(doublereal *, doublereal *, doublereal *);
    integer ltsign;
    extern /* Subroutine */ int ljucrs_(integer *, char *, char *, ftnlen, 
	    ftnlen), setmsg_(char *, ftnlen);
    doublereal tstate[6];
    integer maxitr;
    extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen);
    extern logical return_(void);
    static logical usestl;
    extern logical odd_(integer *);

/* $ Abstract */

/*     Deprecated: This routine has been superseded by SPKAPS. This */
/*     routine is supported for purposes of backward compatibility only. */

/*     Return the state (position and velocity) of a target body */
/*     relative to an observer, optionally corrected for light time and */
/*     stellar aberration. */

/* $ 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 */
/*     --------  ---  -------------------------------------------------- */
/*     TARG       I   Target body. */
/*     ET         I   Observer epoch. */
/*     REF        I   Inertial reference frame of observer's state. */
/*     SOBS       I   State of observer wrt. solar system barycenter. */
/*     ABCORR     I   Aberration correction flag. */
/*     STARG      O   State of target. */
/*     LT         O   One way light time between observer and target. */

/* $ Detailed_Input */

/*     TARG        is the NAIF ID code for a target body.  The target */
/*                 and observer define a state vector whose position */
/*                 component points from the observer to the target. */

/*     ET          is the ephemeris time, expressed as seconds past J2000 */
/*                 TDB, at which the state of the target body relative to */
/*                 the observer is to be computed.  ET refers to time at */
/*                 the observer's location. */

/*     REF         is the inertial reference frame with respect to which */
/*                 the observer's state SOBS is expressed. REF must be */
/*                 recognized by the SPICE Toolkit.  The acceptable */
/*                 frames are listed in the Frames Required Reading, as */
/*                 well as in the SPICELIB routine CHGIRF. */

/*                 Case and blanks are not significant in the string REF. */

/*     SOBS        is the geometric (uncorrected) state of the observer */
/*                 relative to the solar system barycenter at epoch ET. */
/*                 SOBS is a 6-vector:  the first three components of */
/*                 SOBS represent a Cartesian position vector; the last */
/*                 three components represent the corresponding velocity */
/*                 vector.  SOBS is expressed relative to the inertial */
/*                 reference frame designated by REF. */

/*                 Units are always km and km/sec. */

/*     ABCORR      indicates the aberration corrections to be applied */
/*                 to the state of the target body to account for one-way */
/*                 light time and stellar aberration.  See the discussion */
/*                 in the Particulars section for recommendations on */
/*                 how to choose aberration corrections. */

/*                 ABCORR may be any of the following: */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric state of the target body */
/*                               relative to the observer. */

/*                 The following values of ABCORR apply to the */
/*                 "reception" case in which photons depart from the */
/*                 target's location at the light-time corrected epoch */
/*                 ET-LT and *arrive* at the observer's location at ET: */

/*                    'LT'       Correct for one-way light time (also */
/*                               called "planetary aberration") using a */
/*                               Newtonian formulation. This correction */
/*                               yields the state of the target at the */
/*                               moment it emitted photons arriving at */
/*                               the observer at ET. */

/*                               The light time correction involves */
/*                               iterative solution of the light time */
/*                               equation (see Particulars for details). */
/*                               The solution invoked by the 'LT' option */
/*                               uses one iteration. */

/*                    'LT+S'     Correct for one-way light time and */
/*                               stellar aberration using a Newtonian */
/*                               formulation. This option modifies the */
/*                               state obtained with the 'LT' option to */
/*                               account for the observer's velocity */
/*                               relative to the solar system */
/*                               barycenter. The result is the apparent */
/*                               state of the target---the position and */
/*                               velocity of the target as seen by the */
/*                               observer. */

/*                    'CN'       Converged Newtonian light time */
/*                               correction. In solving the light time */
/*                               equation, the 'CN' correction iterates */
/*                               until the solution converges (three */
/*                               iterations on all supported platforms). */
/*                               Whether the 'CN+S' solution is */
/*                               substantially more accurate than the */
/*                               'LT' solution depends on the geometry */
/*                               of the participating objects and on the */
/*                               accuracy of the input data. In all */
/*                               cases this routine will execute more */
/*                               slowly when a converged solution is */
/*                               computed. See the Particulars section */
/*                               of SPKEZR for a discussion of precision */
/*                               of light time corrections. */

/*                    'CN+S'     Converged Newtonian light time */
/*                               correction and stellar aberration */
/*                               correction. */


/*                 The following values of ABCORR apply to the */
/*                 "transmission" case in which photons *depart* from */
/*                 the observer's location at ET and arrive at the */
/*                 target's location at the light-time corrected epoch */
/*                 ET+LT: */

/*                    'XLT'      "Transmission" case:  correct for */
/*                               one-way light time using a Newtonian */
/*                               formulation. This correction yields the */
/*                               state of the target at the moment it */
/*                               receives photons emitted from the */
/*                               observer's location at ET. */

/*                    'XLT+S'    "Transmission" case:  correct for */
/*                               one-way light time and stellar */
/*                               aberration using a Newtonian */
/*                               formulation  This option modifies the */
/*                               state obtained with the 'XLT' option to */
/*                               account for the observer's velocity */
/*                               relative to the solar system */
/*                               barycenter. The position component of */
/*                               the computed target state indicates the */
/*                               direction that photons emitted from the */
/*                               observer's location must be "aimed" to */
/*                               hit the target. */

/*                    'XCN'      "Transmission" case:  converged */
/*                               Newtonian light time correction. */

/*                    'XCN+S'    "Transmission" case:  converged */
/*                               Newtonian light time correction and */
/*                               stellar aberration correction. */

/*                 Neither special nor general relativistic effects are */
/*                 accounted for in the aberration corrections applied */
/*                 by this routine. */

/*                 Case and blanks are not significant in the string */
/*                 ABCORR. */

/* $ Detailed_Output */

/*     STARG       is a Cartesian state vector representing the position */
/*                 and velocity of the target body relative to the */
/*                 specified observer. STARG is corrected for the */
/*                 specified aberrations, and is expressed with respect */
/*                 to the specified inertial reference frame.  The first */
/*                 three components of STARG represent the x-, y- and */
/*                 z-components of the target's position; last three */
/*                 components form the corresponding velocity vector. */

/*                 The position component of STARG points from the */
/*                 observer's location at ET to the aberration-corrected */
/*                 location of the target. Note that the sense of the */
/*                 position vector is independent of the direction of */
/*                 radiation travel implied by the aberration */
/*                 correction. */

/*                 The velocity component of STARG is obtained by */
/*                 evaluating the target's geometric state at the light */
/*                 time corrected epoch, so for aberration-corrected */
/*                 states, the velocity is not precisely equal to the */
/*                 time derivative of the position. */

/*                 Units are always km and km/sec. */

/*     LT          is the one-way light time between the observer and */
/*                 target in seconds.  If the target state is corrected */
/*                 for aberrations, then LT is the one-way light time */
/*                 between the observer and the light time corrected */
/*                 target location. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If the value of ABCORR is not recognized, the error */
/*        'SPICE(SPKINVALIDOPTION)' is signaled. */

/*     2) If the reference frame requested is not a recognized */
/*        inertial reference frame, the error 'SPICE(BADFRAME)' */
/*        is signaled. */

/*     3) If the state of the target relative to the solar system */
/*        barycenter cannot be computed, the error will be diagnosed */
/*        by routines in the call tree of this routine. */

/* $ Files */

/*     This routine computes states using SPK files that have been */
/*     loaded into the SPICE system, normally via the kernel loading */
/*     interface routine FURNSH.  Application programs typically load */
/*     kernels once before this routine is called, for example during */
/*     program initialization; kernels need not be loaded repeatedly. */
/*     See the routine FURNSH and the SPK and KERNEL Required Reading */
/*     for further information on loading (and unloading) kernels. */

/*     If any of the ephemeris data used to compute STARG are expressed */
/*     relative to a non-inertial frame in the SPK files providing those */
/*     data, additional kernels may be needed to enable the reference */
/*     frame transformations required to compute the state.  Normally */
/*     these additional kernels are PCK files or frame kernels.  Any */
/*     such kernels must already be loaded at the time this routine is */
/*     called. */

/* $ Particulars */

/*     In space science or engineering applications one frequently */
/*     wishes to know where to point a remote sensing instrument, such */
/*     as an optical camera or radio antenna, in order to observe or */
/*     otherwise receive radiation from a target.  This pointing problem */
/*     is complicated by the finite speed of light:  one needs to point */
/*     to where the target appears to be as opposed to where it actually */
/*     is at the epoch of observation.  We use the adjectives */
/*     "geometric," "uncorrected," or "true" to refer to an actual */
/*     position or state of a target at a specified epoch.  When a */
/*     geometric position or state vector is modified to reflect how it */
/*     appears to an observer, we describe that vector by any of the */
/*     terms "apparent," "corrected," "aberration corrected," or "light */
/*     time and stellar aberration corrected." */

/*     The SPICE Toolkit can correct for two phenomena affecting the */
/*     apparent location of an object:  one-way light time (also called */
/*     "planetary aberration") and stellar aberration.  Correcting for */
/*     one-way light time is done by computing, given an observer and */
/*     observation epoch, where a target was when the observed photons */
/*     departed the target's location.  The vector from the observer to */
/*     this computed target location is called a "light time corrected" */
/*     vector.  The light time correction depends on the motion of the */
/*     target, but it is independent of the velocity of the observer */
/*     relative to the solar system barycenter. Relativistic effects */
/*     such as light bending and gravitational delay are not accounted */
/*     for in the light time correction performed by this routine. */

/*     The velocity of the observer also affects the apparent location */
/*     of a target:  photons arriving at the observer are subject to a */
/*     "raindrop effect" whereby their velocity relative to the observer */
/*     is, using a Newtonian approximation, the photons' velocity */
/*     relative to the solar system barycenter minus the velocity of the */
/*     observer relative to the solar system barycenter.  This effect is */
/*     called "stellar aberration."  Stellar aberration is independent */
/*     of the velocity of the target.  The stellar aberration formula */
/*     used by this routine is non-relativistic. */

/*     Stellar aberration corrections are applied after light time */
/*     corrections:  the light time corrected target position vector is */
/*     used as an input to the stellar aberration correction. */

/*     When light time and stellar aberration corrections are both */
/*     applied to a geometric position vector, the resulting position */
/*     vector indicates where the target "appears to be" from the */
/*     observer's location. */

/*     As opposed to computing the apparent position of a target, one */
/*     may wish to compute the pointing direction required for */
/*     transmission of photons to the target.  This requires correction */
/*     of the geometric target position for the effects of light time and */
/*     stellar aberration, but in this case the corrections are computed */
/*     for radiation traveling from the observer to the target. */

/*     The "transmission" light time correction yields the target's */
/*     location as it will be when photons emitted from the observer's */
/*     location at ET arrive at the target.  The transmission stellar */
/*     aberration correction is the inverse of the traditional stellar */
/*     aberration correction:  it indicates the direction in which */
/*     radiation should be emitted so that, using a Newtonian */
/*     approximation, the sum of the velocity of the radiation relative */
/*     to the observer and of the observer's velocity, relative to the */
/*     solar system barycenter, yields a velocity vector that points in */
/*     the direction of the light time corrected position of the target. */

/*     The traditional aberration corrections applicable to observation */
/*     and those applicable to transmission are related in a simple way: */
/*     one may picture the geometry of the "transmission" case by */
/*     imagining the "observation" case running in reverse time order, */
/*     and vice versa. */

/*     One may reasonably object to using the term "observer" in the */
/*     transmission case, in which radiation is emitted from the */
/*     observer's location.  The terminology was retained for */
/*     consistency with earlier documentation. */

/*     Below, we indicate the aberration corrections to use for some */
/*     common applications: */

/*        1) Find the apparent direction of a target for a remote-sensing */
/*           observation. */

/*              Use 'LT+S' or 'CN+S: apply both light time and stellar */
/*              aberration corrections. */

/*           Note that using light time corrections alone ('LT' or 'CN') */
/*           is generally not a good way to obtain an approximation to */
/*           an apparent target vector: since light time and stellar */
/*           aberration corrections often partially cancel each other, */
/*           it may be more accurate to use no correction at all than to */
/*           use light time alone. */


/*        2) Find the corrected pointing direction to radiate a signal */
/*           to a target. This computation is often applicable for */
/*           implementing communications sessions. */

/*              Use 'XLT+S' or 'XCN+S: apply both light time and stellar */
/*              aberration corrections for transmission. */


/*        3) Compute the apparent position of a target body relative */
/*           to a star or other distant object. */

/*              Use 'LT', 'CN', 'LT+S', or 'CN+S' as needed to match the */
/*              correction applied to the position of the distant */
/*              object. For example, if a star position is obtained from */
/*              a catalog, the position vector may not be corrected for */
/*              stellar aberration. In this case, to find the angular */
/*              separation of the star and the limb of a planet, the */
/*              vector from the observer to the planet should be */
/*              corrected for light time but not stellar aberration. */


/*        4) Obtain an uncorrected state vector derived directly from */
/*           data in an SPK file. */

/*              Use 'NONE'. */
/* C */

/*        5) Use a geometric state vector as a low-accuracy estimate */
/*           of the apparent state for an application where execution */
/*           speed is critical: */

/*              Use 'NONE'. */


/*        6) While this routine cannot perform the relativistic */
/*           aberration corrections required to compute states */
/*           with the highest possible accuracy, it can supply the */
/*           geometric states required as inputs to these computations: */

/*              Use 'NONE', then apply high-accuracy aberration */
/*              corrections (not available in the SPICE Toolkit). */


/*     Below, we discuss in more detail how the aberration corrections */
/*     applied by this routine are computed. */


/*     Geometric case */
/*     ============== */

/*        SPKAPP begins by computing the geometric position T(ET) of the */
/*        target body relative to the solar system barycenter (SSB). */
/*        Subtracting the geometric position of the observer O(ET) gives */
/*        the geometric position of the target body relative to the */
/*        observer. The one-way light time, LT, is given by */

/*                  | T(ET) - O(ET) | */
/*           LT = ------------------- */
/*                          c */

/*        The geometric relationship between the observer, target, and */
/*        solar system barycenter is as shown: */


/*           SSB ---> O(ET) */
/*            |      / */
/*            |     / */
/*            |    / */
/*            |   /  T(ET) - O(ET) */
/*            V  V */
/*           T(ET) */


/*        The returned state consists of the position vector */

/*           T(ET) - O(ET) */

/*        and a velocity obtained by taking the difference of the */
/*        corresponding velocities.  In the geometric case, the */
/*        returned velocity is actually the time derivative of the */
/*        position. */


/*     Reception case */
/*     ============== */

/*        When any of the options 'LT', 'CN', 'LT+S', 'CN+S' is */
/*        selected, SPKAPP computes the position of the target body at */
/*        epoch ET-LT, where LT is the one-way light time.  Let T(t) and */
/*        O(t) represent the positions of the target and observer */
/*        relative to the solar system barycenter at time t; then LT is */
/*        the solution of the light-time equation */

/*                  | T(ET-LT) - O(ET) | */
/*           LT = ------------------------                            (1) */
/*                           c */

/*        The ratio */

/*            | T(ET) - O(ET) | */
/*          ---------------------                                     (2) */
/*                    c */

/*        is used as a first approximation to LT; inserting (2) into the */
/*        RHS of the light-time equation (1) yields the "one-iteration" */
/*        estimate of the one-way light time. Repeating the process */
/*        until the estimates of LT converge yields the "converged */
/*        Newtonian" light time estimate. */

/*        Subtracting the geometric position of the observer O(ET) gives */
/*        the position of the target body relative to the observer: */
/*        T(ET-LT) - O(ET). */

/*           SSB ---> O(ET) */
/*            | \     | */
/*            |  \    | */
/*            |   \   | T(ET-LT) - O(ET) */
/*            |    \  | */
/*            V     V V */
/*           T(ET)  T(ET-LT) */

/*        The position component of the light-time corrected state */
/*        is the vector */

/*           T(ET-LT) - O(ET) */

/*        The velocity component of the light-time corrected state */
/*        is the difference */

/*           T_vel(ET-LT) - O_vel(ET) */

/*        where T_vel and O_vel are, respectively, the velocities of */
/*        the target and observer relative to the solar system */
/*        barycenter at the epochs ET-LT and ET. */

/*        If correction for stellar aberration is requested, the target */
/*        position is rotated toward the solar system barycenter- */
/*        relative velocity vector of the observer. The rotation is */
/*        computed as follows: */

/*           Let r be the light time corrected vector from the observer */
/*           to the object, and v be the velocity of the observer with */
/*           respect to the solar system barycenter. Let w be the angle */
/*           between them. The aberration angle phi is given by */

/*              sin(phi) = v sin(w) / c */

/*           Let h be the vector given by the cross product */

/*              h = r X v */

/*           Rotate r by phi radians about h to obtain the apparent */
/*           position of the object. */

/*        The velocity component of the output state STARG is */
/*        not corrected for stellar aberration. */


/*     Transmission case */
/*     ================== */

/*        When any of the options 'XLT', 'XCN', 'XLT+S', 'XCN+S' are */
/*        selected, SPKAPP computes the position of the target body T at */
/*        epoch ET+LT, where LT is the one-way light time.  LT is the */
/*        solution of the light-time equation */

/*                  | T(ET+LT) - O(ET) | */
/*           LT = ------------------------                            (3) */
/*                            c */

/*        Subtracting the geometric position of the observer, O(ET), */
/*        gives the position of the target body relative to the */
/*        observer: T(ET-LT) - O(ET). */

/*                   SSB --> O(ET) */
/*                  / |    * */
/*                 /  |  *  T(ET+LT) - O(ET) */
/*                /   |* */
/*               /   *| */
/*              V  V  V */
/*          T(ET+LT)  T(ET) */

/*        The position component of the light-time corrected state */
/*        is the vector */

/*           T(ET+LT) - O(ET) */

/*        The velocity component of the light-time corrected state */
/*        is the difference */

/*           T_vel(ET+LT) - O_vel(ET) */

/*        where T_vel and O_vel are, respectively, the velocities of */
/*        the target and observer relative to the solar system */
/*        barycenter at the epochs ET+LT and ET. */

/*        If correction for stellar aberration is requested, the target */
/*        position is rotated away from the solar system barycenter- */
/*        relative velocity vector of the observer. The rotation is */
/*        computed as in the reception case, but the sign of the */
/*        rotation angle is negated. */

/*        The velocity component of the output state STARG is */
/*        not corrected for stellar aberration. */

/*     Neither special nor general relativistic effects are accounted */
/*     for in the aberration corrections performed by this routine. */

/* $ Examples */

/*     In the following code fragment, SPKSSB and SPKAPP are used */
/*     to display the position of Io (body 501) as seen from the */
/*     Voyager 2 spacecraft (Body -32) at a series of epochs. */

/*     Normally, one would call the high-level reader SPKEZR to obtain */
/*     state vectors.  The example below illustrates the interface */
/*     of this routine but is not intended as a recommendation on */
/*     how to use the SPICE SPK subsystem. */

/*     The use of integer ID codes is necessitated by the low-level */
/*     interface of this routine. */

/*        IO    = 501 */
/*        VGR2  = -32 */

/*        DO WHILE ( EPOCH .LE. END ) */

/*           CALL SPKSSB (  VGR2,   EPOCH,  'J2000',  STVGR2  ) */
/*           CALL SPKAPP (  IO,     EPOCH,  'J2000',  STVGR2, */
/*       .                 'LT+S',  STIO,    LT               ) */

/*           CALL RECRAD (  STIO,   RANGE,   RA,      DEC     ) */
/*           WRITE (*,*)  RA * DPR(),  DEC * DPR() */

/*           EPOCH = EPOCH + DELTA */

/*        END DO */

/* $ Restrictions */

/*     1) The kernel files to be used by SPKAPP must be loaded */
/*        (normally by the SPICELIB kernel loader FURNSH) before */
/*        this routine is called. */

/*     2) Unlike most other SPK state computation routines, this */
/*        routine requires that the input state be relative to an */
/*        inertial reference frame.  Non-inertial frames are not */
/*        supported by this routine. */

/*     3) In a future version of this routine, the implementation */
/*        of the aberration corrections may be enhanced to improve */
/*        accuracy. */

/* $ Literature_References */

/*     SPK Required Reading. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */
/*     H.A. Neilan     (JPL) */
/*     W.L. Taber      (JPL) */
/*     B.V. Semenov    (JPL) */
/*     I.M. Underwood  (JPL) */

/* $ Version */

/* -    SPICELIB Version 3.1.0, 04-JUL-2014 (NJB) (BVS) */

/*        Discussion of light time corrections was updated. Assertions */
/*        that converged light time corrections are unlikely to be */
/*        useful were removed. */

/*     Last update was 21-SEP-2013 (BVS) */

/*        Updated to call LJUCRS instead of CMPRSS/UCASE. */

/* -    SPICELIB Version 3.0.3, 18-MAY-2010 (BVS) */

/*        Index lines now state that this routine is deprecated. */

/* -    SPICELIB Version 3.0.2, 08-JAN-2008 (NJB) */

/*        The Abstract section of the header was updated to */
/*        indicate that this routine has been deprecated. */

/* -    SPICELIB Version 3.0.1, 20-OCT-2003 (EDW) */

/*        Added mention that LT returns in seconds. */
/*        Corrected spelling errors. */

/* -    SPICELIB Version 3.0.0, 18-DEC-2001 (NJB) */

/*        Updated to handle aberration corrections for transmission */
/*        of radiation.  Formerly, only the reception case was */
/*        supported.  The header was revised and expanded to explain */
/*        the functionality of this routine in more detail. */

/* -    SPICELIB Version 2.1.0, 09-JUL-1996 (WLT) */

/*        Corrected the description of LT in the Detailed Output */
/*        section of the header. */

/* -    SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */

/*        The routine was modified to support the options 'CN' and */
/*        'CN+S' aberration corrections.  Moreover, diagnostics were */
/*        added to check for reference frames that are not recognized */
/*        inertial frames. */

/* -    SPICELIB Version 1.1.2, 10-MAR-1992 (WLT) */

/*        Comment section for permuted index source lines was added */
/*        following the header. */

/* -    SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */

/*        In the example program, the calling sequence of SPKAPP */
/*        was corrected. */

/* -    SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */

/*        The local variable CORR was added to eliminate a */
/*        run-time error that occurred when SPKAPP was determining */
/*        what corrections to apply to the state. */

/* -    SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */

/*        Literature references added to the header. */

/* -    SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */

/* -& */
/* $ Index_Entries */

/*     DEPRECATED low-level aberration correction */
/*     DEPRECATED apparent state from spk file */
/*     DEPRECATED get apparent state */

/* -& */
/* $ Revisions */

/* -    SPICELIB Version 2.0.0, 22-MAY-1995 (WLT) */

/*        The routine was modified to support the options 'CN' and */
/*        'CN+S' aberration corrections.  Moreover, diagnostics were */
/*        added to check for reference frames that are not recognized */
/*        inertial frames. */

/* -    SPICELIB Version 1.1.1, 06-MAR-1991 (JML) */

/*        In the example program, the calling sequence of SPKAPP */
/*        was corrected. */

/* -    SPICELIB Version 1.1.0, 25-MAY-1990 (HAN) */

/*        The local variable CORR was added to eliminate a run-time */
/*        error that occurred when SPKAPP was determining what */
/*        corrections to apply to the state. If the literal string */
/*        'LT' was assigned to ABCORR, SPKAPP attempted to look at */
/*        ABCORR(3:4). Because ABCORR is a passed length argument, its */
/*        length is not guaranteed, and those positions may not exist. */
/*        Searching beyond the bounds of a string resulted in a */
/*        run-time error at NAIF because NAIF compiles SPICELIB using the */
/*        CHECK=BOUNDS option for the DEC VAX/VMX DCL FORTRAN command. */
/*        Also, without the local variable CORR, SPKAPP would have to */
/*        modify the value of a passed argument, ABCORR. That's a no no. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Indices of flags in the FLAGS array: */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("ZZSPKAP1", (ftnlen)8);
    }
    if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {

/*        The aberration correction flag differs from the value it */
/*        had on the previous call, if any.  Analyze the new flag. */

/*        Remove leading and embedded white space from the aberration */
/*        correction flag and convert to upper case. */

	ljucrs_(&c__0, abcorr, corr, abcorr_len, (ftnlen)5);

/*        Locate the flag in our list of flags. */

	i__ = isrchc_(corr, &c__9, flags, (ftnlen)5, (ftnlen)5);
	if (i__ == 0) {
	    setmsg_("Requested aberration correction # is not supported.", (
		    ftnlen)51);
	    errch_("#", abcorr, (ftnlen)1, abcorr_len);
	    sigerr_("SPICE(SPKINVALIDOPTION)", (ftnlen)23);
	    chkout_("ZZSPKAP1", (ftnlen)8);
	    return 0;
	}

/*        The aberration correction flag is recognized; save it. */

	s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);

/*        Set logical flags indicating the attributes of the requested */
/*        correction. */

	xmit = i__ > 5;
	uselt = i__ == 2 || i__ == 3 || i__ == 6 || i__ == 7;
	usestl = i__ > 1 && odd_(&i__);
	usecn = i__ == 4 || i__ == 5 || i__ == 8 || i__ == 9;
	first = FALSE_;
    }

/*     See if the reference frame is a recognized inertial frame. */

    irfnum_(ref, &refid, ref_len);
    if (refid == 0) {
	setmsg_("The requested frame '#' is not a recognized inertial frame. "
		, (ftnlen)60);
	errch_("#", ref, (ftnlen)1, ref_len);
	sigerr_("SPICE(BADFRAME)", (ftnlen)15);
	chkout_("ZZSPKAP1", (ftnlen)8);
	return 0;
    }

/*     Determine the sign of the light time offset. */

    if (xmit) {
	ltsign = 1;
    } else {
	ltsign = -1;
    }

/*     Find the geometric state of the target body with respect to the */
/*     solar system barycenter. Subtract the state of the observer */
/*     to get the relative state. Use this to compute the one-way */
/*     light time. */

    zzspksb1_(targ, et, ref, starg, ref_len);
    vsubg_(starg, sobs, &c__6, tstate);
    moved_(tstate, &c__6, starg);
    *lt = vnorm_(starg) / clight_();

/*     To correct for light time, find the state of the target body */
/*     at the current epoch minus the one-way light time. Note that */
/*     the observer remains where he is. */

    if (uselt) {
	maxitr = 1;
    } else if (usecn) {
	maxitr = 3;
    } else {
	maxitr = 0;
    }
    i__1 = maxitr;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = *et + ltsign * *lt;
	zzspksb1_(targ, &d__1, ref, starg, ref_len);
	vsubg_(starg, sobs, &c__6, tstate);
	moved_(tstate, &c__6, starg);
	*lt = vnorm_(starg) / clight_();
    }

/*     At this point, STARG contains the light time corrected */
/*     state of the target relative to the observer. */

/*     If stellar aberration correction is requested, perform it now. */

/*     Stellar aberration corrections are not applied to the target's */
/*     velocity. */

    if (usestl) {
	if (xmit) {

/*           This is the transmission case. */

/*           Compute the position vector obtained by applying */
/*           "reception" stellar aberration to STARG. */

	    stlabx_(starg, &sobs[3], sapos);
	    vequ_(sapos, starg);
	} else {

/*           This is the reception case. */

/*           Compute the position vector obtained by applying */
/*           "reception" stellar aberration to STARG. */

	    stelab_(starg, &sobs[3], sapos);
	    vequ_(sapos, starg);
	}
    }
    chkout_("ZZSPKAP1", (ftnlen)8);
    return 0;
} /* zzspkap1_ */
示例#3
0
/* $Procedure ZZSPKAS1 ( SPK, apparent state ) */
/* Subroutine */ int zzspkas1_(integer *targ, doublereal *et, char *ref, char 
	*abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, 
	doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len)
{
    /* Initialized data */

    static logical first = TRUE_;
    static char prvcor[5] = "     ";

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
	    ), vequ_(doublereal *, doublereal *);
    static logical xmit;
    extern /* Subroutine */ int zzspklt1_(integer *, doublereal *, char *, 
	    char *, doublereal *, doublereal *, doublereal *, doublereal *, 
	    ftnlen, ftnlen), zzstelab_(logical *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *), zzprscor_(char *, 
	    logical *, ftnlen);
    integer refid;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    doublereal pcorr[3];
    static logical uselt;
    extern logical failed_(void);
    logical attblk[15];
    doublereal dpcorr[3], corvel[3];
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, 
	    ftnlen);
    doublereal corpos[3];
    extern logical return_(void);
    static logical usestl;

/* $ Abstract */

/*     Given the state and acceleration of an observer relative to the */
/*     solar system barycenter, return the state (position and velocity) */
/*     of a target body relative to the observer, optionally corrected */
/*     for light time and stellar aberration. All input and output */
/*     vectors are expressed relative to an inertial reference frame. */

/*     This routine supersedes SPKAPP. */

/*     SPICE users normally should call the high-level API routines */
/*     SPKEZR or SPKEZ rather than this routine. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */
/* $ Abstract */

/*     Include file zzabcorr.inc */

/*     SPICE private file intended solely for the support of SPICE */
/*     routines.  Users should not include this file directly due */
/*     to the volatile nature of this file */

/*     The parameters below define the structure of an aberration */
/*     correction attribute block. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Parameters */

/*     An aberration correction attribute block is an array of logical */
/*     flags indicating the attributes of the aberration correction */
/*     specified by an aberration correction string.  The attributes */
/*     are: */

/*        - Is the correction "geometric"? */

/*        - Is light time correction indicated? */

/*        - Is stellar aberration correction indicated? */

/*        - Is the light time correction of the "converged */
/*          Newtonian" variety? */

/*        - Is the correction for the transmission case? */

/*        - Is the correction relativistic? */

/*    The parameters defining the structure of the block are as */
/*    follows: */

/*       NABCOR    Number of aberration correction choices. */

/*       ABATSZ    Number of elements in the aberration correction */
/*                 block. */

/*       GEOIDX    Index in block of geometric correction flag. */

/*       LTIDX     Index of light time flag. */

/*       STLIDX    Index of stellar aberration flag. */

/*       CNVIDX    Index of converged Newtonian flag. */

/*       XMTIDX    Index of transmission flag. */

/*       RELIDX    Index of relativistic flag. */

/*    The following parameter is not required to define the block */
/*    structure, but it is convenient to include it here: */

/*       CORLEN    The maximum string length required by any aberration */
/*                 correction string */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */

/* -& */
/*     Number of aberration correction choices: */


/*     Aberration correction attribute block size */
/*     (number of aberration correction attributes): */


/*     Indices of attributes within an aberration correction */
/*     attribute block: */


/*     Maximum length of an aberration correction string: */


/*     End of include file zzabcorr.inc */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TARG       I   Target body. */
/*     ET         I   Observer epoch. */
/*     REF        I   Inertial reference frame of output state. */
/*     ABCORR     I   Aberration correction flag. */
/*     STOBS      I   State of the observer relative to the SSB. */
/*     ACCOBS     I   Acceleration of the observer relative to the SSB. */
/*     STARG      O   State of target. */
/*     LT         O   One way light time between observer and target. */
/*     DLT        O   Derivative of light time with respect to time. */

/* $ Detailed_Input */

/*     TARG        is the NAIF ID code for a target body.  The target */
/*                 and observer define a state vector whose position */
/*                 component points from the observer to the target. */

/*     ET          is the ephemeris time, expressed as seconds past */
/*                 J2000 TDB, at which the state of the target body */
/*                 relative to the observer is to be computed.  ET */
/*                 refers to time at the observer's location. */

/*     REF         is the inertial reference frame with respect to which */
/*                 the input state STOBS, the input acceleration ACCOBS, */
/*                 and the output state STARG are expressed. REF must be */
/*                 recognized by the SPICE Toolkit.  The acceptable */
/*                 frames are listed in the Frames Required Reading, as */
/*                 well as in the SPICELIB routine CHGIRF. */

/*                 Case and blanks are not significant in the string */
/*                 REF. */

/*     ABCORR      indicates the aberration corrections to be applied */
/*                 to the state of the target body to account for one-way */
/*                 light time and stellar aberration. See the discussion */
/*                 in the header of SPKEZR for recommendations on */
/*                 how to choose aberration corrections. */

/*                 ABCORR may be any of the following: */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric state of the target body */
/*                               relative to the observer. */

/*                 The following values of ABCORR apply to the */
/*                 "reception" case in which photons depart from the */
/*                 target's location at the light-time corrected epoch */
/*                 ET-LT and *arrive* at the observer's location at ET: */

/*                    'LT'       Correct for one-way light time (also */
/*                               called "planetary aberration") using a */
/*                               Newtonian formulation. This correction */
/*                               yields the state of the target at the */
/*                               moment it emitted photons arriving at */
/*                               the observer at ET. */

/*                               The light time correction uses an */
/*                               iterative solution of the light time */
/*                               equation (see Particulars for details). */
/*                               The solution invoked by the 'LT' option */
/*                               uses one iteration. */

/*                    'LT+S'     Correct for one-way light time and */
/*                               stellar aberration using a Newtonian */
/*                               formulation. This option modifies the */
/*                               state obtained with the 'LT' option to */
/*                               account for the observer's velocity */
/*                               relative to the solar system */
/*                               barycenter. The result is the apparent */
/*                               state of the target---the position and */
/*                               velocity of the target as seen by the */
/*                               observer. */

/*                    'CN'       Converged Newtonian light time */
/*                               correction. In solving the light time */
/*                               equation, the 'CN' correction iterates */
/*                               until the solution converges (three */
/*                               iterations on all supported platforms). */

/*                               The 'CN' correction typically does not */
/*                               substantially improve accuracy because */
/*                               the errors made by ignoring */
/*                               relativistic effects may be larger than */
/*                               the improvement afforded by obtaining */
/*                               convergence of the light time solution. */
/*                               The 'CN' correction computation also */
/*                               requires a significantly greater number */
/*                               of CPU cycles than does the */
/*                               one-iteration light time correction. */

/*                    'CN+S'     Converged Newtonian light time */
/*                               and stellar aberration corrections. */


/*                 The following values of ABCORR apply to the */
/*                 "transmission" case in which photons *depart* from */
/*                 the observer's location at ET and arrive at the */
/*                 target's location at the light-time corrected epoch */
/*                 ET+LT: */

/*                    'XLT'      "Transmission" case:  correct for */
/*                               one-way light time using a Newtonian */
/*                               formulation. This correction yields the */
/*                               state of the target at the moment it */
/*                               receives photons emitted from the */
/*                               observer's location at ET. */

/*                    'XLT+S'    "Transmission" case:  correct for */
/*                               one-way light time and stellar */
/*                               aberration using a Newtonian */
/*                               formulation  This option modifies the */
/*                               state obtained with the 'XLT' option to */
/*                               account for the observer's velocity */
/*                               relative to the solar system */
/*                               barycenter. The position component of */
/*                               the computed target state indicates the */
/*                               direction that photons emitted from the */
/*                               observer's location must be "aimed" to */
/*                               hit the target. */

/*                    'XCN'      "Transmission" case:  converged */
/*                               Newtonian light time correction. */

/*                    'XCN+S'    "Transmission" case:  converged */
/*                               Newtonian light time and stellar */
/*                               aberration corrections. */


/*                 Neither special nor general relativistic effects are */
/*                 accounted for in the aberration corrections applied */
/*                 by this routine. */

/*                 Case and blanks are not significant in the string */
/*                 ABCORR. */


/*     STOBS       is the geometric state of the observer relative to */
/*                 the solar system barycenter at ET. STOBS is expressed */
/*                 relative to the reference frame designated by REF. */
/*                 The target and observer define a state vector whose */
/*                 position component points from the observer to the */
/*                 target. */

/*     ACCOBS      is the geometric acceleration of the observer */
/*                 relative to the solar system barycenter at ET. This */
/*                 is the derivative with respect to time of the */
/*                 velocity portion of STOBS. ACCOBS is expressed */
/*                 relative to the reference frame designated by REF. */

/*                 ACCOBS is used for computing stellar aberration */
/*                 corrected velocity. If stellar aberration corrections */
/*                 are not specified by ABCORR, ACCOBS is ignored; the */
/*                 caller need not provide a valid input value in this */
/*                 case. */

/* $ Detailed_Output */

/*     STARG       is a Cartesian state vector representing the position */
/*                 and velocity of the target body relative to the */
/*                 specified observer. STARG is corrected for the */
/*                 specified aberrations, and is expressed with respect */
/*                 to the inertial reference frame designated by REF. */
/*                 The first three components of STARG represent the x-, */
/*                 y- and z-components of the target's position; last */
/*                 three components form the corresponding velocity */
/*                 vector. */

/*                 The position component of STARG points from the */
/*                 observer's location at ET to the aberration-corrected */
/*                 location of the target. Note that the sense of the */
/*                 position vector is independent of the direction of */
/*                 radiation travel implied by the aberration */
/*                 correction. */

/*                 Units are always km and km/sec. */

/*     LT          is the one-way light time between the observer and */
/*                 target in seconds.  If the target state is corrected */
/*                 for light time, then LT is the one-way light time */
/*                 between the observer and the light time-corrected */
/*                 target location. */

/*     DLT         is the derivative with respect to barycentric */
/*                 dynamical time of the one way light time between */
/*                 target and observer: */

/*                    DLT = d(LT)/d(ET) */

/*                 DLT can also be described as the rate of change of */
/*                 one way light time. DLT is unitless, since LT and */
/*                 ET both have units of TDB seconds. */

/*                 If the observer and target are at the same position, */
/*                 then DLT is set to zero. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If the value of ABCORR is not recognized, the error */
/*        is diagnosed by a routine in the call tree of this */
/*        routine. */

/*     2) If ABCORR calls for stellar aberration but not light */
/*        time corrections, the error SPICE(NOTSUPPORTED) is */
/*        signaled. */

/*     3) If ABCORR calls for relativistic light time corrections, the */
/*        error SPICE(NOTSUPPORTED) is signaled. */

/*     4) If the reference frame requested is not a recognized */
/*        inertial reference frame, the error SPICE(BADFRAME) */
/*        is signaled. */

/*     5) If the state of the target relative to the solar system */
/*        barycenter cannot be computed, the error will be diagnosed */
/*        by routines in the call tree of this routine. */

/*     6) If the observer and target are at the same position, */
/*        then DLT is set to zero. This situation could arise, */
/*        for example, when the observer is Mars and the target */
/*        is the Mars barycenter. */

/* $ Files */

/*     This routine computes states using SPK files that have been */
/*     loaded into the SPICE system, normally via the kernel loading */
/*     interface routine FURNSH.  Application programs typically load */
/*     kernels once before this routine is called, for example during */
/*     program initialization; kernels need not be loaded repeatedly. */
/*     See the routine FURNSH and the SPK and KERNEL Required Reading */
/*     for further information on loading (and unloading) kernels. */

/*     If any of the ephemeris data used to compute STARG are expressed */
/*     relative to a non-inertial frame in the SPK files providing those */
/*     data, additional kernels may be needed to enable the reference */
/*     frame transformations required to compute the state. Normally */
/*     these additional kernels are PCK files or frame kernels. Any such */
/*     kernels must already be loaded at the time this routine is */
/*     called. */

/* $ Particulars */

/*     This routine supports higher-level SPK API routines that can */
/*     perform both light time and stellar aberration corrections. */

/*     User applications normally will not need to call this routine */
/*     directly. However, this routine can improve run-time efficiency */
/*     in situations where many targets are observed from the same */
/*     location at the same time. In such cases, the state and */
/*     acceleration of the observer relative to the solar system */
/*     barycenter need be computed only once per look-up epoch. */

/*     When apparent positions, rather than apparent states, are */
/*     required, consider using the high-level position-only API */
/*     routines */

/*        SPKPOS */
/*        SPKEZP */

/*     or the low-level, position-only analog of this routine */

/*        SPKAPO */

/*     In general, the position-only routines are more efficient. */

/*     See the header of the routine SPKEZR for a detailed discussion */
/*     of aberration corrections. */

/* $ Examples */

/*    1) Look up a sequence of states of the Moon as seen from the */
/*       Earth. Use light time and stellar aberration corrections. */
/*       Compute the first state for the epoch 2000 JAN 1 12:00:00 TDB; */
/*       compute subsequent states at intervals of 1 hour. For each */
/*       epoch, display the states, the one way light time between */
/*       target and observer, and the rate of change of the one way */
/*       light time. */

/*       Use the following meta-kernel to specify the kernels to */
/*       load: */

/*          KPL/MK */

/*          This meta-kernel is intended to support operation of SPICE */
/*          example programs. The kernels shown here should not be */
/*          assumed to contain adequate or correct versions of data */
/*          required by SPICE-based user applications. */

/*          In order for an application to use this meta-kernel, the */
/*          kernels referenced here must be present in the user's */
/*          current working directory. */


/*          \begindata */

/*             KERNELS_TO_LOAD = ( 'de418.bsp', */
/*                                 'pck00008.tpc', */
/*                                 'naif0008.tls'  ) */

/*          \begintext */


/*       The code example follows: */

/*           PROGRAM EX1 */
/*           IMPLICIT NONE */
/*     C */
/*     C     Local constants */
/*     C */
/*     C     The meta-kernel name shown here refers to a file whose */
/*     C     contents are those shown above. This file and the kernels */
/*     C     it references must exist in your current working directory. */
/*     C */
/*           CHARACTER*(*)         META */
/*           PARAMETER           ( META   = 'example.mk' ) */
/*     C */
/*     C     Use a time step of 1 hour; look up 5 states. */
/*     C */
/*           DOUBLE PRECISION      STEP */
/*           PARAMETER           ( STEP   = 3600.0D0 ) */

/*           INTEGER               MAXITR */
/*           PARAMETER           ( MAXITR = 5 ) */
/*     C */
/*     C     Local variables */
/*     C */
/*           DOUBLE PRECISION      ACC    ( 3 ) */
/*           DOUBLE PRECISION      DLT */
/*           DOUBLE PRECISION      ET */
/*           DOUBLE PRECISION      ET0 */
/*           DOUBLE PRECISION      LT */
/*           DOUBLE PRECISION      STATE  ( 6 ) */
/*           DOUBLE PRECISION      STATE0 ( 6 ) */
/*           DOUBLE PRECISION      STATE2 ( 6 ) */
/*           DOUBLE PRECISION      STOBS  ( 6 ) */
/*           DOUBLE PRECISION      TDELTA */
/*           INTEGER               I */

/*     C */
/*     C     Load the SPK and LSK kernels via the meta-kernel. */
/*     C */
/*           CALL FURNSH ( META ) */
/*     C */
/*     C     Convert the start time to seconds past J2000 TDB. */
/*     C */
/*           CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */
/*     C */
/*     C     Step through a series of epochs, looking up a */
/*     C     state vector at each one. */
/*     C */
/*           DO I = 1, MAXITR */

/*              ET = ET0 + (I-1)*STEP */

/*     C */
/*     C        Look up a state vector at epoch ET using the */
/*     C        following inputs: */
/*     C */
/*     C           Target:                 Moon (NAIF ID code 301) */
/*     C           Reference frame:        J2000 */
/*     C           Aberration correction:  Light time and stellar */
/*     C                                   aberration ('LT+S') */
/*     C           Observer:               Earth (NAIF ID code 399) */
/*     C */
/*     C        Before we can execute this computation, we'll need the */
/*     C        geometric state and accleration of the observer relative */
/*     C        to the solar system barycenter at ET, expressed */
/*     C        relative to the J2000 reference frame. First find */
/*     C        the state: */
/*     C */
/*              CALL SPKSSB ( 399, ET, 'J2000', STOBS ) */
/*     C */
/*     C        Next compute the acceleration. We numerically */
/*     C        differentiate the velocity using a quadratic */
/*     C        approximation: */
/*     C */
/*              TDELTA = 1.D0 */

/*              CALL SPKSSB ( 399, ET-TDELTA, 'J2000', STATE0 ) */
/*              CALL SPKSSB ( 399, ET+TDELTA, 'J2000', STATE2 ) */

/*              CALL QDERIV ( 3, STATE0(4), STATE2(4), TDELTA, ACC ) */
/*     C */
/*     C        Now compute the desired state vector: */
/*     C */
/*              CALL SPKAPS ( 301,   ET,  'J2000', 'LT+S', */
/*          .                 STOBS, ACC, STATE,    LT,   DLT ) */

/*              WRITE (*,*) 'ET = ', ET */
/*              WRITE (*,*) 'J2000 x-position (km):   ', STATE(1) */
/*              WRITE (*,*) 'J2000 y-position (km):   ', STATE(2) */
/*              WRITE (*,*) 'J2000 z-position (km):   ', STATE(3) */
/*              WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */
/*              WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */
/*              WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */
/*              WRITE (*,*) 'One-way light time (s):  ', LT */
/*              WRITE (*,*) 'Light time rate:         ', DLT */
/*              WRITE (*,*) ' ' */

/*           END DO */

/*           END */


/*     The output produced by this program will vary somewhat as */
/*     a function of the platform on which the program is built and */
/*     executed. On a PC/Linux/g77 platform, the following output */
/*     was produced: */

/*        ET =   0. */
/*        J2000 x-position (km):    -291584.614 */
/*        J2000 y-position (km):    -266693.406 */
/*        J2000 z-position (km):    -76095.6532 */
/*        J2000 x-velocity (km/s):   0.643439157 */
/*        J2000 y-velocity (km/s):  -0.666065874 */
/*        J2000 z-velocity (km/s):  -0.301310063 */
/*        One-way light time (s):    1.34231061 */
/*        Light time rate:           1.07316909E-07 */

/*        ET =   3600. */
/*        J2000 x-position (km):    -289256.459 */
/*        J2000 y-position (km):    -269080.605 */
/*        J2000 z-position (km):    -77177.3528 */
/*        J2000 x-velocity (km/s):   0.64997032 */
/*        J2000 y-velocity (km/s):  -0.660148253 */
/*        J2000 z-velocity (km/s):  -0.299630418 */
/*        One-way light time (s):    1.34269395 */
/*        Light time rate:           1.05652599E-07 */

/*        ET =   7200. */
/*        J2000 x-position (km):    -286904.897 */
/*        J2000 y-position (km):    -271446.417 */
/*        J2000 z-position (km):    -78252.9655 */
/*        J2000 x-velocity (km/s):   0.656443883 */
/*        J2000 y-velocity (km/s):  -0.654183552 */
/*        J2000 z-velocity (km/s):  -0.297928533 */
/*        One-way light time (s):    1.34307131 */
/*        Light time rate:           1.03990457E-07 */

/*        ET =   10800. */
/*        J2000 x-position (km):    -284530.133 */
/*        J2000 y-position (km):    -273790.671 */
/*        J2000 z-position (km):    -79322.4117 */
/*        J2000 x-velocity (km/s):   0.662859505 */
/*        J2000 y-velocity (km/s):  -0.648172247 */
/*        J2000 z-velocity (km/s):  -0.296204558 */
/*        One-way light time (s):    1.34344269 */
/*        Light time rate:           1.02330665E-07 */

/*        ET =   14400. */
/*        J2000 x-position (km):    -282132.378 */
/*        J2000 y-position (km):    -276113.202 */
/*        J2000 z-position (km):    -80385.612 */
/*        J2000 x-velocity (km/s):   0.669216846 */
/*        J2000 y-velocity (km/s):  -0.642114815 */
/*        J2000 z-velocity (km/s):  -0.294458645 */
/*        One-way light time (s):    1.3438081 */
/*        Light time rate:           1.00673404E-07 */


/* $ Restrictions */

/*     1) This routine should not be used to compute geometric states. */
/*        Instead, use SPKEZR, SPKEZ, or SPKGEO. SPKGEO, which is called */
/*        by SPKEZR and SPKEZ, introduces less round-off error when the */
/*        observer and target have a common center that is closer to */
/*        both objects than is the solar system barycenter. */

/*     2) The kernel files to be used by SPKAPS must be loaded */
/*        (normally by the SPICELIB kernel loader FURNSH) before */
/*        this routine is called. */

/*     3) Unlike most other SPK state computation routines, this */
/*        routine requires that the output state be relative to an */
/*        inertial reference frame. */

/* $ Literature_References */

/*     SPK Required Reading. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */

/* -& */
/* $ Index_Entries */

/*     low-level aberration-corrected state computation */
/*     low-level light time and stellar aberration correction */

/* -& */
/* $ Revisions */

/*     None. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("ZZSPKAS1", (ftnlen)8);
    }
    if (first || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {

/*        The aberration correction flag differs from the value it */
/*        had on the previous call, if any.  Analyze the new flag. */

	zzprscor_(abcorr, attblk, abcorr_len);
	if (failed_()) {
	    chkout_("ZZSPKAS1", (ftnlen)8);
	    return 0;
	}

/*        The aberration correction flag is recognized; save it. */

	s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);

/*        Set logical flags indicating the attributes of the requested */
/*        correction: */

/*           XMIT is .TRUE. when the correction is for transmitted */
/*           radiation. */

/*           USELT is .TRUE. when any type of light time correction */
/*           (normal or converged Newtonian) is specified. */

/*           USECN indicates converged Newtonian light time correction. */

/*        The above definitions are consistent with those used by */
/*        ZZPRSCOR. */

	xmit = attblk[4];
	uselt = attblk[1];
	usestl = attblk[2];
	if (usestl && ! uselt) {
	    setmsg_("Aberration correction flag # calls for stellar aberrati"
		    "on but not light time corrections. This combination is n"
		    "ot expected.", (ftnlen)123);
	    errch_("#", abcorr, (ftnlen)1, abcorr_len);
	    sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
	    chkout_("ZZSPKAS1", (ftnlen)8);
	    return 0;
	} else if (attblk[5]) {
	    setmsg_("Aberration correction flag # calls for relativistic lig"
		    "ht time correction.", (ftnlen)74);
	    errch_("#", abcorr, (ftnlen)1, abcorr_len);
	    sigerr_("SPICE(NOTSUPPORTED)", (ftnlen)19);
	    chkout_("ZZSPKAS1", (ftnlen)8);
	    return 0;
	}
	first = FALSE_;
    }

/*     See if the reference frame is a recognized inertial frame. */

    irfnum_(ref, &refid, ref_len);
    if (refid == 0) {
	setmsg_("The requested frame '#' is not a recognized inertial frame. "
		, (ftnlen)60);
	errch_("#", ref, (ftnlen)1, ref_len);
	sigerr_("SPICE(BADFRAME)", (ftnlen)15);
	chkout_("ZZSPKAS1", (ftnlen)8);
	return 0;
    }

/*     Get the state of the target relative to the observer, */
/*     optionally corrected for light time. */

    zzspklt1_(targ, et, ref, abcorr, stobs, starg, lt, dlt, ref_len, 
	    abcorr_len);

/*     If stellar aberration corrections are not needed, we're */
/*     already done. */

    if (! usestl) {
	chkout_("ZZSPKAS1", (ftnlen)8);
	return 0;
    }

/*     Get the stellar aberration correction and its time derivative. */

    zzstelab_(&xmit, accobs, &stobs[3], starg, pcorr, dpcorr);

/*     Adding the stellar aberration correction to the light */
/*     time-corrected target position yields the position corrected for */
/*     both light time and stellar aberration. */

    vadd_(pcorr, starg, corpos);
    vequ_(corpos, starg);

/*     Velocity is treated in an analogous manner. */

    vadd_(dpcorr, &starg[3], corvel);
    vequ_(corvel, &starg[3]);
    chkout_("ZZSPKAS1", (ftnlen)8);
    return 0;
} /* zzspkas1_ */
示例#4
0
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref, 
	integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, 
	    char *, integer);

    /* Local variables */
    extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
	    );
    integer cobs, legs;
    doublereal sobs[6];
    extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
	    ), vequ_(doublereal *, doublereal *), zznamfrm_(integer *, char *,
	     integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer 
	    *);
    integer i__;
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
    integer refid;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    char oname[40];
    doublereal descr[5];
    integer ctarg[20];
    char ident[40], tname[40];
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), 
	    moved_(doublereal *, integer *, doublereal *);
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    doublereal starg[120]	/* was [6][20] */;
    logical nofrm;
    static char svref[32];
    doublereal stemp[6];
    integer ctpos;
    doublereal vtemp[6];
    extern doublereal vnorm_(doublereal *);
    extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
    static integer svctr1[2];
    extern logical failed_(void);
    extern /* Subroutine */ int cleard_(integer *, doublereal *);
    integer handle, cframe;
    extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, 
	    doublereal *);
    extern doublereal clight_(void);
    integer tframe[20];
    extern integer isrchi_(integer *, integer *, integer *);
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen);
    static integer svrefi;
    extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
	    char *, integer *, char *, ftnlen, ftnlen), setmsg_(char *, 
	    ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
    integer tmpfrm;
    extern /* Subroutine */ int irfrot_(integer *, integer *, doublereal *), 
	    spksfs_(integer *, doublereal *, integer *, doublereal *, char *, 
	    logical *, ftnlen);
    extern integer frstnp_(char *, ftnlen);
    extern logical return_(void);
    doublereal psxfrm[9]	/* was [3][3] */;
    extern /* Subroutine */ int spkpvn_(integer *, doublereal *, doublereal *,
	     integer *, doublereal *, integer *), intstr_(integer *, char *, 
	    ftnlen);
    integer nct;
    doublereal rot[9]	/* was [3][3] */;
    extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
	    ;
    char tstring[80];

/* $ Abstract */

/*     Compute the geometric position of a target body relative to an */
/*     observing body. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */
/* $ Abstract */

/*     This file contains the number of inertial reference */
/*     frames that are currently known by the SPICE toolkit */
/*     software. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     None. */

/* $ Keywords */

/*     FRAMES */

/* $ Declarations */
/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     NINERT     P   Number of known inertial reference frames. */

/* $ Parameters */

/*     NINERT     is the number of recognized inertial reference */
/*                frames.  This value is needed by both CHGIRF */
/*                ZZFDAT, and FRAMEX. */

/* $ Author_and_Institution */

/*     W.L. Taber      (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 10-OCT-1996 (WLT) */

/* -& */
/* $ Abstract */

/*     This include file defines the dimension of the counter */
/*     array used by various SPICE subsystems to uniquely identify */
/*     changes in their states. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Parameters */

/*     CTRSIZ      is the dimension of the counter array used by */
/*                 various SPICE subsystems to uniquely identify */
/*                 changes in their states. */

/* $ Author_and_Institution */

/*     B.V. Semenov    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TARG       I   Target body. */
/*     ET         I   Target epoch. */
/*     REF        I   Target reference frame. */
/*     OBS        I   Observing body. */
/*     POS        O   Position of target. */
/*     LT         O   Light time. */

/* $ Detailed_Input */

/*     TARG        is the standard NAIF ID code for a target body. */

/*     ET          is the epoch (ephemeris time) at which the position */
/*                 of the target body is to be computed. */

/*     REF         is the name of the reference frame to */
/*                 which the vectors returned by the routine should */
/*                 be rotated. This may be any frame supported by */
/*                 the SPICELIB subroutine REFCHG. */

/*     OBS         is the standard NAIF ID code for an observing body. */

/* $ Detailed_Output */

/*     POS         contains the position of the target */
/*                 body, relative to the observing body. This vector is */
/*                 rotated into the specified reference frame. Units */
/*                 are always km. */

/*     LT          is the one-way light time from the observing body */
/*                 to the geometric position of the target body at the */
/*                 specified epoch. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If insufficient ephemeris data has been loaded to compute */
/*        the necessary positions, the error SPICE(SPKINSUFFDATA) is */
/*        signalled. */

/* $ Files */

/*     See: $Restrictions. */

/* $ Particulars */

/*     SPKGPS computes the geometric position, T(t), of the target */
/*     body and the geometric position, O(t), of the observing body */
/*     relative to the first common center of motion.  Subtracting */
/*     O(t) from T(t) gives the geometric position of the target */
/*     body relative to the observer. */


/*        CENTER ----- O(t) */
/*            |      / */
/*            |     / */
/*            |    / */
/*            |   /  T(t) - O(t) */
/*            |  / */
/*           T(t) */


/*     The one-way light time, tau, is given by */


/*               | T(t) - O(t) | */
/*        tau = ----------------- */
/*                      c */


/*     For example, if the observing body is -94, the Mars Observer */
/*     spacecraft, and the target body is 401, Phobos, then the */
/*     first common center is probably 4, the Mars Barycenter. */
/*     O(t) is the position of -94 relative to 4 and T(t) is the */
/*     position of 401 relative to 4. */

/*     The center could also be the Solar System Barycenter, body 0. */
/*     For example, if the observer is 399, Earth, and the target */
/*     is 299, Venus, then O(t) would be the position of 399 relative */
/*     to 0 and T(t) would be the position of 299 relative to 0. */

/*     Ephemeris data from more than one segment may be required */
/*     to determine the positions of the target body and observer */
/*     relative to a common center.  SPKGPS reads as many segments */
/*     as necessary, from as many files as necessary, using files */
/*     that have been loaded by previous calls to SPKLEF (load */
/*     ephemeris file). */

/*     SPKGPS is similar to SPKGEO but returns geometric positions */
/*     only. */

/* $ Examples */

/*     The following code example computes the geometric */
/*     position of the moon with respect to the earth and */
/*     then prints the distance of the moon from the */
/*     the earth at a number of epochs. */

/*     Assume the SPK file SAMPLE.BSP contains ephemeris data */
/*     for the moon relative to earth over the time interval */
/*     from BEGIN to END. */

/*            INTEGER               EARTH */
/*            PARAMETER           ( EARTH = 399 ) */

/*            INTEGER               MOON */
/*            PARAMETER           ( MOON  = 301 ) */

/*            INTEGER               N */
/*            PARAMETER           ( N     = 100 ) */

/*            INTEGER               I */
/*            CHARACTER*(20)        UTC */
/*            DOUBLE PRECISION      BEGIN */
/*            DOUBLE PRECISION      DELTA */
/*            DOUBLE PRECISION      END */
/*            DOUBLE PRECISION      ET */
/*            DOUBLE PRECISION      POS ( 3 ) */
/*            DOUBLE PRECISION      LT */

/*            DOUBLE PRECISION      VNORM */

/*     C */
/*     C      Load the binary SPK ephemeris file. */
/*     C */
/*            CALL FURNSH ( 'SAMPLE.BSP' ) */

/*            . */
/*            . */
/*            . */

/*     C */
/*     C      Divide the interval of coverage [BEGIN,END] into */
/*     C      N steps.  At each step, compute the position, and */
/*     C      print out the epoch in UTC time and position norm. */
/*     C */
/*            DELTA = ( END - BEGIN ) / N */

/*            DO I = 0, N */

/*               ET = BEGIN + I*DELTA */

/*               CALL SPKGPS ( MOON, ET, 'J2000', EARTH, POS, LT ) */

/*               CALL ET2UTC ( ET, 'C', 0, UTC ) */

/*               WRITE (*,*) UTC, VNORM ( POS ) */

/*            END DO */

/* $ Restrictions */

/*     1) The ephemeris files to be used by SPKGPS must be loaded */
/*        by SPKLEF before SPKGPS is called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman  (JPL) */
/*     B.V. Semenov  (JPL) */
/*     W.L. Taber    (JPL) */

/* $ Version */

/* -    SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */

/*        Updated to save the input frame name and POOL state counter */
/*        and to do frame name-ID conversion only if the counter has */
/*        changed. */

/*        Updated to map the input frame name to its ID by first calling */
/*        ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/*        change is that now the frame with the fixed name 'DEFAULT' */
/*        that can be associated with any code via CHGIRF's entry point */
/*        IRFDEF will be fully masked by a frame with indentical name */
/*        defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/*        frame masked the text kernel frame with the same name. */

/*        Replaced SPKLEF with FURNSH and fixed errors in Examples. */

/* -    SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */

/*        Updated to remove non-standard use of duplicate arguments */
/*        in VADD calls. */

/* -    SPICELIB Version 1.1.0, 05-JAN-2005 (NJB) */

/*        Tests of routine FAILED() were added. */

/* -    SPICELIB Version 1.0.0, 9-JUL-1998 (WLT) */

/* -& */
/* $ Index_Entries */

/*     geometric position of one body relative to another */

/* -& */
/* $ Revisions */

/* -    SPICELIB Version 1.2.0, 05-NOV-2005 (NJB) */

/*        Updated to remove non-standard use of duplicate arguments */
/*        in VADD calls. */

/* -& */

/*     This is the idea: */

/*     Every body moves with respect to some center. The center */
/*     is itself a body, which in turn moves about some other */
/*     center.  If we begin at the target body (T), follow */
/*     the chain, */

/*                                   T */
/*                                     \ */
/*           SSB                        \ */
/*               \                     C[1] */
/*                \                     / */
/*                 \                   / */
/*                  \                 / */
/*                   \               / */
/*                  C[3]-----------C[2] */

/*     and avoid circular definitions (A moves about B, and B moves */
/*     about A), eventually we get the position relative to the solar */
/*     system barycenter (which, for our purposes, doesn't move). */
/*     Thus, */

/*        T    = T     + C[1]     + C[2]     + ... + C[n] */
/*         SSB    C[1]       C[2]       [C3]             SSB */

/*     where */

/*        X */
/*         Y */

/*     is the position of body X relative to body Y. */

/*     However, we don't want to follow each chain back to the SSB */
/*     if it isn't necessary.  Instead we will just follow the chain */
/*     of the target body and follow the chain of the observing body */
/*     until we find a common node in the tree. */

/*     In the example below, C is the first common node.  We compute */
/*     the position of TARG relative to C and the position of OBS */
/*     relative to C, then subtract the two positions. */

/*                                   TARG */
/*                                     \ */
/*           SSB                        \ */
/*               \                       A */
/*                \                     /            OBS */
/*                 \                   /              | */
/*                  \                 /               | */
/*                   \               /                | */
/*                    B-------------C-----------------D */




/*     SPICELIB functions */


/*     Local parameters */


/*     CHLEN is the maximum length of a chain.  That is, */
/*     it is the maximum number of bodies in the chain from */
/*     the target or observer to the SSB. */


/*     Saved frame name length. */


/*     Local variables */


/*     Saved frame name/ID item declarations. */


/*     Saved frame name/ID items. */


/*     Initial values. */


/*     In-line Function Definitions */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("SPKGPS", (ftnlen)6);
    }

/*     Initialization. */

    if (first) {

/*        Initialize counter. */

	zzctruin_(svctr1);
	first = FALSE_;
    }

/*     We take care of the obvious case first.  It TARG and OBS are the */
/*     same we can just fill in zero. */

    if (*targ == *obs) {
	*lt = 0.;
	cleard_(&c__3, pos);
	chkout_("SPKGPS", (ftnlen)6);
	return 0;
    }

/*     CTARG contains the integer codes of the bodies in the */
/*     target body chain, beginning with TARG itself and then */
/*     the successive centers of motion. */

/*     STARG(1,I) is the position of the target body relative */
/*     to CTARG(I).  The id-code of the frame of this position is */
/*     stored in TFRAME(I). */

/*     COBS and SOBS will contain the centers and positions of the */
/*     observing body.  (They are single elements instead of arrays */
/*     because we only need the current center and position of the */
/*     observer relative to it.) */

/*     First, we construct CTARG and STARG.  CTARG(1) is */
/*     just the target itself, and STARG(1,1) is just a zero */
/*     vector, that is, the position of the target relative */
/*     to itself. */

/*     Then we follow the chain, filling up CTARG and STARG */
/*     as we go.  We use SPKSFS to search through loaded */
/*     files to find the first segment applicable to CTARG(1) */
/*     and time ET.  Then we use SPKPVN to compute the position */
/*     of the body CTARG(1) at ET in the segment that was found */
/*     and get its center and frame of motion (CTARG(2) and TFRAME(2). */

/*     We repeat the process for CTARG(2) and so on, until */
/*     there is no data found for some CTARG(I) or until we */
/*     reach the SSB. */

/*     Next, we find centers and positions in a similar manner */
/*     for the observer.  It's a similar construction as */
/*     described above, but I is always 1.  COBS and SOBS */
/*     are overwritten with each new center and position, */
/*     beginning at OBS.  However, we stop when we encounter */
/*     a common center of motion, that is when COBS is equal */
/*     to CTARG(I) for some I. */

/*     Finally, we compute the desired position of the target */
/*     relative to the observer by subtracting the position of */
/*     the observing body relative to the common node from */
/*     the position of the target body relative to the common */
/*     node. */

/*     CTPOS is the position in CTARG of the common node. */

/*     Since the upgrade to use hashes and counter bypass ZZNAMFRM */
/*     became more efficient in looking up frame IDs than IRFNUM. So the */
/*     original order of calls "IRFNUM first, NAMFRM second" was */
/*     switched to "ZZNAMFRM first, IRFNUM second". */

/*     The call to IRFNUM, now redundant for built-in inertial frames, */
/*     was preserved to for a sole reason -- to still support the */
/*     ancient and barely documented ability for the users to associate */
/*     a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/*     frame code via CHGIRF's entry point IRFDEF. */

/*     Note that in the case of ZZNAMFRM's failure to resolve name and */
/*     IRFNUM's success to do so, the code returned by IRFNUM for */
/*     'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/*     would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/*     calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/*     up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/*     should it change between the calls. */

    zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
    if (refid == 0) {
	irfnum_(ref, &refid, ref_len);
    }
    if (refid == 0) {
	if (frstnp_(ref, ref_len) > 0) {
	    setmsg_("The string supplied to specify the reference frame, ('#"
		    "') contains non-printing characters.  The two most commo"
		    "n causes for this kind of error are: 1. an error in the "
		    "call to SPKGPS; 2. an uninitialized variable. ", (ftnlen)
		    213);
	    errch_("#", ref, (ftnlen)1, ref_len);
	} else if (s_cmp(ref, " ", ref_len, (ftnlen)1) == 0) {
	    setmsg_("The string supplied to specify the reference frame is b"
		    "lank.  The most common cause for this kind of error is a"
		    "n uninitialized variable. ", (ftnlen)137);
	} else {
	    setmsg_("The string supplied to specify the reference frame was "
		    "'#'.  This frame is not recognized. Possible causes for "
		    "this error are: 1. failure to load the frame definition "
		    "into the kernel pool; 2. An out-of-date edition of the t"
		    "oolkit. ", (ftnlen)231);
	    errch_("#", ref, (ftnlen)1, ref_len);
	}
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
	if (failed_()) {
	    chkout_("SPKGPS", (ftnlen)6);
	    return 0;
	}
    }

/*     Fill in CTARG and STARG until no more data is found */
/*     or until we reach the SSB.  If the chain gets too */
/*     long to fit in CTARG, that is if I equals CHLEN, */
/*     then overwrite the last elements of CTARG and STARG. */

/*     Note the check for FAILED in the loop.  If SPKSFS */
/*     or SPKPVN happens to fail during execution, and the */
/*     current error handling action is to NOT abort, then */
/*     FOUND may be stuck at TRUE, CTARG(I) will never */
/*     become zero, and the loop will execute indefinitely. */


/*     Construct CTARG and STARG.  Begin by assigning the */
/*     first elements:  TARG and the position of TARG relative */
/*     to itself. */

    i__ = 1;
    ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", i__1, 
	    "spkgps_", (ftnlen)603)] = *targ;
    found = TRUE_;
    cleard_(&c__6, &starg[(i__1 = i__ * 6 - 6) < 120 && 0 <= i__1 ? i__1 : 
	    s_rnge("starg", i__1, "spkgps_", (ftnlen)606)]);
    while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? 
	    i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs && 
	    ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg", 
	    i__2, "spkgps_", (ftnlen)608)] != 0) {

/*        Find a file and segment that has position */
/*        data for CTARG(I). */

	spksfs_(&ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
		"ctarg", i__1, "spkgps_", (ftnlen)617)], et, &handle, descr, 
		ident, &found, (ftnlen)40);
	if (found) {

/*           Get the position of CTARG(I) relative to some */
/*           center of motion.  This new center goes in */
/*           CTARG(I+1) and the position is called STEMP. */

	    ++i__;
	    spkpvn_(&handle, descr, et, &tframe[(i__1 = i__ - 1) < 20 && 0 <= 
		    i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
		    627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? 
		    i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
		    ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
		    "ctarg", i__3, "spkgps_", (ftnlen)627)]);

/*           Here's what we have.  STARG is the position of CTARG(I-1) */
/*           relative to CTARG(I) in reference frame TFRAME(I) */

/*           If one of the routines above failed during */
/*           execution, we just give up and check out. */

	    if (failed_()) {
		chkout_("SPKGPS", (ftnlen)6);
		return 0;
	    }
	}
    }
    tframe[0] = tframe[1];

/*     If the loop above ended because we ran out of */
/*     room in the arrays CTARG and STARG, then we */
/*     continue finding positions but we overwrite the */
/*     last elements of CTARG and STARG. */

/*     If, as a result, the first common node is */
/*     overwritten, we'll just have to settle for */
/*     the last common node.  This will cause a small */
/*     loss of precision, but it's better than other */
/*     alternatives. */

    if (i__ == 20) {
	while(found && ctarg[19] != 0 && ctarg[19] != *obs) {

/*           Find a file and segment that has position */
/*           data for CTARG(CHLEN). */

	    spksfs_(&ctarg[19], et, &handle, descr, ident, &found, (ftnlen)40)
		    ;
	    if (found) {

/*              Get the position of CTARG(CHLEN) relative to */
/*              some center of motion.  The new center */
/*              overwrites the old.  The position is called */
/*              STEMP. */

		spkpvn_(&handle, descr, et, &tmpfrm, stemp, &ctarg[19]);

/*              Add STEMP to the position of TARG relative to */
/*              the old center to get the position of TARG */
/*              relative to the new center.  Overwrite */
/*              the last element of STARG. */

		if (tframe[19] == tmpfrm) {
		    moved_(&starg[114], &c__3, vtemp);
		} else if (tmpfrm > 0 && tmpfrm <= 21 && tframe[19] > 0 && 
			tframe[19] <= 21) {
		    irfrot_(&tframe[19], &tmpfrm, rot);
		    mxv_(rot, &starg[114], vtemp);
		} else {
		    refchg_(&tframe[19], &tmpfrm, et, psxfrm);
		    if (failed_()) {
			chkout_("SPKGPS", (ftnlen)6);
			return 0;
		    }
		    mxv_(psxfrm, &starg[114], vtemp);
		}
		vadd_(vtemp, stemp, &starg[114]);
		tframe[19] = tmpfrm;

/*              If one of the routines above failed during */
/*              execution, we just give up and check out. */

		if (failed_()) {
		    chkout_("SPKGPS", (ftnlen)6);
		    return 0;
		}
	    }
	}
    }
    nct = i__;

/*     NCT is the number of elements in CTARG, */
/*     the chain length.  We have in hand the following information */

/*        STARG(1...3,K)  position of body */
/*        CTARG(K-1)      relative to body CTARG(K) in the frame */
/*        TFRAME(K) */


/*     For K = 2,..., NCT. */

/*     CTARG(1) = TARG */
/*     STARG(1...3,1) = ( 0, 0, 0 ) */
/*     TFRAME(1)      = TFRAME(2) */


/*     Now follow the observer's chain.  Assign */
/*     the first values for COBS and SOBS. */

    cobs = *obs;
    cleard_(&c__6, sobs);

/*     Perhaps we have a common node already. */
/*     If so it will be the last node on the */
/*     list CTARG. */

/*     We let CTPOS will be the position of the common */
/*     node in CTARG if one is found.  It will */
/*     be zero if COBS is not found in CTARG. */

    if (ctarg[(i__1 = nct - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("ctarg", 
	    i__1, "spkgps_", (ftnlen)762)] == cobs) {
	ctpos = nct;
	cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
		"tframe", i__1, "spkgps_", (ftnlen)764)];
    } else {
	ctpos = 0;
    }

/*     Repeat the same loop as above, but each time */
/*     we encounter a new center of motion, check to */
/*     see if it is a common node.  (When CTPOS is */
/*     not zero, CTARG(CTPOS) is the first common node.) */

/*     Note that we don't need a centers array nor a */
/*     positions array, just a single center and position */
/*     is sufficient --- we just keep overwriting them. */
/*     When the common node is found, we have everything */
/*     we need in that one center (COBS) and position */
/*     (SOBS-position of the target relative to COBS). */

    found = TRUE_;
    nofrm = TRUE_;
    legs = 0;
    while(found && cobs != 0 && ctpos == 0) {

/*        Find a file and segment that has position */
/*        data for COBS. */

	spksfs_(&cobs, et, &handle, descr, ident, &found, (ftnlen)40);
	if (found) {

/*           Get the position of COBS; call it STEMP. */
/*           The center of motion of COBS becomes the */
/*           new COBS. */

	    if (legs == 0) {
		spkpvn_(&handle, descr, et, &tmpfrm, sobs, &cobs);
	    } else {
		spkpvn_(&handle, descr, et, &tmpfrm, stemp, &cobs);
	    }
	    if (nofrm) {
		nofrm = FALSE_;
		cframe = tmpfrm;
	    }

/*           Add STEMP to the position of OBS relative to */
/*           the old COBS to get the position of OBS */
/*           relative to the new COBS. */

	    if (cframe == tmpfrm) {

/*              On the first leg of the position of the observer, we */
/*              don't have to add anything, the position of the */
/*              observer is already in SOBS.  We only have to add when */
/*              the number of legs in the observer position is one or */
/*              greater. */

		if (legs > 0) {
		    vadd_(sobs, stemp, vtemp);
		    vequ_(vtemp, sobs);
		}
	    } else if (tmpfrm > 0 && tmpfrm <= 21 && cframe > 0 && cframe <= 
		    21) {
		irfrot_(&cframe, &tmpfrm, rot);
		mxv_(rot, sobs, vtemp);
		vadd_(vtemp, stemp, sobs);
		cframe = tmpfrm;
	    } else {
		refchg_(&cframe, &tmpfrm, et, psxfrm);
		if (failed_()) {
		    chkout_("SPKGPS", (ftnlen)6);
		    return 0;
		}
		mxv_(psxfrm, sobs, vtemp);
		vadd_(vtemp, stemp, sobs);
		cframe = tmpfrm;
	    }

/*           Check failed.  We don't want to loop */
/*           indefinitely. */

	    if (failed_()) {
		chkout_("SPKGPS", (ftnlen)6);
		return 0;
	    }

/*           We now have one more leg of the path for OBS.  Set */
/*           LEGS to reflect this.  Then see if the new center */
/*           is a common node. If not, repeat the loop. */

	    ++legs;
	    ctpos = isrchi_(&cobs, &nct, ctarg);
	}
    }

/*     If CTPOS is zero at this point, it means we */
/*     have not found a common node though we have */
/*     searched through all the available data. */

    if (ctpos == 0) {
	bodc2n_(targ, tname, &found, (ftnlen)40);
	if (found) {
	    prefix_("# (", &c__0, tname, (ftnlen)3, (ftnlen)40);
	    suffix_(")", &c__0, tname, (ftnlen)1, (ftnlen)40);
	    repmi_(tname, "#", targ, tname, (ftnlen)40, (ftnlen)1, (ftnlen)40)
		    ;
	} else {
	    intstr_(targ, tname, (ftnlen)40);
	}
	bodc2n_(obs, oname, &found, (ftnlen)40);
	if (found) {
	    prefix_("# (", &c__0, oname, (ftnlen)3, (ftnlen)40);
	    suffix_(")", &c__0, oname, (ftnlen)1, (ftnlen)40);
	    repmi_(oname, "#", obs, oname, (ftnlen)40, (ftnlen)1, (ftnlen)40);
	} else {
	    intstr_(obs, oname, (ftnlen)40);
	}
	setmsg_("Insufficient ephemeris data has been loaded to compute the "
		"position of TARG relative to OBS at the ephemeris epoch #. ", 
		(ftnlen)118);
	etcal_(et, tstring, (ftnlen)80);
	errch_("TARG", tname, (ftnlen)4, (ftnlen)40);
	errch_("OBS", oname, (ftnlen)3, (ftnlen)40);
	errch_("#", tstring, (ftnlen)1, (ftnlen)80);
	sigerr_("SPICE(SPKINSUFFDATA)", (ftnlen)20);
	chkout_("SPKGPS", (ftnlen)6);
	return 0;
    }

/*     If CTPOS is not zero, then we have reached a */
/*     common node, specifically, */

/*        CTARG(CTPOS) = COBS = CENTER */

/*     (in diagram below).  The POSITION of the target */
/*     (TARG) relative to the observer (OBS) is just */

/*        STARG(1,CTPOS) - SOBS. */



/*                     SOBS */
/*         CENTER ---------------->OBS */
/*            |                  . */
/*            |                . N */
/*         S  |              . O */
/*         T  |            . I */
/*         A  |          . T */
/*         R  |        . I */
/*         G  |      . S */
/*            |    . O */
/*            |  . P */
/*            V L */
/*           TARG */


/*     And the light-time between them is just */

/*               | POSITION | */
/*          LT = --------- */
/*                   c */


/*     Compute the position of the target relative to CTARG(CTPOS) */

    if (ctpos == 1) {
	tframe[0] = cframe;
    }
    i__1 = ctpos - 1;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if (tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tframe"
		, i__2, "spkgps_", (ftnlen)960)] == tframe[(i__3 = i__) < 20 
		&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
		ftnlen)960)]) {
	    vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : 
		    s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
		    i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 : 
		    s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], stemp);
	    moved_(stemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 
		    <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
		    963)]);
	} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
		"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
		 i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
		"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 && 
		0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
		965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 
		: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
	    irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		    s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
		    i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", 
		    i__3, "spkgps_", (ftnlen)967)], rot);
	    mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 : 
		    s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
	    vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 
		    ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)], 
		    vtemp);
	    moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 
		    <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
		    970)]);
	} else {
	    refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : 
		    s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
		    i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", 
		    i__3, "spkgps_", (ftnlen)974)], et, psxfrm);
	    if (failed_()) {
		chkout_("SPKGPS", (ftnlen)6);
		return 0;
	    }
	    mxv_(psxfrm, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? 
		    i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)981)], 
		    stemp);
	    vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2 
		    ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)], 
		    vtemp);
	    moved_(vtemp, &c__3, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 
		    <= i__2 ? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)
		    983)]);
	}
    }

/*     To avoid unnecessary frame transformations we'll do */
/*     a bit of extra decision making here.  It's a lot */
/*     faster to make logical checks than it is to compute */
/*     frame transformations. */

    if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tframe", 
	    i__1, "spkgps_", (ftnlen)996)] == cframe) {
	vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : 
		s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
    } else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
	    "tframe", i__1, "spkgps_", (ftnlen)1000)] == refid) {

/*        If the last frame associated with the target is already */
/*        in the requested output frame, we convert the position of */
/*        the observer to that frame and then subtract the position */
/*        of the observer from the position of the target. */

	if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {
	    irfrot_(&cframe, &refid, rot);
	    mxv_(rot, sobs, stemp);
	} else {
	    refchg_(&cframe, &refid, et, psxfrm);
	    if (failed_()) {
		chkout_("SPKGPS", (ftnlen)6);
		return 0;
	    }
	    mxv_(psxfrm, sobs, stemp);
	}

/*        We've now transformed SOBS into the requested reference frame. */
/*        Set CFRAME to reflect this. */

	cframe = refid;
	vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : 
		s_rnge("starg", i__1, "spkgps_", (ftnlen)1031)], stemp, pos);
    } else if (cframe > 0 && cframe <= 21 && tframe[(i__1 = ctpos - 1) < 20 &&
	     0 <= i__1 ? i__1 : s_rnge("tframe", i__1, "spkgps_", (ftnlen)
	    1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
	     s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 21) {

/*        If both frames are inertial we use IRFROT instead of */
/*        REFCHG to get things into a common frame. */

	irfrot_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
		"tframe", i__1, "spkgps_", (ftnlen)1040)], &cframe, rot);
	mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 : 
		s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], stemp);
	vsub_(stemp, sobs, pos);
    } else {

/*        Use the more general routine REFCHG to make the transformation. */

	refchg_(&tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
		"tframe", i__1, "spkgps_", (ftnlen)1048)], &cframe, et, 
		psxfrm);
	if (failed_()) {
	    chkout_("SPKGPS", (ftnlen)6);
	    return 0;
	}
	mxv_(psxfrm, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
		 s_rnge("starg", i__1, "spkgps_", (ftnlen)1055)], stemp);
	vsub_(stemp, sobs, pos);
    }

/*     Finally, rotate as needed into the requested frame. */

    if (cframe == refid) {

/*        We don't have to do anything in this case. */

    } else if (refid > 0 && refid <= 21 && cframe > 0 && cframe <= 21) {

/*        Since both frames are inertial, we use the more direct */
/*        routine IRFROT to get the transformation to REFID. */

	irfrot_(&cframe, &refid, rot);
	mxv_(rot, pos, stemp);
	moved_(stemp, &c__3, pos);
    } else {
	refchg_(&cframe, &refid, et, psxfrm);
	if (failed_()) {
	    chkout_("SPKGPS", (ftnlen)6);
	    return 0;
	}
	mxv_(psxfrm, pos, stemp);
	moved_(stemp, &c__3, pos);
    }
    *lt = vnorm_(pos) / clight_();
    chkout_("SPKGPS", (ftnlen)6);
    return 0;
} /* spkgps_ */
示例#5
0
文件: zzspkflt.c 项目: msanrivo/coft
/* $Procedure ZZSPKFLT ( SPK function, light time and rate ) */
/* Subroutine */ int zzspkflt_(S_fp trgsub, doublereal *et, char *ref, char *
	abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, 
	doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len)
{
    /* Initialized data */

    static logical pass1 = TRUE_;
    static char prvcor[5] = "     ";

    /* System generated locals */
    doublereal d__1, d__2, d__3, d__4;

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    doublereal dist;
    extern doublereal vdot_(doublereal *, doublereal *);
    static logical xmit;
    extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen);
    doublereal a, b, c__;
    integer i__;
    extern /* Subroutine */ int vaddg_(doublereal *, doublereal *, integer *, 
	    doublereal *);
    integer refid;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal epoch;
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    static logical usecn;
    extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal 
	    *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *,
	     integer *, doublereal *);
    doublereal lterr;
    static logical uselt;
    extern doublereal vnorm_(doublereal *);
    doublereal prvlt;
    extern logical failed_(void);
    extern doublereal clight_(void);
    logical attblk[15];
    extern doublereal touchd_(doublereal *);
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen);
    doublereal ctrssb[6];
    integer ltsign;
    extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_(
	    char *, ftnlen);
    doublereal ssbtrg[6];
    integer trgctr;
    extern /* Subroutine */ int spkssb_(integer *, doublereal *, char *, 
	    doublereal *, ftnlen);
    integer numitr;
    extern logical return_(void);
    logical usestl;
    doublereal sttctr[6];

/* $ Abstract */

/*     SPICE Private routine intended solely for the support of SPICE */
/*     routines. Users should not call this routine directly due */
/*     to the volatile nature of this routine. */

/*     Return the state (position and velocity) of a target body */
/*     relative to an observer, optionally corrected for light time, */
/*     expressed relative to an inertial reference frame. An input */
/*     subroutine provides the state of the target relative to its */
/*     center of motion. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */
/* $ Abstract */

/*     Include file zzabcorr.inc */

/*     SPICE private file intended solely for the support of SPICE */
/*     routines.  Users should not include this file directly due */
/*     to the volatile nature of this file */

/*     The parameters below define the structure of an aberration */
/*     correction attribute block. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Parameters */

/*     An aberration correction attribute block is an array of logical */
/*     flags indicating the attributes of the aberration correction */
/*     specified by an aberration correction string.  The attributes */
/*     are: */

/*        - Is the correction "geometric"? */

/*        - Is light time correction indicated? */

/*        - Is stellar aberration correction indicated? */

/*        - Is the light time correction of the "converged */
/*          Newtonian" variety? */

/*        - Is the correction for the transmission case? */

/*        - Is the correction relativistic? */

/*    The parameters defining the structure of the block are as */
/*    follows: */

/*       NABCOR    Number of aberration correction choices. */

/*       ABATSZ    Number of elements in the aberration correction */
/*                 block. */

/*       GEOIDX    Index in block of geometric correction flag. */

/*       LTIDX     Index of light time flag. */

/*       STLIDX    Index of stellar aberration flag. */

/*       CNVIDX    Index of converged Newtonian flag. */

/*       XMTIDX    Index of transmission flag. */

/*       RELIDX    Index of relativistic flag. */

/*    The following parameter is not required to define the block */
/*    structure, but it is convenient to include it here: */

/*       CORLEN    The maximum string length required by any aberration */
/*                 correction string */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */

/* -& */
/*     Number of aberration correction choices: */


/*     Aberration correction attribute block size */
/*     (number of aberration correction attributes): */


/*     Indices of attributes within an aberration correction */
/*     attribute block: */


/*     Maximum length of an aberration correction string: */


/*     End of include file zzabcorr.inc */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TRGSUB     I   Target body state subroutine. */
/*     ET         I   Observer epoch. */
/*     REF        I   Inertial reference frame of output state. */
/*     ABCORR     I   Aberration correction flag. */
/*     STOBS      I   State of the observer relative to the SSB. */
/*     STARG      O   State of target. */
/*     LT         O   One way light time between observer and target. */
/*     DLT        O   Derivative of light time with respect to time. */

/* $ Detailed_Input */

/*     TRGSUB      is the name of an external subroutine that returns */
/*                 the geometric state of the target body relative to a */
/*                 center of motion, expressed in the inertial reference */
/*                 frame REF, at the epoch ET. */

/*                 The calling sequence of TRGSUB is */

/*                    SUBROUTINE TRGSUB ( ET, REF, TRGCTR, STATE ) */

/*                    DOUBLE PRECISION      ET */
/*                    CHARACTER*(*)         REF */
/*                    INTEGER               TRGCTR */
/*                    DOUBLE PRECISION      STATE ( 6 ) */

/*                    The inputs of TRGSUB are ET and REF; the outputs */
/*                    are TRGCTR and STATE. STATE is the geometric state */
/*                    of the target relative to the returned center of */
/*                    motion at ET, expressed in the frame REF. */

/*                 The target and observer define a state vector whose */
/*                 position component points from the observer to the */
/*                 target. */

/*     ET          is the ephemeris time, expressed as seconds past */
/*                 J2000 TDB, at which the state of the target body */
/*                 relative to the observer is to be computed. ET */
/*                 refers to time at the observer's location. */

/*     REF         is the inertial reference frame with respect to which */
/*                 the input state STOBS and the output state STARG are */
/*                 expressed. REF must be recognized by the SPICE */
/*                 Toolkit. The acceptable frames are listed in the */
/*                 Frames Required Reading, as well as in the SPICELIB */
/*                 routine CHGIRF. */

/*                 Case and blanks are not significant in the string */
/*                 REF. */


/*     ABCORR      indicates the aberration corrections to be applied to */
/*                 the state of the target body to account for one-way */
/*                 light time. See the discussion in the Particulars */
/*                 section for recommendations on how to choose */
/*                 aberration corrections. */

/*                 If ABCORR includes the stellar aberration correction */
/*                 symbol '+S', this flag is simply ignored. Aside from */
/*                 the possible presence of this symbol, ABCORR may be */
/*                 any of the following: */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric state of the target body */
/*                               relative to the observer. */

/*                 The following values of ABCORR apply to the */
/*                 "reception" case in which photons depart from the */
/*                 target's location at the light-time corrected epoch */
/*                 ET-LT and *arrive* at the observer's location at ET: */

/*                    'LT'       Correct for one-way light time (also */
/*                               called "planetary aberration") using a */
/*                               Newtonian formulation. This correction */
/*                               yields the state of the target at the */
/*                               moment it emitted photons arriving at */
/*                               the observer at ET. */

/*                               The light time correction involves */
/*                               iterative solution of the light time */
/*                               equation. (See the Particulars section */
/*                               of SPKEZR for details.) The solution */
/*                               invoked by the 'LT' option uses one */
/*                               iteration. */

/*                    'CN'       Converged Newtonian light time */
/*                               correction. In solving the light time */
/*                               equation, the 'CN' correction iterates */
/*                               until the solution converges (three */
/*                               iterations on all supported platforms). */
/*                               Whether the 'CN+S' solution is */
/*                               substantially more accurate than the */
/*                               'LT' solution depends on the geometry */
/*                               of the participating objects and on the */
/*                               accuracy of the input data. In all */
/*                               cases this routine will execute more */
/*                               slowly when a converged solution is */
/*                               computed. See the Particulars section of */
/*                               SPKEZR for a discussion of precision of */
/*                               light time corrections. */

/*                 The following values of ABCORR apply to the */
/*                 "transmission" case in which photons *depart* from */
/*                 the observer's location at ET and arrive at the */
/*                 target's location at the light-time corrected epoch */
/*                 ET+LT: */

/*                    'XLT'      "Transmission" case:  correct for */
/*                               one-way light time using a Newtonian */
/*                               formulation. This correction yields the */
/*                               state of the target at the moment it */
/*                               receives photons emitted from the */
/*                               observer's location at ET. */

/*                    'XCN'      "Transmission" case:  converged */
/*                               Newtonian light time correction. */


/*                 Neither special nor general relativistic effects are */
/*                 accounted for in the aberration corrections applied */
/*                 by this routine. */

/*                 Case and blanks are not significant in the string */
/*                 ABCORR. */


/*     STOBS       is the geometric (uncorrected) state of the observer */
/*                 relative to the solar system barycenter at epoch ET. */
/*                 STOBS is a 6-vector: the first three components of */
/*                 STOBS represent a Cartesian position vector; the last */
/*                 three components represent the corresponding velocity */
/*                 vector. STOBS is expressed relative to the inertial */
/*                 reference frame designated by REF. */

/*                 Units are always km and km/sec. */

/* $ Detailed_Output */

/*     STARG       is a Cartesian state vector representing the position */
/*                 and velocity of the target body relative to the */
/*                 specified observer. STARG is corrected for the */
/*                 specified aberration, and is expressed with respect */
/*                 to the specified inertial reference frame.  The first */
/*                 three components of STARG represent the x-, y- and */
/*                 z-components of the target's position; last three */
/*                 components form the corresponding velocity vector. */

/*                 The position component of STARG points from the */
/*                 observer's location at ET to the aberration-corrected */
/*                 location of the target. Note that the sense of the */
/*                 position vector is independent of the direction of */
/*                 radiation travel implied by the aberration */
/*                 correction. */

/*                 Units are always km and km/sec. */

/*     LT          is the one-way light time between the observer and */
/*                 target in seconds.  If the target state is corrected */
/*                 for light time, then LT is the one-way light time */
/*                 between the observer and the light time-corrected */
/*                 target location. */

/*     DLT         is the derivative with respect to barycentric */
/*                 dynamical time of the one way light time between */
/*                 target and observer: */

/*                    DLT = d(LT)/d(ET) */

/*                 DLT can also be described as the rate of change of */
/*                 one way light time. DLT is unitless, since LT and */
/*                 ET both have units of TDB seconds. */

/*                 If the observer and target are at the same position, */
/*                 then DLT is set to zero. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) For the convenience of the caller, the input aberration */
/*        correction flag can call for stellar aberration correction via */
/*        inclusion of the '+S' suffix. This portion of the aberration */
/*        correction flag is ignored if present. */

/*     2) If ABCORR calls for stellar aberration but not light */
/*        time corrections, the error SPICE(NOTSUPPORTED) is */
/*        signaled. */

/*     3) If ABCORR calls for relativistic light time corrections, the */
/*        error SPICE(NOTSUPPORTED) is signaled. */

/*     4) If the value of ABCORR is not recognized, the error */
/*        is diagnosed by a routine in the call tree of this */
/*        routine. */

/*     5) If the reference frame requested is not a recognized */
/*        inertial reference frame, the error SPICE(UNKNOWNFRAME) */
/*        is signaled. */

/*     6) If the state of the target relative to the solar system */
/*        barycenter cannot be computed, the error will be diagnosed */
/*        by routines in the call tree of this routine. */

/*     7) If the observer and target are at the same position, */
/*        then DLT is set to zero. This situation could arise, */
/*        for example, when the observer is Mars and the target */
/*        is the Mars barycenter. */

/*     8) If a division by zero error would occur in the computation */
/*        of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */

/* $ Files */

/*     This routine computes states using SPK files that have been */
/*     loaded into the SPICE system, normally via the kernel loading */
/*     interface routine FURNSH.  Application programs typically load */
/*     kernels once before this routine is called, for example during */
/*     program initialization; kernels need not be loaded repeatedly. */
/*     See the routine FURNSH and the SPK and KERNEL Required Reading */
/*     for further information on loading (and unloading) kernels. */

/*     If any of the ephemeris data used to compute STARG are expressed */
/*     relative to a non-inertial frame in the SPK files providing those */
/*     data, additional kernels may be needed to enable the reference */
/*     frame transformations required to compute the state. Normally */
/*     these additional kernels are PCK files or frame kernels. Any */
/*     such kernels must already be loaded at the time this routine is */
/*     called. */

/* $ Particulars */

/*     This routine supports higher-level routines that can */
/*     perform both light time and stellar aberration corrections */
/*     and that use target states provided by subroutines rather */
/*     than by the conventional, public SPK APIs. For example, this */
/*     routine can be used for objects having fixed positions */
/*     on the surfaces of planets. */

/* $ Examples */

/*     See usage in ZZSPKFAP. */

/* $ Restrictions */

/*     1) This routine must not be called by routines of the SPICE */
/*        frame subsystem. It must not be called by any portion of */
/*        the SPK subsystem other than the private SPK function-based */
/*        component. */

/*     2) The input subroutine TRGSUB must not call this routine. */
/*        or any of the supporting, private SPK routines */

/*     3)  When possible, the routine SPKGEO should be used instead of */
/*         this routine to compute geometric states. SPKGEO introduces */
/*         less round-off error when the observer and target have common */
/*         center that is closer to both objects than is the solar */
/*         system barycenter. */

/*     4)  Unlike most other SPK state computation routines, this */
/*         routine requires that the output state be relative to an */
/*         inertial reference frame. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 04-JUL-2014 (NJB) */

/*        Discussion of light time corrections was updated. Assertions */
/*        that converged light time corrections are unlikely to be */
/*        useful were removed. */

/*     Last update was 22-FEB-2012 (NJB) */

/* -& */
/* $ Index_Entries */

/*     low-level light time correction */
/*     light-time corrected state from spk file */
/*     get light-time corrected state */

/* -& */
/* $ Revisions */

/*     None. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     TOL is the tolerance used for a division-by-zero test */
/*     performed prior to computation of DLT. */


/*     Convergence limit: */


/*     Maximum number of light time iterations for any */
/*     aberration correction: */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    }
    chkin_("ZZSPKFLT", (ftnlen)8);
    if (pass1 || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {

/*        The aberration correction flag differs from the value it */
/*        had on the previous call, if any.  Analyze the new flag. */

	zzvalcor_(abcorr, attblk, abcorr_len);
	if (failed_()) {
	    chkout_("ZZSPKFLT", (ftnlen)8);
	    return 0;
	}

/*        The aberration correction flag is recognized; save it. */

	s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);

/*        Set logical flags indicating the attributes of the requested */
/*        correction: */

/*           XMIT is .TRUE. when the correction is for transmitted */
/*           radiation. */

/*           USELT is .TRUE. when any type of light time correction */
/*           (normal or converged Newtonian) is specified. */

/*           USECN indicates converged Newtonian light time correction. */

/*        The above definitions are consistent with those used by */
/*        ZZVALCOR. */

	xmit = attblk[4];
	uselt = attblk[1];
	usecn = attblk[3];
	usestl = attblk[2];
	pass1 = FALSE_;
    }

/*     See if the reference frame is a recognized inertial frame. */

    irfnum_(ref, &refid, ref_len);
    if (refid == 0) {
	setmsg_("The requested frame '#' is not a recognized inertial frame. "
		, (ftnlen)60);
	errch_("#", ref, (ftnlen)1, ref_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
	chkout_("ZZSPKFLT", (ftnlen)8);
	return 0;
    }

/*     Find the geometric state of the target body with respect to */
/*     the solar system barycenter. Subtract the state of the */
/*     observer to get the relative state. Use this to compute the */
/*     one-way light time. */

    (*trgsub)(et, ref, &trgctr, sttctr, ref_len);
    spkssb_(&trgctr, et, ref, ctrssb, ref_len);
    if (failed_()) {
	chkout_("ZZSPKFLT", (ftnlen)8);
	return 0;
    }
    vaddg_(ctrssb, sttctr, &c__6, ssbtrg);
    vsubg_(ssbtrg, stobs, &c__6, starg);
    dist = vnorm_(starg);
    *lt = dist / clight_();
    if (*lt == 0.) {

/*        This can happen only if the observer and target are at the */
/*        same position. We don't consider this an error, but we're not */
/*        going to compute the light time derivative. */

	*dlt = 0.;
	chkout_("ZZSPKFLT", (ftnlen)8);
	return 0;
    }
    if (! uselt) {

/*        This is a special case: we're not using light time */
/*        corrections, so the derivative */
/*        of light time is just */

/*           (1/c) * d(VNORM(STARG))/dt */

	*dlt = vdot_(starg, &starg[3]) / (dist * clight_());

/*        LT and DLT are both set, so we can return. */

	chkout_("ZZSPKFLT", (ftnlen)8);
	return 0;
    }

/*     To correct for light time, find the state of the target body */
/*     at the current epoch minus the one-way light time. Note that */
/*     the observer remains where it is. */

/*     Determine the sign of the light time offset. */

    if (xmit) {
	ltsign = 1;
    } else {
	ltsign = -1;
    }

/*     Let NUMITR be the number of iterations we'll perform to */
/*     compute the light time. */

    if (usecn) {
	numitr = 5;
    } else {
	numitr = 1;
    }
    i__ = 0;
    lterr = 1.;
    while(i__ < numitr && lterr > 1e-17) {

/*        LT was set either prior to this loop or */
/*        during the previous loop iteration. */

	d__1 = *et + ltsign * *lt;
	epoch = touchd_(&d__1);
	(*trgsub)(&epoch, ref, &trgctr, sttctr, ref_len);
	spkssb_(&trgctr, &epoch, ref, ctrssb, ref_len);
	if (failed_()) {
	    chkout_("ZZSPKFLT", (ftnlen)8);
	    return 0;
	}
	vaddg_(ctrssb, sttctr, &c__6, ssbtrg);
	vsubg_(ssbtrg, stobs, &c__6, starg);
	prvlt = *lt;
	d__1 = vnorm_(starg) / clight_();
	*lt = touchd_(&d__1);

/*        LTERR is the magnitude of the change between the current */
/*        estimate of light time and the previous estimate, relative to */
/*        the previous light time corrected epoch. */

/* Computing MAX */
	d__3 = 1., d__4 = abs(epoch);
	d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4);
	lterr = touchd_(&d__2);
	++i__;
    }

/*     At this point, STARG contains the light time corrected */
/*     state of the target relative to the observer. */

/*     Compute the derivative of light time with respect */
/*     to time: dLT/dt.  Below we derive the formula for */
/*     this quantity for the reception case. Let */

/*        POBS be the position of the observer relative to the */
/*        solar system barycenter. */

/*        VOBS be the velocity of the observer relative to the */
/*        solar system barycenter. */

/*        PTARG be the position of the target relative to the */
/*        solar system barycenter. */

/*        VTARG be the velocity of the target relative to the */
/*        solar system barycenter. */

/*        S be the sign of the light time correction. S is */
/*        negative for the reception case. */

/*     The light-time corrected position of the target relative to */
/*     the observer at observation time ET, given the one-way */
/*     light time LT is: */

/*         PTARG(ET+S*LT) - POBS(ET) */

/*     The light-time corrected velocity of the target relative to */
/*     the observer at observation time ET is */

/*         VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */

/*     We need to compute dLT/dt. Below, we use the facts that, */
/*     for a time-dependent vector X(t), */

/*          ||X||     = <X,X> ** (1/2) */

/*        d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */

/*                    = <X,X>**(-1/2) *  <X,dX/dt> */

/*                    = <X,dX/dt> / ||X|| */

/*     Newtonian light time equation: */

/*        LT     =   (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */

/*     Differentiate both sides: */

/*        dLT/dt =   (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */

/*                  * < PTARG(ET+S*LT) - POBS(ET), */
/*                      VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */


/*               = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */

/*                 * (  < PTARG(ET+S*LT) - POBS(ET), */
/*                        VTARG(ET+S*LT) - VOBS(ET) > */

/*                   +  < PTARG(ET+S*LT) - POBS(ET), */
/*                        VTARG(ET+S*LT)           > * (S*d(LT)/d(ET))  ) */

/*     Let */

/*        A =   (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */

/*        B =   < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */

/*        C =   < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */

/*     Then */

/*        d(LT)/d(ET) =  A * ( B  +  C * S*d(LT)/d(ET) ) */

/*     which implies */

/*        d(LT)/d(ET) =  A*B / ( 1 - S*C*A ) */



    a = 1. / (clight_() * vnorm_(starg));
    b = vdot_(starg, &starg[3]);
    c__ = vdot_(starg, &ssbtrg[3]);

/*     For physically realistic target velocities, S*C*A cannot equal 1. */
/*     We'll check for this case anyway. */

    if (ltsign * c__ * a > .99999999989999999) {
	setmsg_("Target range rate magnitude is approximately the speed of l"
		"ight. The light time derivative cannot be computed.", (ftnlen)
		110);
	sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
	chkout_("ZZSPKFLT", (ftnlen)8);
	return 0;
    }

/*     Compute DLT: the rate of change of light time. */

    *dlt = a * b / (1. - ltsign * c__ * a);

/*     Overwrite the velocity portion of the output state */
/*     with the light-time corrected velocity. */

    d__1 = ltsign * *dlt + 1.;
    vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]);
    chkout_("ZZSPKFLT", (ftnlen)8);
    return 0;
} /* zzspkflt_ */
示例#6
0
/* $Procedure ZZSPKFAP ( SPK function, apparent inertial state ) */
/* Subroutine */ int zzspkfap_(U_fp trgsub, doublereal *et, char *ref, char *
	abcorr, doublereal *stobs, doublereal *accobs, doublereal *starg, 
	doublereal *lt, doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len)
{
    /* Initialized data */

    static logical pass1 = TRUE_;
    static char prvcor[5] = "     ";

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    extern /* Subroutine */ int vadd_(doublereal *, doublereal *, doublereal *
	    ), vequ_(doublereal *, doublereal *);
    static logical xmit;
    extern /* Subroutine */ int zzstelab_(logical *, doublereal *, doublereal 
	    *, doublereal *, doublereal *, doublereal *), zzvalcor_(char *, 
	    logical *, ftnlen), zzspkflt_(U_fp, doublereal *, char *, char *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, ftnlen, 
	    ftnlen);
    integer refid;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    doublereal pcorr[3];
    static logical uselt;
    extern logical failed_(void);
    logical attblk[15];
    doublereal dpcorr[3], corvel[3];
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, 
	    ftnlen);
    doublereal corpos[3];
    extern logical return_(void);
    static logical usestl;

/* $ Abstract */

/*     SPICE Private routine intended solely for the support of SPICE */
/*     routines. Users should not call this routine directly due */
/*     to the volatile nature of this routine. */

/*     Given the state and acceleration of an observer relative to the */
/*     solar system barycenter, return the state (position and velocity) */
/*     of a target body relative to the observer, optionally corrected */
/*     for light time and stellar aberration. All input and output */
/*     vectors are expressed relative to an inertial reference frame. An */
/*     input subroutine provides the state of the target relative to its */
/*     center of motion. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */
/* $ Abstract */

/*     Include file zzabcorr.inc */

/*     SPICE private file intended solely for the support of SPICE */
/*     routines.  Users should not include this file directly due */
/*     to the volatile nature of this file */

/*     The parameters below define the structure of an aberration */
/*     correction attribute block. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Parameters */

/*     An aberration correction attribute block is an array of logical */
/*     flags indicating the attributes of the aberration correction */
/*     specified by an aberration correction string.  The attributes */
/*     are: */

/*        - Is the correction "geometric"? */

/*        - Is light time correction indicated? */

/*        - Is stellar aberration correction indicated? */

/*        - Is the light time correction of the "converged */
/*          Newtonian" variety? */

/*        - Is the correction for the transmission case? */

/*        - Is the correction relativistic? */

/*    The parameters defining the structure of the block are as */
/*    follows: */

/*       NABCOR    Number of aberration correction choices. */

/*       ABATSZ    Number of elements in the aberration correction */
/*                 block. */

/*       GEOIDX    Index in block of geometric correction flag. */

/*       LTIDX     Index of light time flag. */

/*       STLIDX    Index of stellar aberration flag. */

/*       CNVIDX    Index of converged Newtonian flag. */

/*       XMTIDX    Index of transmission flag. */

/*       RELIDX    Index of relativistic flag. */

/*    The following parameter is not required to define the block */
/*    structure, but it is convenient to include it here: */

/*       CORLEN    The maximum string length required by any aberration */
/*                 correction string */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */

/* -& */
/*     Number of aberration correction choices: */


/*     Aberration correction attribute block size */
/*     (number of aberration correction attributes): */


/*     Indices of attributes within an aberration correction */
/*     attribute block: */


/*     Maximum length of an aberration correction string: */


/*     End of include file zzabcorr.inc */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TRGSUB     I   Target body state subroutine. */
/*     ET         I   Observer epoch. */
/*     REF        I   Inertial reference frame of output state. */
/*     ABCORR     I   Aberration correction flag. */
/*     STOBS      I   State of the observer relative to the SSB. */
/*     ACCOBS     I   Acceleration of the observer relative to the SSB. */
/*     STARG      O   State of target. */
/*     LT         O   One way light time between observer and target. */
/*     DLT        O   Derivative of light time with respect to time. */

/* $ Detailed_Input */

/*     TRGSUB      is the name of an external subroutine that returns */
/*                 the geometric state of the target body relative to a */
/*                 center of motion, expressed in the inertial reference */
/*                 frame REF, at the epoch ET. */

/*                 The calling sequence of TRGSUB is */

/*                    SUBROUTINE TRGSUB ( ET, REF, TRGCTR, STATE ) */

/*                    DOUBLE PRECISION      ET */
/*                    CHARACTER*(*)         REF */
/*                    INTEGER               TRGCTR */
/*                    DOUBLE PRECISION      STATE ( 6 ) */


/*                    The inputs of TRGSUB are ET and REF; the outputs */
/*                    are TRGCTR and STATE. STATE is the geometric state */
/*                    of the target relative to the returned center of */
/*                    motion at ET, expressed in the frame REF. */

/*                 The target and observer define a state vector whose */
/*                 position component points from the observer to the */
/*                 target. */

/*     ET          is the ephemeris time, expressed as seconds past */
/*                 J2000 TDB, at which the state of the target body */
/*                 relative to the observer is to be computed.  ET */
/*                 refers to time at the observer's location. */

/*     REF         is the inertial reference frame with respect to which */
/*                 the input state STOBS, the input acceleration ACCOBS, */
/*                 and the output state STARG are expressed. REF must be */
/*                 recognized by the SPICE Toolkit.  The acceptable */
/*                 frames are listed in the Frames Required Reading, as */
/*                 well as in the SPICELIB routine CHGIRF. */

/*                 Case and blanks are not significant in the string */
/*                 REF. */

/*     ABCORR      indicates the aberration corrections to be applied */
/*                 to the state of the target body to account for one-way */
/*                 light time and stellar aberration. See the discussion */
/*                 in the header of SPKEZR for recommendations on */
/*                 how to choose aberration corrections. */

/*                 ABCORR may be any of the following: */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric state of the target body */
/*                               relative to the observer. */

/*                 The following values of ABCORR apply to the */
/*                 "reception" case in which photons depart from the */
/*                 target's location at the light-time corrected epoch */
/*                 ET-LT and *arrive* at the observer's location at ET: */

/*                    'LT'       Correct for one-way light time (also */
/*                               called "planetary aberration") using a */
/*                               Newtonian formulation. This correction */
/*                               yields the state of the target at the */
/*                               moment it emitted photons arriving at */
/*                               the observer at ET. */

/*                               The light time correction uses an */
/*                               iterative solution of the light time */
/*                               equation (see Particulars for details). */
/*                               The solution invoked by the 'LT' option */
/*                               uses one iteration. */

/*                    'LT+S'     Correct for one-way light time and */
/*                               stellar aberration using a Newtonian */
/*                               formulation. This option modifies the */
/*                               state obtained with the 'LT' option to */
/*                               account for the observer's velocity */
/*                               relative to the solar system */
/*                               barycenter. The result is the apparent */
/*                               state of the target---the position and */
/*                               velocity of the target as seen by the */
/*                               observer. */

/*                    'CN'       Converged Newtonian light time */
/*                               correction. In solving the light time */
/*                               equation, the 'CN' correction iterates */
/*                               until the solution converges (three */
/*                               iterations on all supported platforms). */
/*                               Whether the 'CN+S' solution is */
/*                               substantially more accurate than the */
/*                               'LT' solution depends on the geometry */
/*                               of the participating objects and on the */
/*                               accuracy of the input data. In all */
/*                               cases this routine will execute more */
/*                               slowly when a converged solution is */
/*                               computed. See the Particulars section of */
/*                               SPKEZR for a discussion of precision of */
/*                               light time corrections. */

/*                    'CN+S'     Converged Newtonian light time */
/*                               correction and stellar aberration */
/*                               correction. */


/*                 The following values of ABCORR apply to the */
/*                 "transmission" case in which photons *depart* from */
/*                 the observer's location at ET and arrive at the */
/*                 target's location at the light-time corrected epoch */
/*                 ET+LT: */

/*                    'XLT'      "Transmission" case:  correct for */
/*                               one-way light time using a Newtonian */
/*                               formulation. This correction yields the */
/*                               state of the target at the moment it */
/*                               receives photons emitted from the */
/*                               observer's location at ET. */

/*                    'XLT+S'    "Transmission" case:  correct for */
/*                               one-way light time and stellar */
/*                               aberration using a Newtonian */
/*                               formulation  This option modifies the */
/*                               state obtained with the 'XLT' option to */
/*                               account for the observer's velocity */
/*                               relative to the solar system */
/*                               barycenter. The position component of */
/*                               the computed target state indicates the */
/*                               direction that photons emitted from the */
/*                               observer's location must be "aimed" to */
/*                               hit the target. */

/*                    'XCN'      "Transmission" case:  converged */
/*                               Newtonian light time correction. */

/*                    'XCN+S'    "Transmission" case:  converged */
/*                               Newtonian light time correction and */
/*                               stellar aberration correction. */


/*                 Neither special nor general relativistic effects are */
/*                 accounted for in the aberration corrections applied */
/*                 by this routine. */

/*                 Case and blanks are not significant in the string */
/*                 ABCORR. */


/*     STOBS       is the geometric state of the observer relative to */
/*                 the solar system barycenter at ET. STOBS is expressed */
/*                 relative to the reference frame designated by REF. */
/*                 The target and observer define a state vector whose */
/*                 position component points from the observer to the */
/*                 target. */

/*     ACCOBS      is the geometric acceleration of the observer */
/*                 relative to the solar system barycenter at ET. This */
/*                 is the derivative with respect to time of the */
/*                 velocity portion of STOBS. ACCOBS is expressed */
/*                 relative to the reference frame designated by REF. */

/*                 ACCOBS is used for computing stellar aberration */
/*                 corrected velocity. If stellar aberration corrections */
/*                 are not specified by ABCORR, ACCOBS is ignored; the */
/*                 caller need not provide a valid input value in this */
/*                 case. */

/* $ Detailed_Output */

/*     STARG       is a Cartesian state vector representing the position */
/*                 and velocity of the target body relative to the */
/*                 specified observer. STARG is corrected for the */
/*                 specified aberrations, and is expressed with respect */
/*                 to the inertial reference frame designated by REF. */
/*                 The first three components of STARG represent the x-, */
/*                 y- and z-components of the target's position; last */
/*                 three components form the corresponding velocity */
/*                 vector. */

/*                 The position component of STARG points from the */
/*                 observer's location at ET to the aberration-corrected */
/*                 location of the target. Note that the sense of the */
/*                 position vector is independent of the direction of */
/*                 radiation travel implied by the aberration */
/*                 correction. */

/*                 Units are always km and km/sec. */

/*     LT          is the one-way light time between the observer and */
/*                 target in seconds.  If the target state is corrected */
/*                 for light time, then LT is the one-way light time */
/*                 between the observer and the light time-corrected */
/*                 target location. */

/*     DLT         is the derivative with respect to barycentric */
/*                 dynamical time of the one way light time between */
/*                 target and observer: */

/*                    DLT = d(LT)/d(ET) */

/*                 DLT can also be described as the rate of change of */
/*                 one way light time. DLT is unitless, since LT and */
/*                 ET both have units of TDB seconds. */

/*                 If the observer and target are at the same position, */
/*                 then DLT is set to zero. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If the value of ABCORR is not recognized, the error */
/*        is diagnosed by a routine in the call tree of this */
/*        routine. */

/*     2) If the reference frame requested is not a recognized */
/*        inertial reference frame, the error SPICE(BADFRAME) */
/*        is signaled. */

/*     3) If the state of the target relative to the solar system */
/*        barycenter cannot be computed, the error will be diagnosed */
/*        by routines in the call tree of this routine. */

/*     4) If the observer and target are at the same position, */
/*        then DLT is set to zero. This situation could arise, */
/*        for example, when the observer is Mars and the target */
/*        is the Mars barycenter. */

/* $ Files */

/*     This routine computes states using SPK files that have been */
/*     loaded into the SPICE system, normally via the kernel loading */
/*     interface routine FURNSH.  Application programs typically load */
/*     kernels once before this routine is called, for example during */
/*     program initialization; kernels need not be loaded repeatedly. */
/*     See the routine FURNSH and the SPK and KERNEL Required Reading */
/*     for further information on loading (and unloading) kernels. */

/*     If any of the ephemeris data used to compute STARG are expressed */
/*     relative to a non-inertial frame in the SPK files providing those */
/*     data, additional kernels may be needed to enable the reference */
/*     frame transformations required to compute the state. Normally */
/*     these additional kernels are PCK files or frame kernels. Any such */
/*     kernels must already be loaded at the time this routine is */
/*     called. */

/* $ Particulars */

/*     This routine supports higher-level routines that can */
/*     perform both light time and stellar aberration corrections */
/*     and that use target states provided by subroutines rather */
/*     than by the conventional, public SPK APIs. For example, this */
/*     routine can be used for objects having fixed positions */
/*     on the surfaces of planets. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine must not be called by routines of the SPICE */
/*        frame subsystem. It must not be called by any portion of */
/*        the SPK subsystem other than the private SPK function-based */
/*        component. */

/*     2) The input subroutine TRGSUB must not call this routine */
/*        or any of the supporting, private SPK routines */

/*           ZZSPKFAT */
/*           ZZSPKFAO */
/*           ZZSPKFZO */
/*           ZZSPKFZT */

/*     3)  When possible, the routine SPKGEO should be used instead of */
/*         this routine to compute geometric states. SPKGEO introduces */
/*         less round-off error when the observer and target have common */
/*         center that is closer to both objects than is the solar */
/*         system barycenter. */

/*     4)  Unlike most other SPK state computation routines, this */
/*         routine requires that the output state be relative to an */
/*         inertial reference frame. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 04-JUL-2014 (NJB) */

/*        Discussion of light time corrections was updated. Assertions */
/*        that converged light time corrections are unlikely to be */
/*        useful were removed. */

/* -    SPICELIB Version 1.0.0, 09-JAN-2011 (NJB) */

/* -& */
/* $ Index_Entries */

/*     low-level aberration-corrected state computation */
/*     low-level light time and stellar aberration correction */

/* -& */
/* $ Revisions */

/*     None. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    }
    chkin_("ZZSPKFAP", (ftnlen)8);
    if (pass1 || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {

/*        The aberration correction flag differs from the value it */
/*        had on the previous call, if any.  Analyze the new flag. */

	zzvalcor_(abcorr, attblk, abcorr_len);
	if (failed_()) {
	    chkout_("ZZSPKFAP", (ftnlen)8);
	    return 0;
	}

/*        The aberration correction flag is recognized; save it. */

	s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);

/*        Set logical flags indicating the attributes of the requested */
/*        correction: */

/*           XMIT is .TRUE. when the correction is for transmitted */
/*           radiation. */

/*           USELT is .TRUE. when any type of light time correction */
/*           (normal or converged Newtonian) is specified. */

/*           USECN indicates converged Newtonian light time correction. */

/*        The above definitions are consistent with those used by */
/*        ZZVALCOR. */

	xmit = attblk[4];
	uselt = attblk[1];
	usestl = attblk[2];
	pass1 = FALSE_;
    }

/*     See if the reference frame is a recognized inertial frame. */

    irfnum_(ref, &refid, ref_len);
    if (refid == 0) {
	setmsg_("The requested frame '#' is not a recognized inertial frame. "
		, (ftnlen)60);
	errch_("#", ref, (ftnlen)1, ref_len);
	sigerr_("SPICE(BADFRAME)", (ftnlen)15);
	chkout_("ZZSPKFAP", (ftnlen)8);
	return 0;
    }

/*     Get the state of the target relative to the observer, */
/*     optionally corrected for light time. */

    zzspkflt_((U_fp)trgsub, et, ref, abcorr, stobs, starg, lt, dlt, ref_len, 
	    abcorr_len);
    if (failed_()) {
	chkout_("ZZSPKFAP", (ftnlen)8);
	return 0;
    }

/*     If stellar aberration corrections are not needed, we're */
/*     already done. */

    if (! usestl) {
	chkout_("ZZSPKFAP", (ftnlen)8);
	return 0;
    }

/*     Get the stellar aberration correction and its time derivative. */

    zzstelab_(&xmit, accobs, &stobs[3], starg, pcorr, dpcorr);

/*     Adding the stellar aberration correction to the light */
/*     time-corrected target position yields the position corrected for */
/*     both light time and stellar aberration. */

    vadd_(pcorr, starg, corpos);
    vequ_(corpos, starg);

/*     Velocity is treated in an analogous manner. */

    vadd_(dpcorr, &starg[3], corvel);
    vequ_(corvel, &starg[3]);
    chkout_("ZZSPKFAP", (ftnlen)8);
    return 0;
} /* zzspkfap_ */
示例#7
0
文件: pckw02.c 项目: haisamido/GMAT
/* $Procedure PCKW02 ( Write PCK segment, type 2 ) */
/* Subroutine */ int pckw02_(integer *handle, integer *body, char *frame, 
	doublereal *first, doublereal *last, char *segid, doublereal *intlen, 
	integer *n, integer *polydg, doublereal *cdata, doublereal *btime, 
	ftnlen frame_len, ftnlen segid_len)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k;
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen), chkin_(
	    char *, ftnlen), dafps_(integer *, integer *, doublereal *, 
	    integer *, doublereal *);
    doublereal descr[5];
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    doublereal ltime;
    extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
    doublereal rsize;
    char etstr[40];
    extern /* Subroutine */ int dafada_(doublereal *, integer *), dafbna_(
	    integer *, doublereal *, char *, ftnlen), dafena_(void);
    extern logical failed_(void);
    extern /* Subroutine */ int chckid_(char *, integer *, char *, ftnlen, 
	    ftnlen);
    integer refcod, ninrec;
    doublereal radius, numrec;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), irfnum_(char *, integer *, ftnlen), setmsg_(char *, 
	    ftnlen), errint_(char *, integer *, ftnlen);
    extern logical return_(void);
    char netstr[40];
    doublereal dcd[2];
    integer icd[5];
    doublereal mid;

/* $ Abstract */

/*    Write a type 2 segment to a PCK binary file given */
/*    the file handle, body, frame, time range covered by the */
/*    segment, and the Chebyshev polynomial coefficeients. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     NAIF_IDS */
/*     SPC */
/*     PCK */

/* $ Keywords */

/*     PCK */

/* $ Declarations */
/* $ Brief_I/O */

/*   Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     HANDLE     I   Handle of binary PCK file open for writing. */
/*     BODY       I   NAIF code for ephemeris object. */
/*     FRAME      I   Reference frame name. */
/*     FIRST      I   Start time of interval covered by segment. */
/*     LAST       I   End time of interval covered by segment. */
/*     SEGID      I   Segment identifier. */
/*     INTLEN     I   Length of time covered by logical record. */
/*     N          I   Number of logical records in segment. */
/*     POLYDG     I   Chebyshev polynomial degree. */
/*     CDATA      I   Array of Chebyshev coefficients. */
/*     BTIME      I   Begin time of first logical record. */

/* $ Detailed_Input */

/*     HANDLE         is the DAF handle of an PCK file to which a type 2 */
/*                    segment is to be added.  The PCK file must be open */
/*                    for writing. */

/*     BODY           is the NAIF integer code for an ephemeris object */
/*                    whose orientation is described by the segment to */
/*                    be created. */

/*     FRAME          is the NAIF name for a reference frame relative to */
/*                    which the orientation information for BODY is */
/*                    specified. */

/*     FIRST, */
/*     LAST           are, respectively, the start and stop times of */
/*                    the time interval over which the segment defines */
/*                    the orientation of body. */

/*     SEGID          is the segment identifier.  A PCK segment */
/*                    identifier may contain up to 40 characters. */

/*     INTLEN         Length of time, in seconds, covered by each set of */
/*                    Chebyshev polynomial coefficients (each logical */
/*                    record).  Each set of Chebyshev coefficents must */
/*                    cover this fixed time interval, INTLEN. */

/*     N              is the number of sets of Chebyshev polynomial */
/*                    coefficents (number of logical records) */
/*                    to be stored in the segment.  There is one set */
/*                    of Chebyshev coefficients for each time period. */

/*     POLYDG         Degree of each set of Chebyshev polynomials. */

/*     CDATA          Array containing all the sets of Chebyshev */
/*                    polynomial coefficients to be contained in the */
/*                    segment of the PCK file.  The coefficients are */
/*                    stored in CDATA in order as follows: */

/*                       the (degree + 1) coefficients for the first */
/*                       Euler angle of the first logical record */

/*                       the coefficients for the second Euler angle */

/*                       the coefficients for the third Euler angle */

/*                       the coefficients for the first Euler angle for */
/*                       the second logical record, ... */

/*                       and so on. */

/*     BTIME          Begin time (seconds past J2000 TDB) of first set */
/*                    of Chebyshev polynomial coefficients (first */
/*                    logical record). */

/* $ Detailed_Output */

/*      None. */

/* $ Parameters */

/*      None. */

/* $ Exceptions */

/*     1) If the number of sets of coefficients is not positive */
/*        'SPICE(NUMCOEFFSNOTPOS)' is signalled. */

/*     2) If the interval length is not positive, 'SPICE(INTLENNOTPOS)' */
/*        is signalled. */

/*     3) If the integer code for the reference frame is not recognized, */
/*        'SPICE(INVALIDREFFRAME)' is signalled. */

/*     4) If segment stop time is not greater then the begin time, */
/*         'SPICE(BADDESCRTIMES)' is signalled. */

/*     5) If the time of the first record is not greater than */
/*        or equal to the descriptor begin time, 'SPICE(BADDESCRTIMES)' */
/*        is signalled. */

/*     6) If the end time of the last record is not greater than */
/*        or equal to the descriptor end time, 'SPICE(BADDESCRTIMES)' is */
/*        signalled. */

/* $ Files */

/*     A new type 2 PCK segment is written to the PCK file attached */
/*     to HANDLE. */

/* $ Particulars */

/*     This routine writes an PCK type 2 data segment to the designated */
/*     PCK file, according to the format described in the PCK Required */
/*     Reading. */

/*     Each segment can contain data for only one body and reference */
/*     frame.  The Chebyshev polynomial degree and length of time covered */
/*     by each logical record are also fixed.  However, an arbitrary */
/*     number of logical records of Chebyshev polynomial coefficients can */
/*     be written in each segment.  Minimizing the number of segments in */
/*     a PCK file will help optimize how the SPICE system accesses the */
/*     file. */


/* $ Examples */


/*     Suppose that you have sets of Chebyshev polynomial coefficients */
/*     in an array CDATA pertaining to the position of the moon (NAIF ID */
/*     = 301) in the J2000 reference frame, and want to put these into a */
/*     type 2 segment in an existing PCK file.  The following code could */
/*     be used to add one new type 2 segment.  To add multiple segments, */
/*     put the call to PCKW02 in a loop. */

/*     C */
/*     C      First open the PCK file and get a handle for it. */
/*     C */
/*            CALL DAFOPW ( PCKNAM, HANDLE ) */

/*     C */
/*     C      Create a segment identifier. */
/*     C */
/*            SEGID = 'MY_SAMPLE_PCK_TYPE_2_SEGMENT' */

/*     C */
/*     C      Write the segment. */

/*            CALL PCKW02 (  HANDLE, 301,    'J2000', */
/*     .                     FIRST,  LAST,   SEGID,   INTLEN, */
/*     .                     N,      POLYDG, CDATA,   BTIME) */

/*     C */
/*     C      Close the file. */
/*     C */
/*            CALL DAFCLS ( HANDLE ) */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     K.S. Zukor (JPL) */

/* $ Version */

/* -    SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */

/*        The calling sequence was corrected so that REF is */
/*        a character string and BTIME contains only the start */
/*        time of the first record.  Comments updated, and new */
/*        routine CHCKID is called to check segment identifier. */

/* -    SPICELIB Version 1.0.0, 11-MAR-1994 (KSZ) */

/* -& */
/* $ Index_Entries */

/*     write pck type_2 data segment */

/* -& */
/* $ Revisions */

/* -    SPICELIB Version 2.0.0, 1-AUG-1995 (KSZ) */

/*        The calling sequence was corrected so that REF is */
/*        a character string and BTIME contains only the start */
/*        time of the first record.  Comments updated, and new */
/*        routine CHCKID is called to check segment identifier. */

/* -& */

/*     SPICELIB functions */


/*     Local Parameters */

/*     DTYPE is the PCK data type. */


/*     NS is the size of a packed PCK segment descriptor. */


/*     ND is the number of double precision components in an PCK */
/*     segment descriptor. PCK uses ND = 2. */


/*     NI is the number of integer components in an PCK segment */
/*     descriptor. PCK uses NI = 5. */


/*     SIDLEN is the maximum number of characters allowed in an */
/*     PCK segment identifier. */


/*     Local variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("PCKW02", (ftnlen)6);
    }

/*     The number of sets of coefficients must be positive. */

    if (*n <= 0) {
	setmsg_("The number of sets of Euler anglecoefficients is not positi"
		"ve. N = #", (ftnlen)68);
	errint_("#", n, (ftnlen)1);
	sigerr_("SPICE(NUMCOEFFSNOTPOS)", (ftnlen)22);
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     The interval length must be positive. */

    if (*intlen <= 0.) {
	setmsg_("The interval length is not positive.N = #", (ftnlen)41);
	errdp_("#", intlen, (ftnlen)1);
	sigerr_("SPICE(INTLENNOTPOS)", (ftnlen)19);
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     Get the NAIF integer code for the reference frame. */

    irfnum_(frame, &refcod, frame_len);
    if (refcod == 0) {
	setmsg_("The reference frame # is not supported.", (ftnlen)39);
	errch_("#", frame, (ftnlen)1, frame_len);
	sigerr_("SPICE(INVALIDREFFRAME)", (ftnlen)22);
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     The segment stop time must be greater than the begin time. */

    if (*first > *last) {
	setmsg_("The segment start time: # is greater than the segment end t"
		"ime: #", (ftnlen)65);
	etcal_(first, etstr, (ftnlen)40);
	errch_("#", etstr, (ftnlen)1, (ftnlen)40);
	etcal_(last, netstr, (ftnlen)40);
	errch_("#", netstr, (ftnlen)1, (ftnlen)40);
	sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     The begin time of the first record must be less than or equal */
/*     to the begin time of the segment. */

    if (*first < *btime) {
	setmsg_("The segment descriptor start time: # is less than the begin"
		"ning time of the segment data: #", (ftnlen)91);
	etcal_(first, etstr, (ftnlen)40);
	errch_("#", etstr, (ftnlen)1, (ftnlen)40);
	etcal_(btime, etstr, (ftnlen)40);
	errch_("#", etstr, (ftnlen)1, (ftnlen)40);
	sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     The end time of the final record must be greater than or */
/*     equal to the end time of the segment. */

    ltime = *btime + *n * *intlen;
    if (*last > ltime) {
	setmsg_("The segment descriptor end time: # is greater than the end "
		"time of the segment data: #", (ftnlen)86);
	etcal_(last, etstr, (ftnlen)40);
	errch_("#", etstr, (ftnlen)1, (ftnlen)40);
	etcal_(&ltime, etstr, (ftnlen)40);
	errch_("#", etstr, (ftnlen)1, (ftnlen)40);
	sigerr_("SPICE(BADDESCRTIMES)", (ftnlen)20);
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     Now check the validity of the segment identifier. */

    chckid_("PCK segment identifier", &c__40, segid, (ftnlen)22, segid_len);
    if (failed_()) {
	chkout_("PCKW02", (ftnlen)6);
	return 0;
    }

/*     Store the start and end times to be associated */
/*     with this segment. */

    dcd[0] = *first;
    dcd[1] = *last;

/*     Create the integer portion of the descriptor. */

    icd[0] = *body;
    icd[1] = refcod;
    icd[2] = 2;

/*     Pack the segment descriptor. */

    dafps_(&c__2, &c__5, dcd, icd, descr);

/*     Begin a new segment of PCK type 2 form: */

/*        Record 1 */
/*        Record 2 */
/*        ... */
/*        Record N */
/*        INIT       ( initial epoch of first record ) */
/*        INTLEN     ( length of interval covered by each record ) */
/*        RSIZE      ( number of data elements in each record ) */
/*        N          ( number of records in segment ) */

/*     Each record will have the form: */

/*        MID        ( midpoint of time interval ) */
/*        RADIUS     ( radius of time interval ) */
/*        X coefficients, Y coefficients, Z coefficients */

    dafbna_(handle, descr, segid, segid_len);

/*     Calculate the number of entries in a record. */

    ninrec = (*polydg + 1) * 3;

/*     Fill segment with N records of data. */

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {

/*        Calculate the midpoint and radius of the time of each */
/*        record, and put that at the beginning of each record. */

	radius = *intlen / 2;
	mid = *btime + radius + (i__ - 1) * *intlen;
	dafada_(&mid, &c__1);
	dafada_(&radius, &c__1);

/*        Put one set of coefficients into the segment. */

	k = (i__ - 1) * ninrec + 1;
	dafada_(&cdata[k - 1], &ninrec);
    }

/*     Store the initial epoch of the first record. */

    dafada_(btime, &c__1);

/*     Store the length of interval covered by each record. */

    dafada_(intlen, &c__1);

/*     Store the size of each record (total number of array elements). */

    rsize = (doublereal) (ninrec + 2);
    dafada_(&rsize, &c__1);

/*     Store the number of records contained in the segment. */

    numrec = (doublereal) (*n);
    dafada_(&numrec, &c__1);

/*     End this segment. */

    dafena_();
    chkout_("PCKW02", (ftnlen)6);
    return 0;
} /* pckw02_ */
示例#8
0
文件: spkltc.c 项目: Dbelsa/coft
/* $Procedure SPKLTC ( S/P Kernel, light time corrected state ) */
/* Subroutine */ int spkltc_(integer *targ, doublereal *et, char *ref, char *
	abcorr, doublereal *stobs, doublereal *starg, doublereal *lt, 
	doublereal *dlt, ftnlen ref_len, ftnlen abcorr_len)
{
    /* Initialized data */

    static logical pass1 = TRUE_;
    static char prvcor[5] = "     ";

    /* System generated locals */
    doublereal d__1, d__2, d__3, d__4;

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    doublereal dist;
    extern doublereal vdot_(doublereal *, doublereal *);
    static logical xmit;
    extern /* Subroutine */ int zzvalcor_(char *, logical *, ftnlen);
    doublereal a, b, c__;
    integer i__, refid;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal epoch;
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    static logical usecn;
    extern /* Subroutine */ int vlcom_(doublereal *, doublereal *, doublereal 
	    *, doublereal *, doublereal *), vsubg_(doublereal *, doublereal *,
	     integer *, doublereal *);
    doublereal ssblt, lterr;
    static logical uselt;
    extern doublereal vnorm_(doublereal *);
    doublereal prvlt;
    extern logical failed_(void);
    extern doublereal clight_(void);
    logical attblk[15];
    extern doublereal touchd_(doublereal *);
    extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, 
	    integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, 
	    ftnlen), chkout_(char *, ftnlen);
    integer ltsign;
    extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), setmsg_(
	    char *, ftnlen);
    doublereal ssbtrg[6];
    integer numitr;
    extern logical return_(void);
    logical usestl;

/* $ Abstract */

/*     Return the state (position and velocity) of a target body */
/*     relative to an observer, optionally corrected for light time, */
/*     expressed relative to an inertial reference frame. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

/* $ Declarations */
/* $ Abstract */

/*     Include file zzabcorr.inc */

/*     SPICE private file intended solely for the support of SPICE */
/*     routines.  Users should not include this file directly due */
/*     to the volatile nature of this file */

/*     The parameters below define the structure of an aberration */
/*     correction attribute block. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Parameters */

/*     An aberration correction attribute block is an array of logical */
/*     flags indicating the attributes of the aberration correction */
/*     specified by an aberration correction string.  The attributes */
/*     are: */

/*        - Is the correction "geometric"? */

/*        - Is light time correction indicated? */

/*        - Is stellar aberration correction indicated? */

/*        - Is the light time correction of the "converged */
/*          Newtonian" variety? */

/*        - Is the correction for the transmission case? */

/*        - Is the correction relativistic? */

/*    The parameters defining the structure of the block are as */
/*    follows: */

/*       NABCOR    Number of aberration correction choices. */

/*       ABATSZ    Number of elements in the aberration correction */
/*                 block. */

/*       GEOIDX    Index in block of geometric correction flag. */

/*       LTIDX     Index of light time flag. */

/*       STLIDX    Index of stellar aberration flag. */

/*       CNVIDX    Index of converged Newtonian flag. */

/*       XMTIDX    Index of transmission flag. */

/*       RELIDX    Index of relativistic flag. */

/*    The following parameter is not required to define the block */
/*    structure, but it is convenient to include it here: */

/*       CORLEN    The maximum string length required by any aberration */
/*                 correction string */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 1.0.0, 18-DEC-2004 (NJB) */

/* -& */
/*     Number of aberration correction choices: */


/*     Aberration correction attribute block size */
/*     (number of aberration correction attributes): */


/*     Indices of attributes within an aberration correction */
/*     attribute block: */


/*     Maximum length of an aberration correction string: */


/*     End of include file zzabcorr.inc */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TARG       I   Target body. */
/*     ET         I   Observer epoch. */
/*     REF        I   Inertial reference frame of output state. */
/*     ABCORR     I   Aberration correction flag. */
/*     STOBS      I   State of the observer relative to the SSB. */
/*     STARG      O   State of target. */
/*     LT         O   One way light time between observer and target. */
/*     DLT        O   Derivative of light time with respect to time. */

/* $ Detailed_Input */

/*     TARG        is the NAIF ID code for a target body.  The target */
/*                 and observer define a state vector whose position */
/*                 component points from the observer to the target. */

/*     ET          is the ephemeris time, expressed as seconds past */
/*                 J2000 TDB, at which the state of the target body */
/*                 relative to the observer is to be computed. ET */
/*                 refers to time at the observer's location. */

/*     REF         is the inertial reference frame with respect to which */
/*                 the input state STOBS and the output state STARG are */
/*                 expressed. REF must be recognized by the SPICE */
/*                 Toolkit. The acceptable frames are listed in the */
/*                 Frames Required Reading, as well as in the SPICELIB */
/*                 routine CHGIRF. */

/*                 Case and blanks are not significant in the string */
/*                 REF. */


/*     ABCORR      indicates the aberration corrections to be applied to */
/*                 the state of the target body to account for one-way */
/*                 light time. See the discussion in the Particulars */
/*                 section for recommendations on how to choose */
/*                 aberration corrections. */

/*                 If ABCORR includes the stellar aberration correction */
/*                 symbol '+S', this flag is simply ignored. Aside from */
/*                 the possible presence of this symbol, ABCORR may be */
/*                 any of the following: */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric state of the target body */
/*                               relative to the observer. */

/*                 The following values of ABCORR apply to the */
/*                 "reception" case in which photons depart from the */
/*                 target's location at the light-time corrected epoch */
/*                 ET-LT and *arrive* at the observer's location at ET: */

/*                    'LT'       Correct for one-way light time (also */
/*                               called "planetary aberration") using a */
/*                               Newtonian formulation. This correction */
/*                               yields the state of the target at the */
/*                               moment it emitted photons arriving at */
/*                               the observer at ET. */

/*                               The light time correction involves */
/*                               iterative solution of the light time */
/*                               equation (see Particulars for details). */
/*                               The solution invoked by the 'LT' option */
/*                               uses one iteration. */

/*                    'CN'       Converged Newtonian light time */
/*                               correction. In solving the light time */
/*                               equation, the 'CN' correction iterates */
/*                               until the solution converges (three */
/*                               iterations on all supported platforms). */
/*                               Whether the 'CN+S' solution is */
/*                               substantially more accurate than the */
/*                               'LT' solution depends on the geometry */
/*                               of the participating objects and on the */
/*                               accuracy of the input data. In all */
/*                               cases this routine will execute more */
/*                               slowly when a converged solution is */
/*                               computed. See the Particulars section of */
/*                               SPKEZR for a discussion of precision of */
/*                               light time corrections. */

/*                 The following values of ABCORR apply to the */
/*                 "transmission" case in which photons *depart* from */
/*                 the observer's location at ET and arrive at the */
/*                 target's location at the light-time corrected epoch */
/*                 ET+LT: */

/*                    'XLT'      "Transmission" case:  correct for */
/*                               one-way light time using a Newtonian */
/*                               formulation. This correction yields the */
/*                               state of the target at the moment it */
/*                               receives photons emitted from the */
/*                               observer's location at ET. */

/*                    'XCN'      "Transmission" case:  converged */
/*                               Newtonian light time correction. */


/*                 Neither special nor general relativistic effects are */
/*                 accounted for in the aberration corrections applied */
/*                 by this routine. */

/*                 Case and blanks are not significant in the string */
/*                 ABCORR. */


/*     STOBS       is the geometric (uncorrected) state of the observer */
/*                 relative to the solar system barycenter at epoch ET. */
/*                 STOBS is a 6-vector: the first three components of */
/*                 STOBS represent a Cartesian position vector; the last */
/*                 three components represent the corresponding velocity */
/*                 vector. STOBS is expressed relative to the inertial */
/*                 reference frame designated by REF. */

/*                 Units are always km and km/sec. */

/* $ Detailed_Output */

/*     STARG       is a Cartesian state vector representing the position */
/*                 and velocity of the target body relative to the */
/*                 specified observer. STARG is corrected for the */
/*                 specified aberration, and is expressed with respect */
/*                 to the specified inertial reference frame.  The first */
/*                 three components of STARG represent the x-, y- and */
/*                 z-components of the target's position; last three */
/*                 components form the corresponding velocity vector. */

/*                 The position component of STARG points from the */
/*                 observer's location at ET to the aberration-corrected */
/*                 location of the target. Note that the sense of the */
/*                 position vector is independent of the direction of */
/*                 radiation travel implied by the aberration */
/*                 correction. */

/*                 Units are always km and km/sec. */

/*     LT          is the one-way light time between the observer and */
/*                 target in seconds.  If the target state is corrected */
/*                 for light time, then LT is the one-way light time */
/*                 between the observer and the light time-corrected */
/*                 target location. */

/*     DLT         is the derivative with respect to barycentric */
/*                 dynamical time of the one way light time between */
/*                 target and observer: */

/*                    DLT = d(LT)/d(ET) */

/*                 DLT can also be described as the rate of change of */
/*                 one way light time. DLT is unitless, since LT and */
/*                 ET both have units of TDB seconds. */

/*                 If the observer and target are at the same position, */
/*                 then DLT is set to zero. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) For the convenience of the caller, the input aberration */
/*        correction flag can call for stellar aberration correction via */
/*        inclusion of the '+S' suffix. This portion of the aberration */
/*        correction flag is ignored if present. */

/*     2) If the value of ABCORR is not recognized, the error */
/*        is diagnosed by a routine in the call tree of this */
/*        routine. */

/*     3) If the reference frame requested is not a recognized */
/*        inertial reference frame, the error SPICE(BADFRAME) */
/*        is signaled. */

/*     4) If the state of the target relative to the solar system */
/*        barycenter cannot be computed, the error will be diagnosed */
/*        by routines in the call tree of this routine. */

/*     5) If the observer and target are at the same position, */
/*        then DLT is set to zero. This situation could arise, */
/*        for example, when the observer is Mars and the target */
/*        is the Mars barycenter. */

/*     6) If a division by zero error would occur in the computation */
/*        of DLT, the error SPICE(DIVIDEBYZERO) is signaled. */

/* $ Files */

/*     This routine computes states using SPK files that have been */
/*     loaded into the SPICE system, normally via the kernel loading */
/*     interface routine FURNSH.  Application programs typically load */
/*     kernels once before this routine is called, for example during */
/*     program initialization; kernels need not be loaded repeatedly. */
/*     See the routine FURNSH and the SPK and KERNEL Required Reading */
/*     for further information on loading (and unloading) kernels. */

/*     If any of the ephemeris data used to compute STARG are expressed */
/*     relative to a non-inertial frame in the SPK files providing those */
/*     data, additional kernels may be needed to enable the reference */
/*     frame transformations required to compute the state. Normally */
/*     these additional kernels are PCK files or frame kernels. Any */
/*     such kernels must already be loaded at the time this routine is */
/*     called. */

/* $ Particulars */

/*     This routine supports higher-level SPK API routines that can */
/*     perform both light time and stellar aberration corrections. */
/*     User applications normally will not need to call this routine */
/*     directly. */

/*     See the header of the routine SPKEZR for a detailed discussion */
/*     of aberration corrections. */

/* $ Examples */

/*     The numerical results shown for this example may differ across */
/*     platforms. The results depend on the SPICE kernels used as */
/*     input, the compiler and supporting libraries, and the machine */
/*     specific arithmetic implementation. */

/*    1) Look up a sequence of states of the Moon as seen from the */
/*       Earth. Use light time corrections. Compute the first state for */
/*       the epoch 2000 JAN 1 12:00:00 TDB; compute subsequent states at */
/*       intervals of 1 hour. For each epoch, display the states, the */
/*       one way light time between target and observer, and the rate of */
/*       change of the one way light time. */

/*       Use the following meta-kernel to specify the kernels to */
/*       load: */

/*          KPL/MK */

/*          File name: spkltc.tm */

/*          This meta-kernel is intended to support operation of SPICE */
/*          example programs. The kernels shown here should not be */
/*          assumed to contain adequate or correct versions of data */
/*          required by SPICE-based user applications. */

/*          In order for an application to use this meta-kernel, the */
/*          kernels referenced here must be present in the user's */
/*          current working directory. */


/*          \begindata */

/*             KERNELS_TO_LOAD = ( 'de421.bsp', */
/*                                 'pck00010.tpc', */
/*                                 'naif0010.tls'  ) */

/*          \begintext */


/*       The code example follows: */

/*           PROGRAM EX1 */
/*           IMPLICIT NONE */
/*     C */
/*     C     Local constants */
/*     C */
/*     C     The meta-kernel name shown here refers to a file whose */
/*     C     contents are those shown above. This file and the kernels */
/*     C     it references must exist in your current working directory. */
/*     C */
/*           CHARACTER*(*)         META */
/*           PARAMETER           ( META   = 'spkltc.tm' ) */
/*     C */
/*     C     Use a time step of 1 hour; look up 5 states. */
/*     C */
/*           DOUBLE PRECISION      STEP */
/*           PARAMETER           ( STEP   = 3600.0D0 ) */

/*           INTEGER               MAXITR */
/*           PARAMETER           ( MAXITR = 5 ) */
/*     C */
/*     C     Local variables */
/*     C */
/*           DOUBLE PRECISION      DLT */
/*           DOUBLE PRECISION      ET */
/*           DOUBLE PRECISION      ET0 */
/*           DOUBLE PRECISION      LT */
/*           DOUBLE PRECISION      STATE ( 6 ) */
/*           DOUBLE PRECISION      STOBS ( 6 ) */
/*           INTEGER               I */

/*     C */
/*     C     Load the SPK and LSK kernels via the meta-kernel. */
/*     C */
/*           CALL FURNSH ( META ) */
/*     C */
/*     C     Convert the start time to seconds past J2000 TDB. */
/*     C */
/*           CALL STR2ET ( '2000 JAN 1 12:00:00 TDB', ET0 ) */
/*     C */
/*     C     Step through a series of epochs, looking up a */
/*     C     state vector at each one. */
/*     C */
/*           DO I = 1, MAXITR */

/*              ET = ET0 + (I-1)*STEP */

/*     C */
/*     C        Look up a state vector at epoch ET using the */
/*     C        following inputs: */
/*     C */
/*     C           Target:                 Moon (NAIF ID code 301) */
/*     C           Reference frame:        J2000 */
/*     C           Aberration correction:  Light time ('LT') */
/*     C           Observer:               Earth (NAIF ID code 399) */
/*     C */
/*     C        Before we can execute this computation, we'll need the */
/*     C        geometric state of the observer relative to the solar */
/*     C        system barycenter at ET, expressed relative to the */
/*     C        J2000 reference frame: */
/*     C */
/*              CALL SPKSSB ( 399, ET,    'J2000', STOBS ) */
/*     C */
/*     C        Now compute the desired state vector: */
/*     C */
/*              CALL SPKLTC ( 301,   ET,    'J2000', 'LT', */
/*          .                 STOBS, STATE, LT,      DLT     ) */

/*              WRITE (*,*) 'ET = ', ET */
/*              WRITE (*,*) 'J2000 x-position (km):   ', STATE(1) */
/*              WRITE (*,*) 'J2000 y-position (km):   ', STATE(2) */
/*              WRITE (*,*) 'J2000 z-position (km):   ', STATE(3) */
/*              WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */
/*              WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */
/*              WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */
/*              WRITE (*,*) 'One-way light time (s):  ', LT */
/*              WRITE (*,*) 'Light time rate:         ', DLT */
/*              WRITE (*,*) ' ' */

/*           END DO */

/*           END */


/*     On a PC/Linux/gfortran platform, the following output was */
/*     produced: */


/*        ET =    0.0000000000000000 */
/*        J2000 x-position (km):     -291569.26541282982 */
/*        J2000 y-position (km):     -266709.18647825718 */
/*        J2000 z-position (km):     -76099.155118763447 */
/*        J2000 x-velocity (km/s):   0.64353061322177041 */
/*        J2000 y-velocity (km/s):  -0.66608181700820079 */
/*        J2000 z-velocity (km/s):  -0.30132283179625752 */
/*        One-way light time (s):     1.3423106103251679 */
/*        Light time rate:           1.07316908698977495E-007 */

/*        ET =    3600.0000000000000 */
/*        J2000 x-position (km):     -289240.78128184378 */
/*        J2000 y-position (km):     -269096.44087958336 */
/*        J2000 z-position (km):     -77180.899725757539 */
/*        J2000 x-velocity (km/s):   0.65006211520087476 */
/*        J2000 y-velocity (km/s):  -0.66016273921695667 */
/*        J2000 z-velocity (km/s):  -0.29964267390571342 */
/*        One-way light time (s):     1.3426939548635302 */
/*        Light time rate:           1.05652598952224259E-007 */

/*        ET =    7200.0000000000000 */
/*        J2000 x-position (km):     -286888.88736709207 */
/*        J2000 y-position (km):     -271462.30170547962 */
/*        J2000 z-position (km):     -78256.555682137609 */
/*        J2000 x-velocity (km/s):   0.65653599154284592 */
/*        J2000 y-velocity (km/s):  -0.65419657680401588 */
/*        J2000 z-velocity (km/s):  -0.29794027307420823 */
/*        One-way light time (s):     1.3430713117337547 */
/*        Light time rate:           1.03990456898758609E-007 */

/*        ET =    10800.000000000000 */
/*        J2000 x-position (km):     -284513.79173691198 */
/*        J2000 y-position (km):     -273806.60031034052 */
/*        J2000 z-position (km):     -79326.043183274567 */
/*        J2000 x-velocity (km/s):   0.66295190054599118 */
/*        J2000 y-velocity (km/s):  -0.64818380709706158 */
/*        J2000 z-velocity (km/s):  -0.29621577937090349 */
/*        One-way light time (s):     1.3434426890693671 */
/*        Light time rate:           1.02330665243423737E-007 */

/*        ET =    14400.000000000000 */
/*        J2000 x-position (km):     -282115.70368389413 */
/*        J2000 y-position (km):     -276129.16976799071 */
/*        J2000 z-position (km):     -80389.282965712249 */
/*        J2000 x-velocity (km/s):   0.66930950377548726 */
/*        J2000 y-velocity (km/s):  -0.64212490805688027 */
/*        J2000 z-velocity (km/s):  -0.29446934336246899 */
/*        One-way light time (s):     1.3438080956559786 */
/*        Light time rate:           1.00673403630050830E-007 */


/* $ Restrictions */

/*     1) The routine SPKGEO should be used instead of this routine */
/*        to compute geometric states. SPKGEO introduces less */
/*        round-off error when the observer and target have common */
/*        center that is closer to both objects than is the solar */
/*        system barycenter. */

/*     2) The kernel files to be used by SPKLTC must be loaded */
/*        (normally by the SPICELIB kernel loader FURNSH) before */
/*        this routine is called. */

/*     3) Unlike most other SPK state computation routines, this */
/*        routine requires that the output state be relative to an */
/*        inertial reference frame. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman    (JPL) */

/* $ Version */

/* -    SPICELIB Version 2.0.0, 04-JUL-2014 (NJB) */

/*        Discussion of light time corrections was updated. Assertions */
/*        that converged light time corrections are unlikely to be */
/*        useful were removed. */

/*     Last update was 02-MAY-2012 (NJB) */

/*        Updated to ensure convergence when CN or XCN light time */
/*        corrections are used. The new algorithm also terminates early */
/*        (after fewer than three iterations) when convergence is */
/*        attained. */

/*        Call to ZZPRSCOR was replaced by a call to ZZVALCOR. */

/* -    SPICELIB Version 1.0.0, 11-JAN-2008 (NJB) */

/* -& */
/* $ Index_Entries */

/*     low-level light time correction */
/*     light-time corrected state from spk file */
/*     get light-time corrected state */

/* -& */
/* $ Revisions */

/*     None. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     TOL is the tolerance used for a division-by-zero test */
/*     performed prior to computation of DLT. */


/*     Convergence limit: */


/*     Maximum number of light time iterations for any */
/*     aberration correction: */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("SPKLTC", (ftnlen)6);
    }
    if (pass1 || s_cmp(abcorr, prvcor, abcorr_len, (ftnlen)5) != 0) {

/*        The aberration correction flag differs from the value it */
/*        had on the previous call, if any.  Analyze the new flag. */

	zzvalcor_(abcorr, attblk, abcorr_len);
	if (failed_()) {
	    chkout_("SPKLTC", (ftnlen)6);
	    return 0;
	}

/*        The aberration correction flag is recognized; save it. */

	s_copy(prvcor, abcorr, (ftnlen)5, abcorr_len);

/*        Set logical flags indicating the attributes of the requested */
/*        correction: */

/*           XMIT is .TRUE. when the correction is for transmitted */
/*           radiation. */

/*           USELT is .TRUE. when any type of light time correction */
/*           (normal or converged Newtonian) is specified. */

/*           USECN indicates converged Newtonian light time correction. */

/*        The above definitions are consistent with those used by */
/*        ZZVALCOR. */

	xmit = attblk[4];
	uselt = attblk[1];
	usecn = attblk[3];
	usestl = attblk[2];
	pass1 = FALSE_;
    }

/*     See if the reference frame is a recognized inertial frame. */

    irfnum_(ref, &refid, ref_len);
    if (refid == 0) {
	setmsg_("The requested frame '#' is not a recognized inertial frame. "
		, (ftnlen)60);
	errch_("#", ref, (ftnlen)1, ref_len);
	sigerr_("SPICE(BADFRAME)", (ftnlen)15);
	chkout_("SPKLTC", (ftnlen)6);
	return 0;
    }

/*     Find the geometric state of the target body with respect to */
/*     the solar system barycenter. Subtract the state of the */
/*     observer to get the relative state. Use this to compute the */
/*     one-way light time. */

    spkgeo_(targ, et, ref, &c__0, ssbtrg, &ssblt, ref_len);
    if (failed_()) {
	chkout_("SPKLTC", (ftnlen)6);
	return 0;
    }
    vsubg_(ssbtrg, stobs, &c__6, starg);
    dist = vnorm_(starg);
    *lt = dist / clight_();
    if (*lt == 0.) {

/*        This can happen only if the observer and target are at the */
/*        same position. We don't consider this an error, but we're not */
/*        going to compute the light time derivative. */

	*dlt = 0.;
	chkout_("SPKLTC", (ftnlen)6);
	return 0;
    }
    if (! uselt) {

/*        This is a special case: we're not using light time */
/*        corrections, so the derivative */
/*        of light time is just */

/*           (1/c) * d(VNORM(STARG))/dt */

	*dlt = vdot_(starg, &starg[3]) / (dist * clight_());

/*        LT and DLT are both set, so we can return. */

	chkout_("SPKLTC", (ftnlen)6);
	return 0;
    }

/*     To correct for light time, find the state of the target body */
/*     at the current epoch minus the one-way light time. Note that */
/*     the observer remains where it is. */

/*     Determine the sign of the light time offset. */

    if (xmit) {
	ltsign = 1;
    } else {
	ltsign = -1;
    }

/*     Let NUMITR be the number of iterations we'll perform to */
/*     compute the light time. */

    if (usecn) {
	numitr = 5;
    } else {
	numitr = 1;
    }
    i__ = 0;
    lterr = 1.;
    while(i__ < numitr && lterr > 1e-17) {

/*        LT was set either prior to this loop or */
/*        during the previous loop iteration. */

	epoch = *et + ltsign * *lt;
	spkgeo_(targ, &epoch, ref, &c__0, ssbtrg, &ssblt, ref_len);
	if (failed_()) {
	    chkout_("SPKLTC", (ftnlen)6);
	    return 0;
	}
	vsubg_(ssbtrg, stobs, &c__6, starg);
	prvlt = *lt;
	d__1 = vnorm_(starg) / clight_();
	*lt = touchd_(&d__1);
/*        LTERR is the magnitude of the change between the current */
/*        estimate of light time and the previous estimate, relative to */
/*        the previous light time corrected epoch. */

/* Computing MAX */
	d__3 = 1., d__4 = abs(epoch);
	d__2 = (d__1 = *lt - prvlt, abs(d__1)) / max(d__3,d__4);
	lterr = touchd_(&d__2);
	++i__;
    }

/*     At this point, STARG contains the light time corrected */
/*     state of the target relative to the observer. */

/*     Compute the derivative of light time with respect */
/*     to time: dLT/dt.  Below we derive the formula for */
/*     this quantity for the reception case. Let */

/*        POBS be the position of the observer relative to the */
/*        solar system barycenter. */

/*        VOBS be the velocity of the observer relative to the */
/*        solar system barycenter. */

/*        PTARG be the position of the target relative to the */
/*        solar system barycenter. */

/*        VTARG be the velocity of the target relative to the */
/*        solar system barycenter. */

/*        S be the sign of the light time correction. S is */
/*        negative for the reception case. */

/*     The light-time corrected position of the target relative to */
/*     the observer at observation time ET, given the one-way */
/*     light time LT is: */

/*         PTARG(ET+S*LT) - POBS(ET) */

/*     The light-time corrected velocity of the target relative to */
/*     the observer at observation time ET is */

/*         VTARG(ET+S*LT)*( 1 + S*d(LT)/d(ET) ) - VOBS(ET) */

/*     We need to compute dLT/dt. Below, we use the facts that, */
/*     for a time-dependent vector X(t), */

/*          ||X||     = <X,X> ** (1/2) */

/*        d(||X||)/dt = (1/2)<X,X>**(-1/2) * 2 * <X,dX/dt> */

/*                    = <X,X>**(-1/2) *  <X,dX/dt> */

/*                    = <X,dX/dt> / ||X|| */

/*     Newtonian light time equation: */

/*        LT     =   (1/c) * || PTARG(ET+S*LT) - POBS(ET)|| */

/*     Differentiate both sides: */

/*        dLT/dt =   (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */

/*                  * < PTARG(ET+S*LT) - POBS(ET), */
/*                      VTARG(ET+S*LT)*(1+S*d(LT)/d(ET)) - VOBS(ET) > */


/*               = (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */

/*                 * (  < PTARG(ET+S*LT) - POBS(ET), */
/*                        VTARG(ET+S*LT) - VOBS(ET) > */

/*                   +  < PTARG(ET+S*LT) - POBS(ET), */
/*                        VTARG(ET+S*LT)           > * (S*d(LT)/d(ET))  ) */

/*     Let */

/*        A =   (1/c) * ( 1 / || PTARG(ET+S*LT) - POBS(ET) || ) */

/*        B =   < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) - VOBS(ET) > */

/*        C =   < PTARG(ET+S*LT) - POBS(ET), VTARG(ET+S*LT) > */

/*     Then */

/*        d(LT)/d(ET) =  A * ( B  +  C * S*d(LT)/d(ET) ) */

/*     which implies */

/*        d(LT)/d(ET) =  A*B / ( 1 - S*C*A ) */



    a = 1. / (clight_() * vnorm_(starg));
    b = vdot_(starg, &starg[3]);
    c__ = vdot_(starg, &ssbtrg[3]);

/*     For physically realistic target velocities, S*C*A cannot equal 1. */
/*     We'll check for this case anyway. */

    if (ltsign * c__ * a > .99999999989999999) {
	setmsg_("Target range rate magnitude is approximately the speed of l"
		"ight. The light time derivative cannot be computed.", (ftnlen)
		110);
	sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
	chkout_("SPKLTC", (ftnlen)6);
	return 0;
    }

/*     Compute DLT: the rate of change of light time. */

    *dlt = a * b / (1. - ltsign * c__ * a);

/*     Overwrite the velocity portion of the output state */
/*     with the light-time corrected velocity. */

    d__1 = ltsign * *dlt + 1.;
    vlcom_(&d__1, &ssbtrg[3], &c_b19, &stobs[3], &starg[3]);
    chkout_("SPKLTC", (ftnlen)6);
    return 0;
} /* spkltc_ */
示例#9
0
文件: irftrn.c 项目: Dbelsa/coft
/* $Procedure      IRFTRN ( Inertial reference frame transformation ) */
/* Subroutine */ int irftrn_(char *refa, char *refb, doublereal *rotab, 
	ftnlen refa_len, ftnlen refb_len)
{
    integer codea, codeb;
    extern /* Subroutine */ int chkin_(char *, ftnlen), chkout_(char *, 
	    ftnlen), irfnum_(char *, integer *, ftnlen), irfrot_(integer *, 
	    integer *, doublereal *);
    extern logical return_(void);

/* $ Abstract */

/*     Return the matrix that transforms vectors from one specified */
/*     inertial reference frame to another. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     CONVERSION */
/*     COORDINATES */
/*     FRAMES */
/*     MATRIX */
/*     ROTATION */
/*     TRANSFORMATION */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     REFA       I   Name of reference frame to transform vectors FROM. */
/*     REFB       I   Name of reference frame to transform vectors TO. */
/*     ROTAB      O   REFA-to-REFB transformation matrix. */

/* $ Detailed_Input */

/*     REFA, */
/*     REFB           Names of two inertial reference frames.  Any names */
/*                    accepted by the routine IRFNUM may be used.  See */
/*                    $Particulars for a list of some of the more */
/*                    commonly used inertial reference frame names. */

/* $ Detailed_Output */

/*     ROTAB          is a rotation matrix that transforms the */
/*                    coordinates of a vector V relative to the */
/*                    reference frame specified by REFA to the */
/*                    coordinates of V relative to the reference frame */
/*                    specified by REFB.  The transformation is carried */
/*                    out by the matrix multiplication */

/*                       V = ROTAB * V. */
/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1)  If either of the input reference frame names is invalid, the */
/*         error will be diagnosed by routines called by this routine. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     Normally applications should call the more general, higher level */
/*     routine PXFORM instead of this routine. */

/*     This routine is a macro that replaces the code fragment */

/*        CALL IRFNUM ( REFA,  CODEA        ) */
/*        CALL IRFNUM ( REFB,  CODEB        ) */
/*        CALL IRFROT ( CODEA, CODEB, ROTAB ) */


/*     Among the reference frame names accepted by IRFNUM are: */

/*        'J2000' */
/*        'B1950' */
/*        'FK4' */
/*        'DE-96' */
/*        'DE-102' */
/*        'DE-108' */
/*        'DE-111' */
/*        'DE-114' */
/*        'DE-118' */
/*        'DE-122' */
/*        'DE-125' */
/*        'DE-130' */
/*        'DE-200' */
/*        'DE-202' */
/*        'GALACTIC' */

/*     See the SPICELIB routine GHGIRF for details. */


/* $ Examples */

/*     1)  Transform a vector V1950 from the B1950 to the J2000 */
/*         reference frame. */

/*            C */
/*            C     Ask IRFTRN for the matrix that transforms vectors */
/*            C     from the B1950 to the J2000 reference frame. */
/*            C */
/*                  CALL IRFTRN ( 'B1950', 'J2000', TRANS ) */

/*            C */
/*            C     Now transform V1950 to the J2000 reference frame. */
/*            C */
/*                  CALL MXV ( TRANS, V1950, V2000 ) */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman   (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.2, 28-SEP-2004 (NJB) */

/*        Corrected comment in code example in header.  Made other minor */
/*        updates to header. */

/* -    SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */

/*        Comment section for permuted index source lines was added */
/*        following the header. */

/* -    SPICELIB Version 1.0.0, 30-AUG-1991 (NJB) */

/* -& */
/* $ Index_Entries */

/*     tranformation from one inertial frame to another */

/* -& */

/*     SPICELIB functions */


/*     Local variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("IRFTRN", (ftnlen)6);
    }

/*     Encode the reference frame names, and find the transformation */
/*     matrix. */

    irfnum_(refa, &codea, refa_len);
    irfnum_(refb, &codeb, refb_len);
    irfrot_(&codea, &codeb, rotab);
    chkout_("IRFTRN", (ftnlen)6);
    return 0;
} /* irftrn_ */