Exemplo n.º 1
0
Arquivo: illum.c Projeto: Dbelsa/coft
/* $Procedure ILLUM ( Illumination angles ) */
/* Subroutine */ int illum_(char *target, doublereal *et, char *abcorr, char *
	obsrvr, doublereal *spoint, doublereal *phase, doublereal *solar, 
	doublereal *emissn, ftnlen target_len, ftnlen abcorr_len, ftnlen 
	obsrvr_len)
{
    /* Initialized data */

    static logical first = TRUE_;

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

/* $ Abstract */

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

/*     Find the illumination angles at a specified surface point of a */
/*     target body. */

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

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

/* $ Keywords */

/*     GEOMETRY */
/*     MOSPICE */

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

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

/* $ Disclaimer */

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

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     TARGET     I   Name of target body. */
/*     ET         I   Epoch in ephemeris seconds past J2000. */
/*     ABCORR     I   Desired aberration correction. */
/*     OBSRVR     I   Name of observing body. */
/*     SPOINT     I   Body-fixed coordinates of a target surface point. */
/*     PHASE      O   Phase angle at the surface point. */
/*     SOLAR      O   Solar incidence angle at the surface point. */
/*     EMISSN     O   Emission angle at the surface point. */

/* $ Detailed_Input */

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

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

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

/*                       'NONE'        No aberration correction. */

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

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

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

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

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

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

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

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

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

/* $ Detailed_Output */


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

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

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

/* $ Parameters */

/*     None. */

/* $ Exceptions */

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

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

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

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

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

/* $ Files */

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

/* $ Particulars */


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


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

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

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


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


/*                                                      * */
/*                                                     Sun */

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


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

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

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

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


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

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

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

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


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

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


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

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


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


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

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


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

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


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


/* $ Examples */

/*     The numerical results shown for this example may differ across */
/*     platforms.  The results depend on the SPICE kernels used as */
/*     input, the compiler and supporting libraries, and the machine */
/*     specific arithmetic implementation. */

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

/*        spk_m_031103-040201_030502.bsp */

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

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

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

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

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

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

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

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

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

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


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

/*           CALL UTC2ET ( UTC, ET ) */

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

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

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

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

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

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

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

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

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

/*           END */


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


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

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

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

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

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

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

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


/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Version */

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

/*        Updated Index_Entries header section. */

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

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

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

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

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

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

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

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

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Saved body name length. */


/*     Local variables */


/*     Saved name/ID item declarations. */


/*     Saved name/ID items. */


/*     Initial values. */


/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counters. */

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    *phase = vsep_(offsun, offobs);
    *solar = vsep_(normal, offsun);
    *emissn = vsep_(normal, offobs);
    chkout_("ILLUM", (ftnlen)5);
    return 0;
} /* illum_ */
Exemplo n.º 2
0
Arquivo: xfmsta.c Projeto: Dbelsa/coft
/* $Procedure      XFMSTA ( Transform state between coordinate systems) */
/* Subroutine */ int xfmsta_(doublereal *istate, char *icosys, char *ocosys, 
	char *body, doublereal *ostate, ftnlen icosys_len, ftnlen ocosys_len, 
	ftnlen body_len)
{
    /* Initialized data */

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

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

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

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

/* $ Abstract */

/*     Transform a state between coordinate systems. */

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*     None. */

/* $ Keywords */

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

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

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

/* $ Disclaimer */

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

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  ------------------------------------------------- */
/*     ISTATE     I   Input state. */
/*     ICOSYS     I   Current (input) coordinate system. */
/*     OCOSYS     I   Desired (output) coordinate system. */
/*     BODY       I   Name or NAIF ID of body with which */
/*                    coordinates are associated (if applicable). */
/*     OSTATE     O   Converted output state. */

/* $ Detailed_Input */

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

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

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

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

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

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

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

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

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

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

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

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

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

/* $ Detailed_Output */

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

/* $ Parameters */

/*     None. */

/* $ Exceptions */

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

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

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

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

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

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

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

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

/* $ Files */

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

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

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

/* $ Particulars */

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


/* $ Examples */

/*     The numerical results shown for these examples may differ across */
/*     platforms. The results depend on the SPICE kernels used as */
/*     input, the compiler and supporting libraries, and the machine */
/*     specific arithmetic implementation. */

/*     1) Find the apparent state of Phoebe as seen by CASSINI in the */
/*        J2000 frame at 2004 Jun 11 19:32:00. Transform the state */
/*        from rectangular to latitudinal coordinates. For verification, */
/*        transform the state back from latitudinal to rectangular */
/*        coordinates. */

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

/*           KPL/MK */

/*           File name: xfmsta_ex1.tm */

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

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

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

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


/*           \begindata */

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

/*           End of meta-kernel */

/*        Example code begins here. */

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

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

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

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

/*           INTEGER               I */

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

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

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

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

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

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

/*           END */

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

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

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

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

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

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

/*           KPL/MK */

/*           File name: xfmsta_ex2.tm */

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

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

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

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

/*           \begindata */

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

/*           \begintext */

/*           End of meta-kernel */


/*        Example code begins here. */

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

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

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

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

/*           INTEGER               I */

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

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

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

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

/*           END */

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

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

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

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

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Version */

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

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

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

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

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


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


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


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


/*     Saved body name length. */


/*     Local variables */

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


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


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


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


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


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


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


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


/*     Saved name/ID item declarations. */


/*     Saved variables */


/*     Saved name/ID items. */


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


/*     Initial values. */


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

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

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

/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counter. */

	zzctruin_(svctr1);
	first = FALSE_;
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

/*        Find the NAIF ID code */

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

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

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

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

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

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

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

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

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

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

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

/*        To rectangular... */

	if (isys == 2) {

/*                  ... from cylindrical */

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

/*                  ... from latitudinal */

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

/*                  ... from spherical */

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

/*                  ... from geodetic */

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

/*                  ... from planetographic */

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

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

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

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

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

/*        Transform the velocity into rectangular coordinates. */

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

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

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

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

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

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

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

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

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

    if (osys != 1) {

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

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

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

		if (osys == 2) {

/*                  ... to cylindrical */

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

/*                  ... to latitudinal */

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

/*                  ... to spherical */

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

/*                  ... to geodetic */

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

/*                  ... to planetographic */

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

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

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

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

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

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

	if (osys == 2) {

/*                  ... to cylindrical */

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

/*                  ... to latitudinal */

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

/*                  ... to spherical */

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

/*                  ... to geodetic */

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

/*                  ... to planetographic */

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

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

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

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

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

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

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

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

	vequ_(ipos, ostate);
	vequ_(ivel, &ostate[3]);
    } else {
	setmsg_("This error should never occur. This is an ELSE statement. I"
		"f the output coordinate system is not rectangular, the IF sh"
		"ould be executed. If the output coordinate system is rectang"
		"ular, the ELSE IF should be executed.", (ftnlen)216);
	sigerr_("SPICE(BUG5)", (ftnlen)11);
	chkout_("XFMSTA", (ftnlen)6);
	return 0;
    }
    chkout_("XFMSTA", (ftnlen)6);
    return 0;
} /* xfmsta_ */
Exemplo n.º 3
0
Arquivo: pxform.c Projeto: Dbelsa/coft
/* $Procedure      PXFORM ( Position Transformation Matrix ) */
/* Subroutine */ int pxform_(char *from, char *to, doublereal *et, doublereal 
	*rotate, ftnlen from_len, ftnlen to_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    static char svto[32];
    extern /* Subroutine */ int zznamfrm_(integer *, char *, integer *, char *
	    , integer *, ftnlen, ftnlen), zzctruin_(integer *);
    integer fcode;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer tcode;
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    static integer svctr1[2], svctr2[2];
    extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, 
	    doublereal *);
    static integer svfcod, svtcde;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen);
    static char svfrom[32];
    extern logical return_(void);

/* $ Abstract */

/*     Return the matrix that transforms position vectors from one */
/*     specified frame to another at a specified epoch. */

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*      FRAMES */

/* $ Keywords */

/*      FRAMES */

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

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

/* $ Disclaimer */

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

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     FROM       I   Name of the frame to transform from. */
/*     TO         I   Name of the frame to transform to. */
/*     ET         I   Epoch of the rotation matrix. */
/*     ROTATE     O   A rotation matrix */

/* $ Detailed_Input */

/*     FROM        is the name of some reference frame in which */
/*                 a position vector is known. */

/*     TO          is the name of a reference frame in which it */
/*                 is desired to represent a position vector. */

/*     ET          is the epoch in ephemeris seconds past the epoch */
/*                 of J2000 (TDB) at which the position transformation */
/*                 matrix ROTATE should be evaluated. */

/* $ Detailed_Output */

/*     ROTATE      is the matrix that transforms position vectors from */
/*                 the reference frame FROM to the frame TO at epoch ET. */
/*                 If (x, y, z) is a position relative to the frame FROM */
/*                 then the vector ( x', y', z') is the same position */
/*                 relative to the frame TO at epoch ET.  Here the */
/*                 vector ( x', y', z' ) is defined by the equation: */

/*                   -   -       -        -     -  - */
/*                  | x'  |     |          |   | x  | */
/*                  | y'  |     |  ROTATE  |   | y  | */
/*                  | z'  |  =  |          |   | z  | */
/*                   -   -       -        -     -  - */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If sufficient information has not been supplied via loaded */
/*        SPICE kernels to compute the transformation between the */
/*        two frames, the error will be diagnosed by a routine */
/*        in the call tree to this routine. */

/*     2) If either frame FROM or TO is not recognized the error */
/*        'SPICE(UNKNOWNFRAME)' will be signaled. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     This routine provides the user level interface to computing */
/*     position transformations from one reference frame to another. */

/*     Note that the reference frames may be inertial or non-inertial. */
/*     However, the user must take care that sufficient SPICE kernel */
/*     information is loaded to provide a complete position */
/*     transformation path from the FROM frame to the TO frame. */

/* $ Examples */

/*     Suppose that you have geodetic coordinates of a station on the */
/*     surface of the earth and that you need the inertial (J2000) */
/*     position of this station.  The following code fragment */
/*     illustrates how to transform the position of the station to a */
/*     J2000 position. */

/*        CALL BODVRD ( 'EARTH', RADII, 3, N, ABC  ) */

/*        EQUATR   =  ABC(1) */
/*        POLAR    =  ABC(3) */
/*        F        = (EQUATR - POLAR) / EQUATR */

/*        CALL GEOREC ( LONG, LAT, 0.0D0,  EQUATR, F, EPOS ) */

/*        CALL PXFORM ( 'IAU_EARTH', 'J2000', ET,  ROTATE  ) */
/*        CALL MXV    (  ROTATE,      EPOS,   JPOS         ) */

/*     The state JPOS is the desired J2000 position of the station. */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*      None. */

/* $ Author_and_Institution */

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

/* $ Version */

/* -    SPICELIB Version 1.1.0, 23-SEP-2013 (BVS) */

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

/* -    SPICELIB Version 1.0.3, 27-FEB-2008 (BVS) */

/*        Added FRAMES to the Required_Reading section. */

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

/*        Header example had invalid flattening factor computation; */
/*        this was corrected.  Reference to BODVAR in header was */
/*        replaced with reference to BODVRD. */

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

/*        Various header corrections were made. */

/* -    SPICELIB Version 1.0.0, 05-APR-1999 (WLT) */


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

/*     Find a position transformation matrix */

/* -& */

/*     Spicelib Functions */


/*     Local parameters. */


/*     Saved frame name length. */


/*     Local Variables. */


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


/*     Saved frame name/ID items. */


/*     Initial values. */


/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counters. */

	zzctruin_(svctr1);
	zzctruin_(svctr2);
	first = FALSE_;
    }
    zznamfrm_(svctr1, svfrom, &svfcod, from, &fcode, (ftnlen)32, from_len);
    zznamfrm_(svctr2, svto, &svtcde, to, &tcode, (ftnlen)32, to_len);

/*     Only non-zero id-codes are legitimate frame id-codes.  Zero */
/*     indicates that the frame wasn't recognized. */

    if (fcode != 0 && tcode != 0) {
	refchg_(&fcode, &tcode, et, rotate);
    } else if (fcode == 0 && tcode == 0) {
	setmsg_("Neither of the frames # or # was recognized as a known refe"
		"rence frame. ", (ftnlen)72);
	errch_("#", from, (ftnlen)1, from_len);
	errch_("#", to, (ftnlen)1, to_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
    } else if (fcode == 0) {
	setmsg_("The frame # was not recognized as a known reference frame. ",
		 (ftnlen)59);
	errch_("#", from, (ftnlen)1, from_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
    } else if (tcode == 0) {
	setmsg_("The frame # was not recognized as a known reference frame. ",
		 (ftnlen)59);
	errch_("#", to, (ftnlen)1, to_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
    }
    chkout_("PXFORM", (ftnlen)6);
    return 0;
} /* pxform_ */
Exemplo n.º 4
0
/* $Procedure SPKEZR ( S/P Kernel, easier reader ) */
/* Subroutine */ int spkezr_(char *targ, doublereal *et, char *ref, char *
	abcorr, char *obs, doublereal *starg, doublereal *lt, ftnlen targ_len,
	 ftnlen ref_len, ftnlen abcorr_len, ftnlen obs_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *, 
	    logical *, char *, integer *, logical *, ftnlen, ftnlen), 
	    zzctruin_(integer *), chkin_(char *, ftnlen);
    integer obsid;
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    logical found;
    extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
	    , integer *, doublereal *, doublereal *, ftnlen, ftnlen);
    static logical svfnd1, svfnd2;
    static integer svctr1[2], svctr2[2];
    integer targid;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen);
    static integer svtgid;
    extern /* Subroutine */ int setmsg_(char *, ftnlen);
    static integer svobsi;
    static char svtarg[36], svobsn[36];
    extern logical return_(void);

/* $ Abstract */

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

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*     SPK */
/*     NAIF_IDS */
/*     FRAMES */
/*     TIME */

/* $ Keywords */

/*     EPHEMERIS */

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

/*     The parameters below form an enumerated list of the recognized */
/*     frame types.  They are: INERTL, PCK, CK, TK, DYN.  The meanings */
/*     are outlined below. */

/* $ Disclaimer */

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

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

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

/* $ Parameters */

/*     INERTL      an inertial frame that is listed in the routine */
/*                 CHGIRF and that requires no external file to */
/*                 compute the transformation from or to any other */
/*                 inertial frame. */

/*     PCK         is a frame that is specified relative to some */
/*                 INERTL frame and that has an IAU model that */
/*                 may be retrieved from the PCK system via a call */
/*                 to the routine TISBOD. */

/*     CK          is a frame defined by a C-kernel. */

/*     TK          is a "text kernel" frame.  These frames are offset */
/*                 from their associated "relative" frames by a */
/*                 constant rotation. */

/*     DYN         is a "dynamic" frame.  These currently are */
/*                 parameterized, built-in frames where the full frame */
/*                 definition depends on parameters supplied via a */
/*                 frame kernel. */

/*     ALL         indicates any of the above classes. This parameter */
/*                 is used in APIs that fetch information about frames */
/*                 of a specified class. */


/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */

/*       The parameter ALL was added to support frame fetch APIs. */

/* -    SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */

/*       The parameter DYN was added to support the dynamic frame class. */

/* -    SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */

/*        Various unused frames types were removed and the */
/*        frame time TK was added. */

/* -    SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */

/* -& */

/*     End of INCLUDE file frmtyp.inc */

/* $ 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 name. */
/*     ET         I   Observer epoch. */
/*     REF        I   Reference frame of output state vector. */
/*     ABCORR     I   Aberration correction flag. */
/*     OBS        I   Observing body name. */
/*     STARG      O   State of target. */
/*     LT         O   One way light time between observer and target. */

/* $ Detailed_Input */

/*     TARG        is the name of a target body. Optionally, you may */
/*                 supply the integer ID code for the object as */
/*                 an integer string. For example both 'MOON' and */
/*                 '301' are legitimate strings that indicate the */
/*                 moon is the target body. */

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

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

/*     REF         is the name of the reference frame relative to which */
/*                 the output state vector should be expressed. This may */
/*                 be any frame supported by the SPICE system, including */
/*                 built-in frames (documented in the Frames Required */
/*                 Reading) and frames defined by a loaded frame kernel */
/*                 (FK). */

/*                 When REF designates a non-inertial frame, the */
/*                 orientation of the frame is evaluated at an epoch */
/*                 dependent on the selected aberration correction. */
/*                 See the description of the output state vector STARG */
/*                 for details. */

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

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

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

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

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

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

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

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

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


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

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

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

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

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


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

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

/*     OBS         is the name of an observing body. Optionally, you */
/*                 may supply the ID code of the object as an integer */
/*                 string. For example, both 'EARTH' and '399' are */
/*                 legitimate strings to supply to indicate the */
/*                 observer is Earth. */

/* $ Detailed_Output */

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

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

/*                 The velocity component of STARG is the derivative */
/*                 with respect to time of the position component of */
/*                 STARG. */

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

/*                 Non-inertial frames are treated as follows: letting */
/*                 LTCENT be the one-way light time between the observer */
/*                 and the central body associated with the frame, the */
/*                 orientation of the frame is evaluated at ET-LTCENT, */
/*                 ET+LTCENT, or ET depending on whether the requested */
/*                 aberration correction is, respectively, for received */
/*                 radiation, transmitted radiation, or is omitted. */
/*                 LTCENT is computed using the method indicated by */
/*                 ABCORR. */

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

/* $ Parameters */

/*     None. */

/* $ Exceptions */

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

/*     2) If the reference frame REF is not a recognized reference */
/*        frame the error 'SPICE(UNKNOWNFRAME)' is signaled. */

/*     3) If the loaded kernels provide insufficient data to */
/*        compute the requested state vector, the deficiency will */
/*        be diagnosed by a routine in the call tree of this routine. */

/*     4) If an error occurs while reading an SPK or other kernel file, */
/*        the error  will be diagnosed by a routine in the call tree */
/*        of this routine. */

/* $ Files */

/*     This routine computes states using SPK files that have been */
/*     loaded into the SPICE system, normally via the kernel loading */
/*     interface routine FURNSH. See the routine FURNSH and the SPK */
/*     and KERNEL Required Reading for further information on loading */
/*     (and unloading) kernels. */

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

/* $ Particulars */

/*     This routine is part of the user interface to the SPICE ephemeris */
/*     system. It allows you to retrieve state information for any */
/*     ephemeris object relative to any other in a reference frame that */
/*     is convenient for further computations. */

/*     This routine is identical in function to the routine SPKEZ except */
/*     that it allows you to refer to ephemeris objects by name (via a */
/*     character string). */


/*     Aberration corrections */
/*     ====================== */

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

/*     One-way light time */
/*     ------------------ */

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

/*     Stellar aberration */
/*     ------------------ */

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

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

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

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

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

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

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

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

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

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


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

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


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

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


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

/*              Use 'NONE'. */


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

/*              Use 'NONE'. */


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

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


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

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

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

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

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


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


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

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

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


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

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

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

/*        The ratio */

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

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

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

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

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

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

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

/*           T_vel(ET-LT)*(1-dLT/dET) - O_vel(ET) */

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

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

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

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

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

/*              h = r X v */

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

/*        When stellar aberration corrections are used, the rate of */
/*        change of the stellar aberration correction is accounted for */
/*        in the computation of the output velocity. */


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

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

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

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

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

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

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

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

/*           T_vel(ET+LT)*(1+dLT/dET) - O_vel(ET) */

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

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


/*     Precision of light time corrections */
/*     =================================== */

/*        Corrections using one iteration of the light time solution */
/*        ---------------------------------------------------------- */

/*        When the requested aberration correction is 'LT', 'LT+S', */
/*        'XLT', or 'XLT+S', only one iteration is performed in the */
/*        algorithm used to compute LT. */

/*        The relative error in this computation */

/*           | LT_ACTUAL - LT_COMPUTED |  /  LT_ACTUAL */

/*        is at most */

/*            (V/C)**2 */
/*           ---------- */
/*            1 - (V/C) */

/*        which is well approximated by (V/C)**2, where V is the */
/*        velocity of the target relative to an inertial frame and C is */
/*        the speed of light. */

/*        For nearly all objects in the solar system V is less than 60 */
/*        km/sec. The value of C is ~300000 km/sec. Thus the */
/*        one-iteration solution for LT has a potential relative error */
/*        of not more than 4e-8. This is a potential light time error of */
/*        approximately 2e-5 seconds per astronomical unit of distance */
/*        separating the observer and target. Given the bound on V cited */
/*        above: */

/*           As long as the observer and target are separated by less */
/*           than 50 astronomical units, the error in the light time */
/*           returned using the one-iteration light time corrections is */
/*           less than 1 millisecond. */

/*           The magnitude of the corresponding position error, given */
/*           the above assumptions, may be as large as (V/C)**2 * the */
/*           distance between the observer and the uncorrected target */
/*           position: 300 km or equivalently 6 km/AU. */

/*        In practice, the difference between positions obtained using */
/*        one-iteration and converged light time is usually much smaller */
/*        than the value computed above and can be insignificant. For */
/*        example, for the spacecraft Mars Reconnaissance Orbiter and */
/*        Mars Express, the position error for the one-iteration light */
/*        time correction, applied to the spacecraft-to-Mars center */
/*        vector, is at the 1 cm level. */

/*        Comparison of results obtained using the one-iteration and */
/*        converged light time solutions is recommended when adequacy of */
/*        the one-iteration solution is in doubt. */


/*        Converged corrections */
/*        --------------------- */

/*        When the requested aberration correction is 'CN', 'CN+S', */
/*        'XCN', or 'XCN+S', as many iterations as are required for */
/*        convergence are performed in the computation of LT. Usually */
/*        the solution is found after three iterations. The relative */
/*        error present in this case is at most */

/*            (V/C)**4 */
/*           ---------- */
/*            1 - (V/C) */

/*        which is well approximated by (V/C)**4. */

/*           The precision of this computation (ignoring round-off */
/*           error) is better than 4e-11 seconds for any pair of objects */
/*           less than 50 AU apart, and having speed relative to the */
/*           solar system barycenter less than 60 km/s. */

/*           The magnitude of the corresponding position error, given */
/*           the above assumptions, may be as large as (V/C)**4 * the */
/*           distance between the observer and the uncorrected target */
/*           position: 1.2 cm at 50 AU or equivalently 0.24 mm/AU. */

/*        However, to very accurately model the light time between */
/*        target and observer one must take into account effects due to */
/*        general relativity. These may be as high as a few hundredths */
/*        of a millisecond for some objects. */


/*     Relativistic Corrections */
/*     ========================= */

/*     This routine does not attempt to perform either general or */
/*     special relativistic corrections in computing the various */
/*     aberration corrections. For many applications relativistic */
/*     corrections are not worth the expense of added computation */
/*     cycles. If however, your application requires these additional */
/*     corrections we suggest you consult the astronomical almanac (page */
/*     B36) for a discussion of how to carry out these corrections. */


/* $ Examples */

/*     1)  Load a planetary ephemeris SPK, then look up a series of */
/*         geometric states of the moon relative to the earth, */
/*         referenced to the J2000 frame. */


/*               IMPLICIT NONE */
/*         C */
/*         C     Local constants */
/*         C */
/*               CHARACTER*(*)         FRAME */
/*               PARAMETER           ( FRAME  = 'J2000' ) */

/*               CHARACTER*(*)         ABCORR */
/*               PARAMETER           ( ABCORR = 'NONE' ) */

/*         C */
/*         C     The name of the SPK file shown here is fictitious; */
/*         C     you must supply the name of an SPK file available */
/*         C     on your own computer system. */
/*         C */
/*               CHARACTER*(*)         SPK */
/*               PARAMETER           ( SPK    = 'planet.bsp' ) */

/*         C */
/*         C     ET0 represents the date 2000 Jan 1 12:00:00 TDB. */
/*         C */
/*               DOUBLE PRECISION      ET0 */
/*               PARAMETER           ( ET0    = 0.0D0 ) */

/*         C */
/*         C     Use a time step of 1 hour; look up 100 states. */
/*         C */
/*               DOUBLE PRECISION      STEP */
/*               PARAMETER           ( STEP   = 3600.0D0 ) */

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

/*               CHARACTER*(*)         OBSRVR */
/*               PARAMETER           ( OBSRVR = 'Earth' ) */

/*               CHARACTER*(*)         TARGET */
/*               PARAMETER           ( TARGET = 'Moon' ) */

/*         C */
/*         C     Local variables */
/*         C */
/*               DOUBLE PRECISION      ET */
/*               DOUBLE PRECISION      LT */
/*               DOUBLE PRECISION      STATE ( 6 ) */

/*               INTEGER               I */

/*         C */
/*         C     Load the SPK file. */
/*         C */
/*               CALL FURNSH ( SPK ) */

/*         C */
/*         C     Step through a series of epochs, looking up a */
/*         C     state vector at each one. */
/*         C */
/*               DO I = 1, MAXITR */

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

/*                  CALL SPKEZR ( TARGET, ET, FRAME, ABCORR, OBSRVR, */
/*              .                 STATE,  LT                        ) */

/*                  WRITE (*,*) 'ET = ', ET */
/*                  WRITE (*,*) 'J2000 x-position (km):   ', STATE(1) */
/*                  WRITE (*,*) 'J2000 y-position (km):   ', STATE(2) */
/*                  WRITE (*,*) 'J2000 z-position (km):   ', STATE(3) */
/*                  WRITE (*,*) 'J2000 x-velocity (km/s): ', STATE(4) */
/*                  WRITE (*,*) 'J2000 y-velocity (km/s): ', STATE(5) */
/*                  WRITE (*,*) 'J2000 z-velocity (km/s): ', STATE(6) */
/*                  WRITE (*,*) ' ' */

/*               END DO */

/*               END */


/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     SPK Required Reading. */

/* $ Author_and_Institution */

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

/* $ Version */

/* -    SPICELIB Version 4.1.0, 03-JUL-2014 (NJB) (BVS) */

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

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

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

/* -    SPICELIB Version 4.0.0, 27-DEC-2007 (NJB) */

/*        This routine was upgraded to more accurately compute */
/*        aberration-corrected velocity, and in particular, make it */
/*        more consistent with observer-target positions. */

/*        When light time corrections are used, the derivative of light */
/*        time with respect to time is now accounted for in the */
/*        computation of observer-target velocities. When the reference */
/*        frame associated with the output state is time-dependent, the */
/*        derivative of light time with respect to time is now accounted */
/*        for in the computation of the rate of change of orientation of */
/*        the reference frame. */

/*        When stellar aberration corrections are used, velocities */
/*        now reflect the rate of range of the stellar aberration */
/*        correction. */

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

/*        Added mention that LT returns in seconds. */

/* -    SPICELIB Version 3.0.1, 29-JUL-2003 (NJB) (CHA) */

/*        Various minor header changes were made to improve clarity. */

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

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

/* -    Spicelib Version 2.0.0, 21-FEB-1997 (WLT) */

/*        Extended the functionality of the routine. Users may */
/*        now entered the id code of an object as an ascii string */
/*        and the string will be converted to the corresponding */
/*        integer representation. */

/* -    Spicelib Version 1.1.0, 09-JUL-1996 (WLT) */

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

/* -    SPICELIB Version 1.0.0, 25-SEP-1995 (BVS) */

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

/*     using body names get target state relative to an observer */
/*     get state relative to observer corrected for aberrations */
/*     read ephemeris data */
/*     read trajectory data */

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

/*     None. */

/* -& */


/*     SPICELIB functions */


/*     Saved body name length. */


/*     Local variables */


/*     Saved name/ID item declarations. */


/*     Saved name/ID items. */


/*     Initial values. */


/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counters. */

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

/*     Starting from translation of target name to its code */

    zzbods2c_(svctr1, svtarg, &svtgid, &svfnd1, targ, &targid, &found, (
	    ftnlen)36, targ_len);
    if (! found) {
	setmsg_("The target, '#', is not a recognized name for an ephemeris "
		"object. The cause of this problem may be that you need an up"
		"dated version of the SPICE Toolkit. Alternatively you may ca"
		"ll SPKEZ directly if you know the SPICE ID codes for both '#"
		"' and '#' ", (ftnlen)249);
	errch_("#", targ, (ftnlen)1, targ_len);
	errch_("#", targ, (ftnlen)1, targ_len);
	errch_("#", obs, (ftnlen)1, obs_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("SPKEZR", (ftnlen)6);
	return 0;
    }

/*     Now do the same for observer */

    zzbods2c_(svctr2, svobsn, &svobsi, &svfnd2, obs, &obsid, &found, (ftnlen)
	    36, obs_len);
    if (! found) {
	setmsg_("The observer, '#', is not a recognized name for an ephemeri"
		"s object. The cause of this problem may be that you need an "
		"updated version of the SPICE toolkit. Alternatively you may "
		"call SPKEZ directly if you know the SPICE ID codes for both "
		"'#' and '#' ", (ftnlen)251);
	errch_("#", obs, (ftnlen)1, obs_len);
	errch_("#", targ, (ftnlen)1, targ_len);
	errch_("#", obs, (ftnlen)1, obs_len);
	sigerr_("SPICE(IDCODENOTFOUND)", (ftnlen)21);
	chkout_("SPKEZR", (ftnlen)6);
	return 0;
    }

/*     After all translations are done we can call SPKEZ. */

    spkez_(&targid, et, ref, abcorr, &obsid, starg, lt, ref_len, abcorr_len);
    chkout_("SPKEZR", (ftnlen)6);
    return 0;
} /* spkezr_ */
Exemplo n.º 5
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.º 6
0
/* $Procedure    LSPCN  ( Longitude of the sun, planetocentric ) */
doublereal lspcn_(char *body, doublereal *et, char *abcorr, ftnlen body_len, 
	ftnlen abcorr_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2;
    doublereal ret_val;

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

    /* Local variables */
    extern /* Subroutine */ int zzbods2c_(integer *, char *, integer *, 
	    logical *, char *, integer *, logical *, ftnlen, ftnlen);
    doublereal tipm[9]	/* was [3][3] */;
    extern /* Subroutine */ int zzctruin_(integer *);
    integer i__;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    logical found;
    doublereal uavel[3], npole[3], trans[9]	/* was [3][3] */;
    extern /* Subroutine */ int ucrss_(doublereal *, doublereal *, doublereal 
	    *);
    static logical svfnd1;
    static integer svctr1[2];
    extern logical failed_(void);
    integer idcode;
    doublereal lt;
    extern /* Subroutine */ int recrad_(doublereal *, doublereal *, 
	    doublereal *, doublereal *);
    static integer svidcd;
    extern /* Subroutine */ int tipbod_(char *, integer *, doublereal *, 
	    doublereal *, ftnlen);
    doublereal bstate[6], radius;
    extern /* Subroutine */ int spkgeo_(integer *, doublereal *, char *, 
	    integer *, doublereal *, doublereal *, ftnlen), sigerr_(char *, 
	    ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
    doublereal sstate[6];
    static char svbody[36];
    extern /* Subroutine */ int twovec_(doublereal *, integer *, doublereal *,
	     integer *, doublereal *);
    extern logical return_(void);
    extern /* Subroutine */ int spkezr_(char *, doublereal *, char *, char *, 
	    char *, doublereal *, doublereal *, ftnlen, ftnlen, ftnlen, 
	    ftnlen);
    doublereal lat, pos[3];
    extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
	    ;

/* $ Abstract */

/*     Compute L_s, the planetocentric longitude of the sun, as seen */
/*     from a specified body. */

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*     NAIF_IDS */
/*     PCK */
/*     TIME */
/*     SPK */

/* $ Keywords */

/*     GEOMETRY */
/*     TIME */

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

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

/* $ Disclaimer */

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

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     BODY       I   Name of central body. */
/*     ET         I   Epoch in seconds past J2000 TDB. */
/*     ABCORR     I   Aberration correction. */

/*     The function returns the value of L_s for the specified body */
/*     at the specified time. */

/* $ Detailed_Input */

/*     BODY        is the name of the central body, typically a planet. */

/*     ET          is the epoch at which the longitude of the sun (L_s) */
/*                 is to be computed. ET is expressed as seconds past */
/*                 J2000 TDB (Barycentric Dynamical Time). */

/*     ABCORR      indicates the aberration corrections to be applied */
/*                 when computing the longitude of the sun.  ABCORR may */
/*                 be any of the following. */

/*                    'NONE'     Apply no correction. */

/*                    'LT'       Correct the position of the sun, */
/*                               relative to the central body, for */
/*                               planetary (light time) aberration. */

/*                    'LT+S'     Correct the position of the sun, */
/*                               relative to the central body, for */
/*                               planetary and stellar aberrations. */

/* $ Detailed_Output */

/*     The function returns the planetocentric longitude of the sun, */
/*     often called "L_s," for the specified body at the specified time. */
/*     This is the longitude of the body-sun vector in a right-handed */
/*     frame whose basis vectors are defined as follows: */

/*        - The positive Z direction is given by the instantaneous */
/*          angular velocity vector of the orbit of the body about */
/*          the sun. */

/*        - The positive X direction is that of the cross product of the */
/*          instantaneous north spin axis of the body with the positive */
/*          Z direction. */

/*        - The positive Y direction is Z x X. */

/*     Units are radians; the range is 0 to 2*pi.  Longitudes are */
/*     positive to the east. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1) If the input body name cannot be translated to an ID code, */
/*        and if the name is not a string representation of an integer */
/*        (for example, '399'), the error SPICE(NOTRANSLATION) is */
/*        signaled. */

/*     2) If no SPK (ephemeris) file has been loaded prior to calling */
/*        this routine, or if the SPK data has insufficient coverage, an */
/*        error will be diagnosed and signaled by a routine in the call */
/*        tree of this routine. */

/*     3) If a PCK file containing rotational elements for the central */
/*        body has not been loaded prior to calling this routine, an */
/*        error will be diagnosed and signaled by a routine called by a */
/*        routine in the call tree of this routine. */

/*     4) If the instantaneous angular velocity and spin axis of BODY */
/*        are parallel, the error will be diagnosed and signaled by a */
/*        routine in the call tree of this routine. */

/* $ Files */

/*     1) An SPK file (or file) containing ephemeris data sufficient to */
/*        compute the geometric state of the central body relative to */
/*        the sun at ET must be loaded before this routine is called. If */
/*        light time correction is used, data must be available that */
/*        enable computation of the state the sun relative to the solar */
/*        system barycenter at the light-time corrected epoch.  If */
/*        stellar aberration correction is used, data must be available */
/*        that enable computation of the state the central body relative */
/*        to the solar system barycenter at ET. */

/*     2) A PCK file containing rotational elements for the central body */
/*        must be loaded before this routine is called. */

/* $ Particulars */

/*     The direction of the vernal equinox for the central body is */
/*     determined from the instantaneous equatorial and orbital planes */
/*     of the central body.  This equinox definition is specified in */
/*     reference [1].  The "instantaneous orbital plane" is interpreted */
/*     in this routine as the plane normal to the cross product of the */
/*     position and velocity of the central body relative to the sun. */
/*     The geometric state of the central body relative to the sun is */
/*     used for this normal vector computation. The "instantaneous */
/*     equatorial plane" is normal to the central body's north pole */
/*     at the requested epoch.  The pole direction is determined from */
/*     rotational elements loaded via a PCK file. */

/*     The result returned by this routine will depend on the */
/*     ephemeris data and rotational elements used.  The result may */
/*     differ from that given in any particular version of the */
/*     Astronomical Almanac, due to differences in these input data, */
/*     and due to differences in precision of the computations. */

/* $ Examples */

/*     1) A simple program that computes L_s for a body and time */
/*        supplied interactively.  The geometric state of the sun is */
/*        used. */


/*            PROGRAM EX1 */
/*            IMPLICIT NONE */

/*            DOUBLE PRECISION      DPR */
/*            DOUBLE PRECISION      LSPCN */

/*            CHARACTER*(*)         ABCORR */
/*            PARAMETER           ( ABCORR = 'NONE' ) */

/*            INTEGER               FILSIZ */
/*            PARAMETER           ( FILSIZ = 255 ) */

/*            INTEGER               NAMLEN */
/*            PARAMETER           ( NAMLEN = 36 ) */

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

/*            CHARACTER*(NAMLEN)    BODY */
/*            CHARACTER*(FILSIZ)    LSK */
/*            CHARACTER*(FILSIZ)    PCK */
/*            CHARACTER*(FILSIZ)    SPK */
/*            CHARACTER*(TIMLEN)    TIMSTR */

/*            DOUBLE PRECISION      ET */
/*            DOUBLE PRECISION      LON */


/*            CALL PROMPT ( 'Enter name of leapseconds kernel > ', LSK ) */
/*            CALL PROMPT ( 'Enter name of PCK file           > ', PCK ) */
/*            CALL PROMPT ( 'Enter name of SPK file           > ', SPK ) */

/*            CALL FURNSH ( LSK ) */
/*            CALL FURNSH ( PCK ) */
/*            CALL FURNSH ( SPK ) */

/*            WRITE (*,*) ' ' */
/*            WRITE (*,*) 'Kernels have been loaded.' */
/*            WRITE (*,*) ' ' */

/*            DO WHILE ( .TRUE. ) */

/*               CALL PROMPT ( 'Enter name of central body       > ', */
/*           .                  BODY                                  ) */
/*               CALL PROMPT ( 'Enter calendar, JD, or DOY time  > ', */
/*           .                  TIMSTR                                ) */

/*               CALL STR2ET ( TIMSTR, ET ) */

/*      C */
/*      C        Convert longitude to degrees. */
/*      C */
/*               LON = DPR() * LSPCN ( BODY, ET, ABCORR ) */

/*               WRITE (*,*) ' ' */
/*               WRITE (*,*) 'Central body              = ',  BODY */
/*               WRITE (*,*) 'Time                      = ',  TIMSTR */
/*               WRITE (*,*) 'Planetocentric L_s (deg.) = ',  LON */
/*               WRITE (*,*) ' ' */

/*            END DO */

/*            END */

/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     [1] "The Astronomical Almanac for the Year 2005." U.S. Government */
/*         Printing Office, Washington, D.C., 1984, page L9. */

/* $ Author_and_Institution */

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

/* $ Version */

/* -    SPICELIB Version 1.1.0, 19-SEP-2013 (BVS) */

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

/* -    SPICELIB Version 1.0.0, 07-JAN-2005 (NJB) */

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

/*     planetocentric longitude of sun */
/*     compute L_s */
/*     compute Ls */
/*     compute L_sub_s */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Saved body name length. */


/*     Local variables */


/*     Saved name/ID item declarations. */


/*     Saved name/ID items. */


/*     Initial values. */


/*     Give the function an initial value. */

    ret_val = 0.;

/*     Standard SPICE error handling. */

    if (return_()) {
	return ret_val;
    }
    chkin_("LSPCN", (ftnlen)5);

/*     Initialization. */

    if (first) {

/*        Initialize counters */

	zzctruin_(svctr1);
	first = FALSE_;
    }

/*     Map the body name to an ID code. */

    zzbods2c_(svctr1, svbody, &svidcd, &svfnd1, body, &idcode, &found, (
	    ftnlen)36, body_len);
    if (! found) {
	setmsg_("The body name # could not be translated to a NAIF ID code. "
		" The cause of this problem may be that you need an updated v"
		"ersion of the SPICE Toolkit.", (ftnlen)147);
	errch_("#", body, (ftnlen)1, body_len);
	sigerr_("SPICE(NOTRANSLATION)", (ftnlen)20);
	chkout_("LSPCN", (ftnlen)5);
	return ret_val;
    }

/*     Look up the direction of the North pole of the central body. */
/*     Note that TIPBOD does make use of binary PCK data if available. */

    tipbod_("J2000", &idcode, et, tipm, (ftnlen)5);
    for (i__ = 1; i__ <= 3; ++i__) {
	npole[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("npole", i__1,
		 "lspcn_", (ftnlen)397)] = tipm[(i__2 = i__ * 3 - 1) < 9 && 0 
		<= i__2 ? i__2 : s_rnge("tipm", i__2, "lspcn_", (ftnlen)397)];
    }

/*     Get the geometric state of the body relative to the sun. */

    spkgeo_(&idcode, et, "J2000", &c__10, bstate, &lt, (ftnlen)5);

/*     Get the unit direction vector parallel to the angular velocity */
/*     vector of the orbit.  This is just the unitized cross product of */
/*     position and velocity. */

    ucrss_(bstate, &bstate[3], uavel);

/*     We want to create a transformation matrix that maps vectors from */
/*     basis REF to the following frame: */
/*        Z  =  UAVEL */

/*        X  =  NPOLE x UAVEL */

/*        Y  =  Z x X */

/*     This is a "two-vector" frame with the unit orbital */
/*     angular velocity vector UAVEL as the primary vector and the */
/*     spin axis NPOLE as the secondary vector.  The primary */
/*     vector is associated with the +Z axis; the secondary vector */
/*     is associated with the +Y axis. */

    twovec_(uavel, &c__3, npole, &c__2, trans);
    if (failed_()) {
	chkout_("LSPCN", (ftnlen)5);
	return ret_val;
    }

/*     We'll find the position of the Sun relative to this frame. */

/*     Get the state of the sun in frame REF.  Since we may be using */
/*     aberration corrections, this is not necessarily the negative of */
/*     the state we've just found. */

    spkezr_("SUN", et, "J2000", abcorr, body, sstate, &lt, (ftnlen)3, (ftnlen)
	    5, abcorr_len, body_len);

/*     Now transform the position of the Sun into the "orbit plane */
/*     and equinox" frame. */

    mxv_(trans, sstate, pos);

/*     Let RECRAD find the longitude LS for us.  RECRAD performs */
/*     the same coordinate transformation as the more commonly used */
/*     RECLAT, but the range of right ascension is 0:2*pi, which is */
/*     what we want for Ls. */

    recrad_(pos, &radius, &ret_val, &lat);
    chkout_("LSPCN", (ftnlen)5);
    return ret_val;
} /* lspcn_ */
Exemplo n.º 7
0
Arquivo: pxfrm2.c Projeto: Dbelsa/coft
/* $Procedure      PXFRM2 ( Position Transform Matrix, Different Epochs ) */
/* Subroutine */ int pxfrm2_(char *from, char *to, doublereal *etfrom, 
	doublereal *etto, doublereal *rotate, ftnlen from_len, ftnlen to_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    static char svto[32];
    extern /* Subroutine */ int zznamfrm_(integer *, char *, integer *, char *
	    , integer *, ftnlen, ftnlen), zzctruin_(integer *);
    integer fcode;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer tcode;
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    doublereal jf[9]	/* was [3][3] */;
    static integer svctr1[2], svctr2[2];
    doublereal tj[9]	/* was [3][3] */;
    extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, 
	    doublereal *);
    static integer svfcod, svtcde;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen);
    static char svfrom[32];
    extern logical return_(void);
    extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
	    ;

/* $ Abstract */

/*     Return the 3x3 matrix that transforms position vectors from one */
/*     specified frame at a specified epoch to another specified */
/*     frame at another specified epoch. */

/* $ Disclaimer */

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

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

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

/* $ Required_Reading */

/*     FRAMES */

/* $ Keywords */

/*     FRAMES */
/*     TRANSFORM */

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

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

/* $ Disclaimer */

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

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

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

/* $ Parameters */

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

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

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

/* -& */

/*     End of include file. */

/* $ Brief_I/O */

/*     VARIABLE  I/O  DESCRIPTION */
/*     --------  ---  -------------------------------------------------- */
/*     FROM       I   Name of the frame to transform from. */
/*     TO         I   Name of the frame to transform to. */
/*     ETFROM     I   Evaluation time of 'FROM' frame. */
/*     ETTO       I   Evaluation time of 'TO' frame. */
/*     ROTATE     O   A position transformation matrix from */
/*                    frame FROM to frame TO. */

/* $ Detailed_Input */

/*     FROM       is the name of a reference frame recognized by */
/*                SPICELIB that corresponds to the input ETFROM. */


/*     TO         is the name of a reference frame recognized by */
/*                SPICELIB that corresponds to the desired output */
/*                at ETTO. */


/*     ETFROM     is the epoch in ephemeris seconds past the epoch */
/*                of J2000 (TDB) corresponding to the FROM reference */
/*                frame. */


/*     ETTO       is the epoch in ephemeris seconds past the epoch */
/*                of J2000 (TDB) that corresponds to the TO reference */
/*                frame. */


/* $ Detailed_Output */

/*     ROTATE     is the transformation matrix that relates the reference */
/*                frame FROM at epoch ETFROM to the frame TO at epoch */
/*                ETTO. */

/*                If (x, y, z) is a position relative to the reference */
/*                frame FROM at time ETFROM then the vector ( x', y', */
/*                z') is the same position relative to the frame TO at */
/*                epoch ETTO. Here the vector ( x', y', z' ) is defined */
/*                by the equation: */

/*                   -   -       -        -     -  - */
/*                  | x'  |     |          |   | x  | */
/*                  | y'  |  =  |  ROTATE  |   | y  | */
/*                  | z'  |     |          |   | z  | */
/*                   -   -       -        -     -  - */

/* $ Parameters */

/*     None. */


/* $ Exceptions */

/*     1)  If sufficient information has not been supplied via loaded */
/*         SPICE kernels to compute the transformation between the */
/*         two frames, the error will be diagnosed by a routine */
/*         in the call tree to this routine. */

/*     2)  If either frame FROM or TO is not recognized the error */
/*         'SPICE(UNKNOWNFRAME)' will be signaled. */

/* $ Files */

/*     Appropriate kernels must be loaded by the calling program before */
/*     this routine is called.  Kernels that may be required include */
/*     SPK files, PCK files, frame kernels, C-kernels, and SCLK kernels. */

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

/* $ Particulars */

/*     PXFRM2 is most commonly used to transform a position between */
/*     time-dependant reference frames. */

/*     For more examples of where to use PXFRM2, please see: */

/*           SINCPT */
/*           SURFPT */
/*           SUBSLR */
/*           ILUMIN */

/* $ Examples */

/*     The numerical results shown for these examples may differ across */
/*     platforms. The results depend on the SPICE kernels used as */
/*     input, the compiler and supporting libraries, and the machine */
/*     specific arithmetic implementation. */

/*     1) Suppose that MGS has taken a picture of Mars at time ETREC with */
/*        the MOC narrow angle camera. We want to know the latitude and */
/*        longitude associated with two pixels projected to Mars' */
/*        surface: the boresight and one along the boundary of the */
/*        field of view (FOV). Due to light time, the photons taken in */
/*        the picture left Mars at time ETEMIT, when Mars was at a */
/*        different state than at time ETREC. */

/*        In order to solve this problem, we could use the SINCPT */
/*        routine for both pixels, but this would be slow.  Instead, we */
/*        will assume that the light time for each pixel is the same. We */
/*        will call SINCPT once to get the light time and surface point */
/*        associated with the boresight. Then, we will rotate one of the */
/*        FOV boundary vectors from the camera frame at ETREC to the */
/*        body-fixed Mars frame at ETEMIT, and call the faster routine */
/*        SURFPT to retrieve the surface point for one of the FOV */
/*        boundary vectors. */

/*        This example problem could be extended to find the latitude */
/*        and longitude associated with every pixel in an instrument's */
/*        field of view, but this example is simplified to only solve */
/*        for two pixels:  the boresight and one along the boundary of */
/*        the field of view. */

/*        Assumptions: */

/*           1)  The light times from the surface points in the camera's */
/*               field of view to the camera are equal. */

/*           2)  The camera offset from the center of gravity of the */
/*               spacecraft is zero. If the data are more accurate */
/*               and precise, this assumption can be easily discarded. */

/*           3)  An ellipsoid shape model for the target body is */
/*               sufficient. */

/*           4)  The boundary field of view vector returned from GETFOV */
/*               is associated with a boundary field of view pixel. If */
/*               this example were extended to include a geometric camera */
/*               model, this assumption would not be needed since the */
/*               direction vectors associated with each pixel would be */
/*               calculated from the geometric camera model. */

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

/*           KPL/MK */

/*           File name: mgs_ex.tm */

/*           This is the meta-kernel file for the example problem for */
/*           the subroutine PXFRM2. These kernel files can be found in */
/*           the NAIF archives. */

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

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

/*              File name                     Contents */
/*              ---------                     -------- */
/*              de421.bsp                     Planetary ephemeris */
/*              pck00009.tpc                  Planet orientation and */
/*                                            radii */
/*              naif0009.tls                  Leapseconds */
/*              mgs_ext12_ipng_mgs95j.bsp     MGS ephemeris */
/*              mgs_moc_v20.ti                MGS MOC instrument */
/*                                            parameters */
/*              mgs_sclkscet_00061.tsc        MGS SCLK coefficients */
/*              mgs_sc_ext12.bc               MGS s/c bus attitude */

/*           \begindata */

/*           KERNELS_TO_LOAD = ( 'de421.bsp', */
/*                               'pck00009.tpc', */
/*                               'naif0009.tls', */
/*                               'mgs_ext12_ipng_mgs95j.bsp', */
/*                               'mgs_moc_v20.ti', */
/*                               'mgs_sclkscet_00061.tsc', */
/*                               'mgs_sc_ext12.bc' ) */

/*           \begintext */

/*           End of meta-kernel. */


/*       Example code begins here. */

/*           PROGRAM EX_PXFRM2 */
/*           IMPLICIT NONE */
/*     C */
/*     C     SPICELIB functions */
/*     C */
/*     C     Degrees per radian */
/*     C */
/*           DOUBLE PRECISION      DPR */
/*     C */
/*     C     Distance between two vectors */
/*     C */
/*           DOUBLE PRECISION      VDIST */
/*     C */
/*     C     Local parameters */
/*     C */
/*     C     ABCORR is the desired light time and stellar */
/*     C     aberration correction setting. */
/*     C */
/*           CHARACTER*(*)         ABCORR */
/*           PARAMETER           ( ABCORR = 'CN+S' ) */
/*     C */
/*     C     MGS_MOC_NA is the name of the camera that took */
/*     C     the picture being analyzed. */
/*     C */
/*           CHARACTER*(*)         CAMERA */
/*           PARAMETER           ( CAMERA = 'MGS_MOC_NA' ) */

/*           CHARACTER*(*)         METAKR */
/*           PARAMETER           ( METAKR = 'mgs_ex.tm' ) */

/*           INTEGER               FRNMLN */
/*           PARAMETER           ( FRNMLN = 32 ) */

/*           INTEGER               NCORNR */
/*           PARAMETER           ( NCORNR = 4 ) */

/*           INTEGER               SHPLEN */
/*           PARAMETER           ( SHPLEN = 80 ) */

/*     C */
/*     C     Local variables */
/*     C */
/*     C     OBSREF is the observer reference frame on MGS. */
/*     C */
/*           CHARACTER*(FRNMLN)    OBSREF */
/*           CHARACTER*(SHPLEN)    SHAPE */

/*           DOUBLE PRECISION      BOUNDS ( 3, NCORNR ) */
/*           DOUBLE PRECISION      BNDVEC ( 3 ) */
/*           DOUBLE PRECISION      BSIGHT ( 3 ) */
/*     C */
/*     C     ETEMIT is the time at which the photons were */
/*     C     emitted from Mars.  ETREC is the time at */
/*     C     which the picture was taken by MGS. */
/*     C */
/*           DOUBLE PRECISION      ETREC */
/*           DOUBLE PRECISION      ETEMIT */
/*           DOUBLE PRECISION      DIST */
/*     C */
/*     C     LAT and LON are the latitude and longitude */
/*     C     associated with one of the boundary FOV vectors. */
/*     C */
/*           DOUBLE PRECISION      LAT */
/*           DOUBLE PRECISION      LON */
/*     C */
/*     C     PMGSMR is the opposite of the apparent position of */
/*     C     Mars with respect to MGS. */
/*     C */
/*           DOUBLE PRECISION      PMGSMR ( 3 ) */
/*     C */
/*     C     RADII is a vector of the semi-axes of Mars. */
/*     C */
/*           DOUBLE PRECISION      RADII  ( 3 ) */
/*           DOUBLE PRECISION      RADIUS */
/*     C */
/*     C     ROTATE is a position transformation matrix from */
/*     C     the camera frame at ETREC to the IAU_MARS frame */
/*     C     at ETEMIT. */
/*     C */
/*           DOUBLE PRECISION      ROTATE ( 3, 3 ) */
/*           DOUBLE PRECISION      SPOINT ( 3 ) */
/*           DOUBLE PRECISION      SRFVEC ( 3 ) */
/*           DOUBLE PRECISION      TMP    ( 3 ) */

/*           INTEGER               CAMID */
/*           INTEGER               DIM */
/*           INTEGER               N */

/*           LOGICAL               FOUND */
/*     C */
/*     C     ------------------ Program Setup ------------------ */
/*     C */
/*     C     Load kernel files via the meta-kernel. */
/*     C */
/*           CALL FURNSH ( METAKR ) */
/*     C */
/*     C     Convert the time the picture was taken from a */
/*     C     UTC time string to seconds past J2000, TDB. */
/*     C */
/*           CALL STR2ET ( '2003 OCT 13 06:00:00 UTC', ETREC ) */
/*     C */
/*     C     Assume the one-way light times from different */
/*     C     surface points on Mars to MGS within the camera's */
/*     C     FOV are equal. This means the photons that make */
/*     C     up different pixels were all emitted from Mars at */
/*     C     ETEMIT and received by the MGS MOC camera at ETREC. It */
/*     C     would be slow to process images using SINCPT for every */
/*     C     pixel. Instead, we will use SINCPT on the */
/*     C     boresight pixel and use SURFPT for one of the FOV */
/*     C     boundary pixels. If this example program were extended */
/*     C     to include all of the camera's pixels, SURFPT would */
/*     C     be used for the remaining pixels. */
/*     C */
/*     C     Get the MGS MOC Narrow angle camera (MGS_MOC_NA) */
/*     C     ID code. Then look up the field of view (FOV) */
/*     C     parameters by calling GETFOV. */
/*     C */
/*           CALL BODN2C ( CAMERA, CAMID, FOUND ) */

/*           IF ( .NOT. FOUND ) THEN */

/*              CALL SETMSG ( 'Could not find ID code for ' // */
/*          .                 'instrument #.'               ) */
/*              CALL ERRCH  ( '#', CAMERA                   ) */
/*              CALL SIGERR ( 'SPICE(NOTRANSLATION)'        ) */

/*           END IF */
/*     C */
/*     C     GETFOV will return the name of the camera-fixed frame */
/*     C     in the string OBSREF, the camera boresight vector in */
/*     C     the array BSIGHT, and the FOV corner vectors in the */
/*     C     array BOUNDS. */
/*     C */
/*           CALL GETFOV ( CAMID,  NCORNR, SHAPE, OBSREF, */
/*          .              BSIGHT, N,      BOUNDS       ) */

/*           WRITE (*,*) 'Observation Reference frame:  ', OBSREF */

/*     C */
/*     C     ----------- Boresight Surface Intercept ----------- */
/*     C */
/*     C     Retrieve the time, surface intercept point, and vector */
/*     C     from MGS to the boresight surface intercept point */
/*     C     in IAU_MARS coordinates. */
/*     C */
/*           CALL SINCPT ( 'ELLIPSOID', 'MARS',  ETREC, 'IAU_MARS', */
/*          .               ABCORR,     'MGS',   OBSREF, BSIGHT, */
/*          .               SPOINT,      ETEMIT, SRFVEC, FOUND  ) */

/*           IF ( .NOT. FOUND ) THEN */

/*              CALL SETMSG ( 'Intercept not found for the ' // */
/*          .                 'boresight vector.'  ) */
/*              CALL SIGERR ( 'SPICE(NOINTERCEPT)' ) */

/*           END IF */
/*     C */
/*     C     Convert the intersection point of the boresight */
/*     C     vector and Mars from rectangular into latitudinal */
/*     C     coordinates. Convert radians to degrees. */
/*     C */
/*           CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */

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

/*           WRITE (*,*) 'Boresight surface intercept ' // */
/*          .            'coordinates:' */
/*           WRITE (*,*) '   Radius    (km) :  ', RADIUS */
/*           WRITE (*,*) '   Latitude  (deg):  ', LAT */
/*           WRITE (*,*) '   Longitude (deg):  ', LON */

/*     C */
/*     C     --------- A Boundary FOV Surface Intercept (SURFPT) ------ */
/*     C */
/*     C     Now we will transform one of the FOV corner vectors into the */
/*     C     IAU_MARS frame so the surface intercept point can be */
/*     C     calculated using SURFPT, which is faster than SUBPNT. */
/*     C */
/*     C     If this example program were extended to include all */
/*     C     of the pixels in the camera's FOV, a few steps, such as */
/*     C     finding the rotation matrix from the camera frame to the */
/*     C     IAU_MARS frame, looking up the radii values for Mars, */
/*     C     and finding the position of MGS with respect to Mars could */
/*     C     be done once and used for every pixel. */
/*     C */
/*     C     Find the rotation matrix from the ray's reference */
/*     C     frame at the time the photons were received (ETREC) */
/*     C     to IAU_MARS at the time the photons were emitted */
/*     C     (ETEMIT). */
/*     C */
/*           CALL PXFRM2 ( OBSREF, 'IAU_MARS', ETREC, ETEMIT, ROTATE ) */

/*     C */
/*     C     Look up the radii values for Mars. */
/*     C */
/*           CALL BODVRD ( 'MARS', 'RADII', 3, DIM, RADII ) */

/*     C */
/*     C     Find the position of the center of Mars with respect */
/*     C     to MGS.  The position of the observer with respect */
/*     C     to Mars is required for the call to SURFPT.  Note: */
/*     C     the apparent position of MGS with respect to Mars is */
/*     C     not the same as the negative of Mars with respect to MGS. */
/*     C */
/*           CALL VSUB   ( SPOINT, SRFVEC, PMGSMR ) */

/*     C */
/*     C     The selected boundary FOV pixel must be rotated into the */
/*     C     IAU_MARS reference frame. */
/*     C */
/*           CALL MXV    ( ROTATE, BOUNDS(1,1), BNDVEC ) */

/*     C */
/*     C     Calculate the surface point of the boundary FOV */
/*     C     vector. */
/*     C */
/*           CALL SURFPT ( PMGSMR,   BNDVEC, RADII(1), RADII(2), */
/*          .              RADII(3), SPOINT, FOUND ) */

/*           IF ( .NOT. FOUND ) THEN */

/*              CALL SETMSG ( 'Could not calculate surface point.') */
/*              CALL SIGERR ( 'SPICE(NOTFOUND)' ) */

/*           END IF */

/*           CALL VEQU   ( SPOINT, TMP ) */
/*     C */
/*     C     Convert the intersection point of the boundary */
/*     C     FOV vector and Mars from rectangular into */
/*     C     latitudinal coordinates. Convert radians */
/*     C     to degrees. */
/*     C */
/*           CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */

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

/*           WRITE (*,*) 'Boundary vector surface intercept ' // */
/*          .               'coordinates using SURFPT:' */
/*           WRITE (*,*) '   Radius    (km) :  ', RADIUS */
/*           WRITE (*,*) '   Latitude  (deg):  ', LAT */
/*           WRITE (*,*) '   Longitude (deg):  ', LON */
/*           WRITE (*,*) '   Emit time using' */
/*           WRITE (*,*) '   boresight LT(s):  ', ETEMIT */

/*     C */
/*     C     ------ A Boundary FOV Surface Intercept Verification ---- */
/*     C */
/*     C     For verification only, we will calculate the surface */
/*     C     intercept coordinates for the selected boundary vector */
/*     C     using SINCPT and compare to the faster SURFPT method. */
/*     C */
/*           CALL SINCPT ( 'ELLIPSOID', 'MARS',  ETREC, 'IAU_MARS', */
/*          .               ABCORR,     'MGS',   OBSREF, BOUNDS(1,1), */
/*          .               SPOINT,      ETEMIT, SRFVEC, FOUND ) */

/*           IF ( .NOT. FOUND ) THEN */

/*              CALL SETMSG ( 'Intercept not found for the ' // */
/*          .                 'boresight vector.'  ) */
/*              CALL SIGERR ( 'SPICE(NOINTERCEPT)' ) */

/*           END IF */
/*     C */
/*     C     Convert the intersection point of the selected boundary */
/*     C     vector and Mars from rectangular into latitudinal */
/*     C     coordinates. Convert radians to degrees. */
/*     C */
/*           CALL RECLAT ( SPOINT, RADIUS, LON, LAT ) */

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

/*           WRITE (*,*) 'Boundary vector surface intercept ' // */
/*          .               'coordinates using SINCPT:' */
/*           WRITE (*,*) '   Radius    (km) :  ', RADIUS */
/*           WRITE (*,*) '   Latitude  (deg):  ', LAT */
/*           WRITE (*,*) '   Longitude (deg):  ', LON */
/*           WRITE (*,*) '   Emit time using' */
/*           WRITE (*,*) '   boundary LT(s) :  ', ETEMIT */

/*     C */
/*     C     We expect this to be a very small distance. */
/*     C */
/*           DIST = VDIST ( TMP, SPOINT ) */

/*           WRITE (*,*) 'Distance between surface points' */
/*           WRITE (*,*) 'of the selected boundary vector using' */
/*           WRITE (*,*) 'SURFPT and SINCPT:' */
/*           WRITE (*,*) '   Distance (mm):     ', DIST*(10**6) */

/*           END */

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

/*           Observation Reference frame:  MGS_MOC_NA */
/*           Boresight surface intercept coordinates: */
/*              Radius    (km) :     3384.9404101592791 */
/*              Latitude  (deg):    -48.479579821639035 */
/*              Longitude (deg):    -123.43645396290199 */
/*           Boundary vector surface intercept coordinates using SURFPT: */
/*              Radius    (km) :     3384.9411359300038 */
/*              Latitude  (deg):    -48.477481877892437 */
/*              Longitude (deg):    -123.47407986665237 */
/*              Emit time using */
/*              boresight LT(s):     119296864.18105948 */
/*           Boundary vector surface intercept coordinates using SINCPT: */
/*              Radius    (km) :     3384.9411359139663 */
/*              Latitude  (deg):    -48.477481924252693 */
/*              Longitude (deg):    -123.47407904898704 */
/*              Emit time using */
/*              boundary LT(s) :     119296864.18105946 */
/*           Distance between surface points */
/*           of the selected boundary vector using */
/*           SURFPT and SINCPT: */
/*              Distance (mm):       32.139879867352690 */


/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

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

/* $ Version */

/* -    SPICELIB Version 1.0.0, 23-SEP-2013 (SCK) (WLT) (BVS) */

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

/*     Position transformation matrix for different epochs */

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

/*     None. */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*     JCODE represents the NAIF ID of the J2000 reference frame. */
/*     The J2000 frame has a NAIF ID of 1. Any inertial reference */
/*     frame could have been used for this program instead of J2000. */


/*     Saved frame name length. */


/*     Local variables */


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


/*     Saved frame name/ID items. */


/*     Initial values. */


/*     Standard SPICE error handling. */

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

/*     Initialization. */

    if (first) {

/*        Initialize counters. */

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

/*     The frame names must be converted to their corresponding IDs. */

    zznamfrm_(svctr1, svfrom, &svfcod, from, &fcode, (ftnlen)32, from_len);
    zznamfrm_(svctr2, svto, &svtcde, to, &tcode, (ftnlen)32, to_len);

/*     Only non-zero ID codes are legitimate frame ID codes.  Zero */
/*     indicates that the frame was not recognized. */

    if (fcode != 0 && tcode != 0) {

/*        The following three lines of code calculate the following: */

/*        1)  [JF]      The rotation matrix is calculated from the frame */
/*                          FROM to the inertial J2000 frame at ETFROM. */
/*        2)  [TJ]      The rotation matrix is calculated from the J2000 */
/*                          frame to the TO frame at ETTO. */
/*        3)  [ROTATE]  The rotation matrix from frame FROM at ETFROM to */
/*                          frame TO at ETTO is given by the following: */

/*                              [ROTATE] = [TF] = [TJ][JF] */

	refchg_(&fcode, &c__1, etfrom, jf);
	refchg_(&c__1, &tcode, etto, tj);
	mxm_(tj, jf, rotate);
    } else if (fcode == 0 && tcode == 0) {
	setmsg_("Neither frame # nor # was recognized as a known reference f"
		"rame. ", (ftnlen)65);
	errch_("#", from, (ftnlen)1, from_len);
	errch_("#", to, (ftnlen)1, to_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
    } else if (fcode == 0) {
	setmsg_("The frame # was not recognized as a known reference frame. ",
		 (ftnlen)59);
	errch_("#", from, (ftnlen)1, from_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
    } else {

/*        TCODE is zero */

	setmsg_("The frame # was not recognized as a known reference frame. ",
		 (ftnlen)59);
	errch_("#", to, (ftnlen)1, to_len);
	sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19);
    }
    chkout_("PXFRM2", (ftnlen)6);
    return 0;
} /* pxfrm2_ */
Exemplo n.º 8
0
/* $Procedure      CKGP ( C-kernel, get pointing ) */
/* Subroutine */ int ckgp_(integer *inst, doublereal *sclkdp, doublereal *tol,
	 char *ref, doublereal *cmat, doublereal *clkout, logical *found, 
	ftnlen ref_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    logical pfnd, sfnd;
    integer sclk;
    extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *),
	     zznamfrm_(integer *, char *, integer *, char *, integer *, 
	    ftnlen, ftnlen);
    integer type1, type2;
    extern /* Subroutine */ int zzctruin_(integer *);
    char segid[40];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal descr[5];
    extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *, 
	    doublereal *, integer *), ckbss_(integer *, doublereal *, 
	    doublereal *, logical *), ckpfs_(integer *, doublereal *, 
	    doublereal *, doublereal *, logical *, doublereal *, doublereal *,
	     doublereal *, logical *), moved_(doublereal *, integer *, 
	    doublereal *), cksns_(integer *, doublereal *, char *, logical *, 
	    ftnlen);
    static char svref[32];
    logical gotit;
    static integer svctr1[2];
    extern logical failed_(void);
    doublereal av[3], et;
    integer handle;
    extern /* Subroutine */ int refchg_(integer *, integer *, doublereal *, 
	    doublereal *);
    logical needav;
    extern /* Subroutine */ int ckmeta_(integer *, char *, integer *, ftnlen);
    integer refseg, center;
    extern /* Subroutine */ int frinfo_(integer *, integer *, integer *, 
	    integer *, logical *);
    integer refreq, typeid;
    extern /* Subroutine */ int chkout_(char *, ftnlen);
    doublereal tmpmat[9]	/* was [3][3] */;
    static integer svrefr;
    extern logical return_(void);
    doublereal dcd[2];
    integer icd[6];
    extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
	    ;
    doublereal rot[9]	/* was [3][3] */;

/* $ Abstract */

/*     Get pointing (attitude) for a specified spacecraft clock time. */

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

/*     CK */
/*     SCLK */

/* $ Keywords */

/*     POINTING */

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

/*     The parameters below form an enumerated list of the recognized */
/*     frame types.  They are: INERTL, PCK, CK, TK, DYN.  The meanings */
/*     are outlined below. */

/* $ Disclaimer */

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

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

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

/* $ Parameters */

/*     INERTL      an inertial frame that is listed in the routine */
/*                 CHGIRF and that requires no external file to */
/*                 compute the transformation from or to any other */
/*                 inertial frame. */

/*     PCK         is a frame that is specified relative to some */
/*                 INERTL frame and that has an IAU model that */
/*                 may be retrieved from the PCK system via a call */
/*                 to the routine TISBOD. */

/*     CK          is a frame defined by a C-kernel. */

/*     TK          is a "text kernel" frame.  These frames are offset */
/*                 from their associated "relative" frames by a */
/*                 constant rotation. */

/*     DYN         is a "dynamic" frame.  These currently are */
/*                 parameterized, built-in frames where the full frame */
/*                 definition depends on parameters supplied via a */
/*                 frame kernel. */

/*     ALL         indicates any of the above classes. This parameter */
/*                 is used in APIs that fetch information about frames */
/*                 of a specified class. */


/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 4.0.0, 08-MAY-2012 (NJB) */

/*       The parameter ALL was added to support frame fetch APIs. */

/* -    SPICELIB Version 3.0.0, 28-MAY-2004 (NJB) */

/*       The parameter DYN was added to support the dynamic frame class. */

/* -    SPICELIB Version 2.0.0, 12-DEC-1996 (WLT) */

/*        Various unused frames types were removed and the */
/*        frame time TK was added. */

/* -    SPICELIB Version 1.0.0, 10-DEC-1995 (WLT) */

/* -& */

/*     End of INCLUDE file frmtyp.inc */

/* $ 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 */
/*     --------  ---  -------------------------------------------------- */
/*     INST       I   NAIF ID of instrument, spacecraft, or structure. */
/*     SCLKDP     I   Encoded spacecraft clock time. */
/*     TOL        I   Time tolerance. */
/*     REF        I   Reference frame. */
/*     CMAT       O   C-matrix pointing data. */
/*     CLKOUT     O   Output encoded spacecraft clock time. */
/*     FOUND      O   True when requested pointing is available. */

/* $ Detailed_Input */

/*     INST       is the NAIF integer ID for the instrument, spacecraft, */
/*                or other structure for which pointing is requested. */
/*                For brevity we will refer to this object as the */
/*                "instrument," and the frame fixed to this object as */
/*                the "instrument frame" or "instrument-fixed" frame. */

/*     SCLKDP     is the encoded spacecraft clock time for which */
/*                pointing is requested. */

/*                The SPICELIB routines SCENCD and SCE2C respectively */
/*                convert spacecraft clock strings and ephemeris time to */
/*                encoded spacecraft clock.  The inverse conversions are */
/*                performed by SCDECD and SCT2E. */

/*     TOL        is a time tolerance in ticks, the units of encoded */
/*                spacecraft clock time. */

/*                The SPICELIB routine SCTIKS converts a spacecraft */
/*                clock tolerance duration from its character string */
/*                representation to ticks.  SCFMT performs the inverse */
/*                conversion. */

/*                The C-matrix returned by CKGP is the one whose time */
/*                tag is closest to SCLKDP and within TOL units of */
/*                SCLKDP.  (More in Particulars, below.) */

/*                In general, because using a non-zero tolerance */
/*                affects selection of the segment from which the */
/*                data is obtained, users are strongly discouraged */
/*                from using a non-zero tolerance when reading CKs */
/*                with continuous data. Using a non-zero tolerance */
/*                should be reserved exclusively to reading CKs with */
/*                discrete data because in practice obtaining data */
/*                from such CKs using a zero tolerance is often not */
/*                possible due to time round off. */

/*     REF        is the desired reference frame for the returned */
/*                pointing.  The returned C-matrix CMAT gives the */
/*                orientation of the instrument designated by INST */
/*                relative to the frame designated by REF.  When a */
/*                vector specified relative to frame REF is left- */
/*                multiplied by CMAT, the vector is rotated to the */
/*                frame associated with INST.  See the discussion of */
/*                CMAT below for details. */

/*                Consult the SPICE document "Frames" for a discussion */
/*                of supported reference frames. */

/* $ Detailed_Output */

/*     CMAT       is a rotation matrix that transforms the components of */
/*                a vector expressed in the reference frame specified by */
/*                REF to components expressed in the frame tied to the */
/*                instrument, spacecraft, or other structure at time */
/*                CLKOUT (see below). */

/*                Thus, if a vector v has components x,y,z in the REF */
/*                reference frame, then v has components x',y',z' in the */
/*                instrument fixed frame at time CLKOUT: */

/*                     [ x' ]     [          ] [ x ] */
/*                     | y' |  =  |   CMAT   | | y | */
/*                     [ z' ]     [          ] [ z ] */

/*                If you know x', y', z', use the transpose of the */
/*                C-matrix to determine x, y, z as follows: */

/*                     [ x ]      [          ]T    [ x' ] */
/*                     | y |  =   |   CMAT   |     | y' | */
/*                     [ z ]      [          ]     [ z' ] */
/*                              (Transpose of CMAT) */


/*     CLKOUT     is the encoded spacecraft clock time associated with */
/*                the returned C-matrix. This value may differ from the */
/*                requested time, but never by more than the input */
/*                tolerance TOL. */

/*                The particulars section below describes the search */
/*                algorithm used by CKGP to satisfy a pointing */
/*                request.  This algorithm determines the pointing */
/*                instance (and therefore the associated time value) */
/*                that is returned. */

/*     FOUND      is true if a record was found to satisfy the pointing */
/*                request.  FOUND will be false otherwise. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*     1)  If a C-kernel file has not been loaded using FURNSH prior to */
/*         a call to this routine, an error is signaled by a routine in */
/*         the call tree of this routine. */

/*     2)  If TOL is negative, found is set to .FALSE. */

/*     3)  If REF is not a supported reference frame, an error is */
/*         signaled by a routine in the call tree of this routine and */
/*         FOUND is set to .FALSE. */

/* $ Files */

/*     CKGP searches through files loaded by FURNSH to locate a */
/*     segment that can satisfy the request for pointing for instrument */
/*     INST at time SCLKDP.  You must load a C-kernel file using FURNSH */
/*     prior to calling this routine. */

/* $ Particulars */

/*     How the tolerance argument is used */
/*     ================================== */


/*     Reading a type 1 CK segment (discrete pointing instances) */
/*     --------------------------------------------------------- */

/*     In the diagram below */

/*        - "0" is used to represent discrete pointing instances */
/*          (quaternions and associated time tags). */

/*        - "( )" are used to represent the end points of the time */
/*          interval covered by a segment in a CK file. */

/*        - SCLKDP is the time at which you requested pointing. */
/*          The location of SCLKDP relative to the time tags of the */
/*          pointing instances is indicated by the "+" sign. */

/*        - TOL is the time tolerance specified in the pointing */
/*          request.  The square brackets "[ ]" represent the */
/*          endpoints of the time interval */

/*             SCLKDP-TOL : SCLKDP+TOL */

/*        - The quaternions occurring in the segment need not be */
/*          evenly spaced in time. */


/*     Case 1:  pointing is available */
/*     ------------------------------ */

/*                              SCLKDP */
/*                                   \   TOL */
/*                                    | / */
/*                                    |/\ */
/*     Your request                [--+--] */
/*                                 .  .  . */
/*     Segment      (0-----0--0--0--0--0--0---0--0------------0--0--0--0) */
/*                                     ^ */
/*                                     | */
/*                         CKGP returns this instance. */


/*     Case 2:  pointing is not available */
/*     ---------------------------------- */

/*                                                   SCLKDP */
/*                                                      \   TOL */
/*                                                       | / */
/*                                                       |/\ */
/*     Your request                                   [--+--] */
/*                                                    .  .  . */
/*     Segment      (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0) */


/*                         CKGP returns no pointing; the output */
/*                         FOUND flag is set to .FALSE. */



/*     Reading a type 2, 3, 4, or 5 CK segment (continuous pointing) */
/*     ------------------------------------------------------------- */

/*     In the diagrams below */

/*        - "==" is used to represent periods of continuous pointing. */

/*        - "--" is used to represent gaps in the pointing coverage. */

/*        - "( )" are used to represent the end points of the time */
/*          interval covered by a segment in a CK file. */

/*        - SCLKDP is the time at which you requested pointing. */
/*          The location of SCLKDP relative to the time tags of the */
/*          pointing instances is indicated by the "+" sign. */

/*        - TOL is the time tolerance specified in the pointing */
/*          request.  The square brackets "[ ]" represent the */
/*          endpoints of the time interval */

/*             SCLKDP-TOL : SCLKDP+TOL */

/*        - The quaternions occurring in the periods of continuous */
/*          pointing need not be evenly spaced in time. */


/*     Case 1:  pointing is available at the request time */
/*     -------------------------------------------------- */

/*                             SCLKDP */
/*                                   \   TOL */
/*                                    | / */
/*                                    |/\ */
/*     Your request                [--+--] */
/*                                 .  .  . */
/*                                 .  .  . */
/*                                 .  .  . */
/*     Segment            (==---===========---=======----------===--) */
/*                                    ^ */
/*                                    | */

/*                   The request time lies within an interval where */
/*                   continuous pointing is available. CKGP returns */
/*                   pointing at the requested epoch. */


/*     Case 2:  pointing is available "near" the request time */
/*     ------------------------------------------------------ */

/*                                    SCLKDP */
/*                                          \   TOL */
/*                                           | / */
/*                                           |/\ */
/*     Your request                       [--+--] */
/*                                        .  .  . */
/*     Segment            (==---===========----=======---------===--) */
/*                                             ^ */
/*                                             | */

/*                   The request time lies in a gap:  an interval where */
/*                   continuous pointing is *not* available.  CKGP */
/*                   returns pointing for the epoch closest to the */
/*                   request time SCLKDP. */


/*     Case 3:  pointing is not available */
/*     ---------------------------------- */

/*                                                 SCLKDP */
/*                                                       \   TOL */
/*                                                        | / */
/*                                                        |/\ */
/*     Your request                                    [--+--] */
/*                                                     .  .  . */
/*     Segment            (==---===========----=======---------===--) */

/*                         CKGP returns no pointing; the output */
/*                         FOUND flag is set to .FALSE. */



/*     Tolerance and segment priority */
/*     ============================== */

/*     CKGP searches through loaded C-kernels to satisfy a pointing */
/*     request. Last-loaded files are searched first. Individual files */
/*     are searched in backwards order, so that between competing */
/*     segments (segments containing data for the same object, for */
/*     overlapping time ranges), the one closest to the end of the file */
/*     has highest priority. */

/*     The search ends when a segment is found that can provide pointing */
/*     for the specified instrument at a time falling within the */
/*     specified tolerance on either side of the request time. Within */
/*     that segment, the instance closest to the input time is located */
/*     and returned. */

/*     The following four cases illustrate this search procedure. */
/*     Segments A and B are in the same file, with segment A located */
/*     further towards the end of the file than segment B. Both segments */
/*     A and B contain discrete pointing data, indicated by the number */
/*     0. */


/*     Case 1:  Pointing is available in the first segment searched. */
/*              Because segment A has the highest priority and can */
/*              satisfy the request, segment B is not searched. */


/*                                  SCLKDP */
/*                                        \  TOL */
/*                                         | / */
/*                                         |/\ */
/*     Your request                     [--+--] */
/*                                      .  .  . */
/*     Segment A          (0-----------------0--------0--0-----0) */
/*                                           ^ */
/*                                           | */
/*                                           | */
/*                               CKGP returns this instance */

/*     Segment B     (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */



/*     Case 2:  Pointing is not available in the first segment searched. */
/*              Because segment A cannot satisfy the request, segment B */
/*              is searched. */


/*                             SCLKDP */
/*                                  \   TOL */
/*                                   | / */
/*                                   |/\ */
/*     Your request               [--+--] */
/*                                .  .  . */
/*     Segment A          (0-----------------0--------0--0-----0) */
/*                                .  .  . */
/*     Segment B     (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0) */
/*                                   ^ */
/*                                   | */
/*                       CKGP returns this instance */


/*     Segments that contain continuous pointing data are searched in */
/*     the same manner as segments containing discrete pointing data. */
/*     For request times that fall within the bounds of continuous */
/*     intervals, CKGP will return pointing at the request time. When */
/*     the request time does not fall within an interval, then a time at */
/*     an endpoint of an interval may be returned if it is the closest */
/*     time in the segment to the user request time and is also within */
/*     the tolerance. */

/*     In the following examples, segment A is located further towards */
/*     the end of the file than segment C. Segment A contains discrete */
/*     pointing data and segment C contains continuous data, indicated */
/*     by the "=" character. */


/*     Case 3:  Pointing is not available in the first segment searched. */
/*              Because segment A cannot satisfy the request, segment C */
/*              is searched. */

/*                             SCLKDP */
/*                                   \  TOL */
/*                                    | / */
/*                                    |/\ */
/*     Your request                [--+--] */
/*                                 .  .  . */
/*                                 .  .  . */
/*     Segment A          (0-----------------0--------0--0-----0) */
/*                                 .  .  . */
/*                                 .  .  . */
/*     Segment C          (---=============-----====--------==--) */
/*                                    ^ */
/*                                    | */
/*                                    | */
/*                         CKGP returns this instance */


/*     In the next case, assume that the order of segments A and C in the */
/*     file is reversed:  A is now closer to the front, so data from */
/*     segment C are considered first. */


/*     Case 4:  Pointing is available in the first segment searched. */
/*              Because segment C has the highest priority and can */
/*              satisfy the request, segment A is not searched. */

/*                                             SCLKDP */
/*                                            / */
/*                                           |  TOL */
/*                                           | / */
/*                                           |/\ */
/*     Your request                       [--+--] */
/*                                        .  .  . */
/*                                        .  .  . */
/*     Segment C          (---=============-----====--------==--) */
/*                                             ^ */
/*                                             | */
/*                                CKGP returns this instance */

/*     Segment A          (0-----------------0--------0--0-----0) */
/*                                           ^ */
/*                                           | */
/*                                     "Best" answer */


/*     The next case illustrates an unfortunate side effect of using */
/*     a non-zero tolerance when reading multi-segment CKs with */
/*     continuous data. In all cases when the look-up interval */
/*     formed using tolerance overlaps a segment boundary and */
/*     the request time falls within the coverage of the lower */
/*     priority segment, the data at the end of the higher priority */
/*     segment will be picked instead of the data from the lower */
/*     priority segment. */


/*     Case 5:  Pointing is available in the first segment searched. */
/*              Because segment C has the highest priority and can */
/*              satisfy the request, segment A is not searched. */

/*                                             SCLKDP */
/*                                            / */
/*                                           |  TOL */
/*                                           | / */
/*                                           |/\ */
/*     Your request                       [--+--] */
/*                                        .  .  . */
/*                                        .  .  . */
/*     Segment C                                (===============) */
/*                                              ^ */
/*                                              | */
/*                                CKGP returns this instance */

/*     Segment A          (=====================) */
/*                                           ^ */
/*                                           | */
/*                                     "Best" answer */

/* $ Examples */

/*     Suppose you have two C-kernel files containing data for the */
/*     Voyager 2 narrow angle camera.  One file contains predict values, */
/*     and the other contains corrected pointing for a selected group */
/*     of images, that is, for a subset of images from the first file. */

/*     The following example program uses CKGP to get C-matrices for a */
/*     set of images whose SCLK counts (un-encoded character string */
/*     versions) are contained in the array SCLKCH. */

/*     If available, the program will get the corrected pointing values. */
/*     Otherwise, predict values will be used. */

/*     For each C-matrix, a unit  pointing vector is constructed */
/*     and printed. */


/*     C */
/*     C     Constants for this program. */
/*     C */
/*     C     -- The code for the Voyager 2 spacecraft clock is -32 */
/*     C */
/*     C     -- The code for the narrow angle camera on the Voyager 2 */
/*     C        spacecraft is -32001. */
/*     C */
/*     C    --  Spacecraft clock times for successive Voyager images */
/*     C        always differ by more than 0:0:400.  This is an */
/*     C        acceptable tolerance, and must be converted to "ticks" */
/*     C        (units of encoded SCLK) for input to CKGP. */
/*     C */
/*     C     -- The reference frame we want is FK4. */
/*     C */
/*     C     -- The narrow angle camera boresight defines the third */
/*     C        axis of the instrument-fixed coordinate system. */
/*     C        Therefore, the vector ( 0, 0, 1 ) represents */
/*     C        the boresight direction in the camera-fixed frame. */
/*     C */
/*           IMPLICIT NONE */

/*           INTEGER               FILEN */
/*           PARAMETER           ( FILEN  = 255 ) */

/*           INTEGER               NPICS */
/*           PARAMETER           ( NPICS  = 2 ) */

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

/*           INTEGER               REFLEN */
/*           PARAMETER           ( REFLEN = 32 ) */

/*           CHARACTER*(TIMLEN)    CLKCH */
/*           CHARACTER*(FILEN)     CKPRED */
/*           CHARACTER*(FILEN)     CKCORR */
/*           CHARACTER*(REFLEN)    REF */
/*           CHARACTER*(FILEN)     SCLK */
/*           CHARACTER*(TIMLEN)    SCLKCH ( NPICS ) */
/*           CHARACTER*(TIMLEN)    TOLVGR */

/*           DOUBLE PRECISION      CLKOUT */
/*           DOUBLE PRECISION      CMAT   ( 3, 3 ) */
/*           DOUBLE PRECISION      SCLKDP */
/*           DOUBLE PRECISION      TOLTIK */
/*           DOUBLE PRECISION      VCFIX  ( 3 ) */
/*           DOUBLE PRECISION      VINERT ( 3 ) */

/*           INTEGER               SC */
/*           INTEGER               I */
/*           INTEGER               INST */

/*           LOGICAL               FOUND */

/*           CKPRED     = 'voyager2_predict.bc' */
/*           CKCORR     = 'voyager2_corrected.bc' */
/*           SCLK       = 'voyager2_sclk.tsc' */
/*           SC         = -32 */
/*           INST       = -32001 */
/*           SCLKCH(1)  = '4/08966:30:768' */
/*           SCLKCH(2)  = '4/08970:58:768' */
/*           TOLVGR     = '0:0:400' */
/*           REF        = 'FK4' */
/*           VCFIX( 1 ) =  0.D0 */
/*           VCFIX( 2 ) =  0.D0 */
/*           VCFIX( 3 ) =  1.D0 */

/*     C */
/*     C     Loading the files in this order ensures that the */
/*     C     corrected file will get searched first. */
/*     C */
/*           CALL FURNSH ( CKPRED ) */
/*           CALL FURNSH ( CKCORR ) */

/*     C */
/*     C     Need to load a Voyager 2 SCLK kernel to convert from */
/*     C     clock strings to ticks. */
/*     C */
/*           CALL FURNSH ( SCLK ) */

/*     C */
/*     C     Convert tolerance from VGR formatted character string */
/*     C     SCLK to ticks which are units of encoded SCLK. */
/*     C */
/*           CALL SCTIKS ( SC, TOLVGR, TOLTIK ) */


/*           DO I = 1, NPICS */
/*     C */
/*     C        CKGP requires encoded spacecraft clock. */
/*     C */
/*              CALL SCENCD ( SC, SCLKCH( I ), SCLKDP ) */

/*              CALL CKGP ( INST,   SCLKDP, TOLTIK, REF, CMAT, */
/*          .               CLKOUT, FOUND                      ) */

/*              IF ( FOUND ) THEN */

/*     C */
/*     C           Use the transpose of the C-matrix to transform the */
/*     C           boresight vector from camera-fixed to reference */
/*     C           coordinates. */
/*     C */
/*                 CALL MTXV   ( CMAT, VCFIX,  VINERT ) */
/*                 CALL SCDECD ( SC,   CLKOUT, CLKCH  ) */

/*                 WRITE (*,*) 'VGR 2 SCLK Time:         ', CLKCH */
/*                 WRITE (*,*) 'VGR 2 NA ISS boresight ' */
/*          .      //          'pointing vector: ',         VINERT */

/*              ELSE */

/*                 WRITE (*,*) 'Pointing not found for time ', SCLKCH(I) */

/*              END IF */

/*           END DO */

/*           END */


/* $ Restrictions */

/*     None. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     C.H. Acton     (JPL) */
/*     N.J. Bachman   (JPL) */
/*     W.L. Taber     (JPL) */
/*     J.M. Lynch     (JPL) */
/*     B.V. Semenov   (JPL) */
/*     M.J. Spencer   (JPL) */
/*     R.E. Thurman   (JPL) */
/*     I.M. Underwood (JPL) */

/* $ Version */

/* -    SPICELIB Version 5.4.0, 23-SEP-2013 (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. */

/* -    SPICELIB Version 5.3.1, 09-JUN-2010 (BVS) */

/*        Header update: description of the tolerance and Particulars */
/*        section were expanded to address some problems arising from */
/*        using a non-zero tolerance. */

/* -    SPICELIB Version 5.3.0, 23-APR-2010 (NJB) */

/*        Bug fix: this routine now obtains the rotation */
/*        from the request frame to the applicable CK segment's */
/*        base frame via a call to REFCHG. Formerly the routine */
/*        used FRMCHG, which required that angular velocity data */
/*        be available for this transformation. */

/* -    SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */

/*        Updated to remove non-standard use of duplicate arguments */
/*        in MXM call. */

/* -    SPICELIB Version 5.1.2, 29-JAN-2004 (NJB) */

/*        Header update:  description of input argument REF was */
/*        expanded. */

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

/*        Various header corrections were made. */

/* -    SPICELIB Version 3.2.0, 23-FEB-1999 (WLT) */

/*        The previous editions of this routine did not properly handle */
/*        the case when TOL was negative.  The routine now returns a */
/*        value of .FALSE. for FOUND as is advertised above. */

/* -    SPICELIB Version 3.1.0, 13-APR-1998 (WLT) */

/*        The call to CHKOUT in the case when FAILED returned the */
/*        value TRUE used to check out with the name 'CKGPAV'.  This */
/*        has been changed to a CKGP. */

/* -    SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */

/*        The routine was upgraded to support non-inertial frames. */

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

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

/* -    SPICELIB Version 2.0.0, 30-AUG-1991 (JML) */

/*        The Particulars section was updated to show how the */
/*        search algorithm processes segments with continuous */
/*        pointing data. */

/*        The example program now loads an SCLK kernel. */

/*        FAILED is checked after the call to IRFROT to handle the */
/*        case where the reference frame is invalid and the error */
/*        handling is not set to abort. */

/*        FAILED is checked in the DO WHILE loop to handle the case */
/*        where an error is detected by a SPICELIB routine inside the */
/*        loop and the error handling is not set to abort. */

/* -    SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */

/*        The restriction that a C-kernel file must be loaded */
/*        was explicitly stated. */


/* -    SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU) */

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

/*     get ck pointing */

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

/* -    SPICELIB Version 5.2.0, 25-AUG-2005 (NJB) */

/*        Updated to remove non-standard use of duplicate arguments */
/*        in MXM call. */

/* -    SPICELIB Version 3.1.0, 20-DEC-1995 (WLT) */

/*        A call to FRINFO did not have enough arguments and */
/*        went undetected until Howard Taylor of ACT.  Many */
/*        thanks go out to Howard for tracking down this error. */

/* -    SPICELIB Version 3.0.0, 19-SEP-1994 (WLT) */

/*        The routine was upgraded to support non-inertial frames. */

/*        Calls to NAMIRF and IRFROT were replaced with calls to */
/*        NAMFRM and FRMCHG respectively. */


/* -    SPICELIB Version 1.0.2, 30-AUG-1991 (JML) */

/*        1) The Particulars section was updated to show how the */
/*           search algorithm processes segments with continuous */
/*           pointing data. */

/*        2) The example program now loads an SCLK kernel. */

/*        3) FAILED is checked after the call to IRFROT to handle the */
/*           case where the reference frame is invalid and the error */
/*           handling is not set to abort. */

/*        4) FAILED is checked in the DO WHILE loop to handle the case */
/*           where an error is detected by a SPICELIB routine inside the */
/*           loop and the error handling is not set to abort. */

/* -    SPICELIB Version 1.0.1, 02-NOV-1990 (JML) */

/*        1) The restriction that a C-kernel file must be loaded */
/*           was explicitly stated. */
/*        2) Minor changes were made to the wording of the header. */


/* -    Beta Version 1.1.0, 29-AUG-1990 (MJS) */

/*        The following changes were made as a result of the */
/*        NAIF CK Code and Documentation Review: */

/*        1) The variable SCLK was changed to SCLKDP. */
/*        2) The variable INSTR was changed to INST. */
/*        3) The variable IDENT was changed to SEGID. */
/*        4) The declarations for the parameters NDC, NIC, NC, and */
/*           IDLEN were moved from the "Declarations" section of the */
/*           header to the "Local parameters" section of the code below */
/*           the header. These parameters are not meant to modified by */
/*           users. */
/*        5) The header was updated to reflect the changes. */

/* -    Beta Version 1.0.0, 04-MAY-1990 (RET) (IMU) */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */

/*        NDC        is the number of double precision components in an */
/*                   unpacked C-kernel segment descriptor. */

/*        NIC        is the number of integer components in an unpacked */
/*                   C-kernel segment descriptor. */

/*        NC         is the number of components in a packed C-kernel */
/*                   descriptor.  All DAF summaries have this formulaic */
/*                   relationship between the number of its integer and */
/*                   double precision components and the number of packed */
/*                   components. */

/*        IDLEN      is the length of the C-kernel segment identifier. */
/*                   All DAF names have this formulaic relationship */
/*                   between the number of summary components and */
/*                   the length of the name (You will notice that */
/*                   a name and a summary have the same length in bytes.) */


/*     Saved frame name length. */


/*     Local variables */


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


/*     Saved frame name/ID items. */


/*     Initial values. */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("CKGP", (ftnlen)4);
    }

