Index of Functions: A  B  C  D  E  F  G  H  I  J  K  L  M  N  O  P  Q  R  S  T  U  V  W  X 
Index Page
subslr

Table of contents
Procedure
Abstract
Required_Reading
Keywords
Declarations
Brief_I/O
Detailed_Input
Detailed_Output
Parameters
Exceptions
Files
Particulars
Examples
Restrictions
Literature_References
Author_and_Institution
Version

Procedure

     SUBSLR ( Sub-solar point )

     SUBROUTINE SUBSLR ( METHOD, TARGET, ET,     FIXREF,
    .                    ABCORR, OBSRVR, SPOINT, TRGEPC, SRFVEC )

Abstract

     Compute the rectangular coordinates of the sub-solar point on
     a target body at a specified epoch, optionally corrected for
     light time and stellar aberration.

     The surface of the target body may be represented by a triaxial
     ellipsoid or by topographic data provided by DSK files.

     This routine supersedes SUBSOL.

Required_Reading

     DSK
     FRAMES
     NAIF_IDS
     PCK
     SPK
     TIME

Keywords

     GEOMETRY

Declarations

     IMPLICIT NONE

     INCLUDE               'dsk.inc'
     INCLUDE               'frmtyp.inc'
     INCLUDE               'gf.inc'
     INCLUDE               'zzabcorr.inc'
     INCLUDE               'zzctr.inc'
     INCLUDE               'zzdsk.inc'

     CHARACTER*(*)         METHOD
     CHARACTER*(*)         TARGET
     DOUBLE PRECISION      ET
     CHARACTER*(*)         FIXREF
     CHARACTER*(*)         ABCORR
     CHARACTER*(*)         OBSRVR
     DOUBLE PRECISION      SPOINT ( 3 )
     DOUBLE PRECISION      TRGEPC
     DOUBLE PRECISION      SRFVEC ( 3 )

Brief_I/O

     VARIABLE  I/O  DESCRIPTION
     --------  ---  --------------------------------------------------
     METHOD     I   Computation method.
     TARGET     I   Name of target body.
     ET         I   Epoch in ephemeris seconds past J2000 TDB.
     FIXREF     I   Body-fixed, body-centered target body frame.
     ABCORR     I   Aberration correction.
     OBSRVR     I   Name of observing body.
     SPOINT     O   Sub-solar point on the target body.
     TRGEPC     O   Sub-solar point epoch.
     SRFVEC     O   Vector from observer to sub-solar point.

