Пример #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
/* $Procedure      XFMSTA ( Transform state between coordinate systems) */
/* Subroutine */ int xfmsta_(doublereal *istate, char *icosys, char *ocosys, 
	char *body, doublereal *ostate, ftnlen icosys_len, ftnlen ocosys_len, 
	ftnlen body_len)
{
    /* Initialized data */

    static char cosys[40*6] = "RECTANGULAR                             " 
	    "CYLINDRICAL                             " "LATITUDINAL         "
	    "                    " "SPHERICAL                               " 
	    "GEODETIC                                " "PLANETOGRAPHIC      "
	    "                    ";
    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2;
    doublereal d__1, d__2;

    /* Builtin functions */
    double sqrt(doublereal);
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *, 
	    logical *, char *, integer *, logical *, ftnlen, ftnlen);
    doublereal ivel[3], ipos[3];
    extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
    integer isys, osys;
    doublereal f;
    extern /* Subroutine */ int zzctruin_(integer *);
    integer i__, j;
    doublereal radii[3];
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen), vpack_(doublereal *, doublereal *, doublereal *,
	     doublereal *);
    extern doublereal dpmax_(void);
    logical found;
    extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen), vequg_(
	    doublereal *, integer *, doublereal *);
    doublereal sqtmp;
    char isysu[40], osysu[40];
    static logical svfnd1;
    static integer svctr1[2];
    extern logical failed_(void);
    doublereal jacobi[9]	/* was [3][3] */;
    extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer 
	    *, doublereal *, ftnlen), georec_(doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *), drdgeo_(
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *), recgeo_(doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *), dgeodr_(
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *);
    integer bodyid;
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
    static integer svbdid;
    extern /* Subroutine */ int latrec_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), drdlat_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), cylrec_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), drdcyl_(doublereal *, doublereal *, 
	    doublereal *, doublereal *);
    doublereal toobig;
    extern /* Subroutine */ int sphrec_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), drdsph_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), pgrrec_(char *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, ftnlen), drdpgr_(char *, doublereal *, doublereal *,
	     doublereal *, doublereal *, doublereal *, doublereal *, ftnlen), 
	    reccyl_(doublereal *, doublereal *, doublereal *, doublereal *), 
	    reclat_(doublereal *, doublereal *, doublereal *, doublereal *), 
	    sigerr_(char *, ftnlen), recsph_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), chkout_(char *, ftnlen), recpgr_(
	    char *, doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, ftnlen), dcyldr_(doublereal *, 
	    doublereal *, doublereal *, doublereal *), dlatdr_(doublereal *, 
	    doublereal *, doublereal *, doublereal *), ljucrs_(integer *, 
	    char *, char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), dsphdr_(
	    doublereal *, doublereal *, doublereal *, doublereal *);
    static char svbody[36];
    extern /* Subroutine */ int dpgrdr_(char *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, ftnlen);
    extern logical return_(void);
    integer dim;
    extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
	    ;

/* $ Abstract */

/*     Transform a state between coordinate systems. */

/* $ 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 */

/*     CONVERSION */
/*     COORDINATE */
/*     EPHEMERIS */
/*     STATE */

/* $ Declarations */
/* $ 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 */
/*     --------  ---  ------------------------------------------------- */
/*     ISTATE     I   Input state. */
/*     ICOSYS     I   Current (input) coordinate system. */
/*     OCOSYS     I   Desired (output) coordinate system. */
/*     BODY       I   Name or NAIF ID of body with which */
/*                    coordinates are associated (if applicable). */
/*     OSTATE     O   Converted output state. */

/* $ Detailed_Input */

/*     ISTATE     is a state vector in the input (ICOSYS) coordinate */
/*                system representing position and velocity. */

/*                All angular measurements must be in radians. */

/*                Note: body radii values taken from the kernel */
/*                pool are used when converting to or from geodetic or */
/*                planetographic coordinates. It is the user's */
/*                responsibility to verify the distance inputs are in */
/*                the same units as the radii in the kernel pool, */
/*                typically kilometers. */

/*     ICOSYS     is the name of the coordinate system that the input */
/*                state vector (ISTATE) is currently in. */

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

/*                    'RECTANGULAR' */
/*                    'CYLINDRICAL' */
/*                    'LATITUDINAL' */
/*                    'SPHERICAL' */
/*                    'GEODETIC' */
/*                    'PLANETOGRAPHIC' */

/*                Leading spaces, trailing spaces, and letter case */
/*                are ignored. For example, ' cyLindRical  ' would be */
/*                accepted. */

/*     OCOSYS     is the name of the coordinate system that the state */
/*                should be converted to. */

/*                Please see the description of ICOSYS for details. */

/*     BODY       is the name or NAIF ID of the body associated with the */
/*                planetographic or geodetic coordinate system. */

/*                If neither of the coordinate system choices are */
/*                geodetic or planetographic, BODY may be an empty */
/*                string (' '). */

/*                Examples of accepted body names or IDs are: */
/*                         'Earth' */
/*                         '399' */

/*                Leading spaces, trailing spaces, and letter case are */
/*                ignored. */

/* $ Detailed_Output */

/*     OSTATE     is the state vector that has been converted to the */
/*                output coordinate system (OCOSYS). */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1)  If either the input or output coordinate system is not */
/*         recognized, the error SPICE(COORDSYSNOTREC) is signaled. */

/*     2)  If the input body name cannot be converted to a NAIF ID */
/*         (applies to geodetic and planetographic coordinate */
/*         systems), the error 'SPICE(IDCODENOTFOUND)' is signaled. */

/*     3)  If the input state ISTATE is not valid, meaning the position */
/*         but not the velocity is along the z-axis, the error */
/*         'SPICE(INVALIDSTATE)' is signaled. */

/*         Note: If both the input position and velocity are along */
/*         the z-axis and the output coordinate system is not */
/*         rectangular, the velocity can still be calculated even */
/*         though the Jacobian is undefined. This case will not */
/*         signal an error. An example of the input position and */
/*         velocity along the z-axis is below. */

/*                       Term    Value */
/*                       -----   ------ */
/*                         x       0 */
/*                         y       0 */
/*                         z       z */
/*                       dx/dt     0 */
/*                       dy/dt     0 */
/*                       dz/dt   dz_dt */

/*     4)  If either the input or output coordinate system is */
/*         geodetic or planetographic and at least one of the body's */
/*         radii is less than or equal to zero, the error */
/*         SPICE(INVALIDRADIUS) will be signaled. */

/*     5)  If either the input or output coordinate system is */
/*         geodetic or planetographic and the difference of the */
/*         equatorial and polar radii divided by the equatorial radius */
/*         would produce numeric overflow, the error */
/*         'SPICE(INVALIDRADIUS)' will be signaled. */

/*     6)  If the product of the Jacobian and velocity components */
/*         may lead to numeric overflow, the error */
/*         'SPICE(NUMERICOVERFLOW)' is signaled. */

/* $ Files */

/*     SPK, PCK, CK, and FK kernels may be required. */

/*     If the input or output coordinate systems are either geodetic or */
/*     planetographic, a PCK providing the radii of the body */
/*     name BODY must be loaded via FURNSH. */

/*     Kernel data are normally loaded once per program run, NOT every */
/*     time this routine is called. */

/* $ Particulars */

/*     Input Order */
/*     ------------------------------------------- */

/*     The input and output states will be structured by the */
/*     following descriptions. */

/*     For rectangular coordinates, the state vector is the following */
/*     in which X, Y, and Z are the rectangular position components and */
/*     DX, DY, and DZ are the time derivatives of each position */
/*     component. */

/*             ISTATE = ( X, Y, Z, DX, DY, DZ ) */

/*     For cylindrical coordinates, the state vector is the following */
/*     in which R is the radius, LONG is the longitudes, Z is the */
/*     height, and DR, DLONG, and DZ are the time derivatives of each */
/*     position component. */

/*             ISTATE = ( R, LONG, Z, DR, DLONG, DZ ) */

/*     For latitudinal coordinates, the state vector is the following */
/*     in which R is the radius, LONG is the longitude, LAT is the */
/*     latitude, and DR, DLONG, and DLAT are the time derivatives of */
/*     each position component. */

/*             ISTATE = ( R, LONG, LAT, DR, DLONG, DLAT ) */

/*     For spherical coordinates, the state vector is the following in */
/*     which R is the radius, COLAT is the colatitude, LONG is the */
/*     longitude, and DR, DCOLAT, and DLONG are the time derivatives of */
/*     each position component. */

/*             ISTATE = ( R, COLAT, LONG, DR, DCOLAT, DLONG ) */

/*     For geodetic coordinates, the state vector is the following in */
/*     which LONG is the longitude, LAT is the latitude, ALT is the */
/*     altitude, and DLONG, DLAT, and DALT are the time derivatives of */
/*     each position component. */

/*             ISTATE = ( LONG, LAT, ALT, DLONG, DLAT, DALT ) */

/*     For planetographic coordinates, the state vector is the */
/*     following in which LONG is the longitude, LAT is the latitude, */
/*     ALT is the altitude, and DLONG, DLAT, and DALT are the time */
/*     derivatives of each position component. */

/*             ISTATE = ( LONG, LAT, ALT, DLONG, DLAT, DALT ) */


/*     Input Boundaries */
/*     ------------------------------------------- */

/*     There are intervals the input angles must fall within if */
/*     the input coordinate system is not rectangular. These */
/*     intervals are provided below. */

/*        Input variable    Input meaning   Input interval [rad] */
/*        --------------    -------------   ------------------------ */
/*            LONG           Longitude        0     <= LONG  <  2*pi */
/*            LAT            Latitude        -pi/2  <= LAT   <= pi/2 */
/*            COLAT          Colatitude       0     <= COLAT <= pi */


/* $ Examples */

/*     The numerical results shown for these examples 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) Find the apparent state of Phoebe as seen by CASSINI in the */
/*        J2000 frame at 2004 Jun 11 19:32:00. Transform the state */
/*        from rectangular to latitudinal coordinates. For verification, */
/*        transform the state back from latitudinal to rectangular */
/*        coordinates. */

/*        Use the meta-kernel shown below to load the required SPICE */
/*        kernels. */

/*           KPL/MK */

/*           File name: xfmsta_ex1.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. */

/*           The names and contents of the kernels referenced */
/*           by this meta-kernel are as follows: */

/*                  File name                     Contents */
/*                  ---------                     -------- */
/*                  cpck05Mar2004.tpc             Planet orientation and */
/*                                                radii */
/*                  naif0009.tls                  Leapseconds */
/*                  020514_SE_SAT105.bsp          Satellite ephemeris for */
/*                                                Saturn */
/*                  030201AP_SK_SM546_T45.bsp     CASSINI ephemeris */
/*                  981005_PLTEPH-DE405S.bsp      Planetary ephemeris */


/*           \begindata */

/*           KERNELS_TO_LOAD = ( 'naif0009.tls'  , */
/*                               '020514_SE_SAT105.bsp'  , */
/*                               '030201AP_SK_SM546_T45.bsp'  , */
/*                               '981005_PLTEPH-DE405S.bsp', */
/*                               'cpck05Mar2004.tpc'   ) */

/*           End of meta-kernel */

/*        Example code begins here. */

/*           PROGRAM  EX1_XFMSTA */
/*           IMPLICIT NONE */
/*     C */
/*     C     Local parameters */
/*     C */
/*     C     METAKR is the meta-kernel's filename. */
/*     C */
/*           CHARACTER*(*)         METAKR */
/*           PARAMETER           ( METAKR = 'xfmsta_ex1.tm' ) */

/*           CHARACTER*(*)         FORM */
/*           PARAMETER           ( FORM = '(F16.6, F16.6, F16.6)' ) */

/*     C */
/*     C     Local variables */
/*     C */
/*     C     STAREC is the state of Phoebe with respect to CASSINI in */
/*     C     rectangular coordinates. STALAT is the state rotated into */
/*     C     latitudinal coordinates. STREC2 is the state transformed */
/*     C     back into rectangular coordinates from latitudinal. */
/*     C */
/*           DOUBLE PRECISION      STAREC (6) */
/*           DOUBLE PRECISION      STALAT (6) */
/*           DOUBLE PRECISION      STREC2 (6) */

/*     C */
/*     C     ET is the ephemeris time (TDB) corresponding to the */
/*     C     observation. */
/*     C */
/*           DOUBLE PRECISION      ET */
/*           DOUBLE PRECISION      LT */

/*           INTEGER               I */

/*     C */
/*     C     The required kernels must be loaded. */
/*     C */
/*           CALL FURNSH ( METAKR ) */

/*     C */
/*     C     Calculate the state at 2004 Jun 11 19:32:00 UTC. */
/*     C */
/*           CALL STR2ET ( '2004-JUN-11-19:32:00', ET ) */

/*     C */
/*     C     Calculate the apparent state of Phoebe as seen by */
/*     C     CASSINI in the J2000 frame. */
/*     C */
/*           CALL SPKEZR ( 'PHOEBE',  ET, 'IAU_PHOEBE', 'LT+S', */
/*          .              'CASSINI', STAREC, LT ) */

/*     C */
/*     C     Transform the state from rectangular to latitudinal. */
/*     C     Notice that since neither the input nor output */
/*     C     coordinate frames are 'geodetic' or 'planetographic', */
/*     C     the input for the body name is a blank string. */
/*     C */
/*           CALL XFMSTA ( STAREC, 'RECTANGULAR', 'LATITUDINAL', ' ', */
/*          .              STALAT ) */