/*     Initialization. */

    if (first) {

/*        Initialize counter. */

	zzctruin_(svctr1);
	first = FALSE_;
    }

/*     Don't need angular velocity data. */
/*     Assume the segment won't be found until it really is. */

    needav = FALSE_;
    *found = FALSE_;

/*     If the tolerance is less than zero, we go no further. */

    if (*tol < 0.) {
	chkout_("CKGP", (ftnlen)4);
	return 0;
    }

/*     Begin a search for this instrument and time, and get the first */
/*     applicable segment. */

    ckbss_(inst, sclkdp, tol, &needav);
    cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);

/*     Keep trying candidate segments until a segment can produce a */
/*     pointing instance within the specified time tolerance of the */
/*     input time. */

/*     Check FAILED to prevent an infinite loop if an error is detected */
/*     by a SPICELIB routine and the error handling is not set to abort. */

    while(sfnd && ! failed_()) {
	ckpfs_(&handle, descr, sclkdp, tol, &needav, cmat, av, clkout, &pfnd);
	if (pfnd) {

/*           Found one. If the C-matrix doesn't already rotate from the */
/*           requested frame, convert it to one that does. */

	    dafus_(descr, &c__2, &c__6, dcd, icd);
	    refseg = icd[1];

/*           Look up the id code for the requested reference frame. */

	    zznamfrm_(svctr1, svref, &svrefr, ref, &refreq, (ftnlen)32, 
		    ref_len);
	    if (refreq != refseg) {

/*              We may need to convert the output ticks CLKOUT to ET */
/*              so that we can get the needed state transformation */
/*              matrix.  This is the case if either of the frames */
/*              is non-inertial. */

		frinfo_(&refreq, &center, &type1, &typeid, &gotit);
		frinfo_(&refseg, &center, &type2, &typeid, &gotit);
		if (type1 == 1 && type2 == 1) {

/*                 Any old value of ET will do in this case.  We'll */
/*                 use zero. */

		    et = 0.;
		} else {

/*                 Look up the spacecraft clock id to use to convert */
/*                 the output CLKOUT to ET. */

		    ckmeta_(inst, "SCLK", &sclk, (ftnlen)4);
		    sct2e_(&sclk, clkout, &et);
		}

/*              Get the transformation from the requested frame to */
/*              the segment frame at ET. */

		refchg_(&refreq, &refseg, &et, rot);

/*              If REFCHG detects that the reference frame is invalid */
/*              then return from this routine with FOUND equal to false. */

		if (failed_()) {
		    chkout_("CKGP", (ftnlen)4);
		    return 0;
		}

/*              Transform the attitude information: convert CMAT so that */
/*              it maps from request frame to C-matrix frame. */

		mxm_(cmat, rot, tmpmat);
		moved_(tmpmat, &c__9, cmat);
	    }
	    *found = TRUE_;
	    chkout_("CKGP", (ftnlen)4);
	    return 0;
	}
	cksns_(&handle, descr, segid, &sfnd, (ftnlen)40);
    }