Detailed_Input

     METHOD   is a short string providing parameters defining
              the computation method to be used. In the syntax
              descriptions below, items delimited by brackets
              are optional.

              METHOD may be assigned the following values:

                 'NEAR POINT/ELLIPSOID'

                    The sub-solar point computation uses a triaxial
                    ellipsoid to model the surface of the target body.
                    The sub-solar point is defined as the nearest
                    point on the target relative to the sun.

                    The word "NADIR" may be substituted for the phrase
                    "NEAR POINT" in the string above.

                    For backwards compatibility, the older syntax

                       'Near point: ellipsoid'

                    is accepted as well.


                 'INTERCEPT/ELLIPSOID'

                    The sub-solar point computation uses a triaxial
                    ellipsoid to model the surface of the target body.
                    The sub-solar point is defined as the target
                    surface intercept of the line containing the sun
                    and the target's center.

                    For backwards compatibility, the older syntax

                       'Intercept: ellipsoid'

                    is accepted as well.


                 'NADIR/DSK/UNPRIORITIZED[/SURFACES = <surface list>]'

                    The sub-solar point computation uses DSK data to
                    model the surface of the target body. The
                    sub-solar point is defined as the intercept, on
                    the surface represented by the DSK data, of the
                    line containing the sun and the nearest point on
                    the target's reference ellipsoid. If multiple such
                    intercepts exist, the one closest to the sun is
                    selected.

                    Note that this definition of the sub-solar point
                    is not equivalent to the "nearest point on the
                    surface to the sun." The phrase "NEAR POINT" may
                    NOT be substituted for "NADIR" in the string
                    above.

                    The surface list specification is optional. The
                    syntax of the list is

                       <surface 1> [, <surface 2>...]

                    If present, it indicates that data only for the
                    listed surfaces are to be used; however, data
                    need not be available for all surfaces in the
                    list. If absent, loaded DSK data for any surface
                    associated with the target body are used.

                    The surface list may contain surface names or
                    surface ID codes. Names containing blanks must
                    be delimited by double quotes, for example

                       SURFACES = "Mars MEGDR 128 PIXEL/DEG"

                    If multiple surfaces are specified, their names
                    or IDs must be separated by commas.

                    See the $Particulars section below for details
                    concerning use of DSK data.


                 'INTERCEPT/DSK/UNPRIORITIZED[/SURFACES =
                                              <surface list>]'

                    The sub-solar point computation uses DSK data to
                    model the surface of the target body. The
                    sub-solar point is defined as the target surface
                    intercept of the line containing the sun and the
                    target's center.

                    If multiple such intercepts exist, the one closest
                    to the sun is selected.

                    The surface list specification is optional. The
                    syntax of the list is identical to that for the
                    NADIR option described above.


                 Neither case nor white space are significant in
                 METHOD, except within double-quoted strings. For
                 example, the string ' eLLipsoid/nearpoint ' is valid.

                 Within double-quoted strings, blank characters are
                 significant, but multiple consecutive blanks are
                 considered equivalent to a single blank. Case is
                 not significant. So

                    "Mars MEGDR 128 PIXEL/DEG"

                 is equivalent to

                    " mars megdr  128  pixel/deg "

                 but not to

                    "MARS MEGDR128PIXEL/DEG"


     TARGET   is the name of the target body. The target body is
              an ephemeris object (its trajectory is given by
              SPK data), and is an extended object.

              The string 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.

              When the target body's surface is represented by a
              tri-axial ellipsoid, this routine assumes that a
              kernel variable representing the ellipsoid's radii is
              present in the kernel pool. Normally the kernel
              variable would be defined by loading a PCK file.


     ET       is the epoch of participation of the observer,
              expressed as ephemeris seconds past J2000 TDB: ET is
              the epoch at which the observer's state is computed.

              When aberration corrections are not used, ET is also
              the epoch at which the position and orientation of
              the target body and the position of the Sun are
              computed.

              When aberration corrections are used, ET is the epoch
              at which the observer's state relative to the solar
              system barycenter is computed; in this case the
              position and orientation of the target body are
              computed at ET-LT, where LT is the one-way light time
              between the sub-solar point and the observer. See the
              description of ABCORR below for details.


     FIXREF   is the name of a body-fixed reference frame centered
              on the target body. FIXREF may be any such 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). The
              string FIXREF is case-insensitive, and leading and
              trailing blanks in FIXREF are not significant.

              The output sub-solar point SPOINT and the
              observer-to-sub-solar point vector SRFVEC will be
              expressed relative to this reference frame.


     ABCORR   indicates the aberration correction to be applied
              when computing the target position and orientation
              and the position of the Sun.

              For remote sensing applications, where the apparent
              sub-solar point seen by the observer is desired,
              normally either of the corrections

                 'LT+S'
                 'CN+S'

              should be used. These and the other supported options
              are described below. ABCORR may be any of the
              following:

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

              Let LT represent the one-way light time between the
              observer and the sub-solar point (note: NOT between
              the observer and the target body's center). The
              following values of ABCORR apply to the "reception"
              case in which photons depart from the sub-solar
              point'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 location of sub-solar
                            point 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. The solution invoked by the
                            'LT' option uses one iteration.

                            The target position and orientation as
                            seen by the observer are corrected for
                            light time. The position of the Sun
                            relative to the target is corrected for
                            one-way light time between the Sun and
                            target.

                 'LT+S'     Correct for one-way light time and
                            stellar aberration using a Newtonian
                            formulation. This option modifies the
                            sub-solar point obtained with the 'LT'
                            option to account for the observer's
                            velocity relative to the solar system
                            barycenter. These corrections yield
                            the apparent sub-solar point.

                 'CN'       Converged Newtonian light time
                            correction. In solving the light time
                            equation, the 'CN' correction iterates
                            until the solution converges. Both the
                            position and rotation of the target
                            body, and the position of the Sun, are
                            corrected for light time.

                 'CN+S'     Converged Newtonian light time and
                            stellar aberration corrections. This
                            option produces a solution that is at
                            least as accurate at that obtainable
                            with the 'LT+S' option. Whether the
                            'CN+S' solution is substantially more
                            accurate 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.

              Neither case nor white space are significant in
              ABCORR. For example, the string

                'Lt + s'

              is valid.


     OBSRVR   is the name of the observing body. The observing body
              is an ephemeris object: it typically is 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 'MOON' and '301' are
              legitimate strings that indicate the Moon is the
              observer.

              The observer may coincide with the target.

Detailed_Output

     SPOINT   is the sub-solar point on the target body.

              For target shapes modeled by ellipsoids, the
              sub-solar point is defined either as the point on the
              target body that is closest to the sun, or the target
              surface intercept of the line from the sun to the
              target's center.

              For target shapes modeled by topographic data
              provided by DSK files, the sub-solar point is defined
              as the target surface intercept of the line from the
              sun to either the nearest point on the reference
              ellipsoid, or to the target's center. If multiple
              such intercepts exist, the one closest to the sun is
              selected.

              The input argument METHOD selects the target shape
              model and sub-solar point definition to be used.

              SPOINT is expressed in Cartesian coordinates,
              relative to the body-fixed target frame designated by
              FIXREF. The body-fixed target frame is evaluated at
              the sub-solar point epoch TRGEPC (see description
              below).

              When aberration corrections are used, SPOINT is
              computed using target body position and orientation
              that have been adjusted for the corrections
              applicable to SPOINT itself rather than to the target
              body's center. In particular, if the stellar
              aberration correction applicable to SPOINT is
              represented by a shift vector S, then the light-time
              corrected position of the target is shifted by S
              before the sub-solar point is computed.

              The components of SPOINT have units of km.


     TRGEPC   is the "sub-solar point epoch." TRGEPC is defined as
              follows: letting LT be the one-way light time between
              the observer and the sub-solar point, TRGEPC is
              either the epoch ET-LT or ET depending on whether the
              requested aberration correction is, respectively, for
              received radiation or omitted. LT is computed using
              the method indicated by ABCORR.

              TRGEPC is expressed as seconds past J2000 TDB.


     SRFVEC   is the vector from the observer's position at ET to
              the aberration-corrected (or optionally, geometric)
              position of SPOINT, where the aberration corrections
              are specified by ABCORR. SRFVEC is expressed in the
              target body-fixed reference frame designated by
              FIXREF, evaluated at TRGEPC.

              The components of SRFVEC are given in units of km.

              One can use the SPICELIB function VNORM to obtain the
              distance between the observer and SPOINT:

                 DIST = VNORM ( SRFVEC )

              The observer's position OBSPOS, relative to the
              target body's center, where the center's position is
              corrected for aberration effects as indicated by
              ABCORR, can be computed via the call:

                 CALL VSUB ( SPOINT, SRFVEC, OBSPOS )

              To transform the vector SRFVEC from a reference frame
              FIXREF at time TRGEPC to a time-dependent reference
              frame REF at time ET, the routine PXFRM2 should be
              called. Let XFORM be the 3x3 matrix representing the
              rotation from the reference frame FIXREF at time
              TRGEPC to the reference frame REF at time ET. Then
              SRFVEC can be transformed to the result REFVEC as
              follows:

                  CALL PXFRM2 ( FIXREF, REF,    TRGEPC, ET, XFORM )
                  CALL MXV    ( XFORM,  SRFVEC, REFVEC )

Parameters

     None.

Exceptions

     1)  If the specified aberration correction is unrecognized, an
         error is signaled by a routine in the call tree of this
         routine.

     2)  If transmission aberration corrections are specified, the
         error SPICE(NOTSUPPORTED) is signaled.

     3)  If either the target or observer input strings cannot be
         converted to an integer ID code, the error
         SPICE(IDCODENOTFOUND) is signaled.

     4)  If the input target body-fixed frame FIXREF is not
         recognized, the error SPICE(NOFRAME) is signaled. A frame
         name may fail to be recognized because a required frame
         specification kernel has not been loaded; another cause is a
         misspelling of the frame name.

     5)  If the input frame FIXREF is not centered at the target body,
         the error SPICE(INVALIDFRAME) is signaled.

     6)  If the input argument METHOD is not recognized, the error
         SPICE(INVALIDMETHOD) is signaled by this routine, or, the
         error is signaled by a routine in the call tree of this
         routine.

     7)  If the sub-solar point type is not specified or is not
         recognized, the error SPICE(INVALIDSUBTYPE) is signaled.

     8)  If insufficient ephemeris data have been loaded prior to
         calling SUBSLR, an error is signaled by a
         routine in the call tree of this routine. Note that when
         light time correction is used, sufficient ephemeris data must
         be available to propagate the states of observer, target, and
         the Sun to the solar system barycenter.

     9)  If the computation method specifies an ellipsoidal target
         shape and triaxial radii of the target body have not been
         loaded into the kernel pool prior to calling SUBSLR, an error
         is signaled by a routine in the call tree of this routine.

     10) The target must be an extended body, and must have a shape
         for which a sub-solar point can be defined.

         If the target body's shape is modeled by DSK data, the shape
         must be such that the specified sub-solar point definition is
         applicable. For example, if the target shape is a torus, both
         the NADIR and INTERCEPT definitions might be inapplicable,
         depending on the relative locations of the sun and target.

     11) If PCK data specifying the target body-fixed frame orientation
         have not been loaded prior to calling SUBSLR, an error is
         signaled by a routine in the call tree of this routine.

     12) If METHOD specifies that the target surface is represented by
         DSK data, and no DSK files are loaded for the specified
         target, an error is signaled by a routine in the call tree
         of this routine.

     13) If METHOD specifies that the target surface is represented
         by DSK data, and the ray from the observer to the
         sub-observer point doesn't intersect the target body's
         surface, the error SPICE(SUBPOINTNOTFOUND) is signaled.

     14) If the surface intercept on the target body's reference
         ellipsoid of the observer to target center vector cannot not
         be computed, the error SPICE(DEGENERATECASE) is signaled. Note
         that this is a very rare case.

     15) If the target body is the sun, the error SPICE(INVALIDTARGET)
         is signaled.

     16) If radii for TARGET are not found in the kernel pool, an error
         is signaled by a routine in the call tree of this routine.

     17) If the size of the TARGET body radii kernel variable is not
         three, an error is signaled by a routine in the call tree of
         this routine.

     18) If any of the three TARGET body radii is less-than or equal to
         zero, an error is signaled by a routine in the call tree of
         this routine.