/*     C */
/*     C     Transform the state back to rectangular from latitudinal */
/*     C     for verification. This result should be very similar to */
/*     C     STAREC. */
/*     C */
/*           CALL XFMSTA ( STALAT, 'LATITUDINAL', 'RECTANGULAR',' ', */
/*          .              STREC2 ) */

/*     C */
/*     C     Report the results. */
/*     C */
/*           WRITE (*,*)    ' ' */
/*           WRITE (*,*)    'Phoebe as seen by CASSINI - rectangular' */
/*           WRITE (*,*)    '  Position [km]:' */
/*           WRITE (*,FORM) (STAREC(I), I = 1, 3) */
/*           WRITE (*,*)    '  Velocity [km/s]:' */
/*           WRITE (*,FORM) (STAREC(I), I = 4, 6) */
/*           WRITE (*,*)    ' ' */
/*           WRITE (*,*)    'Phoebe as seen by CASSINI - latitudinal' */
/*           WRITE (*,*)    '  Position [km, rad, rad]:' */
/*           WRITE (*,FORM) (STALAT(I), I = 1, 3) */
/*           WRITE (*,*)    '  Velocity [km/s, rad/s, rad/s]:' */
/*           WRITE (*,FORM) (STALAT(I), I = 4, 6) */
/*           WRITE (*,*)    ' ' */
/*           WRITE (*,*)    'Verification: ' */
/*           WRITE (*,*)    'Phoebe as seen by CASSINI - rectangular' */
/*           WRITE (*,*)    '  Position [km]:' */
/*           WRITE (*,FORM) (STREC2(I), I = 1, 3) */
/*           WRITE (*,*)    '  Velocity [km/s]:' */
/*           WRITE (*,FORM) (STREC2(I), I = 4, 6) */

/*           END */

/*        When this program was executed using gfortran on a PC Linux */
/*        64 bit environment, the output was: */

/*             Phoebe as seen by CASSINI - rectangular */
/*               Position [km]: */
/*                -1982.639762     -934.530471     -166.562595 */
/*               Velocity [km/s]: */
/*                    3.970832       -3.812496       -2.371663 */

/*             Phoebe as seen by CASSINI - latitudinal */
/*               Position [km, rad, rad]: */
/*                 2198.169858       -2.701121       -0.075846 */
/*               Velocity [km/s, rad/s, rad/s]: */
/*                   -1.780939        0.002346       -0.001144 */

/*             Verification: */
/*             Phoebe as seen by CASSINI - rectangular */
/*               Position [km]: */
/*                -1982.639762     -934.530471     -166.562595 */
/*               Velocity [km/s]: */
/*                    3.970832       -3.812496       -2.371663 */

/*     2) Transform a given state from cylindrical to planetographic */
/*        coordinates with respect to Earth. */

/*        Use the meta-kernel shown below to load the required SPICE */
/*        kernels. */

/*           KPL/MK */

/*           File name: xfmsta_ex2.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. */

/*           The names and contents of the kernels referenced */
/*           by this meta-kernel are as follows: */

/*              File name                     Contents */
/*              ---------                     -------- */
/*              cpck05Mar2004.tpc             Planet orientation and */
/*                                            radii */

/*           \begindata */

/*              KERNELS_TO_LOAD = ( 'cpck05Mar2004.tpc' ) */

/*           \begintext */

/*           End of meta-kernel */


/*        Example code begins here. */

/*           PROGRAM  EX2_XFMSTA */
/*           IMPLICIT NONE */

/*     C */
/*     C     Local parameters */
/*     C */
/*     C     METAKR is the meta-kernel's filename. */
/*     C */
/*           CHARACTER*(*)         METAKR */
/*           PARAMETER           ( METAKR = 'xfmsta_ex2.tm' ) */

/*           CHARACTER*(*)         FORM */
/*           PARAMETER           ( FORM = '(F16.6, F16.6, F16.6)' ) */

/*     C */
/*     C     Local variables */
/*     C */
/*     C     STACYL is the state in cylindrical coordinates. */
/*     C */
/*           DOUBLE PRECISION      STACYL (6) */
/*     C */
/*     C     STAPLN is the state transformed into planetographic */
/*     C     coordinates. */
/*     C */
/*           DOUBLE PRECISION      STAPLN (6) */
/*     C */
/*     C     STCYL2 is the state transformed back into */
/*     C     cylindrical coordinates from planetographic. */
/*     C */
/*           DOUBLE PRECISION      STCYL2 (6) */

/*           INTEGER               I */

/*           DATA STACYL / 1.0D0, 0.5D0, 0.5D0, 0.2D0, 0.1D0, -0.2D0 / */
/*     C */
/*     C     The required kernels must be loaded. */
/*     C */
/*           CALL FURNSH ( METAKR ) */

/*     C */
/*     C     Transform the state from cylindrical to planetographic. */
/*     C     Note that since one of the coordinate systems is */
/*     C     planetographic, the body name must be input. */
/*     C */
/*           CALL XFMSTA ( STACYL, 'CYLINDRICAL', 'PLANETOGRAPHIC', */
/*          .              'EARTH', STAPLN ) */

/*     C */
/*     C     Transform the state back to cylindrical from */
/*     C     planetographic for verification. The result should be very */
/*     C     close to STACYL. */
/*     C */
/*           CALL XFMSTA ( STAPLN, 'PLANETOGRAPHIC', 'CYLINDRICAL', */
/*          .              'EARTH', STCYL2 ) */

/*     C */
/*     C     Report the results. */
/*     C */
/*           WRITE (*,*)    'Cylindrical state' */
/*           WRITE (*,*)    '  Position [km, rad, km]:' */
/*           WRITE (*,FORM) (STACYL(I), I = 1, 3) */
/*           WRITE (*,*)    '  Velocity [km/s, rad/s, km/s]:' */
/*           WRITE (*,FORM) (STACYL(I), I = 4, 6) */
/*           WRITE (*,*)    ' ' */
/*           WRITE (*,*) 'Planetographic state' */
/*           WRITE (*,*)    '  Position [rad, rad, km]:' */
/*           WRITE (*,FORM) (STAPLN(I), I = 1, 3) */
/*           WRITE (*,*)    '  Velocity [rad/s, rad/s, km/s]:' */
/*           WRITE (*,FORM) (STAPLN(I), I = 4, 6) */
/*           WRITE (*,*)    ' ' */
/*           WRITE (*,*)    'Verification:  Cylindrical state' */
/*           WRITE (*,*)    '  Position [km, rad, km]:' */
/*           WRITE (*,FORM) (STCYL2(I), I = 1, 3) */
/*           WRITE (*,*)    '  Velocity [km/s, rad/s, km/s]:' */
/*           WRITE (*,FORM) (STCYL2(I), I = 4, 6) */

/*           END */

/*        When this program was executed using gfortran on a PC Linux */
/*        64 bit environment, the output was: */

/*             Cylindrical state */
/*               Position [km, rad, km]: */
/*                    1.000000        0.500000        0.500000 */
/*               Velocity [km/s, rad/s, km/s]: */
/*                    0.200000        0.100000       -0.200000 */

/*             Planetographic state */
/*               Position [rad, rad, km]: */
/*                    0.500000        1.547727    -6356.238467 */
/*               Velocity [rad/s, rad/s, km/s]: */
/*                    0.100000       -0.004721       -0.195333 */

/*             Verification:  Cylindrical state */
/*               Position [km, rad, km]: */
/*                    1.000000        0.500000        0.500000 */
/*               Velocity [km/s, rad/s, km/s]: */
/*                    0.200000        0.100000       -0.200000 */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     S.C. Krening      (JPL) */
/*     B.V. Semenov      (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.0.0  22-APR-2014 (SCK)(BVS) */

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

/*     state transformation between coordinate systems */
/*     convert state */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Potentially large numbers produced by transforming the */
/*     velocity using the Jacobian must not exceed DPMAX()/MARGIN: */


/*     The size of each coordinate system name must not exceed */
/*     CHSIZ characters. */


/*     NCOSYS is the number of coordinate systems supported by */
/*     this routine. */


/*     The following integer parameters represent the coordinate */
/*     systems supported by this routine. */


/*     Saved body name length. */


/*     Local variables */

/*     COSYS is the array of supported coordinate system names. */
/*     ISYSU and OSYSU are the input and output coordinate systems */
/*     from the user that are made insensitive to case or leading and */
/*     trailing spaces. */


/*     IPOS and IVEL are the input position and velocity translated */
/*     into rectangular. */


/*     For transformations including either geodetic or planetographic */
/*     coordinate systems, RADII is an array of the radii values */
/*     associated with the input body. These values will be loaded */
/*     from the kernel pool. */


/*     JACOBI is the Jacobian matrix that converts the velocity */
/*     coordinates between systems. */


/*     The flattening coefficient, F, is calculated when either */
/*     geodetic or planetographic coordinate systems are included */
/*     in the transformation. */


/*     SQTMP and TOOBIG are used to check for possible numeric */
/*     overflow situations. */


/*     BODYID and DIM are only used when the input or output coordinate */
/*     systems are geodetic or planetographic. The BODYID is the NAID ID */
/*     associated with the input body name. DIM is used while retrieving */
/*     the radii from the kernel pool. */


/*     ISYS and OSYS are the integer codes corresponding to the */
/*     input and output coordinate systems. I and J are iterators. */


/*     Saved name/ID item declarations. */


/*     Saved variables */


/*     Saved name/ID items. */


/*     Assign the names of the coordinate systems to a character */
/*     array in which each coordinate system name is located at */
/*     the index of the integer ID of the coordinate system. */


/*     Initial values. */


/*     There are three main sections of this routine: */

/*       1)  Error handling and initialization. */
/*       2)  Conversion of the input to rectangular coordinates. */
/*       3)  Conversion from rectangular to the output coordinates. */

/*     Error handling and initialization */
/*     ---------------------------------------------------------------- */

/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counter. */

	zzctruin_(svctr1);
	first = FALSE_;
    }

/*     Remove initial and trailing spaces. */
/*     Convert the input coordinate systems to upper case. */

    ljucrs_(&c__0, icosys, isysu, icosys_len, (ftnlen)40);
    ljucrs_(&c__0, ocosys, osysu, ocosys_len, (ftnlen)40);

/*     Check to see if the input and output coordinate systems */
/*     provided by the user are acceptable. Store the integer */
/*     code of the input and output coordinate systems into */
/*     ISYS and OSYS. */

    isys = isrchc_(isysu, &c__6, cosys, (ftnlen)40, (ftnlen)40);
    osys = isrchc_(osysu, &c__6, cosys, (ftnlen)40, (ftnlen)40);

/*     If the coordinate systems are not acceptable, an error is */
/*     signaled. */

    if (isys == 0 || osys == 0) {
	if (isys == 0 && osys == 0) {

/*           Both the input and the output coordinate systems were not */
/*           recognized. */

	    setmsg_("Input coordinate system # and output coordinate system "
		    "# are not recognized.", (ftnlen)76);
	    errch_("#", icosys, (ftnlen)1, icosys_len);
	    errch_("#", ocosys, (ftnlen)1, ocosys_len);
	    sigerr_("SPICE(COORDSYSNOTREC)", (ftnlen)21);
	    chkout_("XFMSTA", (ftnlen)6);
	    return 0;
	} else if (isys == 0) {

/*           The input coordinate system was not recognized. */

	    setmsg_("Input coordinate system # was not recognized", (ftnlen)
		    44);
	    errch_("#", icosys, (ftnlen)1, icosys_len);
	    sigerr_("SPICE(COORDSYSNOTREC)", (ftnlen)21);
	    chkout_("XFMSTA", (ftnlen)6);
	    return 0;
	} else {

/*           The output coordinate system was not recognized. */

	    setmsg_("Output coordinate system # was not recognized", (ftnlen)
		    45);
	    errch_("#", ocosys, (ftnlen)1, ocosys_len);
	    sigerr_("SPICE(COORDSYSNOTREC)", (ftnlen)21);
	    chkout_("XFMSTA", (ftnlen)6);
	    return 0;
	}
    }

/*     If the input and output coordinate systems are equal, set the */
/*     output equal to the input since no conversion needs to take */
/*     place. */

    if (isys == osys) {
	vequg_(istate, &c__6, ostate);
	chkout_("XFMSTA", (ftnlen)6);
	return 0;
    }