Exemplo n.º 9
0
/* $Procedure      SCPART ( Spacecraft Clock Partition Information ) */
/* Subroutine */ int scpart_(integer *sc, integer *nparts, doublereal *pstart,
	 doublereal *pstop)
{
    /* Initialized data */

    static logical first = TRUE_;
    static logical nodata = TRUE_;
    static integer oldsc = 0;

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

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_rnge(char *, integer, char *, integer);
    double d_nint(doublereal *);

    /* Local variables */
    extern /* Subroutine */ int zzcvpool_(char *, integer *, logical *, 
	    ftnlen), zzctruin_(integer *);
    integer i__;
    extern /* Subroutine */ int scld01_(char *, integer *, integer *, integer 
	    *, doublereal *, ftnlen), chkin_(char *, ftnlen), repmi_(char *, 
	    char *, integer *, char *, ftnlen, ftnlen, ftnlen);
    static doublereal prtsa[9999], prtso[9999];
    extern logical failed_(void);
    char kvname[60*2];
    logical update;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, 
	    ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen);
    integer nprtsa;
    extern logical return_(void);
    static integer usrctr[2];
    extern /* Subroutine */ int swpool_(char *, integer *, char *, ftnlen, 
	    ftnlen);
    integer nprtso;
    static integer lstprt;