Files

     Appropriate kernels must be loaded by the calling program before
     this routine is called.

     The following data are required:

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

     -  PCK data: rotation data for the target body must be
        loaded. These may be provided in a text or binary PCK file.

     -  Shape data for the target body:

           PCK data:

              If the target body shape is modeled as an ellipsoid,
              triaxial radii for the target body must be loaded into
              the kernel pool. Typically this is done by loading a
              text PCK file via FURNSH.

              Triaxial radii are also needed if the target shape is
              modeled by DSK data, but the DSK NADIR method is
              selected.

           DSK data:

              If the target shape is modeled by DSK data, DSK files
              containing topographic data for the target body must be
              loaded. If a surface list is specified, data for at
              least one of the listed surfaces must be loaded.

     The following data may be required:

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

     -  Surface name-ID associations: if surface names are specified
        in METHOD, the association of these names with their
        corresponding surface ID codes must be established by
        assignments of the kernel variables

           NAIF_SURFACE_NAME
           NAIF_SURFACE_CODE
           NAIF_SURFACE_BODY

        Normally these associations are made by loading a text
        kernel containing the necessary assignments. An example
        of such an assignment is

           NAIF_SURFACE_NAME += 'Mars MEGDR 128 PIXEL/DEG'
           NAIF_SURFACE_CODE += 1
           NAIF_SURFACE_BODY += 499

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