/*     If converting to or from either geodetic or planetographic, the */
/*     NAIF ID must be found from the input body name BODY. If the */
/*     body name does not have a valid NAIF ID code, an error is */
/*     signaled. If the NAIF ID is valid, the radii of the body are */
/*     located and the flattening coefficient is calculated. */

    if (osys == 5 || osys == 6 || isys == 5 || isys == 6) {

/*        Find the NAIF ID code */

	zzbods2c_(svctr1, svbody, &svbdid, &svfnd1, body, &bodyid, &found, (
		ftnlen)36, body_len);

/*        If the body's name was found, find the body's radii and */
/*        compute flattening coefficient. Otherwise, signal an error. */

	if (found) {
	    bodvcd_(&bodyid, "RADII", &c__3, &dim, radii, (ftnlen)5);
	    if (failed_()) {
		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    }

/*           If either radius is less than or equal to zero, an error is */
/*           signaled. */

	    if (radii[2] <= 0. || radii[0] <= 0.) {
		setmsg_("At least one radii is less than or equal to zero. T"
			"he equatorial radius has a value of # and the polar "
			"radius has has a value of #.", (ftnlen)131);
		errdp_("#", radii, (ftnlen)1);
		errdp_("#", &radii[2], (ftnlen)1);
		sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    }

/*           If the difference of the equatorial and polar radii */
/*           divided by the equatorial radius is greater than DPMAX, */
/*           a numeric overflow may occur, so an error is signaled. */

	    if (sqrt((d__1 = radii[0] - radii[2], abs(d__1))) / sqrt((abs(
		    radii[0]))) >= sqrt(dpmax_())) {
		setmsg_("The equatorial radius for # has a value of # and a "
			"polar radius of #. The flattening coefficient cannot"
			" be calculated due to numeric overflow.", (ftnlen)142)
			;
		errch_("#", body, (ftnlen)1, body_len);
		errdp_("#", radii, (ftnlen)1);
		errdp_("#", &radii[2], (ftnlen)1);
		sigerr_("SPICE(INVALIDRADIUS)", (ftnlen)20);
		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    }
	    f = (radii[0] - radii[2]) / radii[0];
	} else {
	    setmsg_("The input body name # does not have a valid NAIF ID cod"
		    "e.", (ftnlen)57);
	    errch_("#", body, (ftnlen)1, body_len);
	    sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	    chkout_("XFMSTA", (ftnlen)6);
	    return 0;
	}
    }

/*     Conversion of the input to rectangular coordinates */
/*     ---------------------------------------------------------------- */

/*     First, the position and velocity coordinates will be converted */
/*     into rectangular coordinates. If the input system is not */
/*     rectangular, then the velocity coordinates must be translated */
/*     into rectangular using the Jacobian. If the input system is */
/*     rectangular, then the input state must simply be saved into IPOS */
/*     and IVEL. */

/*     TOOBIG is used for preventing numerical overflow. The square */
/*     roots of values are used to safely check if overflow will occur. */

    toobig = sqrt(dpmax_() / 100.);
    if (isys != 1) {

/*        To rectangular... */

	if (isys == 2) {

/*                  ... from cylindrical */

	    cylrec_(istate, &istate[1], &istate[2], ipos);
	    drdcyl_(istate, &istate[1], &istate[2], jacobi);
	} else if (isys == 3) {

/*                  ... from latitudinal */

	    latrec_(istate, &istate[1], &istate[2], ipos);
	    drdlat_(istate, &istate[1], &istate[2], jacobi);
	} else if (isys == 4) {

/*                  ... from spherical */

	    sphrec_(istate, &istate[1], &istate[2], ipos);
	    drdsph_(istate, &istate[1], &istate[2], jacobi);
	} else if (isys == 5) {

/*                  ... from geodetic */

	    georec_(istate, &istate[1], &istate[2], radii, &f, ipos);
	    if (failed_()) {
		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    }
	    drdgeo_(istate, &istate[1], &istate[2], radii, &f, jacobi);
	} else if (isys == 6) {

/*                  ... from planetographic */

	    pgrrec_(body, istate, &istate[1], &istate[2], radii, &f, ipos, 
		    body_len);
	    if (failed_()) {
		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    }
	    drdpgr_(body, istate, &istate[1], &istate[2], radii, &f, jacobi, 
		    body_len);
	} else {
	    setmsg_("This error should never occur. This is an intermediate "
		    "step in which a non-rectangular input state should be tr"
		    "ansferred to rectangular.  The input coordinate system i"
		    "s not recognized, yet was not caught by an earlier check."
		    , (ftnlen)224);
	    sigerr_("SPICE(BUG1)", (ftnlen)11);
	    chkout_("XFMSTA", (ftnlen)6);
	    return 0;
	}

/*        Some DRD* routines are not error free. Be safe and check */
/*        FAILED to not use un-initialized JACOBI. */

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

/*        If the multiplication of the Jacobian and velocity can cause */
/*        overflow, signal an error. */

	for (i__ = 1; i__ <= 3; ++i__) {
	    for (j = 1; j <= 3; ++j) {
		sqtmp = sqrt((d__1 = jacobi[(i__1 = i__ + j * 3 - 4) < 9 && 0 
			<= i__1 ? i__1 : s_rnge("jacobi", i__1, "xfmsta_", (
			ftnlen)1054)], abs(d__1))) * sqrt((d__2 = istate[(
			i__2 = j + 2) < 6 && 0 <= i__2 ? i__2 : s_rnge("ista"
			"te", i__2, "xfmsta_", (ftnlen)1054)], abs(d__2)));
		if (sqtmp > toobig) {
		    setmsg_("The product of the Jacobian and velocity may ca"
			    "use numeric overflow.", (ftnlen)68);
		    sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22);
		    chkout_("XFMSTA", (ftnlen)6);
		    return 0;
		}
	    }
	}

/*        Transform the velocity into rectangular coordinates. */

	mxv_(jacobi, &istate[3], ivel);
    } else if (isys == 1) {

/*        If the input coordinate system is rectangular, the input */
/*        position does not need to be translated into rectangular. */

	vequ_(istate, ipos);
	vequ_(&istate[3], ivel);
    } else {
	setmsg_("This error should never occur. This is an ELSE statement. I"
		"f the input coordinate system is not rectangular, the IF sho"
		"uld be executed. If the input coordinate system is rectangul"
		"ar, the ELSE IF should be executed.", (ftnlen)214);
	sigerr_("SPICE(BUG2)", (ftnlen)11);
	chkout_("XFMSTA", (ftnlen)6);
	return 0;
    }

/*     Conversion from rectangular into the output coordinates */
/*     ---------------------------------------------------------------- */

/*     Convert to the output coordinate system. If the output */
/*     coordinate system is not rectangular, four calculations must */
/*     be made: */

/*       1)  Verify the position and velocity are not along the z-axis. */
/*           If the position and velocity are along the z-axis, the */
/*           velocity can still be converted even though the */
/*           Jacobian is not defined. If the position is along the */
/*           z-axis but the velocity is not, the velocity cannot be */
/*           converted to the output coordinate system. */

/*       2)  Calculate the Jacobian from rectangular to the output */
/*           coordinate system and verify the product of the Jacobian */
/*           and velocity will not cause numeric overflow. */

/*       3)  Transform the position to the output coordinate system. */

/*       4)  Transform the velocity to the output coordinates using */
/*           the Jacobian and the rectangular velocity IVEL. */

    if (osys != 1) {

/*        From rectangular for the case when the input position is along */
/*        the z-axis ... */

	if (abs(ipos[0]) + abs(ipos[1]) == 0.) {
	    if (abs(ivel[0]) + abs(ivel[1]) == 0.) {

/*              If the velocity is along the z-axis, then the velocity */
/*              can be computed in the output coordinate frame even */
/*              though the Jacobian is not defined. */

		if (osys == 2) {

/*                  ... to cylindrical */

		    vpack_(&c_b56, &c_b56, &ivel[2], &ostate[3]);
		    reccyl_(ipos, ostate, &ostate[1], &ostate[2]);
		} else if (osys == 3) {

/*                  ... to latitudinal */

		    vpack_(&ivel[2], &c_b56, &c_b56, &ostate[3]);
		    reclat_(ipos, ostate, &ostate[1], &ostate[2]);
		} else if (osys == 4) {

/*                  ... to spherical */

		    vpack_(&ivel[2], &c_b56, &c_b56, &ostate[3]);
		    recsph_(ipos, ostate, &ostate[1], &ostate[2]);
		} else if (osys == 5) {

/*                  ... to geodetic */

		    vpack_(&c_b56, &c_b56, &ivel[2], &ostate[3]);
		    recgeo_(ipos, radii, &f, ostate, &ostate[1], &ostate[2]);
		} else if (osys == 6) {

/*                  ... to planetographic */

		    vpack_(&c_b56, &c_b56, &ivel[2], &ostate[3]);
		    recpgr_(body, ipos, radii, &f, ostate, &ostate[1], &
			    ostate[2], body_len);
		} else {
		    setmsg_("This error should never occur. This is an inter"
			    "mediate step in which a position and velocity al"
			    "ong the z-axis are converted to a non-rectangula"
			    "r coordinate system from rectangular. The output"
			    " coordinate system is not recognized, yet was no"
			    "t caught by an earlier check.", (ftnlen)268);
		    sigerr_("SPICE(BUG3)", (ftnlen)11);
		    chkout_("XFMSTA", (ftnlen)6);
		    return 0;
		}

/*              The output state has been calculated for the special */
/*              case of the position and velocity existing along the */
/*              z-axis. */

		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    } else {

/*              The Jacobian is undefined and the velocity cannot be */
/*              converted since it is not along the z-axis. */
/*              Signal an error. */

		setmsg_("Invalid input state: z axis.", (ftnlen)28);
		sigerr_("SPICE(INVALIDSTATE)", (ftnlen)19);
		chkout_("XFMSTA", (ftnlen)6);
		return 0;
	    }
	}

/*        From rectangular for cases when the input position is not along */
/*        the z-axis ... */

	if (osys == 2) {

/*                  ... to cylindrical */

	    dcyldr_(ipos, &ipos[1], &ipos[2], jacobi);
	    reccyl_(ipos, ostate, &ostate[1], &ostate[2]);
	} else if (osys == 3) {

/*                  ... to latitudinal */

	    dlatdr_(ipos, &ipos[1], &ipos[2], jacobi);
	    reclat_(ipos, ostate, &ostate[1], &ostate[2]);
	} else if (osys == 4) {

/*                  ... to spherical */

	    dsphdr_(ipos, &ipos[1], &ipos[2], jacobi);
	    recsph_(ipos, ostate, &ostate[1], &ostate[2]);
	} else if (osys == 5) {

/*                  ... to geodetic */

	    dgeodr_(ipos, &ipos[1], &ipos[2], radii, &f, jacobi);
	    recgeo_(ipos, radii, &f, ostate, &ostate[1], &ostate[2]);
	} else if (osys == 6) {

/*                  ... to planetographic */

	    dpgrdr_(body, ipos, &ipos[1], &ipos[2], radii, &f, jacobi, 
		    body_len);
	    recpgr_(body, ipos, radii, &f, ostate, &ostate[1], &ostate[2], 
		    body_len);
	} else {
	    setmsg_("This error should never occur. This is an intermediate "
		    "step in which a state is converted to a non-rectangular "
		    "coordinate system from rectangular. The output coordinat"
		    "e system is not recognized, yet was not caught by an ear"
		    "lier check.", (ftnlen)234);
	    sigerr_("SPICE(BUG4)", (ftnlen)11);
	    chkout_("XFMSTA", (ftnlen)6);
	    return 0;
	}

/*        Many D*DR and REC* routines are not error free. Be safe and */
/*        check FAILED to not use un-initialized JACOBI. */

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

/*        If the multiplication of the Jacobian and velocity can cause */
/*        overflow, signal an error. */

	for (i__ = 1; i__ <= 3; ++i__) {
	    for (j = 1; j <= 3; ++j) {
		sqtmp = sqrt((d__1 = jacobi[(i__1 = i__ + j * 3 - 4) < 9 && 0 
			<= i__1 ? i__1 : s_rnge("jacobi", i__1, "xfmsta_", (
			ftnlen)1314)], abs(d__1))) * sqrt((d__2 = ivel[(i__2 =
			 j - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("ivel", i__2,
			 "xfmsta_", (ftnlen)1314)], abs(d__2)));
		if (sqtmp > toobig) {
		    setmsg_("The product of the Jacobian and velocity may ca"
			    "use numeric overflow.", (ftnlen)68);
		    sigerr_("SPICE(NUMERICOVERFLOW)", (ftnlen)22);
		    chkout_("XFMSTA", (ftnlen)6);
		    return 0;
		}
	    }
	}

/*        Calculate the velocity in the output coordinate system. */

	mxv_(jacobi, ivel, &ostate[3]);
    } else if (osys == 1) {

/*        If the output coordinate system is rectangular, the position */
/*        and velocity components of the output state are set equal to */
/*        the rectangular IPOS and IVEL, respectively, because the */
/*        components have already been converted to rectangular. */

	vequ_(ipos, ostate);
	vequ_(ivel, &ostate[3]);
    } else {
	setmsg_("This error should never occur. This is an ELSE statement. I"
		"f the output coordinate system is not rectangular, the IF sh"
		"ould be executed. If the output coordinate system is rectang"
		"ular, the ELSE IF should be executed.", (ftnlen)216);
	sigerr_("SPICE(BUG5)", (ftnlen)11);
	chkout_("XFMSTA", (ftnlen)6);
	return 0;
    }
    chkout_("XFMSTA", (ftnlen)6);
    return 0;
} /* xfmsta_ */
Пример #3
0
/* $Procedure ILLUM ( Illumination angles ) */
/* Subroutine */ int illum_(char *target, doublereal *et, char *abcorr, char *
	obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar, 
	doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen 
	obsrvr_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *, 
	    logical *, char *, integer *, logical *, ftnlen, ftnlen);
    extern doublereal vsep_(doublereal *, doublereal *);
    extern /* Subroutine */ int vsub_(doublereal *, doublereal *, doublereal *
	    ), vequ_(doublereal *, doublereal *), zzctruin_(integer *);
    integer n;
    doublereal radii[3];
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    logical found;
    extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
	    , integer *, doublereal *, doublereal *, ftnlen, ftnlen);
    extern logical eqstr_(char *, char *, ftnlen, ftnlen);
    static logical svfnd1, svfnd2;
    static integer svctr1[2], svctr2[2];
    integer obscde;
    doublereal lt;
    extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer 
	    *, doublereal *, ftnlen);
    integer frcode;
    extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical 
	    *, ftnlen);
    char frname[80];
    integer trgcde;
    doublereal offobs[3], obsvec[3], tepoch, normal[3];
    static integer svtcde;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen);
    static integer svobsc;
    doublereal offsun[3];
    extern /* Subroutine */ int setmsg_(char *, ftnlen);
    doublereal sstate[6], sunvec[3], tstate[6];
    static char svtarg[36];
    extern /* Subroutine */ int surfnm_(doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *);
    extern logical return_(void);
    static char svobsr[36];
    extern /* Subroutine */ int vminus_(doublereal *, doublereal *);
    doublereal lts;