/* $ Abstract */

/*     Get spacecraft clock partition information from a spacecraft */
/*     clock kernel file. */

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

/*     SCLK */

/* $ Keywords */

/*     TIME */

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

/*     Include file sclk.inc */

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

/*     The parameters below define sizes and limits used by */
/*     the SCLK system. */

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

/*     See the declaration section below. */

/* $ Author_and_Institution */

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

/* $ Literature_References */

/*     None. */

/* $ Version */

/* -    SPICELIB Version 2.0.0, 24-MAY-2010 (NJB) */

/*        Increased value of maximum coefficient record count */
/*        parameter MXCOEF from 10K to 50K. */

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

/* -& */

/*     Number of supported SCLK field delimiters: */


/*     Supported SCLK string field delimiters: */


/*     Maximum number of partitions: */


/*     Partition string length. */

/*     Since the maximum number of partitions is given by MXPART is */
/*     9999, PRTSTR needs at most 4 characters for the partition number */
/*     and one character for the slash. */


/*     Maximum number of coefficient records: */


/*     Maximum number of fields in an SCLK string: */


/*     Length of strings used to represent D.P. */
/*     numbers: */


/*     Maximum number of supported parallel time systems: */


/*     End of include file sclk.inc */

/* $ 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 */
/*     --------  ---  -------------------------------------------------- */
/*     SC         I   NAIF spacecraft identification code. */
/*     NPARTS     O   The number of spacecraft clock partitions. */
/*     PSTART     O   Array of partition start times. */
/*     PSTOP      O   Array of partition stop times. */
/*     MXPART     P   Maximum number of partitions. */