Particulars

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

     This routine computes light time corrections using light time
     between the observer and the sub-solar point, as opposed to the
     center of the target. Similarly, stellar aberration corrections
     done by this routine are based on the direction of the vector
     from the observer to the light-time corrected sub-solar point,
     not to the target center. This technique avoids errors due to the
     differential between aberration corrections across the target
     body. Therefore it's valid to use aberration corrections with
     this routine even when the observer is very close to the
     sub-solar point, in particular when the observer to sub-solar
     point distance is much less than the observer to target center
     distance.

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


     Using DSK data
     ==============

        DSK loading and unloading
        -------------------------

        DSK files providing data used by this routine are loaded by
        calling FURNSH and can be unloaded by calling UNLOAD or
        KCLEAR. See the documentation of FURNSH for limits on numbers
        of loaded DSK files.

        For run-time efficiency, it's desirable to avoid frequent
        loading and unloading of DSK files. When there is a reason to
        use multiple versions of data for a given target body---for
        example, if topographic data at varying resolutions are to be
        used---the surface list can be used to select DSK data to be
        used for a given computation. It is not necessary to unload
        the data that are not to be used. This recommendation presumes
        that DSKs containing different versions of surface data for a
        given body have different surface ID codes.


        DSK data priority
        -----------------

        A DSK coverage overlap occurs when two segments in loaded DSK
        files cover part or all of the same domain---for example, a
        given longitude-latitude rectangle---and when the time
        intervals of the segments overlap as well.

        When DSK data selection is prioritized, in case of a coverage
        overlap, if the two competing segments are in different DSK
        files, the segment in the DSK file loaded last takes
        precedence. If the two segments are in the same file, the
        segment located closer to the end of the file takes
        precedence.

        When DSK data selection is unprioritized, data from competing
        segments are combined. For example, if two competing segments
        both represent a surface as sets of triangular plates, the
        union of those sets of plates is considered to represent the
        surface.

        Currently only unprioritized data selection is supported.
        Because prioritized data selection may be the default behavior
        in a later version of the routine, the UNPRIORITIZED keyword is
        required in the METHOD argument.


        Syntax of the METHOD input argument
        -----------------------------------

        The keywords and surface list in the METHOD argument
        are called "clauses." The clauses may appear in any
        order, for example

           NADIR/DSK/UNPRIORITIZED/<surface list>
           DSK/NADIR/<surface list>/UNPRIORITIZED
           UNPRIORITIZED/<surface list>/DSK/NADIR

        The simplest form of the METHOD argument specifying use of
        DSK data is one that lacks a surface list, for example:

           'NADIR/DSK/UNPRIORITIZED'
           'INTERCEPT/DSK/UNPRIORITIZED'

        For applications in which all loaded DSK data for the target
        body are for a single surface, and there are no competing
        segments, the above strings suffice. This is expected to be
        the usual case.

        When, for the specified target body, there are loaded DSK
        files providing data for multiple surfaces for that body, the
        surfaces to be used by this routine for a given call must be
        specified in a surface list, unless data from all of the
        surfaces are to be used together.

        The surface list consists of the string

           SURFACES =

        followed by a comma-separated list of one or more surface
        identifiers. The identifiers may be names or integer codes in
        string format. For example, suppose we have the surface
        names and corresponding ID codes shown below:

           Surface Name                              ID code
           ------------                              -------
           'Mars MEGDR 128 PIXEL/DEG'                1
           'Mars MEGDR 64 PIXEL/DEG'                 2
           'Mars_MRO_HIRISE'                         3

        If data for all of the above surfaces are loaded, then
        data for surface 1 can be specified by either

           'SURFACES = 1'

        or

           'SURFACES = "Mars MEGDR 128 PIXEL/DEG"'

        Double quotes are used to delimit the surface name because
        it contains blank characters.

        To use data for surfaces 2 and 3 together, any
        of the following surface lists could be used:

           'SURFACES = 2, 3'

           'SURFACES = "Mars MEGDR  64 PIXEL/DEG", 3'

           'SURFACES = 2, Mars_MRO_HIRISE'

           'SURFACES = "Mars MEGDR 64 PIXEL/DEG", Mars_MRO_HIRISE'

        An example of a METHOD argument that could be constructed
        using one of the surface lists above is

        'NADIR/DSK/UNPRIORITIZED/SURFACES= "Mars MEGDR 64 PIXEL/DEG",3'


        Aberration corrections
        ----------------------

        For irregularly shaped target bodies, the distance between the
        observer and the nearest surface intercept need not be a
        continuous function of time; hence the one-way light time
        between the intercept and the observer may be discontinuous as
        well. In such cases, the computed light time, which is found
        using an iterative algorithm, may converge slowly or not at
        all. In all cases, the light time computation will terminate,
        but the result may be less accurate than expected.