/* $ Abstract */

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

/*     Find the illumination angles at a specified surface point of a */
/*     target 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 */

/*     KERNEL */
/*     NAIF_IDS */
/*     SPK */
/*     TIME */

/* $ Keywords */

/*     GEOMETRY */
/*     MOSPICE */

/* $ Declarations */
/* $ 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 */
/*     --------  ---  -------------------------------------------------- */
/*     TARGET     I   Name of target body. */
/*     ET         I   Epoch in ephemeris seconds past J2000. */
/*     ABCORR     I   Desired aberration correction. */
/*     OBSRVR     I   Name of observing body. */
/*     SPOINT     I   Body-fixed coordinates of a target surface point. */
/*     PHASE      O   Phase angle at the surface point. */
/*     SOLAR      O   Solar incidence angle at the surface point. */
/*     EMISSN     O   Emission angle at the surface point. */

/* $ Detailed_Input */

/*     TARGET         is the name of the target body.  TARGET is */
/*                    case-insensitive, and leading and trailing blanks */
/*                    in TARGET are not significant. Optionally, you may */
/*                    supply a string containing the integer ID code for */
/*                    the object.  For example both 'MOON' and '301' are */
/*                    legitimate strings that indicate the moon is the */
/*                    target body. */

/*     ET             is the epoch, specified in ephemeris seconds past */
/*                    J2000, at which the apparent illumination angles at */
/*                    the specified surface point on the target body, as */
/*                    seen from the observing body, are to be computed. */

/*     ABCORR         is the aberration correction to be used in */
/*                    computing the location and orientation of the */
/*                    target body and the location of the Sun.  Possible */
/*                    values are: */

/*                       'NONE'        No aberration correction. */

/*                       'LT'          Correct the position and */
/*                                     orientation of target body for */
/*                                     light time, and correct the */
/*                                     position of the Sun for light */
/*                                     time. */

/*                       'LT+S'        Correct the observer-target vector */
/*                                     for light time and stellar */
/*                                     aberration, correct the */
/*                                     orientation of the target body */
/*                                     for light time, and correct the */
/*                                     target-Sun vector for light time */
/*                                     and stellar aberration. */

/*                       '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. */

/*                                     Both the state and rotation of */
/*                                     the target body are corrected for */
/*                                     light time. */

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

/*                                     Both the state and rotation of */
/*                                     the target body are corrected for */
/*                                     light time. */

/*     OBSRVR         is the name of the observing body, typically a */
/*                    spacecraft, the earth, or a surface point on the */
/*                    earth.  OBSRVR is case-insensitive, and leading */
/*                    and trailing blanks in OBSRVR are not significant. */
/*                    Optionally, you may supply a string containing the */
/*                    integer ID code for the object.  For example both */
/*                    'EARTH' and '399' are legitimate strings that */
/*                    indicate the earth is the observer. */

/*                    OBSRVR may be not be identical to TARGET. */

/*     SPOINT         is a surface point on the target body, expressed */
/*                    in rectangular body-fixed (body equator and prime */
/*                    meridian) coordinates.  SPOINT need not be visible */
/*                    from the observer's location at time ET. */

/* $ Detailed_Output */


/*     PHASE          is the phase angle at SPOINT, as seen from OBSRVR */
/*                    at time ET.  This is the angle between the */
/*                    SPOINT-OBSRVR vector and the SPOINT-Sun vector. */
/*                    Units are radians.  The range of  PHASE is [0, pi]. */
/*                    See Particulars below for a detailed discussion of */
/*                    the definition. */

/*     SOLAR          is the solar incidence angle at SPOINT, as seen */
/*                    from OBSRVR at time ET.  This is the angle */
/*                    between the surface normal vector at SPOINT and the */
/*                    SPOINT-Sun vector.  Units are radians.  The range */
/*                    of SOLAR is [0, pi]. See Particulars below for a */
/*                    detailed discussion of the definition. */

/*     EMISSN         is the emission angle at SPOINT, as seen from */
/*                    OBSRVR at time ET.  This is the angle between the */
/*                    surface normal vector at SPOINT and the */
/*                    SPOINT-observer vector.  Units are radians.  The */
/*                    range of EMISSN is [0, pi]. See Particulars below */
/*                    for a detailed discussion of the definition. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1)  If TARGET and OBSRVR are not distinct, the error */
/*         SPICE(BODIESNOTDISTINCT) will be signaled. */

/*     2)  If no SPK (ephemeris) data are available for the observer, */
/*         target, and Sun at the time specified by ET, the error will */
/*         be diagnosed by routines called by this routine.  If light */
/*         time corrections are used, SPK data for the target body must */
/*         be available at the time ET - LT, where LT is the one-way */
/*         light time from the target to the observer at ET. */
/*         Additionally, SPK data must be available for the Sun at the */
/*         time ET - LT - LT2, where LT2 is the light time from the Sun */
/*         to the target body at time ET - LT. */

/*     3)  If PCK data defining the orientation or shape of the target */
/*         body are unavailable, the error will be diagnosed by routines */
/*         called by this routine. */

/*     4)  If no body-fixed frame is associated with the target body, */
/*         the error SPICE(NOFRAME) is signaled. */

/*     5) If name of target or observer cannot be translated to its */
/*        NAIF ID code, the error SPICE(IDCODENOTFOUND) is signaled. */

/* $ Files */

/*     No files are input to this routine.  However, ILLUM expects */
/*     that the appropriate SPK and PCK files have been loaded via */
/*     FURNSH. */

/* $ Particulars */


/*     The term "illumination angles" refers to following set of */
/*     angles: */


/*        solar incidence angle    Angle between the surface normal at */
/*                                 the specified surface point and the */
/*                                 vector from the surface point to the */
/*                                 Sun. */

/*        emission angle           Angle between the surface normal at */
/*                                 the specified surface point and the */
/*                                 vector from the surface point to the */
/*                                 observer. */

/*        phase angle              Angle between the vectors from the */
/*                                 surface point to the observing body's */
/*                                 location and from the surface point */
/*                                 to the Sun. */


/*     The diagram below illustrates the geometrical relationships */
/*     defining these angles.  The labels for the solar incidence, */
/*     emission, and phase angles are "s.i.", "e.", and "phase". */


/*                                                      * */
/*                                                     Sun */

/*                    surface normal vector */
/*                              ._                 _. */
/*                              |\                 /|  Sun vector */
/*                                \    phase      / */
/*                                 \   .    .    / */
/*                                 .            . */
/*                                   \   ___   / */
/*                              .     \/     \/ */
/*                                    _\ s.i./ */
/*                             .    /   \   / */
/*                             .   |  e. \ / */
/*         *             <--------------- *  surface point on */
/*      viewing            vector            target body */
/*      location           to viewing */
/*      (observer)         location */


/*     Note that if the target-observer vector, the target normal vector */
/*     at the surface point, and the target-sun vector are coplanar, */
/*     then phase is the sum of incidence and emission.  This is rarely */
/*     true; usually */

/*        phase angle  <  solar incidence angle + emission angle */

/*     All of the above angles can be computed using light time */
/*     corrections, light time and stellar aberration corrections, or */
/*     no aberration corrections.  The way aberration corrections */
/*     are used is described below. */

/*     Care must be used in computing light time corrections.  The */
/*     guiding principle used here is "describe what appears in */
/*     an image."  We ignore differential light time; the light times */
/*     from all points on the target to the observer are presumed to be */
/*     equal. */


/*        Observer-target body vector */
/*        --------------------------- */

/*        Let ET be the epoch at which an observation or remote */
/*        sensing measurement is made, and let ET - LT ("LT" stands */
/*        for "light time") be the epoch at which the photons received */
/*        at ET were emitted from the body (we use the term "emitted" */
/*        loosely here). */

/*        The correct observer-target vector points from the observer's */
/*        location at ET to the target body's location at ET - LT. */
/*        The target-observer vector points in the opposite direction. */

/*        Since light time corrections are not symmetric, the correct */
/*        target-observer vector CANNOT be found by computing the light */
/*        time corrected position of the observer as seen from the */
/*        target body. */


/*        Target body's orientation */
/*        ------------------------- */

/*        Using the definitions of ET and LT above, the target */
/*        body's orientation at ET - LT is used.  The surface */
/*        normal is dependent on the target body's orientation, so */
/*        the body's orientation model must be evaluated for the correct */
/*        epoch. */


/*        Target body -- Sun vector */
/*        ------------------------- */

/*        All surface features on the target body will appear in */
/*        a measurement made at ET as they were at ET-LT.  In */
/*        particular, lighting on the target body is dependent on */
/*        the apparent location of the Sun as seen from the target */
/*        body at ET-LT.  So, a second light time correction is used */
/*        in finding the apparent location of the Sun. */


/*     Stellar aberration corrections, when used, are applied as follows: */


/*        Observer-target body vector */
/*        --------------------------- */

/*        In addition to light time correction, stellar aberration is */
/*        used in computing the apparent target body position as seen */
/*        from the observer's location at time ET.  This apparent */
/*        position defines the observer-target body vector. */


/*        Target body-Sun vector */
/*        ---------------------- */

/*        The target body-Sun vector is the apparent position of the Sun, */
/*        corrected for light time and stellar aberration, as seen from */
/*        the target body at time ET-LT.  Note that the target body's */
/*        position is not affected by the stellar aberration correction */
/*        applied in finding its apparent position as seen by the */
/*        observer. */


/*     Once all of the vectors, as well as the target body's */
/*     orientation, have been computed with the proper aberration */
/*     corrections, the element of time is eliminated from the */
/*     computation.  The problem becomes a purely geometrical one, */
/*     and is described by the diagram above. */


/* $ 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. */

/*     In the following example program, the file */

/*        spk_m_031103-040201_030502.bsp */

/*     is a binary SPK file containing data for Mars Global Surveyor, */
/*     Mars, and the Sun for a time interval bracketing the date */

/*         2004 JAN 1 12:00:00 UTC. */

/*     pck00007.tpc is a planetary constants kernel file containing */
/*     radii and rotation model constants.  naif0007.tls is a */
/*     leapseconds kernel. */

/*     Find the phase, solar incidence, and emission angles at the */
/*     sub-solar and sub-spacecraft points on Mars as seen from the */
/*     Mars Global Surveyor spacecraft at a specified UTC time. */
/*     Use light time and stellar aberration corrections. */

/*           PROGRAM ANGLES */
/*           IMPLICIT NONE */
/*     C */
/*     C     SPICELIB functions */
/*     C */
/*           DOUBLE PRECISION      DPR */

/*     C */
/*     C     Local parameters */
/*     C */
/*           INTEGER               NAMLEN */
/*           PARAMETER           ( NAMLEN = 32 ) */

/*           INTEGER               TIMLEN */
/*           PARAMETER           ( TIMLEN = 25 ) */

/*     C */
/*     C     Local variables */
/*     C */
/*           CHARACTER*(NAMLEN)    OBSRVR */
/*           CHARACTER*(NAMLEN)    TARGET */
/*           CHARACTER*(TIMLEN)    UTC */

/*           DOUBLE PRECISION      ALT */
/*           DOUBLE PRECISION      ET */
/*           DOUBLE PRECISION      SSCEMI */
/*           DOUBLE PRECISION      SSCPHS */
/*           DOUBLE PRECISION      SSCSOL */
/*           DOUBLE PRECISION      SSLEMI */
/*           DOUBLE PRECISION      SSLPHS */
/*           DOUBLE PRECISION      SSLSOL */
/*           DOUBLE PRECISION      SSOLPT ( 3 ) */
/*           DOUBLE PRECISION      SSCPT  ( 3 ) */

/*     C */
/*     C     Load kernel files. */
/*     C */
/*           CALL FURNSH ( 'naif0007.tls'                   ) */
/*           CALL FURNSH ( 'pck00007.tpc'                   ) */
/*           CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */


/*     C */
/*     C     Convert our UTC time to ephemeris seconds past J2000. */
/*     C */
/*           UTC = '2004 JAN 1 12:00:00' */

/*           CALL UTC2ET ( UTC, ET ) */

/*     C */
/*     C     Assign observer and target names.  The acronym MGS */
/*     C     indicates Mars Global Surveyor.  See NAIF_IDS for a */
/*     C     list of names recognized by SPICE. */
/*     C */
/*           TARGET = 'Mars' */
/*           OBSRVR = 'MGS' */

/*     C */
/*     C     Find the sub-solar point on the Earth as seen from */
/*     C     the MGS spacecraft at ET.  Use the "surface intercept" */
/*     C     style of sub-point definition. This makes it easy */
/*     C     to verify the solar incidence angle. */
/*     C */
/*           CALL SUBSOL ( 'Near point', TARGET,  ET, */
/*          .              'LT+S',       OBSRVR,  SSOLPT  ) */

