Exemplo n.º 1
0
/* $Procedure SPKGPS ( S/P Kernel, geometric position ) */
/* Subroutine */ int spkgps_(integer *targ, doublereal *et, char *ref, 
	integer *obs, doublereal *pos, doublereal *lt, ftnlen ref_len)
{
    /* Initialized data */

    static logical first = TRUE_;

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

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

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

/* $ Abstract */

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

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*     SPK */

/* $ Keywords */

/*     EPHEMERIS */

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

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

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*     None. */

/* $ Keywords */

/*     FRAMES */

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

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

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

/* $ Disclaimer */

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

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

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

/* $ Detailed_Input */

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

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

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

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

/* $ Detailed_Output */

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

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

/* $ Parameters */

/*     None. */

/* $ Exceptions */

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

/* $ Files */

/*     See: $Restrictions. */

/* $ Particulars */

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


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


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


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


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

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

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

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

/* $ Examples */

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

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

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

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

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

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

/*            DOUBLE PRECISION      VNORM */

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

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

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

/*            DO I = 0, N */

/*               ET = BEGIN + I*DELTA */

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

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

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

/*            END DO */

/* $ Restrictions */

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

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Version */

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

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

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

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

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

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

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

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

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

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

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

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

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

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

/* -& */

/*     This is the idea: */

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

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

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

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

/*     where */

/*        X */
/*         Y */

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

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

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

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




/*     SPICELIB functions */


/*     Local parameters */


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


/*     Saved frame name length. */


/*     Local variables */


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


/*     Saved frame name/ID items. */


/*     Initial values. */


/*     In-line Function Definitions */


/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counter. */

	zzctruin_(svctr1);
	first = FALSE_;
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

	    if (cframe == tmpfrm) {

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

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

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

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

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

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

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

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

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

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

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

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



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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (cframe == refid) {

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

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

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

	irfrot_(&cframe, &refid, rot);
	mxv_(rot, pos, stemp);
	moved_(stemp, &c__3, pos);
    } else {
	refchg_(&cframe, &refid, et, psxfrm);
	if (failed_()) {
	    chkout_("SPKGPS", (ftnlen)6);
	    return 0;
	}
	mxv_(psxfrm, pos, stemp);
	moved_(stemp, &c__3, pos);
    }
    *lt = vnorm_(pos) / clight_();
    chkout_("SPKGPS", (ftnlen)6);
    return 0;
} /* spkgps_ */
Exemplo n.º 2
0
/* $Procedure      CKWSS ( CK write segment summary ) */
/* Subroutine */ int ckwss_(integer *unit, char *segid, integer *segins, 
	integer *segfrm, integer *segtyp, integer *segrts, doublereal *segbtm,
	 doublereal *segetm, ftnlen segid_len)
{
    /* Initialized data */

    static char cktyp[80*6] = "Discrete Pointing                            "
	    "                                   " "Continuous Pointing: Const"
	    "ant Angular Velocity                                  " "Continu"
	    "ous Pointing: Linear Interpolation                              "
	    "         " "Continuous Pointing: Chebyshev, Variable Interval Le"
	    "ngth                        " "Continuous Pointing: MEX/Rosetta "
	    "Polynomial Interpolation                       " "Continuous Poi"
	    "nting: ESOC/DDID Piecewise Interpolation                        "
	    "  ";
    static char pvstat[40*2] = "Pointing Only                           " 
	    "Pointing and Angular Velocity           ";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    static integer sclk;
    extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
    static doublereal beget;
    static char frame[32];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    static doublereal endet;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    static char lines[80*11];
    static logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, 
	    ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, 
	    ftnlen);
    extern logical failed_(void);
    extern /* Subroutine */ int scdecd_(integer *, doublereal *, char *, 
	    ftnlen), ckmeta_(integer *, char *, integer *, ftnlen);
    static char begtim[32], endtim[32], spname[32];
    extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
	    char *, ftnlen);
    static integer spcrft;
    extern /* Subroutine */ int writla_(integer *, char *, integer *, ftnlen);
    static char typdsc[80];
    extern logical return_(void);

/* $ Abstract */

/*     Write a segment summary for a CK segment to a Fortran logical */
/*     unit. */

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

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I   The logical unit to use for writing the summary. */
/*      SEGID     I   Segment ID for a segment in a CK file. */
/*      SEGINS    I   ID for the instrument having data in a CK segment. */
/*      SEGFRM    I   Reference frame for a segment in a CK file. */
/*      SEGTYP    I   Data type for a segment in a CK file. */
/*      SEGRTS    I   Flag for velocity info in a CK segment. */
/*      SEGBTM    I   Begin time (SCLK) for a segment in a CK file. */
/*      SEGETM    I   End time (SCLK) for a segment in a CK file. */

/* $ Detailed_Input */

/*      UNIT     The Fortran logical unit on which the segment summary */
/*               is to be written. */

/*      SEGID    Segment ID for the current segment in a CK file. */

/*      SEGINS   NAIF integer ID code for the instrument having data */
/*               in the current segment in a CK file. */

/*      SEGFRM   Inertial reference frame for the current segment in a */
/*               CK file. This is the NAIF integer code for the inertial */
/*               reference frame. */

/*      SEGTYP   Data type for the current segment in a CK file. This */
/*               is an integer code which specifies the type of the data */
/*               in the current segment. */

/*      SEGRTS   Integer flag which indicates whether the segment */
/*               contains angular velocity data in addition to pointing */
/*               data, SEGRTS .EQ. 1, or just pointing data, SEGRTS .EQ. */
/*               0. */

/*      SEGBTM   The beginning encoded SCLK time for the data in the */
/*               current segment in a CK file. */

/*      SEGETM   The ending encoded SCLK time for the data in the */
/*               current segment in a CK file. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If an error occurs while writing to the logical unit, the error */
/*        SPICE(FILEWRITEFAILED) will be signalled. */

/*     2) If an error occurs in a routine called by this routine, this */
/*        routine will check out and return. Presumably an appropriate */
/*        error message will already have been set. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will format and display a CK segment summary in a */
/*     human compatible fashion. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine performs time conversions using SCDECD, and */
/*        therefore requires that a SPICE SCLK kernel file be */
/*        loaded into the SPICELIB kernel pool before it is called. */