Examples

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


     1) Find the sub-solar point on Mars as seen from the Earth for a
        specified time.

        Compute the sub-solar point using both triaxial ellipsoid
        and topographic surface models. Topography data are provided by
        a DSK file. For the ellipsoid model, use both the "intercept"
        and "near point" sub-observer point definitions; for the DSK
        case, use both the "intercept" and "nadir" definitions.

        Display the locations of both the sun and the sub-solar
        point relative to the center of Mars, in the IAU_MARS
        body-fixed reference frame, using both planetocentric and
        planetographic coordinates.

        The topographic model is based on data from the MGS MOLA DEM
        megr90n000cb, which has a resolution of 4 pixels/degree. A
        triangular plate model was produced by computing a 720 x 1440
        grid of interpolated heights from this DEM, then tessellating
        the height grid. The plate model is stored in a type 2 segment
        in the referenced DSK file.

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


           KPL/MK

           File: subslr_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
              ---------                        --------
              de430.bsp                        Planetary ephemeris
              mar097.bsp                       Mars satellite ephemeris
              pck00010.tpc                     Planet orientation and
                                               radii
              naif0011.tls                     Leapseconds
              megr90n000cb_plate.bds           Plate model based on
                                               MEGDR DEM, resolution
                                               4 pixels/degree.

           \begindata

              KERNELS_TO_LOAD = ( 'de430.bsp',
                                  'mar097.bsp',
                                  'pck00010.tpc',
                                  'naif0011.tls',
                                  'megr90n000cb_plate.bds' )
           \begintext

           End of meta-kernel


        Example code begins here.


              PROGRAM SUBSLR_EX1
              IMPLICIT NONE
        C
        C     SPICELIB functions
        C
              DOUBLE PRECISION      DPR
        C
        C     Local parameters
        C
              CHARACTER*(*)         META
              PARAMETER           ( META   = 'subslr_ex1.tm' )

              CHARACTER*(*)         FM
              PARAMETER           ( FM     =  '(A,F18.9)' )

              INTEGER               MTHLEN
              PARAMETER           ( MTHLEN = 50 )

              INTEGER               NMETH
              PARAMETER           ( NMETH  = 4 )

        C
        C     Local variables
        C
              CHARACTER*(MTHLEN)    METHOD ( NMETH )

              DOUBLE PRECISION      ET
              DOUBLE PRECISION      F
              DOUBLE PRECISION      RADII  ( 3 )
              DOUBLE PRECISION      RE
              DOUBLE PRECISION      RP
              DOUBLE PRECISION      SPCLAT
              DOUBLE PRECISION      SPCLON
              DOUBLE PRECISION      SPCRAD
              DOUBLE PRECISION      SPGALT
              DOUBLE PRECISION      SPGLAT
              DOUBLE PRECISION      SPGLON
              DOUBLE PRECISION      SPOINT ( 3 )
              DOUBLE PRECISION      SRFVEC ( 3 )
              DOUBLE PRECISION      SUNLT
              DOUBLE PRECISION      SUNPOS ( 3 )
              DOUBLE PRECISION      SUNST  ( 6 )
              DOUBLE PRECISION      SUPCLN
              DOUBLE PRECISION      SUPCLT
              DOUBLE PRECISION      SUPCRD
              DOUBLE PRECISION      SUPGAL
              DOUBLE PRECISION      SUPGLN
              DOUBLE PRECISION      SUPGLT
              DOUBLE PRECISION      TRGEPC

              INTEGER               I
              INTEGER               N
        C
        C     Saved variables
        C
              SAVE                  METHOD
        C
        C     Initial values
        C
              DATA                  METHOD / 'Intercept/ellipsoid',
             .                               'Near point/ellipsoid',
             .                      'Intercept/DSK/Unprioritized',
             .                      'Nadir/DSK/Unprioritized'      /
        C
        C     Load kernel files via the meta-kernel.
        C
              CALL FURNSH ( META )

        C
        C     Convert the UTC request time to ET (seconds past
        C     J2000, TDB).
        C
              CALL STR2ET ( '2008 AUG 11 00:00:00', ET )

        C
        C     Look up the target body's radii. We'll use these to
        C     convert Cartesian to planetographic coordinates. Use
        C     the radii to compute the flattening coefficient of
        C     the reference ellipsoid.
        C
              CALL BODVRD ( 'MARS', 'RADII', 3, N, RADII )

        C
        C     Let RE and RP be, respectively, the equatorial and
        C     polar radii of the target.
        C
              RE = RADII( 1 )
              RP = RADII( 3 )

              F  = ( RE - RP ) / RE

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

                 CALL SUBSLR ( METHOD(I),
             .                'MARS',  ET,     'IAU_MARS', 'CN+S',
             .                'EARTH', SPOINT, TRGEPC,     SRFVEC )
        C
        C        Convert the sub-solar point's rectangular coordinates
        C        to planetographic longitude, latitude and altitude.
        C        Convert radians to degrees.
        C
                 CALL RECPGR ( 'MARS', SPOINT, RE,    F,
             .                 SPGLON, SPGLAT, SPGALT   )

                 SPGLON = SPGLON * DPR ()
                 SPGLAT = SPGLAT * DPR ()

        C
        C        Convert sub-solar point's rectangular coordinates to
        C        planetocentric radius, longitude, and latitude.
        C        Convert radians to degrees.
        C
                 CALL RECLAT ( SPOINT, SPCRAD, SPCLON, SPCLAT )

                 SPCLON = SPCLON * DPR ()
                 SPCLAT = SPCLAT * DPR ()

        C
        C        Compute the Sun's apparent position relative to the
        C        sub-solar point at TRGEPC. Add the position of
        C        the sub-solar point relative to the target's center
        C        to obtain the position of the sun relative to the
        C        target's center. Express the latter position in
        C        planetographic coordinates.
        C
                 CALL SPKCPO ( 'SUN',  TRGEPC, 'IAU_MARS', 'OBSERVER',
             .                 'CN+S', SPOINT, 'MARS',     'IAU_MARS',
             .                 SUNST,  SUNLT                          )

                 CALL VADD ( SUNST, SPOINT, SUNPOS )

                 CALL RECPGR ( 'MARS', SUNPOS, RE,    F,
             .                 SUPGLN, SUPGLT, SUPGAL   )

                 SUPGLN = SUPGLN * DPR ()
                 SUPGLT = SUPGLT * DPR ()

        C
        C        Convert the Sun's rectangular coordinates to
        C        planetocentric radius, longitude, and latitude.
        C        Convert radians to degrees.
        C
                 CALL RECLAT ( SUNPOS, SUPCRD, SUPCLN, SUPCLT )

                 SUPCLN = SUPCLN * DPR ()
                 SUPCLT = SUPCLT * DPR ()

        C
        C        Write the results.
        C
                 WRITE(*,FM) ' '
                 WRITE(*,* ) 'Computation method = ', METHOD(I)
                 WRITE(*,FM) ' '
                 WRITE(*,FM) '  Sub-solar point altitude            '
             .   // '(km) = ', SPGALT
                 WRITE(*,FM) '  Sub-solar planetographic longitude '
             .   // '(deg) = ', SPGLON
                 WRITE(*,FM) '  Sun''s planetographic longitude     '
             .   // '(deg) = ', SUPGLN
                 WRITE(*,FM) '  Sub-solar planetographic latitude  '
             .   // '(deg) = ', SPGLAT
                 WRITE(*,FM) '  Sun''s planetographic latitude      '
             .   // '(deg) = ', SUPGLT
                 WRITE(*,FM) '  Sub-solar planetocentric longitude '
             .   // '(deg) = ', SPCLON
                 WRITE(*,FM) '  Sun''s planetocentric longitude     '
             .   // '(deg) = ', SUPCLN
                 WRITE(*,FM) '  Sub-solar planetocentric latitude  '
             .   // '(deg) = ', SPCLAT
                 WRITE(*,FM) '  Sun''s planetocentric latitude      '
             .   // '(deg) = ', SUPCLT
                 WRITE(*,FM) ' '

              END DO

              END


        When this program was executed on a Mac/Intel/gfortran/64-bit
        platform, the output was:


         Computation method = Intercept/ellipsoid

          Sub-solar point altitude            (km) =        0.000000000
          Sub-solar planetographic longitude (deg) =      175.810675508
          Sun's planetographic longitude     (deg) =      175.810675508
          Sub-solar planetographic latitude  (deg) =       23.668550281
          Sun's planetographic latitude      (deg) =       23.420823362
          Sub-solar planetocentric longitude (deg) =     -175.810675508
          Sun's planetocentric longitude     (deg) =     -175.810675508
          Sub-solar planetocentric latitude  (deg) =       23.420819936
          Sun's planetocentric latitude      (deg) =       23.420819936


         Computation method = Near point/ellipsoid

          Sub-solar point altitude            (km) =       -0.000000000
          Sub-solar planetographic longitude (deg) =      175.810675408
          Sun's planetographic longitude     (deg) =      175.810675408
          Sub-solar planetographic latitude  (deg) =       23.420823362
          Sun's planetographic latitude      (deg) =       23.420823362
          Sub-solar planetocentric longitude (deg) =     -175.810675408
          Sun's planetocentric longitude     (deg) =     -175.810675408
          Sub-solar planetocentric latitude  (deg) =       23.175085578
          Sun's planetocentric latitude      (deg) =       23.420819936


         Computation method = Intercept/DSK/Unprioritized

          Sub-solar point altitude            (km) =       -4.052254284
          Sub-solar planetographic longitude (deg) =      175.810675512
          Sun's planetographic longitude     (deg) =      175.810675512
          Sub-solar planetographic latitude  (deg) =       23.668848891
          Sun's planetographic latitude      (deg) =       23.420823362
          Sub-solar planetocentric longitude (deg) =     -175.810675512
          Sun's planetocentric longitude     (deg) =     -175.810675512
          Sub-solar planetocentric latitude  (deg) =       23.420819936
          Sun's planetocentric latitude      (deg) =       23.420819936


         Computation method = Nadir/DSK/Unprioritized

          Sub-solar point altitude            (km) =       -4.022302438
          Sub-solar planetographic longitude (deg) =      175.810675412
          Sun's planetographic longitude     (deg) =      175.810675412
          Sub-solar planetographic latitude  (deg) =       23.420823362
          Sun's planetographic latitude      (deg) =       23.420823362
          Sub-solar planetocentric longitude (deg) =     -175.810675412
          Sun's planetocentric longitude     (deg) =     -175.810675412
          Sub-solar planetocentric latitude  (deg) =       23.174793924
          Sun's planetocentric latitude      (deg) =       23.420819936