/*     C */
/*     C     Now find the sub-spacecraft point.  Use the */
/*     C     "nearest point" definition of the sub-point */
/*     C     here---this makes it easy to verify the emission angle. */
/*     C */
/*           CALL SUBPT ( 'Near point',  TARGET,  ET, */
/*          .             'LT+S',        OBSRVR,  SSCPT,  ALT ) */

/*     C */
/*     C     Find the phase, solar incidence, and emission */
/*     C     angles at the sub-solar point on the Earth as seen */
/*     C     from Mars Observer at time ET. */
/*     C */
/*           CALL ILLUM ( TARGET, ET,     'LT+S', OBSRVR, */
/*          .             SSOLPT, SSLPHS, SSLSOL, SSLEMI ) */

/*     C */
/*     C     Do the same for the sub-spacecraft point. */
/*     C */
/*           CALL ILLUM ( TARGET, ET,     'LT+S', OBSRVR, */
/*          .             SSCPT,  SSCPHS, SSCSOL, SSCEMI ) */

/*     C */
/*     C     Convert the angles to degrees and write them out. */
/*     C */
/*           SSLPHS = DPR() * SSLPHS */
/*           SSLSOL = DPR() * SSLSOL */
/*           SSLEMI = DPR() * SSLEMI */

/*           SSCPHS = DPR() * SSCPHS */
/*           SSCSOL = DPR() * SSCSOL */
/*           SSCEMI = DPR() * SSCEMI */

/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'UTC epoch is ', UTC */
/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'Illumination angles at the sub-solar point:' */
/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'Phase angle           (deg.): ', SSLPHS */
/*           WRITE (*,*) 'Solar incidence angle (deg.): ', SSLSOL */
/*           WRITE (*,*) 'Emission angle        (deg.): ', SSLEMI */
/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'The solar incidence angle should be 0.' */
/*           WRITE (*,*) 'The emission and phase angles should be equal.' */

/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'Illumination angles at the sub-s/c point:' */
/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'Phase angle           (deg.): ', SSCPHS */
/*           WRITE (*,*) 'Solar incidence angle (deg.): ', SSCSOL */
/*           WRITE (*,*) 'Emission angle        (deg.): ', SSCEMI */
/*           WRITE (*,*) ' ' */
/*           WRITE (*,*) 'The emission angle should be 0.' */
/*           WRITE (*,*) 'The solar incidence and phase angles should '// */
/*          .            'be equal.' */

/*           END */


/*     When this program is executed, the output will be: */


/*        UTC epoch is 2004 JAN 1 12:00:00 */

/*        Illumination angles at the sub-solar point: */

/*        Phase angle           (deg.):   150.210714 */
/*        Solar incidence angle (deg.):   6.3735213E-15 */
/*        Emission angle        (deg.):   150.210714 */

/*        The solar incidence angle should be 0. */
/*        The emission and phase angles should be equal. */

/*        Illumination angles at the sub-s/c point: */

/*        Phase angle           (deg.):   123.398202 */
/*        Solar incidence angle (deg.):   123.398202 */
/*        Emission angle        (deg.):   6.36110936E-15 */

/*        The emission angle should be 0. */
/*        The solar incidence and phase angles should be equal. */


/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     C.H. Acton     (JPL) */
/*     B.V. Semenov   (JPL) */
/*     N.J. Bachman   (JPL) */

/* $ Version */

/* -    SPICELIB Version 1.3.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 19-SEP-2013 (BVS) */

/*        Updated to save the input body names and ZZBODTRN state */
/*        counters and to do name-ID conversions only if the counters */
/*        have changed. */

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

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

/* -    SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */

/*        Abstract now states that this routine is deprecated. */

/* -    SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */

/*        Updated to remove non-standard use of duplicate arguments */
/*        in VSUB calls.  Replaced call to BODVAR with call to BODVCD. */

/* -    SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */

/*        Updated to support representations of integers in the input */
/*        arguments TARGET and OBSRVR. */

/* -    SPICELIB Version 1.0.2, 27-JUL-2003 (NJB) (CHA) */

/*        Various header corrections were made.  The example program */
/*        was upgraded to use real kernels, and the program's output is */
/*        shown. */

/* -    SPICELIB Version 1.0.1, 10-JUL-2002 (NJB) */

/*        Updated Index_Entries header section. */

/* -    SPICELIB Version 1.0.0, 21-MAR-1999 (NJB) */

/*        Adapted from the MGSSPICE version dated 10-MAR-1992. */
/* -& */
/* $ Index_Entries */

/*     DEPRECATED illumination angles */
/*     DEPRECATED lighting angles */
/*     DEPRECATED phase angle */
/*     DEPRECATED solar incidence angle */
/*     DEPRECATED emission angle */

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

/* -    SPICELIB Version 1.2.0, 23-OCT-2005 (NJB) */

/*        Updated to remove non-standard use of duplicate arguments */
/*        in VSUB calls.  Replaced call to BODVAR with call to BODVCD. */

/* -    SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */

/*        Updated to support representations of integers in the */
/*        input arguments TARGET and OBSRVR:  calls to BODN2C */
/*        were replaced by calls to BODS2C. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Saved body name length. */


/*     Local variables */


/*     Saved name/ID item declarations. */


/*     Saved name/ID items. */


/*     Initial values. */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("ILLUM", (ftnlen)5);
    }

/*     Initialization. */

    if (first) {

/*        Initialize counters. */

	zzctruin_(svctr1);
	zzctruin_(svctr2);
	first = FALSE_;
    }

/*     Obtain integer codes for the target and observer. */

    zzbods2c_(svctr1, svtarg, &svtcde, &svfnd1, target, &trgcde, &found, (
	    ftnlen)36, target_len);
    if (! found) {
	setmsg_("The target, '#', is not a recognized name for an ephemeris "
		"object. The cause of this problem may be that you need an up"
		"dated version of the SPICE Toolkit. ", (ftnlen)155);
	errch_("#", target, (ftnlen)1, target_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("ILLUM", (ftnlen)5);
	return 0;
    }
    zzbods2c_(svctr2, svobsr, &svobsc, &svfnd2, obsrvr, &obscde, &found, (
	    ftnlen)36, obsrvr_len);
    if (! found) {
	setmsg_("The observer, '#', is not a recognized name for an ephemeri"
		"s object. The cause of this problem may be that you need an "
		"updated version of the SPICE Toolkit. ", (ftnlen)157);
	errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("ILLUM", (ftnlen)5);
	return 0;
    }

/*     The observer and target must be distinct. */

    if (trgcde == obscde) {
	setmsg_("Target is #; observer is #.", (ftnlen)27);
	errch_("#", target, (ftnlen)1, target_len);
	errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
	sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
	chkout_("ILLUM", (ftnlen)5);
	return 0;
    }

/*     Find the name of the body-fixed frame associated with the */
/*     target body.  We'll want the state of the target relative to */
/*     the observer in this body-fixed frame. */

    cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
    if (! found) {
	setmsg_("No body-fixed frame is associated with target body #; a fra"
		"me kernel must be loaded to make this association.  Consult "
		"the FRAMES Required Reading for details.", (ftnlen)159);
	errch_("#", target, (ftnlen)1, target_len);
	sigerr_("SPICE(NOFRAME)", (ftnlen)14);
	chkout_("ILLUM", (ftnlen)5);
	return 0;
    }

/*     Find the body-fixed state of the target as seen from the observer */
/*     at ET.  The appropriate aberration corrections will be used in */
/*     evaluating this state. */

    spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, &lt, (ftnlen)80, 
	    abcorr_len);

/*     Determine the epoch to be used in computing the target-Sun vector. */

    if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
	tepoch = *et;
    } else {
	tepoch = *et - lt;
    }

/*     Find the body-fixed state of the Sun as seen from the target at */
/*     TEPOCH. */

    spkez_(&c__10, &tepoch, frname, abcorr, &trgcde, sstate, &lts, (ftnlen)80,
	     abcorr_len);

/*     Grab the position portions of the states (the first three */
/*     elements of each state).  Negate the observer-target vector, */
/*     since the vector required for the illumination angle */
/*     computation is the target-observer vector.  The vectors we've */
/*     found point from the target body center to the observer and */
/*     Sun, and already take light time corrections into account. */

    vminus_(tstate, obsvec);
    vequ_(sstate, sunvec);

/*     Now we'll modify target-observer and target-Sun vectors to */
/*     take into account the offset between the target center and the */
/*     surface point of interest; we want the vectors to point from */
/*     the surface point to the observer and Sun respectively. */

    vsub_(obsvec, spoint, offobs);
    vsub_(sunvec, spoint, offsun);

/*     Find the surface normal at SPOINT.  We'll need the radii of the */
/*     target body. */

    bodvcd_(&trgcde, "RADII", &c__3, &n, radii, (ftnlen)5);
    surfnm_(radii, &radii[1], &radii[2], spoint, normal);

/*     Find the illumination angles.  VSEP will give us angular */
/*     separation in radians. */

    *phase = vsep_(offsun, offobs);
    *solar = vsep_(normal, offsun);
    *emissn = vsep_(normal, offobs);
    chkout_("ILLUM", (ftnlen)5);
    return 0;
} /* illum_ */
Пример #4
0
/* $Procedure SUBSOL ( Sub-solar point ) */
/* Subroutine */ int subsol_(char *method, char *target, doublereal *et, char 
	*abcorr, char *obsrvr, doublereal *spoint, ftnlen method_len, ftnlen 
	target_len, ftnlen abcorr_len, ftnlen obsrvr_len)
{
    /* Initialized data */

    static doublereal origin[3] = { 0.,0.,0. };

    doublereal radii[3];
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen), ltime_(doublereal *, integer *, char *, integer 
	    *, doublereal *, doublereal *, ftnlen);
    logical found;
    extern logical eqstr_(char *, char *, ftnlen, ftnlen);
    doublereal sunlt;
    extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
    integer obscde;
    doublereal lt;
    extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer 
	    *, doublereal *, ftnlen);
    integer frcode;
    extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical 
	    *, ftnlen);
    integer nradii;
    char frname[80];
    integer trgcde;
    doublereal ettarg;
    extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
	    char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
    extern logical return_(void);
    extern /* Subroutine */ int spkpos_(char *, doublereal *, char *, char *, 
	    char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen, 
	    ftnlen), surfpt_(doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, logical *);
    doublereal alt, pos[3];

/* $ Abstract */

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

/*     Determine the coordinates of the sub-solar point on a target */
/*     body as seen by a specified observer at a specified epoch, */
/*     optionally corrected for planetary (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 */

/*     FRAMES */
/*     PCK */
/*     SPK */
/*     TIME */

/* $ Keywords */

/*     GEOMETRY */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     METHOD     I   Computation method. */
/*     TARGET     I   Name of target body. */
/*     ET         I   Epoch in ephemeris seconds past J2000 TDB. */
/*     ABCORR     I   Aberration correction. */
/*     OBSRVR     I   Name of observing body. */
/*     SPOINT     O   Sub-solar point on the target body. */

/* $ Detailed_Input */

/*     METHOD      is a short string specifying the computation method */
/*                 to be used.  The choices are: */

/*                    'Near point'       The sub-solar point is defined */
/*                                       as the nearest point on the */
/*                                       target to the sun. */

/*                    'Intercept'        The sub-observer point is */
/*                                       defined as the target surface */
/*                                       intercept of the line */
/*                                       containing the target's center */
/*                                       and the sun's center. */

/*                 In both cases, the intercept computation treats the */
/*                 surface of the target body as a triaxial ellipsoid. */
/*                 The ellipsoid's radii must be available in the kernel */
/*                 pool. */

/*                 Neither case nor white space are significant in */
/*                 METHOD.  For example, the string ' NEARPOINT' is */
/*                 valid. */


/*     TARGET      is the name of the target body.  TARGET is */
/*                 case-insensitive, and leading and trailing blanks in */
/*                 TARGET are not significant. Optionally, you may */
/*                 supply a string containing the integer ID code for */
/*                 the object.  For example both 'MOON' and '301' are */
/*                 legitimate strings that indicate the moon is the */
/*                 target body. */

/*                 This routine assumes that the target body is modeled */
/*                 by a tri-axial ellipsoid, and that a PCK file */
/*                 containing its radii has been loaded into the kernel */
/*                 pool via FURNSH. */


/*     ET          is the epoch in ephemeris seconds past J2000 at which */
/*                 the sub-solar point on the target body is to be */
/*                 computed. */


/*     ABCORR      indicates the aberration corrections to be applied */
/*                 when computing the observer-target state.  ABCORR */
/*                 may be any of the following. */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric sub-solar point on the target */
/*                               body. */

/*                    'LT'       Correct for planetary (light time) */
/*                               aberration.  Both the state and rotation */
/*                               of the target body are corrected for one */
/*                               way light time from target to observer. */

/*                               The state of the sun relative to the */
/*                               target is corrected for one way light */
/*                               from the sun to the target; this state */
/*                               is evaluated at the epoch obtained by */
/*                               retarding ET by the one way light time */
/*                               from target to observer. */

/*                    'LT+S'     Correct for planetary (light time) and */
/*                               stellar aberrations.  Light time */
/*                               corrections are the same as in the 'LT' */
/*                               case above.  The target state is */
/*                               additionally corrected for stellar */
/*                               aberration as seen by the observer, and */
/*                               the sun state is corrected for stellar */
/*                               aberration as seen from the target. */