/* $ Detailed_Input */

/*     SC         is the NAIF ID for the spacecraft whose clock partition */
/*                information is being requested. */

/* $ Detailed_Output */

/*     NPARTS     is the number of spacecraft clock time partitions */
/*                described in the kernel file for spacecraft SC. */

/*     PSTART     is an array containing NPARTS partition start times */
/*                represented as double precision, encoded SCLK */
/*                ("ticks"). The values contained in PSTART are whole */
/*                numbers. */

/*     PSTOP      is an array containing NPARTS partition end times */
/*                represented as double precision, encoded SCLK */
/*                ("ticks"). The values contained in PSTOP are whole */
/*                numbers. */

/* $ Parameters */

/*     MXPART     is the maximum number of partitions for any spacecraft */
/*                clock. SCLK kernels contain start and stop times for */
/*                each partition. See the INCLUDE file sclk.inc for this */
/*                parameter's value. */

/* $ Exceptions */

/*     1)  If the kernel variables containing the spacecraft clock */
/*         partition start and stop times have not been loaded in the */
/*         kernel pool, the error will be diagnosed by routines called */
/*         by this routine. */

/*     2)  If the number of start and stop times are different then */
/*         the error SPICE(NUMPARTSUNEQUAL) is signaled. */

/* $ Files */