/*     2) This routine performs time conversions using ET2UTC, and */
/*        therefore requires that a SPICE leapseconds kernel file be */
/*        loaded into the SPICELIB kernel pool before it is called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     K.R. Gehringer (JPL) */

/* $ Version */

/* -    SPACIT Version 4.0.0,  08-MAR-2014 (NJB) */

/*        The routine was updated to handle CK type 6. */

/* -    SPACIT Version 3.0.0,  28-AUG-2002 (NJB) */

/*        The routine was updated to handle CK types 4 and 5. */

/* -    Beta Version 2.1.0,  7-FEB-1997 (WLT) */

/*        The routine was modified to use CKMETA to obtain the */
/*        spacecraft and spacecraft clock associated with a */
/*        a segment.  This replaces the old method of just dividing */
/*        by 1000. */

/* -    Beta Version 2.0.0, 24-JAN-1996 (KRG) */

/*        There have been several undocumented revisions of this */
/*        subroutine to improve its display formats and fix display bugs. */
/*        We are starting a new trend here, with the documentation of the */
/*        changes to this version. Hopefully we will continue to do so. */

/*        The changes to this version are: */

/*           Calling a new subroutien to get reference frame names, to */
/*           support the non-inertial frames software. */

/*           Fixing some display inconsistencies when body, or frame */
/*           names are not found. */

/* -    Beta Version 1.0.0, 25-FEB-1993 (KRG) */

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

/*      format and write a ck segment summary */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set the value for the maximum output display width. */


/*     Set the maximum length for the inertial reference frame name. */


/*     Set the maximum length for a body name. */


/*     Set the precision for fractions of seconds used for UTC times */
/*     when converted from ET times. */


/*     Set the length of a time string, UTC or SCLK. */


/*     Set the maximum length of a CK data type description. */


/*     Set a value for the length of the pointing only/pointing and */
/*     angular velocity messages. */


/*     Set the maximum number of CK data types. */


/*     Set up some mnemonics for accessing the correct labels. */


/*     Set the number of output lines. */


/*     Local variables */


/*     Initial Values */


/*     Standard SPICE error handling. */

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

/*     Set up the line labels. */

    s_copy(lines, "   Segment ID     : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 160, "   Spacecraft     : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 80, "   Instrument Code: #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 560, "   UTC Start Time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 640, "   UTC Stop Time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 720, "   SCLK Start Time: #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 800, "   SCLK Stop Time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 240, "   Reference Frame: Frame #", (ftnlen)80, (ftnlen)27)
	    ;
    s_copy(lines + 320, "   CK Data Type   : Type #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 400, "      Description : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 480, "   Available Data : #", (ftnlen)80, (ftnlen)21);

/*     Format the segment ID. */

    repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
	    ftnlen)80);

/*     Get the spacecraft ID code from the instrument ID code by dividing */
/*     by 1000. */

    ckmeta_(segins, "SPK", &spcrft, (ftnlen)3);
    ckmeta_(segins, "SCLK", &sclk, (ftnlen)4);

/*     Format the spacecraft name and its name if we found it. */

    bodc2n_(&spcrft, spname, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 160, "#", &spcrft, lines + 160, (ftnlen)80, (ftnlen)1, 
		(ftnlen)80);
	repmc_(lines + 160, "#", spname, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 160, "#", &spcrft, lines + 160, (ftnlen)80, (ftnlen)1, 
		(ftnlen)80);
    }

/*     Format the instrument name if we found it. */

    repmi_(lines + 80, "#", segins, lines + 80, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);

/*     Convert the segment start and stop times from encoded SCLK */
/*     to SCLK time strings that are human readable. */

    scdecd_(&sclk, segbtm, begtim, (ftnlen)32);
    scdecd_(&sclk, segetm, endtim, (ftnlen)32);
    if (failed_()) {
	chkout_("CKWSS", (ftnlen)5);
	return 0;
    }