/*                    'CN'       Converged Newtonian light time */
/*                               corrections.  This is the same as LT */
/*                               corrections but with further iterations */
/*                               to a converged Newtonian light time */
/*                               solution.  Given that relativistic */
/*                               effects may be as large as the higher */
/*                               accuracy achieved by this computation, */
/*                               this is correction is seldom worth the */
/*                               additional computations required unless */
/*                               the user incorporates additional */
/*                               relativistic corrections.  Light */
/*                               time corrections are applied as in the */
/*                               'LT' case. */

/*                    'CN+S'     Converged Newtonian light time */
/*                               corrections and stellar aberration. */
/*                               Light time and stellar aberration */
/*                               corrections are applied as in the */
/*                               'LT+S' case. */


/*     OBSRVR      is the name of the observing body, typically a */
/*                 spacecraft, the earth, or a surface point on the */
/*                 earth.  OBSRVR is case-insensitive, and leading and */
/*                 trailing blanks in OBSRVR are not significant. */
/*                 Optionally, you may supply a string containing the */
/*                 integer ID code for the object.  For example both */
/*                 'EARTH' and '399' are legitimate strings that indicate */
/*                 the earth is the observer. */

/* $ Detailed_Output */

/*     SPOINT      is the sub-solar point on the target body at ET */
/*                 expressed relative to the body-fixed frame of the */
/*                 target body. */

/*                 The sub-solar point is defined either as the point on */
/*                 the target body that is closest to the sun, or the */
/*                 target surface intercept of the line containing the */
/*                 target's center and the sun's center; the input */
/*                 argument METHOD selects the definition to be used. */

/*                 The body-fixed frame, which is time-dependent, is */
/*                 evaluated at ET if ABCORR is 'NONE'; otherwise the */
/*                 frame is evaluated at ET-LT, where LT is the one way */
/*                 light time from target to observer. */

/*                 The state of the target body is corrected for */
/*                 aberration as specified by ABCORR; the corrected */
/*                 state is used in the geometric computation.  As */
/*                 indicated above, the rotation of the target is */
/*                 retarded by one way light time if ABCORR specifies */
/*                 that light time correction is to be done. */

/*                 The state of the sun as seen from the observing */
/*                 body is also corrected for aberration as specified */
/*                 by ABCORR.  The corrections, when selected, are */
/*                 applied at the epoch ET-LT, where LT is the one way */
/*                 light time from target to observer. */


/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     If any of the listed errors occur, the output arguments are */
/*     left unchanged. */


/*     1) If the input argument METHOD is not recognized, the error */
/*        SPICE(DUBIOUSMETHOD) is signaled. */

/*     2) If either of the input body names TARGET or OBSRVR cannot be */
/*        mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */
/*        is signaled. */

/*     3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */
/*        error SPICE(BODIESNOTDISTINCT) is signaled. */

/*     4) If frame definition data enabling the evaluation of the state */
/*        of the target relative to the observer in target body-fixed */
/*        coordinates have not been loaded prior to calling SUBSOL, the */
/*        error will be diagnosed and signaled by a routine in the call */
/*        tree of this routine. */

/*     5) If the specified aberration correction is not recognized, the */
/*        error will be diagnosed and signaled by a routine in the call */
/*        tree of this routine. */

/*     6) If insufficient ephemeris data have been loaded prior to */
/*        calling SUBSOL, the error will be diagnosed and signaled by a */
/*        routine in the call tree of this routine. */

/*     7) If the triaxial radii of the target body have not been loaded */
/*        into the kernel pool prior to calling SUBSOL, the error will be */
/*        diagnosed and signaled by a routine in the call tree of this */
/*        routine. */

/*     8) The target must be an extended body:  if any of the radii of */
/*        the target body are non-positive, the error will be diagnosed */
/*        and signaled by routines in the call tree of this routine. */

/*     9) If PCK data supplying a rotation model for the target body */
/*        have not been loaded prior to calling SUBSOL, the error will be */
/*        diagnosed and signaled by a routine in the call tree of this */
/*        routine. */

/* $ Files */

/*     Appropriate SPK, PCK, and frame data must be available to */
/*     the calling program before this routine is called.  Typically */
/*     the data are made available by loading kernels; however the */
/*     data may be supplied via subroutine interfaces if applicable. */

/*     The following data are required: */

/*        - SPK data:  ephemeris data for sun, target, and observer must */
/*          be loaded.  If aberration corrections are used, the states of */
/*          sun, target, and observer relative to the solar system */
/*          barycenter must be calculable from the available ephemeris */
/*          data. Ephemeris data are made available by loading */
/*          one or more SPK files via FURNSH. */

/*        - PCK data:  triaxial radii for the target body must be loaded */
/*          into the kernel pool.  Typically this is done by loading a */
/*          text PCK file via FURNSH. */

/*        - Further PCK data:  a rotation model for the target body must */
/*          be loaded.  This may be provided in a text or binary PCK */
/*          file which is loaded via FURNSH. */

/*        - Frame data:  if a frame definition is required to convert */
/*          the sun, observer, and target states to the body-fixed frame */
/*          of the target, that definition must be available in the */
/*          kernel pool.  Typically the definition is supplied by loading */
/*          a frame kernel via FURNSH. */

/*     In all cases, kernel data are normally loaded once per program */
/*     run, NOT every time this routine is called. */

/* $ Particulars */

/*     SUBSOL computes the sub-solar point on a target body, as seen by */
/*     a specified observer. */

/*     There are two different popular ways to define the sub-solar */
/*     point:  "nearest point on target to the sun" or "target surface */
/*     intercept of line containing target and sun."  These coincide */
/*     when the target is spherical and generally are distinct otherwise. */

/*     When comparing sub-point computations with results from sources */
/*     other than SPICE, it's essential to make sure the same geometric */
/*     definitions are used. */

/* $ Examples */


/*     In the following example program, the file MGS.BSP is a */
/*     hypothetical binary SPK ephemeris file containing data for the */
/*     Mars Global Surveyor orbiter.  The SPK file de405s.bsp contains */
/*     data for the planet barycenters as well as the Earth, Moon, and */
/*     Sun for the time period including the date 1997 Dec 31 12:000 */
/*     UTC. MGS0000A.TPC is a planetary constants kernel file */
/*     containing radii and rotation model constants.  MGS00001.TLS is */
/*     a leapseconds file.  (File names shown here that are specific */
/*     to MGS are not names of actual files.) */

/*           IMPLICIT NONE */

/*           CHARACTER*25          METHOD ( 2 ) */

/*           INTEGER               I */

/*           DOUBLE PRECISION      DPR */
/*           DOUBLE PRECISION      ET */
/*           DOUBLE PRECISION      LAT */
/*           DOUBLE PRECISION      LON */
/*           DOUBLE PRECISION      RADIUS */
/*           DOUBLE PRECISION      SPOINT ( 3 ) */

/*           DATA                  METHOD / 'Intercept', 'Near point' / */

/*     C */
/*     C     Load kernel files. */
/*     C */
/*           CALL FURNSH ( 'MGS00001.TLS' ) */
/*           CALL FURNSH ( 'MGS0000A.TPC' ) */
/*           CALL FURNSH ( 'de405s.bsp'   ) */
/*           CALL FURNSH ( 'MGS.BSP'      ) */

/*     C */
/*     C     Convert the UTC request time to ET (seconds past */
/*     C     J2000, TDB). */
/*     C */
/*           CALL STR2ET ( '1997 Dec 31 12:00:00', ET ) */

/*     C */
/*     C     Compute sub-spacecraft point using light time and stellar */
/*     C     aberration corrections.  Use the "target surface intercept" */
/*     C     definition of sub-spacecraft point on the first loop */
/*     C     iteration, and use the "near point" definition on the */
/*     C     second. */
/*     C */
/*           DO I = 1, 2 */

/*              CALL SUBSOL ( METHOD(I), */
/*          .                 'MARS',  ET,  'LT+S',  'MGS',  SPOINT ) */

/*     C */
/*     C        Convert rectangular coordinates to planetocentric */
/*     C        latitude and longitude.  Convert radians to degrees. */
/*     C */
/*              CALL RECLAT ( SPOINT, RADIUS, LON, LAT  ) */

/*              LON = LON * DPR () */
/*              LAT = LAT * DPR () */

/*     C */
/*     C        Write the results. */
/*     C */
/*              WRITE (*,*) ' ' */
/*              WRITE (*,*) 'Computation method: ', METHOD(I) */
/*              WRITE (*,*) ' ' */
/*              WRITE (*,*) '  Radius                   (km)  = ', RADIUS */
/*              WRITE (*,*) '  Planetocentric Latitude  (deg) = ', LAT */
/*              WRITE (*,*) '  Planetocentric Longitude (deg) = ', LON */
/*              WRITE (*,*) ' ' */

/*           END DO */

/*           END */

/* $ Restrictions */

/*     The appropriate kernel data must have been loaded before this */
/*     routine is called.  See the Files section above. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Version */

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

/*        Index line now states that this routine is deprecated. */

/* -    SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */

/*        Typo correction in Required_Reading, changed */
/*        FRAME to FRAMES. */

/* -    SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */

/*        Abstract now states that this routine is deprecated. */

/* -    SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */

/*        Call to BODVAR was replaced with call to BODVCD. */

/* -    SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */

/*        Updated to support representations of integers in the input */
/*        arguments TARGET and OBSRVR.   Deleted references in header to */
/*        kernel-specific loaders. Made miscellaneous minor corrections */
/*        to header comments. */

/* -    SPICELIB Version 1.0.2, 12-DEC-2002 (NJB) */

/*        Corrected and updated code example in header. */

/* -    SPICELIB Version 1.0.1, 1-NOV-1999 (WLT) */

/*        Declared routine LTIME to be external. */

/* -    SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */

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

/*     DEPRECATED sub-solar point */

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

/* -    SPICELIB Version 1.1.0, 22-JUL-2004 (NJB) */

/*        Updated to support representations of integers in the */
/*        input arguments TARGET and OBSRVR:  calls to BODN2C */
/*        were replaced by calls to BODS2C. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

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

/*     Obtain integer codes for the target and observer. */

    bods2c_(target, &trgcde, &found, target_len);
    if (! found) {
	setmsg_("The target, '#', is not a recognized name for an ephemeris "
		"object. The cause of this problem may be that you need an up"
		"dated version of the SPICE Toolkit. ", (ftnlen)155);
	errch_("#", target, (ftnlen)1, target_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("SUBSOL", (ftnlen)6);
	return 0;
    }
    bods2c_(obsrvr, &obscde, &found, obsrvr_len);
    if (! found) {
	setmsg_("The observer, '#', is not a recognized name for an ephemeri"
		"s object. The cause of this problem may be that you need an "
		"updated version of the SPICE Toolkit. ", (ftnlen)157);
	errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("SUBSOL", (ftnlen)6);
	return 0;
    }

/*     Check the input body codes.  If they are equal, signal */
/*     an error. */

    if (obscde == trgcde) {
	setmsg_("In computing the sub-observer point, the observing body and"
		" target body are the same. Both are #.", (ftnlen)97);
	errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
	sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
	chkout_("SUBSOL", (ftnlen)6);
	return 0;
    }

/*     Get the radii of the target body from the kernel pool. */

    bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5);

/*     Find the name of the body-fixed frame associated with the */
/*     target body.  We'll want the state of the target relative to */
/*     the observer in this body-fixed frame. */

    cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
    if (! found) {
	setmsg_("No body-fixed frame is associated with target body #; a fra"
		"me kernel must be loaded to make this association.  Consult "
		"the FRAMES Required Reading for details.", (ftnlen)159);
	errch_("#", target, (ftnlen)1, target_len);
	sigerr_("SPICE(NOFRAME)", (ftnlen)14);
	chkout_("SUBSOL", (ftnlen)6);
	return 0;
    }

/*     If we're using aberration corrections, we'll need the */
/*     one way light time from the target to the observer.  Otherwise, */
/*     we set the time time to zero. */

    if (eqstr_(abcorr, "NONE", abcorr_len, (ftnlen)4)) {
	lt = 0.;
	ettarg = *et;
    } else {
	ltime_(et, &obscde, "<-", &trgcde, &ettarg, &lt, (ftnlen)2);
    }

/*     Determine the position of the sun in target body-fixed */
/*     coordinates. */

/*     Call SPKEZ to compute the position of the sun as seen from the */
/*     target body and the light time between them SUNLT.  This state is */
/*     evaluated at the target epoch ETTARG. We request that the */
/*     coordinates of the target-sun position vector POS be returned */
/*     relative to the body fixed reference frame associated with the */
/*     target body, using aberration corrections specified by the input */
/*     argument ABCORR. */

    spkpos_("SUN", &ettarg, frname, abcorr, target, pos, &sunlt, (ftnlen)3, (
	    ftnlen)80, abcorr_len, target_len);

/*     Find the sub-solar point using the specified geometric definition. */

    if (eqstr_(method, "Near point", method_len, (ftnlen)10)) {

/*        Locate the nearest point to the sun on the target. */

	nearpt_(pos, radii, &radii[1], &radii[2], spoint, &alt);
    } else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) {
	surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found);