/*     An SCLK kernel containing spacecraft clock partition start */
/*     and stop times for the spacecraft clock indicated by SC must */
/*     be loaded into the kernel pool. */

/* $ Particulars */

/*     SCPART looks for two variables in the kernel pool for each */
/*     spacecraft's partition information. If SC = -nn, then the names of */
/*     the variables are */

/*         'SCLK_PARTITION_START_nn' and */
/*         'SCLK_PARTITION_END_nn'. */

/*     The start and stop times returned are in units of "ticks". */

/* $ Examples */

/*     1)  The following program fragment finds and prints out partition */
/*         start and stop times in clock format for the Galileo mission. */
/*         In this example, Galileo partition times are assumed to be */
/*         in the kernel file SCLK.KER. */

/*            CHARACTER*(30)        START */
/*            CHARACTER*(30)        STOP */

/*            CALL FURNSH ( 'SCLK.KER' ) */

/*            SC = -77 */

/*            CALL SCPART ( SC, NPARTS, PSTART, PSTOP ) */

/*            DO I = 1, NPARTS */

/*               CALL SCFMT ( SC, PSTART( I ), START ) */
/*               CALL SCFMT ( SC, PSTOP ( I ), STOP  ) */

/*               WRITE (*,*) */
/*               WRITE (*,*) 'Partition ', I, ':' */
/*               WRITE (*,*) 'Start = ', START */
/*               WRITE (*,*) 'Stop  = ', STOP */