Restrictions

     None.

Literature_References

     None.

Author_and_Institution

     N.J. Bachman       (JPL)
     J. Diaz del Rio    (ODC Space)
     S.C. Krening       (JPL)
     B.V. Semenov       (JPL)
     E.D. Wright        (JPL)

Version

    SPICELIB Version 3.1.0, 01-NOV-2021 (JDR) (NJB) (EDW)

        Bug fix: PRVCOR is no longer set to blank before
        ABCORR is parsed.

        Body radii accessed from kernel pool using ZZGFTREB.

        Edited the header to comply with NAIF standard.
        Changed code example and its output to comply with maximum
        line length for header comments.

    SPICELIB Version 3.0.0, 04-APR-2017 (NJB)

        Added FAILED tests.

       14-JUL-2016 (NJB)

        Now uses surface mapping tracking capability.
        Updated header.

       09-FEB-2015 (NJB)

        Support for surface specification was added.
        Header was updated to document DSK features.

       24-DEC-2014 (NJB)

        Updated to support DSK data.

    SPICELIB Version 2.0.0, 31-MAR-2014 (NJB) (SCK) (BVS)

        Bug fix: stellar aberration is no longer applied to the
        observer-to-estimated sub-solar point vector while solving for
        the sub-solar point. This correction involved unnecessary code
        but did not affect this routine's outputs.

        Bug fix: FIRST is now set to .FALSE. at the completion of a
        successful initialization pass. This does not affect the
        routine's outputs but improves efficiency.

        $Exceptions removed: the observer and target are now
        permitted to coincide.

        Upgrade: the algorithm for finding the apparent state of the
        sun as seen from the estimated sub-solar point has been
        improved.

        Upgrade: this routine now uses ZZVALCOR rather than ZZPRSCOR,
        simplifying the implementation.

        The header example program was updated to reflect the new
        method of computing the apparent sun location, and the set
        of kernels referenced by the example meta-kernel were updated.
        The display of the program's output was updated accordingly.

        References to the new PXFRM2 routine were added, which changed
        the Detailed Output section.

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

        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 call LJUCRS instead of CMPRSS/UCASE.

    SPICELIB Version 1.1.0, 18-MAY-2010 (NJB)

        Bug fix: calls to FAILED() have been added after
        SPK calls, target radius lookup, near point
        and surface intercept computations.

    SPICELIB Version 1.0.1, 17-MAR-2009 (NJB)

        Typo correction: changed FIXFRM to FIXREF in header
        documentation. Meta-kernel name suffix was changed to
        ".tm" in header code example.

        Typo correction in $Required_Reading, changed
        FRAME to FRAMES.

    SPICELIB Version 1.0.0, 02-MAR-2008 (NJB)
Fri Dec 31 18:36:58 2021