/*        Since the line in question passes through the center of the */
/*        target, there will always be a surface intercept.  So we should */
/*        never have FOUND = .FALSE. */

	if (! found) {
	    setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex "
		    "of ray is at target center. This indicates a bug. Please"
		    " contact NAIF.", (ftnlen)125);
	    sigerr_("SPICE(BUG)", (ftnlen)10);
	    chkout_("SUBSOL", (ftnlen)6);
	    return 0;
	}
    } else {
	setmsg_("The computation method # was not recognized. Allowed values"
		" are \"Near point\" and \"Intercept.\"", (ftnlen)93);
	errch_("#", method, (ftnlen)1, method_len);
	sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20);
	chkout_("SUBSOL", (ftnlen)6);
	return 0;
    }
    chkout_("SUBSOL", (ftnlen)6);
    return 0;
} /* subsol_ */
Пример #5
0
/* $Procedure      SUBPT ( Sub-observer point ) */
/* Subroutine */ int subpt_(char *method, char *target, doublereal *et, char *
	abcorr, char *obsrvr, doublereal *spoint, doublereal *alt, ftnlen 
	method_len, ftnlen target_len, ftnlen abcorr_len, ftnlen obsrvr_len)
{
    /* Initialized data */

    static doublereal origin[3] = { 0.,0.,0. };

    doublereal radii[3];
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    logical found;
    extern doublereal vdist_(doublereal *, doublereal *);
    extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
	    , integer *, doublereal *, doublereal *, ftnlen, ftnlen);
    extern logical eqstr_(char *, char *, ftnlen, ftnlen);
    extern /* Subroutine */ int bods2c_(char *, integer *, logical *, ftnlen);
    integer obscde;
    doublereal lt;
    extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer 
	    *, doublereal *, ftnlen);
    integer frcode;
    extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical 
	    *, ftnlen);
    integer nradii;
    char frname[80];
    integer trgcde;
    extern /* Subroutine */ int nearpt_(doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *), sigerr_(
	    char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
    doublereal tstate[6];
    extern logical return_(void);
    extern /* Subroutine */ int vminus_(doublereal *, doublereal *), surfpt_(
	    doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, logical *);
    doublereal pos[3];

/* $ Abstract */

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

/*     Compute the rectangular coordinates of the sub-observer point on */
/*     a target body at a particular epoch, optionally corrected for */
/*     planetary (light time) and stellar aberration.  Return these */
/*     coordinates expressed in the body-fixed frame associated with the */
/*     target body.  Also, return the observer's altitude above the */
/*     target 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 */

/*     FRAMES */
/*     PCK */
/*     SPK */
/*     TIME */

/* $ Keywords */

/*     GEOMETRY */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     METHOD     I   Computation method. */
/*     TARGET     I   Name of target body. */
/*     ET         I   Epoch in ephemeris seconds past J2000 TDB. */
/*     ABCORR     I   Aberration correction. */
/*     OBSRVR     I   Name of observing body. */
/*     SPOINT     O   Sub-observer point on the target body. */
/*     ALT        O   Altitude of the observer above the target body. */

/* $ Detailed_Input */

/*     METHOD      is a short string specifying the computation method */
/*                 to be used.  The choices are: */

/*                    'Near point'       The sub-observer point is */
/*                                       defined as the nearest point on */
/*                                       the target relative to the */
/*                                       observer. */

/*                    'Intercept'        The sub-observer point is */
/*                                       defined as the target surface */
/*                                       intercept of the line */
/*                                       containing the observer and the */
/*                                       target's center. */

/*                 In both cases, the intercept computation treats the */
/*                 surface of the target body as a triaxial ellipsoid. */
/*                 The ellipsoid's radii must be available in the kernel */
/*                 pool. */

/*                 Neither case nor white space are significant in */
/*                 METHOD.  For example, the string ' NEARPOINT' is */
/*                 valid. */


/*     TARGET      is the name of a target body.  Optionally, you may */
/*                 supply the integer ID code for the object as */
/*                 an integer string.  For example both 'MOON' and */
/*                 '301' are legitimate strings that indicate the */
/*                 moon is the target body. This routine assumes */
/*                 that this body is modeled by a tri-axial ellipsoid, */
/*                 and that a PCK file containing its radii has been */
/*                 loaded into the kernel pool via FURNSH. */

/*     ET          is the epoch in ephemeris seconds past J2000 at which */
/*                 the sub-observer point on the target body is to be */
/*                 computed. */


/*     ABCORR      indicates the aberration corrections to be applied */
/*                 when computing the observer-target state.  ABCORR */
/*                 may be any of the following. */

/*                    'NONE'     Apply no correction. Return the */
/*                               geometric sub-observer point on the */
/*                               target body. */

/*                    'LT'       Correct for planetary (light time) */
/*                               aberration.  Both the state and rotation */
/*                               of the target body are corrected for */
/*                               light time. */

/*                    'LT+S'     Correct for planetary (light time) and */
/*                               stellar aberrations. Both the state and */
/*                               rotation of the target body are */
/*                               corrected for light time. */

/*                    'CN'       Converged Newtonian light time */
/*                               corrections.  This is the same as LT */
/*                               corrections but with further iterations */
/*                               to a converged Newtonian light time */
/*                               solution.  Given that relativistic */
/*                               effects may be as large as the higher */
/*                               accuracy achieved by this computation, */
/*                               this is correction is seldom worth the */
/*                               additional computations required unless */
/*                               the user incorporates additional */
/*                               relativistic corrections.  Both the */
/*                               state and rotation of the target body */
/*                               are corrected for light time. */

/*                    'CN+S'     Converged Newtonian light time */
/*                               corrections and stellar aberration. */
/*                               Both the state and rotation of the */
/*                               target body are corrected for light */
/*                               time. */

/*     OBSRVR      is the name of the observing body.  This is typically */
/*                 a spacecraft, the earth, or a surface point on the */
/*                 earth. Optionally, you  may supply the ID code of */
/*                 the object as an integer string. For example, both */
/*                 'EARTH' and '399' are legitimate strings to supply */
/*                 to indicate the observer is Earth. */

/* $ Detailed_Output */

/*     SPOINT      is the sub-observer point on the target body at ET */
/*                 expressed relative to the body-fixed frame of the */
/*                 target body. */

/*                 The sub-observer point is defined either as the point */
/*                 on the target body that is closest to the observer, */
/*                 or the target surface intercept of the line from the */
/*                 observer to the target's center; the input argument */
/*                 METHOD selects the definition to be used. */

/*                 The body-fixed frame, which is time-dependent, is */
/*                 evaluated at ET if ABCORR is 'NONE'; otherwise the */
/*                 frame is evaluated at ET-LT, where LT is the one-way */
/*                 light time from target to observer. */

/*                 The state of the target body is corrected for */
/*                 aberration as specified by ABCORR; the corrected */
/*                 state is used in the geometric computation.  As */
/*                 indicated above, the rotation of the target is */
/*                 retarded by one-way light time if ABCORR specifies */
/*                 that light time correction is to be done. */


/*     ALT         is the "altitude" of the observer above the target */
/*                 body.  When METHOD specifies a "near point" */
/*                 computation, ALT is truly altitude in the standard */
/*                 geometric sense:  the length of a segment dropped from */
/*                 the observer to the target's surface, such that the */
/*                 segment is perpendicular to the surface at the */
/*                 contact point SPOINT. */

/*                 When METHOD specifies an "intercept" computation, ALT */
/*                 is still the length of the segment from the observer */
/*                 to the surface point SPOINT, but this segment in */
/*                 general is not perpendicular to the surface. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     If any of the listed errors occur, the output arguments are */
/*     left unchanged. */


/*     1) If the input argument METHOD is not recognized, the error */
/*        SPICE(DUBIOUSMETHOD) is signaled. */

/*     2) If either of the input body names TARGET or OBSRVR cannot be */
/*        mapped to NAIF integer codes, the error SPICE(IDCODENOTFOUND) */
/*        is signaled. */

/*     3) If OBSRVR and TARGET map to the same NAIF integer ID codes, the */
/*        error SPICE(BODIESNOTDISTINCT) is signaled. */

/*     4) If frame definition data enabling the evaluation of the state */
/*        of the target relative to the observer in target body-fixed */
/*        coordinates have not been loaded prior to calling SUBPT, the */
/*        error will be diagnosed and signaled by a routine in the call */
/*        tree of this routine. */

/*     5) If the specified aberration correction is not recognized, the */
/*        error will be diagnosed and signaled by a routine in the call */
/*        tree of this routine. */

/*     6) If insufficient ephemeris data have been loaded prior to */
/*        calling SUBPT, the error will be diagnosed and signaled by a */
/*        routine in the call tree of this routine. */

/*     7) If the triaxial radii of the target body have not been loaded */
/*        into the kernel pool prior to calling SUBPT, the error will be */
/*        diagnosed and signaled by a routine in the call tree of this */
/*        routine. */

/*     8) The target must be an extended body:  if any of the radii of */
/*        the target body are non-positive, the error will be diagnosed */
/*        and signaled by routines in the call tree of this routine. */

/*     9) If PCK data supplying a rotation model for the target body */
/*        have not been loaded prior to calling SUBPT, the error will be */
/*        diagnosed and signaled by a routine in the call tree of this */
/*        routine. */

/* $ Files */

/*     Appropriate SPK, PCK, and frame kernels must be loaded */
/*     prior by the calling program before this routine is called. */

/*     The following data are required: */

/*        - SPK data:  ephemeris data for target and observer must be */
/*          loaded.  If aberration corrections are used, the states of */
/*          target and observer relative to the solar system barycenter */
/*          must be calculable from the available ephemeris data. */
/*          Typically ephemeris data are made available by loading one */
/*          or more SPK files via FURNSH. */

/*        - PCK data:  triaxial radii for the target body must be loaded */
/*          into the kernel pool.  Typically this is done by loading a */
/*          text PCK file via FURNSH. */

/*        - Further PCK data:  rotation data for the target body must */
/*          be loaded.  These may be provided in a text or binary PCK */
/*          file.  Either type of file may be loaded via FURNSH. */

/*        - Frame data:  if a frame definition is required to convert */
/*          the observer and target states to the body-fixed frame of */
/*          the target, that definition must be available in the kernel */
/*          pool.  Typically the definition is supplied by loading a */
/*          frame kernel via FURNSH. */

/*     In all cases, kernel data are normally loaded once per program */
/*     run, NOT every time this routine is called. */

/* $ Particulars */

/*     SUBPT computes the sub-observer point on a target body. */
/*     (The sub-observer point is commonly called the sub-spacecraft */
/*     point when the observer is a spacecraft.)  SUBPT also */
/*     determines the altitude of the observer above the target body. */

/*     There are two different popular ways to define the sub-observer */
/*     point:  "nearest point on target to observer" or "target surface */
/*     intercept of line containing observer and target."  These */
/*     coincide when the target is spherical and generally are distinct */
/*     otherwise. */

/*     When comparing sub-point computations with results from sources */
/*     other than SPICE, it's essential to make sure the same geometric */
/*     definitions are used. */

/* $ 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. */

/*     In the following example program, the file */

/*        spk_m_031103-040201_030502.bsp */

/*     is a binary SPK file containing data for Mars Global Surveyor, */
/*     Mars, and the Sun for a time interval bracketing the date */

/*         2004 JAN 1 12:00:00 UTC. */

/*     pck00007.tpc is a planetary constants kernel file containing */
/*     radii and rotation model constants.  naif0007.tls is a */
/*     leapseconds kernel. */

/*     Find the sub-observer point of the Mars Global Surveyor (MGS) */
/*     spacecraft on Mars for a specified time.  Perform the computation */
/*     twice, using both the "intercept" and "near point" options. */


/*           IMPLICIT NONE */

/*           CHARACTER*25          METHOD ( 2 ) */

/*           INTEGER               I */

/*           DOUBLE PRECISION      ALT */
/*           DOUBLE PRECISION      DPR */
/*           DOUBLE PRECISION      ET */
/*           DOUBLE PRECISION      LAT */
/*           DOUBLE PRECISION      LON */
/*           DOUBLE PRECISION      RADIUS */
/*           DOUBLE PRECISION      SPOINT ( 3 ) */

/*           DATA                  METHOD / 'Intercept', 'Near point' / */

/*     C */
/*     C     Load kernel files. */
/*     C */
/*           CALL FURNSH ( 'naif0007.tls'                   ) */
/*           CALL FURNSH ( 'pck00007.tpc'                   ) */
/*           CALL FURNSH ( 'spk_m_031103-040201_030502.bsp' ) */

/*     C */
/*     C     Convert the UTC request time to ET (seconds past */
/*     C     J2000, TDB). */
/*     C */
/*           CALL STR2ET ( '2004 JAN 1 12:00:00', ET ) */

/*     C */
/*     C     Compute sub-spacecraft point using light time and stellar */
/*     C     aberration corrections.  Use the "target surface intercept" */
/*     C     definition of sub-spacecraft point on the first loop */
/*     C     iteration, and use the "near point" definition on the */
/*     C     second. */
/*     C */
/*           DO I = 1, 2 */

/*              CALL SUBPT ( METHOD(I), */
/*          .               'MARS',     ET,     'LT+S', */
/*          .               'MGS',      SPOINT,  ALT    ) */

/*     C */
/*     C        Convert rectangular coordinates to planetocentric */
/*     C        latitude and longitude.  Convert radians to degrees. */
/*     C */
/*              CALL RECLAT ( SPOINT, RADIUS, LON, LAT  ) */

/*              LON = LON * DPR () */
/*              LAT = LAT * DPR () */

/*     C */
/*     C        Write the results. */
/*     C */
/*              WRITE (*,*) ' ' */
/*              WRITE (*,*) 'Computation method: ', METHOD(I) */
/*              WRITE (*,*) ' ' */
/*              WRITE (*,*) '  Radius                   (km)  = ', RADIUS */
/*              WRITE (*,*) '  Planetocentric Latitude  (deg) = ', LAT */
/*              WRITE (*,*) '  Planetocentric Longitude (deg) = ', LON */
/*              WRITE (*,*) '  Altitude                 (km)  = ', ALT */
/*              WRITE (*,*) ' ' */

/*           END DO */

/*           END */


/*     When this program is executed, the output will be: */


/*        Computation method: Intercept */

/*          Radius                   (km)  =   3387.97077 */
/*          Planetocentric Latitude  (deg) =  -39.7022724 */
/*          Planetocentric Longitude (deg) =  -159.226663 */
/*          Altitude                 (km)  =   373.173506 */


/*        Computation method: Near point */

/*          Radius                   (km)  =   3387.9845 */
/*          Planetocentric Latitude  (deg) =  -39.6659329 */
/*          Planetocentric Longitude (deg) =  -159.226663 */
/*          Altitude                 (km)  =   373.166636 */


/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     C.H. Acton     (JPL) */
/*     N.J. Bachman   (JPL) */
/*     J.E. McLean    (JPL) */

/* $ Version */

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

/*        Index line now states that this routine is deprecated. */

/* -    SPICELIB Version 1.2.2, 17-MAR-2009 (EDW) */

/*        Typo correction in Required_Reading, changed */
/*        FRAME to FRAMES. */

/* -    SPICELIB Version 1.2.1, 07-FEB-2008 (NJB) */

/*        Abstract now states that this routine is deprecated. */

/* -    SPICELIB Version 1.2.0, 24-OCT-2005 (NJB) */

/*        Replaced call to BODVAR with call to BODVCD. */

/* -    SPICELIB Version 1.1.0, 21-JUL-2004 (EDW) */

/*        Changed BODN2C call to BODS2C giving the routine */
/*        the capability to accept string representations of */
/*        interger IDs for TARGET and OBSRVR. */

/* -    SPICELIB Version 1.0.1, 27-JUL-2003 (NJB) (CHA) */

/*        Various header corrections were made.  The example program */
/*        was upgraded to use real kernels, and the program's output is */
/*        shown. */

/* -    SPICELIB Version 1.0.0, 03-SEP-1999 (NJB) (JEM) */

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

/*     DEPRECATED sub-observer point */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("SUBPT", (ftnlen)5);
    }