/*     Format the UTC AND SCLK times. */

    repmc_(lines + 720, "#", begtim, lines + 720, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 800, "#", endtim, lines + 800, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Convert the segment start and stop times from encoded SCLK to ET */
/*     so that we can convert them to UTC. */

    sct2e_(&sclk, segbtm, &beget);
    sct2e_(&sclk, segetm, &endet);
    if (failed_()) {
	chkout_("CKWSS", (ftnlen)5);
	return 0;
    }

/*     Convert the segment start and stop times from ET to UTC for */
/*     human readability. */

    et2utc_(&beget, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
    et2utc_(&endet, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
    if (failed_()) {
	chkout_("CKWSS", (ftnlen)5);
	return 0;
    }

/*     Format the UTC times. */

    repmc_(lines + 560, "#", begtim, lines + 560, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 640, "#", endtim, lines + 640, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Format the inertial reference frame and its name if we found it. */

    frmnam_(segfrm, frame, (ftnlen)32);
    if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
	repmc_(lines + 240, "#", "#, #", lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 240, "#", frame, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the CK segment type and a description if we have one. */

    if (*segtyp > 6 || *segtyp < 1) {
	s_copy(typdsc, "No description for this type. Do you need a new tool"
		"kit?", (ftnlen)80, (ftnlen)56);
    } else {
	s_copy(typdsc, cktyp + ((i__1 = *segtyp - 1) < 6 && 0 <= i__1 ? i__1 :
		 s_rnge("cktyp", i__1, "ckwss_", (ftnlen)424)) * 80, (ftnlen)
		80, (ftnlen)80);
    }
    repmi_(lines + 320, "#", segtyp, lines + 320, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);
    repmc_(lines + 400, "#", typdsc, lines + 400, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80, (ftnlen)80);

/*     Format the pointing / pointing and angular velocity status */

    repmc_(lines + 480, "#", pvstat + ((i__1 = *segrts) < 2 && 0 <= i__1 ? 
	    i__1 : s_rnge("pvstat", i__1, "ckwss_", (ftnlen)432)) * 40, lines 
	    + 480, (ftnlen)80, (ftnlen)1, (ftnlen)40, (ftnlen)80);

/*     Display the summary. */

    writla_(&c__11, lines, unit, (ftnlen)80);

/*     We were either successful or not on the previous write. In either */
/*     event, we want to check out and return to the caller, so there is */
/*     no need to check FAILED() here. */

    chkout_("CKWSS", (ftnlen)5);
    return 0;
} /* ckwss_ */
Exemplo n.º 3
0
/* $Procedure      SPKWSS ( SPK write segment summary ) */
/* Subroutine */ int spkwss_(integer *unit, char *segid, integer *segtgt, 
	integer *segcen, integer *segfrm, integer *segtyp, doublereal *segbtm,
	 doublereal *segetm, ftnlen segid_len)
{
    /* Initialized data */

    static char spktyp[80*21] = "Modified Difference Array                  "
	    "                                     " "Fixed Width, Fixed Order"
	    " Chebyshev Polynomials: Pos                             " "Fixed"
	    " Width, Fixed Order Chebyshev Polynomials: Pos, Vel             "
	    "           " "TRW Elements (Space Telescope, TDRS)              "
	    "                              " "Two Body Propagation Using Disc"
	    "rete States                                      " "Type 6      "
	    "                                                                "
	    "    " "Precession Conic Elements                                "
	    "                       " "Discrete States, Evenly Spaced, Lagran"
	    "ge Interpolation                          " "Discrete States, Un"
	    "evenly Spaced, Lagrange Interpolation                        " 
	    "Two-Line Elements (Short Period)                               "
	    "                 " "Two-Line Elements (Long Period)             "
	    "                                    " "Discrete States, Evenly S"
	    "paced, Hermite Interpolation                           " "Discre"
	    "te States, Unevenly Spaced, Hermite Interpolation               "
	    "          " "Variable Width, Fixed order Chebyshev Polynomials: "
	    "Pos, Vel                     " "Two-Body with J2 precession     "
	    "                                                " "ISO elements "
	    "                                                                "
	    "   " "Precessing Equinoctial Elements                           "
	    "                      " "Mex/Rosetta Hermite/Lagrange Interpolat"
	    "ion                                      " "ESOC/DDID Piecewise "
	    "Interpolation                                               " 
	    "Fixed Width, Fixed Order Chebyshev Polynomials: Vel            "
	    "                 " "Extended Modified Difference Array          "
	    "                                    ";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    char body[32];
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
    char frame[32];
    extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
	     char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
    char lines[80*10];
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, 
	    ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, 
	    ftnlen);
    extern logical failed_(void);
    char begtim[32], endtim[32];
    extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
	    char *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
    char typdsc[80];
    extern logical return_(void);

/* $ Abstract */

/*     Write the segment summary for an SPK segment to a Fortran logical */
/*     unit. */

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

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I   The logical unit to use for writing the summary. */
/*      SEGIDS    I   Segment ID for the segment in an SPK file. */
/*      SEGTGT    I   Target body for the segment in an SPK file. */
/*      SEGCEN    I   Center body for the segment in an SPK file. */
/*      SEGFRM    I   Reference frame for the segment in an SPK file. */
/*      SEGTYP    I   Ephemeris type for the segment in an SPK file. */
/*      SEGBTM    I   Begin time (ET) for the segment in an SPK file. */
/*      SEGETM    I   End time (ET) for the segment in an SPK file. */

/* $ Detailed_Input */

/*      UNIT     The Fortran logical unit to which the segment summary */
/*               is written. */

/*      SEGID    Segment ID for a segment in an SPK file. */

/*      SEGTGT   Target body for a segment in an SPK file. This is the */
/*               NAIF integer code for the target body. */

/*      SEGCEN   Center body for a segment in an SPK file. This is the */
/*               NAIF integer code for the center body. */

/*      SEGFRM   Inertial reference frame for a segment in an SPK file. */
/*               this is the NAIF integer code for the inertial reference */
/*               frame. */

/*      SEGTYP   Ephemeris type for a segment in an SPK file. This is an */
/*               integer code which represents the SPK segment data type. */

/*      SEGBTM   Begin time (ET) for a segment in an SPK file. */

/*      SEGETM   End time (ET) for a segment in an SPK file. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If an error occurs while writing to the logical unit, the error */
/*        will be signaled by a routine called by this routine. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will format and display an SPK segment summary in a */
/*     human compatible fashion. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine performs time conversions using ET2UTC, and */
/*        therefore requires that a SPICE leapseconds kernel file be */
/*        loaded into the SPICELIB kernel pool before being called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     K.R. Gehringer (JPL) */
/*     W.L. Taber     (JPL) */

/* $ Version */

/* -    SPACIT Version 4.0.0, 18-OCT-2012 (NJB) */

/*        Updated to support SPK types 19, 20, and 21. */

/* -    SPACIT Version 3.0.0, 28-AUG-2002 (NJB) */

/*        Updated to support SPK type 18.  Fixed typo in type 13 */
/*        description. */

/* -    Beta Version 2.1.0, 28-FEB-1997 (WLT) */

/*        Added descriptions for types 4, 7, 10, 11, 12, 13, 15, 16 */
/*        and 17. */

/* -    Beta Version 2.0.0, 24-JAN-1996 (KRG) */

/*        There have been several undocumented revisions of this */
/*        subroutine to improve its display formats and fix display bugs. */
/*        We are starting a new trend here, with the documentation of the */
/*        changes to this version. Hopefully we will continue to do so. */

/*        The changes to this version are: */

/*           Calling a new subroutine to get reference frame names, to */
/*           support the non-inertial frames software. */

/*           Fixing some display inconsistencies when body, or frame */
/*           names are not found. */

/* -    Beta Version 1.0.0, 25-FEB-1993 (KRG) */

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

/*      format and write an spk segment summary */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set the value for the maximum output display width. */


/*     Set the maximum length for the inertial reference frame name. */


/*     Set the maximum length for a body name. */


/*     Set the precision for fractions of seconds used for UTC times */
/*     when converted from ET times. */


/*     Set the length of a UTC time string. */


/*     Set the maximum length of an SPK data type description. */


/*     Set the maximum number of SPK data types. */


/*     Set up some mnemonics for accessing the correct labels. */


/*     Set the number of output lines. */


/*     Local variables */


/*     Initial Values */


/*     Standard SPICE error handling. */

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

/*     Set up the line labels. */

    s_copy(lines, "   Segment ID     : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 480, "   UTC Start Time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 560, "   UTC Stop Time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 640, "   ET Start Time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 720, "   ET Stop time   : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 80, "   Target Body    : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 160, "   Center Body    : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 240, "   Reference frame: Frame #", (ftnlen)80, (ftnlen)27)
	    ;
    s_copy(lines + 320, "   SPK Data Type  : Type #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 400, "      Description : #", (ftnlen)80, (ftnlen)21);

/*     Format segment ID. */

    repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
	    ftnlen)80);

/*     Convert the segment start and stop times from ET to UTC for */
/*     human readability. */

    et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
    et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
    if (failed_()) {
	chkout_("SPKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the UTC times. */

    repmc_(lines + 480, "#", begtim, lines + 480, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 560, "#", endtim, lines + 560, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Convert the ET times into Calendar format. */

    etcal_(segbtm, begtim, (ftnlen)32);
    etcal_(segetm, endtim, (ftnlen)32);
    if (failed_()) {
	chkout_("SPKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the ET times. */

    repmc_(lines + 640, "#", begtim, lines + 640, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 720, "#", endtim, lines + 720, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Format the target body and its name if we found it. */

    bodc2n_(segtgt, body, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 80, "#", segtgt, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 80, "#", segtgt, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the central body and its name if we found it. */

    bodc2n_(segcen, body, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 160, "#", segcen, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 160, "#", body, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 160, "#", segcen, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the reference frame and its name if we found it. */

    frmnam_(segfrm, frame, (ftnlen)32);
    if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
	repmc_(lines + 240, "#", "#, #", lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 240, "#", frame, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 240, "#", segfrm, lines + 240, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the SPK segment type and a description if we have one. */

    if (*segtyp > 21 || *segtyp < 1) {
	s_copy(typdsc, "No description for this type. Do you need a new tool"
		"kit?", (ftnlen)80, (ftnlen)56);
    } else {
	s_copy(typdsc, spktyp + ((i__1 = *segtyp - 1) < 21 && 0 <= i__1 ? 
		i__1 : s_rnge("spktyp", i__1, "spkwss_", (ftnlen)400)) * 80, (
		ftnlen)80, (ftnlen)80);
    }
    repmi_(lines + 320, "#", segtyp, lines + 320, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);
    repmc_(lines + 400, "#", typdsc, lines + 400, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80, (ftnlen)80);

/*     Display the summary. */

    writla_(&c__10, lines, unit, (ftnlen)80);

/*     We were either successful or not on the previous write. In either */
/*     event, we want to check out and return to the caller, so there is */
/*     no need to check FAILED() here. */

    chkout_("SPKWSS", (ftnlen)6);
    return 0;
} /* spkwss_ */
Exemplo n.º 4
0
Arquivo: et2lst.c Projeto: Dbelsa/coft
/* $Procedure ET2LST ( ET to Local Solar Time ) */
/* Subroutine */ int et2lst_(doublereal *et, integer *body, doublereal *
	long__, char *type__, integer *hr, integer *mn, integer *sc, char *
	time, char *ampm, ftnlen type_len, ftnlen time_len, ftnlen ampm_len)
{
    /* System generated locals */
    address a__1[5], a__2[7];
    integer i__1[5], i__2[7];
    doublereal d__1;

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

    /* Local variables */
    doublereal rate, slat, mins;
    char h__[2], m[2];
    integer n;
    doublereal q;
    char s[2];
    doublereal angle;
    char frame[32];
    doublereal range;
    extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
	     ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen), dpfmt_(
	    doublereal *, char *, char *, ftnlen, ftnlen);
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    doublereal state[6], slong;
    extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
	    , integer *, doublereal *, doublereal *, ftnlen, ftnlen);
    doublereal hours;
    extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
    extern doublereal twopi_(void);
    extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
    extern doublereal pi_(void);
    char bodnam[36];
    doublereal lt;
    integer frcode;
    extern /* Subroutine */ int cidfrm_(integer *, integer *, char *, logical 
	    *, ftnlen);
    extern doublereal brcktd_(doublereal *, doublereal *, doublereal *);
    extern /* Subroutine */ int reclat_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), rmaind_(doublereal *, doublereal *, 
	    doublereal *, doublereal *);
    doublereal secnds;
    extern /* Subroutine */ int pgrrec_(char *, doublereal *, doublereal *, 
	    doublereal *, doublereal *, doublereal *, doublereal *, ftnlen);
    char bpmkwd[32];
    integer hrampm;
    doublereal tmpang;
    extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer 
	    *, doublereal *, logical *, ftnlen);
    char amorpm[4];
    doublereal tmpsec;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), dtpool_(char *, logical *, integer *, char *, ftnlen, 
	    ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, 
	    ftnlen);
    doublereal mylong, spoint[3];
    extern logical return_(void);
    char kwtype[1];
    extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
    char mytype[32];
    doublereal lat;

/* $ Abstract */

/*     Given an ephemeris epoch ET, compute the local solar time for */
/*     an object on the surface of a body at a specified longitude. */

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

/*     TIME */

/* $ Keywords */

/*     TIME */

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

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     ET         I   Epoch in seconds past J2000 epoch */
/*     BODY       I   ID-code of the body of interest */
/*     LONG       I   Longitude of surface point (RADIANS) */
/*     TYPE       I   Type of longitude 'PLANETOCENTRIC', etc. */
/*     HR         O   Local hour on a "24 hour" clock */
/*     MN         O   Minutes past the hour */
/*     SC         O   Seconds past the minute */
/*     TIME       O   String giving local time on 24 hour clock */
/*     AMPM       O   String giving time on A.M./ P.M. scale */

/* $ Detailed_Input */

/*     ET         is the epoch expressed in TDB seconds past */
/*                the J2000 epoch at which a local time is desired. */

/*     BODY       is the NAIF ID-code of a body on which local */
/*                time is to be measured. */

/*     LONG       is the longitude (either planetocentric or */
/*                planetographic) in radians of the site on the */
/*                surface of body for which local time should be */
/*                computed. */

/*     TYPE       is the form of longitude supplied by the variable */
/*                LONG.  Allowed values are 'PLANETOCENTRIC' and */
/*                'PLANETOGRAPHIC'.  Note the case of the letters */
/*                in TYPE is insignificant.  Both 'PLANETOCENTRIC' */
/*                and 'planetocentric' are recognized. */

/* $ Detailed_Output */

/*     HR         is the local "hour" of the site specified at the */
/*                epoch ET. Note that an "hour" of local time does not */
/*                have the same duration as an hour measured by */
/*                conventional clocks.  It is simply a representation */
/*                of an angle. See the "Particulars" section for a more */
/*                complete discussion of the meaning of local time. */

/*     MN         is the number of "minutes" past the hour of the */
/*                local time of the site at the epoch ET. Again note */
/*                that a "local minute" is not the same as a minute */
/*                you would measure with conventional clocks. */

/*     SC         is the number of "seconds" past the minute of the */
/*                local time of the site at the epoch ET.  Again note */
/*                that a "local second" is not the same as a second */
/*                you would measure with conventional clocks. */

/*     TIME       is a string expressing the local time */
/*                on a "24 hour" local clock. */

/*     AMPM       is a string expressing the local time on a "12 hour" */
/*                local clock together with the traditional AM/PM */
/*                label to indicate whether the sun has crossed */
/*                the local zenith meridian. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) This routine defines local solar time for any point on the */
/*        surface of the Sun to be 12:00:00 noon. */

/*     2) If the TYPE of the coordinates is not recognized, the */
/*        error 'SPICE(UNKNOWNSYSTEM)' will be signaled. */

/*     3) If the body-fixed frame to associate with BODY cannot be */
/*        determined, the error 'SPICE(CANTFINDFRAME)' is signaled. */

/*     4) If insufficient data is available to compute the */
/*        location of the sun in body-fixed coordinates, the */
/*        error will be diagnosed by a routine called by this one. */

/*     5) If the BODY#_PM keyword required to determine the body */
/*        rotation sense is not found in the POOL or if it is found but */
/*        is not a numeric keyword with at least two elements, the error */
/*        'SPICE(CANTGETROTATIONTYPE)' is signaled. */

/* $ Files */

/*     Suitable SPK and PCK files must be loaded prior to calling this */
/*     routine so that the body-fixed position of the sun relative to */
/*     BODY can be computed. The PCK files must contain the standard */
/*     BODY#_PM keyword need by this routine to determine the body */
/*     rotation sense. */

/*     When the input longitude is planetographic, the default */
/*     interpretation of this value can be overridden using the optional */
/*     kernel variable */

/*        BODY<body ID>_PGR_POSITIVE_LON */

/*     which is normally defined via loading a text kernel. */

/* $ Particulars */

/*     This routine returns the local solar time at a user */
/*     specified location on a user specified body. */

/*     Let SUNLNG be the planetocentric longitude (in degrees) of */
/*     the sun as viewed from the center of the body of interest. */

/*     Let SITLNG be the planetocentric longitude (in degrees) of */
/*     the site for which local time is desired. */

/*     We define local time to be 12 + (SITLNG - SUNLNG)/15 */

/*     (where appropriate care is taken to map ( SITLNG - SUNLNG ) */
/*     into the range from -180 to 180). */

/*     Using this definition, we see that from the point of view */
/*     of this routine, local solar time is simply a measure of angles */
/*     between meridians on the surface of a body.  Consequently, */
/*     this routine is not appropriate for computing "local times" */
/*     in the sense of Pacific Standard Time.   For computing times */
/*     relative to standard time zones on earth, see the routines */
/*     TIMOUT and STR2ET. */


/*     Regarding planetographic longitude */
/*     ---------------------------------- */

/*     In the planetographic coordinate system, longitude is defined */
/*     using the spin sense of the body.  Longitude is positive to the */
/*     west if the spin is prograde and positive to the east if the spin */
/*     is retrograde.  The spin sense is given by the sign of the first */
/*     degree term of the time-dependent polynomial for the body's prime */
/*     meridian Euler angle "W":  the spin is retrograde if this term is */
/*     negative and prograde otherwise.  For the sun, planets, most */
/*     natural satellites, and selected asteroids, the polynomial */
/*     expression for W may be found in a SPICE PCK kernel. */

/*     The earth, moon, and sun are exceptions: planetographic longitude */
/*     is measured positive east for these bodies. */

/*     If you wish to override the default sense of positive */
/*     planetographic longitude for a particular body, you can do so by */
/*     defining the kernel variable */

/*        BODY<body ID>_PGR_POSITIVE_LON */

/*     where <body ID> represents the NAIF ID code of the body. This */
/*     variable may be assigned either of the values */

/*        'WEST' */
/*        'EAST' */

/*     For example, you can have this routine treat the longitude */
/*     of the earth as increasing to the west using the kernel */
/*     variable assignment */

/*        BODY399_PGR_POSITIVE_LON = 'WEST' */

/*     Normally such assignments are made by placing them in a text */
/*     kernel and loading that kernel via FURNSH. */


/* $ Examples */

/*     The following code fragment illustrates how you */
/*     could print the local time at a site on Mars with */
/*     planetographic longitude 326.17 deg E at epoch ET. */

/*     (This example assumes all required SPK and PCK files have */
/*     been loaded). */

/*     Convert the longitude to radians, set the type of the longitude */
/*     and make up a mnemonic for Mars' ID-code. */

/*     LONG = 326.17 * RPD() */
/*     TYPE = 'PLANETOGRAPHIC' */
/*     MARS = 499 */

/*     CALL ET2LST ( ET, MARS, LONG, TYPE, HR, MN, SC, TIME, AMPM ) */

/*     WRITE (*,*) 'The local time at Mars 326.17 degrees E ' */
/*     WRITE (*,*) 'planetographic longitude is: ', AMPM */

/* $ Restrictions */

/*     This routine relies on being able to determine the name */
/*     of the body-fixed frame associated with BODY through the */
/*     frames subsystem.  If the BODY specified is NOT one of the */
/*     nine planets or their satellites, you will need to load */
/*     an appropriate frame definition kernel that contains */
/*     the relationship between the body id and the body-fixed frame */
/*     name.  See the FRAMES required reading for more details */
/*     on specifying this relationship. */

/*     The routine determines the body rotation sense using the PCK */
/*     keyword BODY#_PM. Therefore, you will need to a text PCK file */
/*     defining the complete set of the standard PCK body rotation */
/*     keywords for the body of interest. The text PCK file must be */
/*     loaded independently of whether a binary PCK file providing */
/*     rotation data for the same body is loaded or not. */

/*     Although it is not currently the case for any of the Solar System */
/*     bodies, it is possible that the retrograde rotation rate of a */
/*     body would be slower than the orbital rate of the body rotation */
/*     around the Sun. The routine does not account for such cases; for */
/*     them it will compute incorrect the local time progressing */
/*     backwards. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Version */

/* -    SPICELIB Version 3.0.2, 18-APR-2014 (BVS) */

/*        Minor edits to long error messages. */

/* -    SPICELIB Version 3.0.1, 09-SEP-2009 (EDW) */

/*        Header edits: deleted a spurious C$ marker from the */
/*        "Detailed_Output" section. The existence of the marker */
/*        caused a failure in the HTML documentation creation script. */

/*        Deleted the "Revisions" section as it contained several */
/*        identical entries from the "Version" section. */

/*        Corrected order of header sections. */

/* -    SPICELIB Version 3.0.0, 28-OCT-2006 (BVS) */

/*        Bug fix: incorrect computation of the local time for the */
/*        bodies with the retrograde rotation causing the local time to */
/*        flow backwards has been fixed. The local time for all types of */
/*        bodies now progresses as expected -- midnight, increasing AM */
/*        hours, noon, increasing PM hours, next midnight, and so on. */

/* -    SPICELIB Version 2.0.0, 03-NOV-2005 (NJB) */

/*        Bug fix:  treatment of planetographic longitude has been */
/*        updated to be consistent with the SPICE planetographic/ */
/*        rectangular coordinate conversion routines.  The effect of */
/*        this change is that the default sense of positive longitude */
/*        for the moon is now east; also, the default sense of positive */
/*        planetographic longitude now may be overridden for any body */
/*        (see Particulars above). */

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

/* -    SPICELIB Version 1.1.0, 24-MAR-1998 (WLT) */

/*        The integer variable SUN was never initialized in the */
/*        previous version of the routine.  Now it is set to */
/*        the proper value of 10. */

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


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

/*     Compute the local time for a point on a body. */

/* -& */

/*     SPICELIB Functions */


/*     Local parameters */



/*     Local Variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    }
    chkin_("ET2LST", (ftnlen)6);
    ljust_(type__, mytype, type_len, (ftnlen)32);
    ucase_(mytype, mytype, (ftnlen)32, (ftnlen)32);
    if (s_cmp(mytype, "PLANETOGRAPHIC", (ftnlen)32, (ftnlen)14) == 0) {

/*        Find planetocentric longitude corresponding to the input */
/*        longitude.  We first represent in rectangular coordinates */
/*        a surface point having zero latitude, zero altitude, and */
/*        the input planetographic longitude. We then find the */
/*        planetocentric longitude of this point. */

/*        Since PGRREC accepts a body name, map the input code to */
/*        a name, if possible.  Otherwise, just convert the input code */
/*        to a string. */

	bodc2n_(body, bodnam, &found, (ftnlen)36);
	if (! found) {
	    intstr_(body, bodnam, (ftnlen)36);
	}

/*        Convert planetographic coordinates to rectangular coordinates. */
/*        All we care about here is longitude.  Set the other inputs */
/*        as follows: */

/*            Latitude          = 0 */
/*            Altitude          = 0 */
/*            Equatorial radius = 1 */
/*            Flattening factor = 0 */

	pgrrec_(bodnam, long__, &c_b4, &c_b4, &c_b6, &c_b4, spoint, (ftnlen)
		36);

/*        The output MYLONG is planetocentric longitude.  The other */
/*        outputs are not used.  Note that the variable RANGE appears */
/*        later in another RECLAT call; it's not used after that. */

	reclat_(spoint, &range, &mylong, &lat);
    } else if (s_cmp(mytype, "PLANETOCENTRIC", (ftnlen)32, (ftnlen)14) == 0) {
	mylong = *long__;
    } else {
	setmsg_("The coordinate system '#' is not a recognized system of lon"
		"gitude.  The recognized systems are 'PLANETOCENTRIC' and 'PL"
		"ANETOGRAPHIC'. ", (ftnlen)134);
	errch_("#", type__, (ftnlen)1, type_len);
	sigerr_("SPICE(UNKNOWNSYSTEM)", (ftnlen)20);
	chkout_("ET2LST", (ftnlen)6);
	return 0;
    }

/*     It's always noon on the surface of the sun. */

    if (*body == 10) {
	*hr = 12;
	*mn = 0;
	*sc = 0;
	s_copy(time, "12:00:00", time_len, (ftnlen)8);
	s_copy(ampm, "12:00:00 P.M.", ampm_len, (ftnlen)13);
	chkout_("ET2LST", (ftnlen)6);
	return 0;
    }

/*     Get the body-fixed position of the sun. */

    cidfrm_(body, &frcode, frame, &found, (ftnlen)32);
    if (! found) {
	setmsg_("The body-fixed frame associated with body # could not be de"
		"termined.  This information needs to be \"loaded\" via a fra"
		"mes definition kernel.  See frames.req for more details. ", (
		ftnlen)174);
	errint_("#", body, (ftnlen)1);
	sigerr_("SPICE(CANTFINDFRAME)", (ftnlen)20);
	chkout_("ET2LST", (ftnlen)6);
	return 0;
    }
    spkez_(&c__10, et, frame, "LT+S", body, state, &lt, (ftnlen)32, (ftnlen)4)
	    ;
    reclat_(state, &range, &slong, &slat);
    angle = mylong - slong;

/*     Force the angle into the region from -PI to PI */

    d__1 = twopi_();
    rmaind_(&angle, &d__1, &q, &tmpang);
    angle = tmpang;
    if (angle > pi_()) {
	angle -= twopi_();
    }

/*     Get the rotation sense of the body and invert the angle if the */
/*     rotation sense is retrograde. Use the BODY#_PM PCK keyword to */
/*     determine the sense of the body rotation. */

    s_copy(bpmkwd, "BODY#_PM", (ftnlen)32, (ftnlen)8);
    repmi_(bpmkwd, "#", body, bpmkwd, (ftnlen)32, (ftnlen)1, (ftnlen)32);
    dtpool_(bpmkwd, &found, &n, kwtype, (ftnlen)32, (ftnlen)1);
    if (! found || *(unsigned char *)kwtype != 'N' || n < 2) {
	setmsg_("The rotation type for the body # could not be determined be"
		"cause the # keyword was either not found in the POOL or or i"
		"t was not of the expected type and/or dimension. This keywor"
		"d is usually provided via a planetary constants kernel. See "
		"pck.req for more details. ", (ftnlen)265);
	errint_("#", body, (ftnlen)1);
	errch_("#", bpmkwd, (ftnlen)1, (ftnlen)32);
	sigerr_("SPICE(CANTGETROTATIONTYPE)", (ftnlen)26);
	chkout_("ET2LST", (ftnlen)6);
	return 0;
    } else {

/*        If the rotation rate is negative, invert the angle. */

	gdpool_(bpmkwd, &c__2, &c__1, &n, &rate, &found, (ftnlen)32);
	if (rate < 0.) {
	    angle = -angle;
	}
    }

/*     Convert the angle to "angle seconds" before or after local noon. */

    secnds = angle * 86400. / twopi_();
    secnds = brcktd_(&secnds, &c_b32, &c_b33);

/*     Get the hour, and minutes components of the local time. */

    rmaind_(&secnds, &c_b34, &hours, &tmpsec);
    rmaind_(&tmpsec, &c_b35, &mins, &secnds);

/*     Construct the integer components of the local time. */

    *hr = (integer) hours + 12;
    *mn = (integer) mins;
    *sc = (integer) secnds;

/*     Set the A.M./P.M. components of local time. */

    if (*hr == 24) {
	*hr = 0;
	hrampm = 12;
	s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
    } else if (*hr > 12) {
	hrampm = *hr - 12;
	s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
    } else if (*hr == 12) {
	hrampm = 12;
	s_copy(amorpm, "P.M.", (ftnlen)4, (ftnlen)4);
    } else if (*hr == 0) {
	hrampm = 12;
	s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
    } else {
	hrampm = *hr;
	s_copy(amorpm, "A.M.", (ftnlen)4, (ftnlen)4);
    }

/*     Now construct the two strings we need. */

    hours = (doublereal) (*hr);
    mins = (doublereal) (*mn);
    secnds = (doublereal) (*sc);
    dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
    dpfmt_(&mins, "0x", m, (ftnlen)2, (ftnlen)2);
    dpfmt_(&secnds, "0x", s, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
    i__1[0] = 2, a__1[0] = h__;
    i__1[1] = 1, a__1[1] = ":";
    i__1[2] = 2, a__1[2] = m;
    i__1[3] = 1, a__1[3] = ":";
    i__1[4] = 2, a__1[4] = s;
    s_cat(time, a__1, i__1, &c__5, time_len);
    hours = (doublereal) hrampm;
    dpfmt_(&hours, "0x", h__, (ftnlen)2, (ftnlen)2);
/* Writing concatenation */
    i__2[0] = 2, a__2[0] = h__;
    i__2[1] = 1, a__2[1] = ":";
    i__2[2] = 2, a__2[2] = m;
    i__2[3] = 1, a__2[3] = ":";
    i__2[4] = 2, a__2[4] = s;
    i__2[5] = 1, a__2[5] = " ";
    i__2[6] = 4, a__2[6] = amorpm;
    s_cat(ampm, a__2, i__2, &c__7, ampm_len);
    chkout_("ET2LST", (ftnlen)6);
    return 0;
} /* et2lst_ */
Exemplo n.º 5
0
/* $Procedure      PCKWSS ( PCK write segment summary ) */
/* Subroutine */ int pckwss_(integer *unit, char *segid, integer *segbod, 
	integer *segfrm, integer *segtyp, doublereal *segbtm, doublereal *
	segetm, ftnlen segid_len)
{
    /* Initialized data */

    static char pcktyp[80*3] = "***Not Used***                              "
	    "                                    " "Fixed Width, Fixed Order "
	    "Chebyshev Polynomials: Angles                          " "Variab"
	    "le Width Chebyshev Polynomials Angles (in degrees!!!)           "
	    "          ";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    static char body[32];
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
    static char frame[32];
    extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
	     char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
    static char lines[80*9];
    static logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen), bodc2n_(integer *, char *, logical *, 
	    ftnlen), et2utc_(doublereal *, char *, integer *, char *, ftnlen, 
	    ftnlen);
    extern logical failed_(void);
    static char begtim[32], endtim[32];
    extern /* Subroutine */ int frmnam_(integer *, char *, ftnlen), chkout_(
	    char *, ftnlen), writla_(integer *, char *, integer *, ftnlen);
    static char typdsc[80];
    extern logical return_(void);

/* $ Abstract */

/*     Write the segment summary for a PCK segment to a Fortran logical */
/*     unit. */

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

/*     None. */

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

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I   The logical unit to use for writing the summary. */
/*      SEGIDS    I   Segment ID for the segment in a PCK file. */
/*      SEGBOD    I   Body for the segment in a PCK file. */
/*      SEGFRM    I   Reference frame for the segment in a PCK file. */
/*      SEGTYP    I   Ephemeris type for the segment in a PCK file. */
/*      SEGBTM    I   Begin time (ET) for the segment in a PCK file. */
/*      SEGETM    I   End time (ET) for the segment in a PCK file. */

/* $ Detailed_Input */

/*      UNIT     The Fortran logical unit to which the segment summary */
/*               is written. */

/*      SEGID    Segment ID for a segment in a PCK file. */

/*      SEGBOD   Body for a segment in a PCK file. This is the */
/*               NAIF integer code for the body. */

/*      SEGFRM   Inertial reference frame for a segment in a PCK file. */
/*               this is the NAIF integer code for the inertial reference */
/*               frame. */

/*      SEGTYP   Ephemeris type for a segment in a PCK file. This is an */
/*               integer code which represents the PCK segment data type. */

/*      SEGBTM   Begin time (ET) for a segment in a PCK file. */

/*      SEGETM   End time (ET) for a segment in a PCK file. */

/* $ Detailed_Output */

/*     None. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If an error occurs while writing to the logical unit, the error */
/*        will be signalled by a routine called by this routine. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine will format and display a PCK segment summary in a */
/*     human compatible fashion. */

/* $ Examples */

/*     None. */

/* $ Restrictions */

/*     1) This routine performs time conversions using ET2UTC, and */
/*        therefore requires that a SPICE leapseconds kernel file be */
/*        loaded into the SPICELIB kernel pool before being called. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     W.L. Taber (JPL) */
/*     K.R. Gehringer (JPL) */

/* $ Version */

/* -    Beta Version 2.1.0, 17-May-2001 (WLT) (20 years in CA today!) */

/*        Added a description for type 03 PCK segments. */

/* -    Beta Version 2.0.0, 24-JAN-1996 (KRG) */

/*        There have been several undocumented revisions of this */
/*        subroutine to improve its display formats and fix display bugs. */
/*        We are starting a new trend here, with the documentation of the */
/*        changes to this version. Hopefully we will continue to do so. */

/*        The changes to this version are: */

/*           Calling a new subroutien to get reference frame names, to */
/*           support the non-inertial frames software. */

/*           Fixing some display inconsistencies when body, or frame */
/*           names are not found. */

/* -    Beta Version 1.0.0, 25-FEB-1993 (KRG) */

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

/*      format and write a pck segment summary */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     Set the value for the maximum output display width. */


/*     Set the maximum length for the inertial reference frame name. */


/*     Set the maximum length for a body name. */


/*     Set the precision for fractions of seconds used for UTC times */
/*     when converted from ET times. */


/*     Set the length of a UTC time string. */


/*     Set the maximum length of an PCK data type description. */


/*     Set the maximum number of PCK data types. */


/*     Set up some mnemonics for accessing the correct labels. */


/*     Set the number of output lines. */


/*     Local variables */


/*     Save everything to keep configuration control happy. */


/*     Initial Values */


/*     Standard SPICE error handling. */

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

/*     Set up the line labels. */

    s_copy(lines, "   Segment ID     : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 400, "   UTC Start time : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 480, "   UTC Stop time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 560, "   ET Start time  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 640, "   ET Stop time   : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 80, "   Body           : Body #", (ftnlen)80, (ftnlen)26);
    s_copy(lines + 160, "   Reference frame: Frame #", (ftnlen)80, (ftnlen)27)
	    ;
    s_copy(lines + 240, "   PCK Data Type  : #", (ftnlen)80, (ftnlen)21);
    s_copy(lines + 320, "      Description : #", (ftnlen)80, (ftnlen)21);

/*     Format the segment ID. */

    repmc_(lines, "#", segid, lines, (ftnlen)80, (ftnlen)1, segid_len, (
	    ftnlen)80);

/*     Convert the segment start and stop times from ET to UTC for */
/*     human readability. */

    et2utc_(segbtm, "C", &c__3, begtim, (ftnlen)1, (ftnlen)32);
    et2utc_(segetm, "C", &c__3, endtim, (ftnlen)1, (ftnlen)32);
    if (failed_()) {
	chkout_("PCKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the UTC times. */

    repmc_(lines + 400, "#", begtim, lines + 400, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 480, "#", endtim, lines + 480, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Convert the ET times into Calendar format. */

    etcal_(segbtm, begtim, (ftnlen)32);
    etcal_(segetm, endtim, (ftnlen)32);
    if (failed_()) {
	chkout_("PCKWSS", (ftnlen)6);
	return 0;
    }

/*     Format the ET times. */

    repmc_(lines + 560, "#", begtim, lines + 560, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);
    repmc_(lines + 640, "#", endtim, lines + 640, (ftnlen)80, (ftnlen)1, (
	    ftnlen)32, (ftnlen)80);

/*     Format the body and its name if we found it. */

    bodc2n_(segbod, body, &found, (ftnlen)32);
    if (found) {
	repmc_(lines + 80, "#", "#, #", lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 80, "#", body, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 80, "#", segbod, lines + 80, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the inertial reference frame and its name if we found it. */

    frmnam_(segfrm, frame, (ftnlen)32);
    if (s_cmp(frame, " ", (ftnlen)32, (ftnlen)1) != 0) {
	repmc_(lines + 160, "#", "#, #", lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)4, (ftnlen)80);
	repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
	repmc_(lines + 160, "#", frame, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)32, (ftnlen)80);
    } else {
	repmi_(lines + 160, "#", segfrm, lines + 160, (ftnlen)80, (ftnlen)1, (
		ftnlen)80);
    }

/*     Format the PCK segment type and a description if we have one. */
/*     The reason SEGTYP >= 2 is that this routine works on binary */
/*     PCK files, and their segment types begin with type 2. Type 1 is */
/*     considered to be the text PCK files. */

    if (*segtyp > 3 || *segtyp < 2) {
	s_copy(typdsc, "No description for this type. Do you need a new tool"
		"kit?", (ftnlen)80, (ftnlen)56);
    } else {
	s_copy(typdsc, pcktyp + ((i__1 = *segtyp - 1) < 3 && 0 <= i__1 ? i__1 
		: s_rnge("pcktyp", i__1, "pckwss_", (ftnlen)352)) * 80, (
		ftnlen)80, (ftnlen)80);
    }
    repmi_(lines + 240, "#", segtyp, lines + 240, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80);
    repmc_(lines + 320, "#", typdsc, lines + 320, (ftnlen)80, (ftnlen)1, (
	    ftnlen)80, (ftnlen)80);

/*     Display the summary. */

    writla_(&c__9, lines, unit, (ftnlen)80);

/*     We were either successful or not on the previous write. In either */
/*     event, we want to check out and return to the caller, so there is */
/*     no need to check FAILED() here. */

    chkout_("PCKWSS", (ftnlen)6);
    return 0;
} /* pckwss_ */