/*            END DO */

/* $ Restrictions */

/*     1) This routine assumes that an SCLK kernel appropriate to the */
/*        spacecraft identified by SC has been loaded into the kernel */
/*        pool. */

/* $ Literature_References */

/*     None. */

/* $ Author_and_Institution */

/*     N.J. Bachman   (JPL) */
/*     J.M. Lynch     (JPL) */
/*     B.V. Semenov   (JPL) */
/*     R.E. Thurman   (JPL) */

/* $ Version */

/* -    SPICELIB Version 2.3.1, 19-MAR-2014 (NJB) */

/*        Minor header comment updates were made. */

/* -    SPICELIB Version 2.3.0, 09-SEP-2013 (BVS) */

/*        Updated to keep track of the POOL counter and call ZZCVPOOL. */

/* -    SPICELIB Version 2.2.0, 05-MAR-2009 (NJB) */

/*        Bug fix: this routine now keeps track of whether its */
/*        kernel pool look-up succeeded. If not, a kernel pool */
/*        lookup is attempted on the next call to this routine. */

/* -    SPICELIB Version 2.1.0, 05-FEB-2008 (NJB) */

/*        The values of the parameter MXPART is now */
/*        provided by the INCLUDE file sclk.inc. */

/* -    SPICELIB Version 1.1.1, 22-AUG-2006 (EDW) */