/*     Obtain integer codes for the target and observer. */

/*     Target... */

    bods2c_(target, &trgcde, &found, target_len);
    if (! found) {
	setmsg_("The target, '#', is not a recognized name for an ephemeris "
		"object. The cause of this problem may be that you need an up"
		"dated version of the SPICE Toolkit. ", (ftnlen)155);
	errch_("#", target, (ftnlen)1, target_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("SUBPT", (ftnlen)5);
	return 0;
    }

/*     ...observer. */

    bods2c_(obsrvr, &obscde, &found, obsrvr_len);
    if (! found) {
	setmsg_("The observer, '#', is not a recognized name for an ephemeri"
		"s object. The cause of this problem may be that you need an "
		"updated version of the SPICE Toolkit. ", (ftnlen)157);
	errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("SUBPT", (ftnlen)5);
	return 0;
    }

/*     Check the input body codes.  If they are equal, signal */
/*     an error. */

    if (obscde == trgcde) {
	setmsg_("In computing the sub-observer point, the observing body and"
		" target body are the same. Both are #.", (ftnlen)97);
	errch_("#", obsrvr, (ftnlen)1, obsrvr_len);
	sigerr_("SPICE(BODIESNOTDISTINCT)", (ftnlen)24);
	chkout_("SUBPT", (ftnlen)5);
	return 0;
    }

/*     Get the radii of the target body from the kernel pool. */

    bodvcd_(&trgcde, "RADII", &c__3, &nradii, radii, (ftnlen)5);

/*     Find the name of the body-fixed frame associated with the */
/*     target body.  We'll want the state of the target relative to */
/*     the observer in this body-fixed frame. */

    cidfrm_(&trgcde, &frcode, frname, &found, (ftnlen)80);
    if (! found) {
	setmsg_("No body-fixed frame is associated with target body #; a fra"
		"me kernel must be loaded to make this association.  Consult "
		"the FRAMES Required Reading for details.", (ftnlen)159);
	errch_("#", target, (ftnlen)1, target_len);
	sigerr_("SPICE(NOFRAME)", (ftnlen)14);
	chkout_("SUBPT", (ftnlen)5);
	return 0;
    }

/*     Determine the position of the observer in target */
/*     body-fixed coordinates. */

/*         -  Call SPKEZR to compute the position of the target */
/*            body as seen from the observing body and the light time */
/*            (LT) between them.  SPKEZR returns a state which is */
/*            the position and velocity, but we'll only use the position */
/*            which is the first three elements.  We request that the */
/*            coordinates of POS be returned relative to the body fixed */
/*            reference frame associated with the target body, using */
/*            aberration corrections specified by the input argument */
/*            ABCORR. */

/*         -  Call VMINUS to negate the direction of the vector (POS) */
/*            so it will be the position of the observer as seen from */
/*            the target body in target body fixed coordinates. */

/*            Note that this result is not the same as the result of */
/*            calling SPKEZR with the target and observer switched.  We */
/*            computed the vector FROM the observer TO the target in */
/*            order to get the proper light time and stellar aberration */
/*            corrections (if requested).  Now we need the inverse of */
/*            that corrected vector in order to compute the sub-point. */

    spkez_(&trgcde, et, frname, abcorr, &obscde, tstate, &lt, (ftnlen)80, 
	    abcorr_len);

/*     Negate the target's state to obtain the position of the observer */
/*     relative to the target. */

    vminus_(tstate, pos);

/*     Find the sub-point and "altitude" (distance from observer to */
/*     sub-point) using the specified geometric definition. */

    if (eqstr_(method, "Near point", method_len, (ftnlen)10)) {

/*        Locate the nearest point to the observer on the target. */

	nearpt_(pos, radii, &radii[1], &radii[2], spoint, alt);
    } else if (eqstr_(method, "Intercept", method_len, (ftnlen)9)) {
	surfpt_(origin, pos, radii, &radii[1], &radii[2], spoint, &found);

/*        Since the line in question passes through the center of the */
/*        target, there will always be a surface intercept.  So we should */
/*        never have FOUND = .FALSE. */

	if (! found) {
	    setmsg_("Call to SURFPT returned FOUND=FALSE even though vertex "
		    "of ray is at target center. This indicates a bug. Please"
		    " contact NAIF.", (ftnlen)125);
	    sigerr_("SPICE(BUG)", (ftnlen)10);
	    chkout_("SUBPT", (ftnlen)5);
	    return 0;
	}

/*        SURFPT doesn't compute altitude, so do it here. */

	*alt = vdist_(pos, spoint);
    } else {
	setmsg_("The computation method # was not recognized. Allowed values"
		" are \"Near point\" and \"Intercept.\"", (ftnlen)93);
	errch_("#", method, (ftnlen)1, method_len);
	sigerr_("SPICE(DUBIOUSMETHOD)", (ftnlen)20);
	chkout_("SUBPT", (ftnlen)5);
	return 0;
    }
    chkout_("SUBPT", (ftnlen)5);
    return 0;
} /* subpt_ */
Пример #6
0
   void bodvcd_c ( SpiceInt           bodyid,
                   ConstSpiceChar   * item,
                   SpiceInt           maxn,
                   SpiceInt         * dim,
                   SpiceDouble      * values ) 

/*

-Brief_I/O
 
   VARIABLE  I/O  DESCRIPTION 
   --------  ---  -------------------------------------------------- 
   bodyid     I   Body ID code.
   item       I   Item for which values are desired. ("RADII", 
                  "NUT_PREC_ANGLES", etc. ) 
   maxn       I   Maximum number of values that may be returned. 
   dim        O   Number of values returned. 
   values     O   Values. 
 
-Detailed_Input
 
   bodyid     is the NAIF integer ID code for a body of interest.
              For example, if the body is the earth, the code is
              399.
 
   item       is the item to be returned. Together, the NAIF ID 
              code of the body and the item name combine to form a 
              kernel variable name, e.g., 
 
                 "BODY599_RADII"      
                 "BODY401_POLE_RA"  
 
              The values associated with the kernel variable having 
              the name constructed as shown are sought.  Below 
              we'll take the shortcut of calling this kernel variable 
              the "requested kernel variable." 
 
              Note that `item' *is* case-sensitive.  This attribute 
              is inherited from the case-sensitivity of kernel 
              variable names. 
 
   maxn       is the maximum number of values that may be returned. 
              The output array `values' must be declared with size at 
              least `maxn'.  It's an error to supply an output array 
              that is too small to hold all of the values associated 
              with the requested kernel variable. 
 
-Detailed_Output
 
   dim        is the number of values returned; this is always the 
              number of values associated with the requested kernel 
              variable unless an error has been signaled. 
 
   values     is the array of values associated with the requested 
              kernel variable.  If `values' is too small to hold all 
              of the values associated with the kernel variable, the 
              returned values of `dim' and `values' are undefined. 
 
-Parameters
 
   None. 
 
-Exceptions
 
   1) If the requested kernel variable is not found in the kernel 
      pool, the error SPICE(KERNELVARNOTFOUND) is signaled. 
 
   2) If the requested kernel variable is found but the associated 
      values aren't numeric, the error SPICE(TYPEMISMATCH) is 
      signaled. 
 
   3) The output array `values' must be declared with sufficient size
      to contain all of the values associated with the requested kernel
      variable.  If the dimension of `values' indicated by `maxn' is
      too small to contain the requested values, the error
      SPICE(ARRAYTOOSMALL) is signaled.
 
   4) If the input dimension `maxn' indicates there is more room 
      in `values' than there really is---for example, if `maxn' is 
      10 but `values' is declared with dimension 5---and the dimension 
      of the requested kernel variable is larger than the actual 
      dimension of `values', then this routine may overwrite  
      memory.  The results are unpredictable. 
 
   5) If the input string pointer `item' is null, the error
      SPICE(NULLPOINTER) will be signaled.

   6) If either of the input strings referred to by `item' contains
      no data characters, the error SPICE(EMPTYSTRING) will 
      be signaled.

-Files
 
   None. 
 
-Particulars
 
   This routine simplifies looking up PCK kernel variables by
   constructing names of requested kernel variables and by performing
   error checking.
 
   This routine is intended for use in cases where the maximum number
   of values that may be returned is known at compile time.  The caller
   fetches all of the values associated with the specified kernel
   variable via a single call to this routine.  If the number of values
   to be fetched cannot be known until run time, the lower-level
   routine  gdpool_c should be used instead. gdpool_c supports fetching
   arbitrary amounts of data in multiple "chunks."
 
   This routine is intended for use in cases where the requested kernel
   variable is expected to be present in the kernel pool.  If the
   variable is not found or has the wrong data type, this routine
   signals an error.  In cases where it is appropriate to indicate
   absence of an expected kernel variable by returning a boolean "found
   flag" with the value SPICEFALSE, again the routine gdpool_c should
   be used.
 
-Examples
 
   1)  When the kernel variable  
 
          BODY399_RADII 
 
       is present in the kernel pool---normally because a PCK defining
       this variable has been loaded---the call
 
          bodvcd_c ( 399, "RADII", 3, &dim, values );
 
       returns the dimension and values associated with the variable 
       "BODY399_RADII", for example, 
 
          dim      == 3 
          value[0] == 6378.140 
          value[1] == 6378.140 
          value[2] == 6356.755 
 
 
   2) The call  
 
         bodvcd_c ( 399, "radii", 3, &dim, values ); 
 
      usually will cause a SPICE(KERNELVARNOTFOUND) error to be
      signaled, because this call will attempt to look up the values
      associated with a kernel variable of the name
 
         "BODY399_radii" 
 
      Since kernel variable names are case sensitive, this name is not
      considered to match the name
 
         "BODY399_RADII" 
 
      which normally would be present after a text PCK containing data
      for all planets and satellites has been loaded.
  
-Restrictions
 
   None. 
 
-Literature_References
 
   None. 
 
-Author_and_Institution
 
   N.J. Bachman    (JPL) 
   B.V. Semenov    (JPL) 
   W.L. Taber      (JPL) 
   I.M. Underwood  (JPL) 
 
-Version
 
   -CSPICE Version 1.0.1, 12-APR-2006 (NJB)

       Header fix:  output argument `dim' is now preceded by
       an ampersand in example calls to bodvcd_c.c.

   -CSPICE Version 1.0.0, 24-OCT-2005 (NJB) (BVS) (WLT) (IMU)

-Index_Entries
 
   fetch constants for a body from the kernel pool 
   physical constants for a body 
 
-&
*/

{ /* Begin bodvcd_c */


   /*
   Participate in error tracing.
   */
   if ( return_c() )
   {
      return;
   }
   chkin_c ( "bodvcd_c" );


   /*
   Check the input string.
   */
   CHKFSTR ( CHK_STANDARD, "bodvcd_c", item   );


   /*
   Call the f2c'd SPICELIB function.
   */
   bodvcd_ ( (integer    *) &bodyid,
             (char       *) item,
             (integer    *) &maxn,
             (integer    *) dim,
             (doublereal *) values,
             (ftnlen      ) strlen(item)    );

   chkout_c ( "bodvcd_c" );

} /* End bodvcd_c */