/*        Replaced references to LDPOOL with references */
/*        to FURNSH. */

/* -    SPICELIB Version 1.1.0, 22-MAR-1993 (JML) */

/*        The routine now uses the kernel pool watch capability. */

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

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

/* -    SPICELIB Version 1.0.0, 03-SEP-1990 (NJB) (JML) (RET) */

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

/*     spacecraft_clock partition information */

/* -& */

/*     SPICELIB functions */


/*     Local parameters */


/*     Local variables */


/*     Saved variables */


/*     Initial values */


/*     Standard SPICE error handling. */

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

/*     On the first pass through the subroutine, or if the */
/*     spacecraft code changes, set watches on the SCLK kernel */
/*     variables for the current clock. */

    if (first || *sc != oldsc) {

/*        Make up a list of names of kernel variables that we'll use. */

	s_copy(kvname, "SCLK_PARTITION_START", (ftnlen)60, (ftnlen)20);
	s_copy(kvname + 60, "SCLK_PARTITION_END", (ftnlen)60, (ftnlen)18);
	for (i__ = 1; i__ <= 2; ++i__) {
	    suffix_("_#", &c__0, kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ?
		     i__1 : s_rnge("kvname", i__1, "scpart_", (ftnlen)284)) * 
		    60, (ftnlen)2, (ftnlen)60);
	    i__3 = -(*sc);
	    repmi_(kvname + ((i__1 = i__ - 1) < 2 && 0 <= i__1 ? i__1 : 
		    s_rnge("kvname", i__1, "scpart_", (ftnlen)285)) * 60, 
		    "#", &i__3, kvname + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ? 
		    i__2 : s_rnge("kvname", i__2, "scpart_", (ftnlen)285)) * 
		    60, (ftnlen)60, (ftnlen)1, (ftnlen)60);
	}

/*        Set a watch on all of the kernel variables used. */

	swpool_("SCPART", &c__2, kvname, (ftnlen)6, (ftnlen)60);

/*        Keep track of the last spacecraft ID encountered. */

	oldsc = *sc;

/*        Initialize the local POOL counter to user value. */

	zzctruin_(usrctr);
	first = FALSE_;
    }

/*     If any of the kernel pool variables that this routine uses */
/*     have been updated, or if the spacecraft ID changes, look up */
/*     the new values from the kernel pool. */

    zzcvpool_("SCPART", usrctr, &update, (ftnlen)6);
    if (update || nodata) {

/*        Read the values from the kernel pool. */

	scld01_("SCLK_PARTITION_START", sc, &c__9999, &nprtsa, prtsa, (ftnlen)
		20);
	scld01_("SCLK_PARTITION_END", sc, &c__9999, &nprtso, prtso, (ftnlen)
		18);
	if (failed_()) {
	    nodata = TRUE_;
	    chkout_("SCPART", (ftnlen)6);
	    return 0;
	}

/*        Error checking. */

	if (nprtsa != nprtso) {
	    nodata = TRUE_;
	    setmsg_("The number of partition start and stop times are unequa"
		    "l for spacecraft #.    ", (ftnlen)78);
	    errint_("#", sc, (ftnlen)1);
	    sigerr_("SPICE(NUMPARTSUNEQUAL)", (ftnlen)22);
	    chkout_("SCPART", (ftnlen)6);
	    return 0;
	}

/*        At this point we have the data we sought. We need not */
/*        perform another kernel pool look-up unless there's */
/*        a kernel pool update or change in the SCLK ID. */

	nodata = FALSE_;

/*        Buffer the number of partitions and the partition start */
/*        and stop times. */

	lstprt = nprtsa;

/*        The partition start and stop times must be whole numbers. */

	i__1 = lstprt;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtsa"
		    , i__2, "scpart_", (ftnlen)360)] = d_nint(&prtsa[(i__3 = 
		    i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtsa", 
		    i__3, "scpart_", (ftnlen)360)]);
	    prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : s_rnge("prtso"
		    , i__2, "scpart_", (ftnlen)361)] = d_nint(&prtso[(i__3 = 
		    i__ - 1) < 9999 && 0 <= i__3 ? i__3 : s_rnge("prtso", 
		    i__3, "scpart_", (ftnlen)361)]);
	}
    }

/*     Copy the values in local buffers to the output arguments. */

    *nparts = lstprt;
    i__1 = *nparts;
    for (i__ = 1; i__ <= i__1; ++i__) {
	pstart[i__ - 1] = prtsa[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : 
		s_rnge("prtsa", i__2, "scpart_", (ftnlen)372)];
	pstop[i__ - 1] = prtso[(i__2 = i__ - 1) < 9999 && 0 <= i__2 ? i__2 : 
		s_rnge("prtso", i__2, "scpart_", (ftnlen)373)];
    }
    chkout_("SCPART", (ftnlen)6);
    return 0;
} /* scpart_ */