C$Procedure GFOCLT ( GF, find occultation )

      SUBROUTINE GFOCLT ( OCCTYP,  FRONT,   FSHAPE,  FFRAME,
     .                    BACK,    BSHAPE,  BFRAME,  ABCORR,
     .                    OBSRVR,  STEP,    CNFINE,  RESULT  )

C$ Abstract
C
C     Determine time intervals when an observer sees one target body
C     occulted by, or in transit across, another.
C
C     The surfaces of the target bodies may be represented by triaxial
C     ellipsoids or by topographic data provided by DSK files.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     CK
C     FRAMES
C     GF
C     KERNEL
C     NAIF_IDS
C     SPK
C     TIME
C     WINDOWS
C
C$ Keywords
C
C     EVENT
C     GEOMETRY
C     OCCULTATION
C     SEARCH
C     WINDOW
C
C$ Declarations

      IMPLICIT NONE

      INCLUDE               'gf.inc'
      INCLUDE               'zzholdd.inc'

      INTEGER               LBCELL
      PARAMETER           ( LBCELL = -5 )

      CHARACTER*(*)         OCCTYP
      CHARACTER*(*)         FRONT
      CHARACTER*(*)         FSHAPE
      CHARACTER*(*)         FFRAME
      CHARACTER*(*)         BACK
      CHARACTER*(*)         BSHAPE
      CHARACTER*(*)         BFRAME
      CHARACTER*(*)         ABCORR
      CHARACTER*(*)         OBSRVR
      DOUBLE PRECISION      STEP
      DOUBLE PRECISION      CNFINE ( LBCELL : * )
      DOUBLE PRECISION      RESULT ( LBCELL : * )

C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     LBCELL     P   SPICE Cell lower bound.
C     CNVTOL     P   Convergence tolerance.
C     ZZGET      P   ZZHOLDD retrieves a stored DP value.
C     GF_TOL     P   ZZHOLDD acts on the GF subsystem tolerance.
C     OCCTYP     I   Type of occultation.
C     FRONT      I   Name of body occulting the other.
C     FSHAPE     I   Type of shape model used for front body.
C     FFRAME     I   Body-fixed, body-centered frame for front body.
C     BACK       I   Name of body occulted by the other.
C     BSHAPE     I   Type of shape model used for back body.
C     BFRAME     I   Body-fixed, body-centered frame for back body.
C     ABCORR     I   Aberration correction flag.
C     OBSRVR     I   Name of the observing body.
C     STEP       I   Step size in seconds for finding occultation
C                    events.
C     CNFINE     I   SPICE window to which the search is restricted.
C     RESULT     O   SPICE window containing results.
C
C$ Detailed_Input
C
C
C     OCCTYP     indicates the type of occultation that is to be found.
C                Note that transits are considered to be a type of
C                occultation.
C
C                Supported values and corresponding definitions are:
C
C                   'FULL'      denotes the full occultation of the
C                               body designated by BACK by the body
C                               designated by FRONT, as seen from the
C                               location of the observer. In other
C                               words, the occulted body is completely
C                               invisible as seen from the observer's
C                               location.
C
C                   'ANNULAR'   denotes an annular occultation: the
C                               body designated by FRONT blocks part
C                               of, but not the limb of, the body
C                               designated by BACK, as seen from the
C                               location of the observer.
C
C                   'PARTIAL'   denotes a partial, non-annular
C                               occultation: the body designated by
C                               FRONT blocks part, but not all, of the
C                               limb of the body designated by BACK, as
C                               seen from the location of the observer.
C
C                   'ANY'       denotes any of the above three types of
C                               occultations: 'PARTIAL', 'ANNULAR', or
C                               'FULL'.
C
C                               'ANY' should be used to search for
C                               times when the body designated by FRONT
C                               blocks any part of the body designated
C                               by BACK.
C
C                               The option 'ANY' must be used if either
C                               the front or back target body is
C                               modeled as a point.
C
C                Case and leading or trailing blanks are not
C                significant in the string OCCTYP.
C
C
C     FRONT      is the name of the target body that occults---that is,
C                passes in front of---the other. Optionally, you may
C                supply the integer NAIF ID code for the body as a
C                string. For example both 'MOON' and '301' are
C                legitimate strings that designate the Moon.
C
C                Case and leading or trailing blanks are not
C                significant in the string FRONT.
C
C
C     FSHAPE     is a string indicating the geometric model used to
C                represent the shape of the front target body. The
C                supported options are:
C
C                   'ELLIPSOID'
C
C                       Use a triaxial ellipsoid model with radius
C                       values provided via the kernel pool. A kernel
C                       variable having a name of the form
C
C                          'BODYnnn_RADII'
C
C                       where nnn represents the NAIF integer code
C                       associated with the body, must be present in
C                       the kernel pool. This variable must be
C                       associated with three numeric values giving the
C                       lengths of the ellipsoid's X, Y, and Z
C                       semi-axes.
C
C                   'POINT'
C
C                       Treat the body as a single point. When a point
C                       target is specified, the occultation type must
C                       be set to 'ANY'.
C
C                   'DSK/UNPRIORITIZED[/SURFACES = <surface list>]'
C
C                       Use topographic data provided by DSK files to
C                       model the body's shape. These data must be
C                       provided by loaded DSK files.
C
C                       The surface list specification is optional. The
C                       syntax of the list is
C
C                          <surface 1> [, <surface 2>...]
C
C                       If present, it indicates that data only for the
C                       listed surfaces are to be used; however, data
C                       need not be available for all surfaces in the
C                       list. If absent, loaded DSK data for any surface
C                       associated with the target body are used.
C
C                       The surface list may contain surface names or
C                       surface ID codes. Names containing blanks must
C                       be delimited by double quotes, for example
C
C                          SURFACES = "Mars MEGDR 128 PIXEL/DEG"
C
C                       If multiple surfaces are specified, their names
C                       or IDs must be separated by commas.
C
C                       See the Particulars section below for details
C                       concerning use of DSK data.
C
C                The combinations of the shapes of the target bodies
C                FRONT and BACK must be one of:
C
C                   One ELLIPSOID, one POINT
C                   Two ELLIPSOIDs
C                   One DSK, one POINT
C
C                Case and leading or trailing blanks are not
C                significant in the string FSHAPE.
C
C
C     FFRAME     is the name of the body-fixed, body-centered reference
C                frame associated with the front target body. Examples
C                of such names are 'IAU_SATURN' (for Saturn) and
C                'ITRF93' (for the Earth).
C
C                If the front target body is modeled as a point, FFRAME
C                should be left blank.
C
C                Case and leading or trailing blanks bracketing a
C                non-blank frame name are not significant in the string
C                FFRAME.
C
C
C     BACK       is the name of the target body that is occulted
C                by---that is, passes in back of---the other.
C                Optionally, you may supply the integer NAIF ID code
C                for the body as a string. For example both 'MOON' and
C                '301' are legitimate strings that designate the Moon.
C
C                Case and leading or trailing blanks are not
C                significant in the string BACK.
C
C
C     BSHAPE     is the shape specification for the body designated
C                by BACK. The supported options are those for
C                FSHAPE. See the description of FSHAPE above for
C                details.
C
C
C     BFRAME     is the name of the body-fixed, body-centered reference
C                frame associated with the ``back'' target body.
C                Examples of such names are 'IAU_SATURN' (for Saturn)
C                and 'ITRF93' (for the Earth).
C
C                If the back target body is modeled as a point, BFRAME
C                should be left blank.
C
C                Case and leading or trailing blanks bracketing a
C                non-blank frame name are not significant in the string
C                BFRAME.
C
C
C     ABCORR     indicates the aberration corrections to be applied to
C                the state of each target body to account for one-way
C                light time.  Stellar aberration corrections are
C                ignored if specified, since these corrections don't
C                improve the accuracy of the occultation determination.
C
C                See the header of the SPICE routine SPKEZR for a
C                detailed description of the aberration correction
C                options. For convenience, the options supported by
C                this routine are listed below:
C
C                   'NONE'     Apply no correction.
C
C                   'LT'       "Reception" case:  correct for
C                              one-way light time using a Newtonian
C                              formulation.
C
C                   'CN'       "Reception" case:  converged
C                              Newtonian light time correction.
C
C                   'XLT'      "Transmission" case:  correct for
C                              one-way light time using a Newtonian
C                              formulation.
C
C                   'XCN'      "Transmission" case:  converged
C                              Newtonian light time correction.
C
C                Case and blanks are not significant in the string
C                ABCORR.
C
C
C     OBSRVR     is the name of the body from which the occultation is
C                observed. Optionally, you may supply the integer NAIF
C                ID code for the body as a string.
C
C                Case and leading or trailing blanks are not
C                significant in the string OBSRVR.
C
C
C     STEP       is the step size to be used in the search. STEP must
C                be shorter than any interval, within the confinement
C                window, over which the specified occultation condition
C                is met. In other words, STEP must be shorter than the
C                shortest occultation event that the user wishes to
C                detect; STEP must also be shorter than the shortest
C                time interval between two occultation events that
C                occur within the confinement window (see below).
C                However, STEP must not be *too* short, or the search
C                will take an unreasonable amount of time.
C
C                The choice of STEP affects the completeness but not
C                the precision of solutions found by this routine; the
C                precision is controlled by the convergence tolerance.
C                See the discussion of the parameter CNVTOL for
C                details.
C
C                STEP has units of TDB seconds.
C
C
C     CNFINE     is a SPICE window that confines the time period over
C                which the specified search is conducted. CNFINE may
C                consist of a single interval or a collection of
C                intervals.
C
C                The endpoints of the time intervals comprising CNFINE
C                are interpreted as seconds past J2000 TDB.
C
C                See the Examples section below for a code example
C                that shows how to create a confinement window.
C
C                CNFINE must be initialized by the caller via the
C                SPICELIB routine SSIZED.
C
C
C$ Detailed_Output
C
C     RESULT     is a SPICE window representing the set of time
C                intervals, within the confinement window, when the
C                specified occultation occurs.
C
C                The endpoints of the time intervals comprising RESULT
C                are interpreted as seconds past J2000 TDB.
C
C                If RESULT is non-empty on input, its contents
C                will be discarded before GFOCLT conducts its
C                search.
C
C$ Parameters
C
C     LBCELL     is the lower bound for SPICE cell arrays.
C
C     CNVTOL     is the convergence tolerance used for finding
C                endpoints of the intervals comprising the result
C                window. CNVTOL is used to determine when binary
C                searches for roots should terminate: when a root is
C                bracketed within an interval of length CNVTOL, the
C                root is considered to have been found.
C
C                The accuracy, as opposed to precision, of roots found
C                by this routine depends on the accuracy of the input
C                data. In most cases, the accuracy of solutions will be
C                inferior to their precision.
C
C
C     See INCLUDE file gf.inc for declarations and descriptions of
C     parameters used throughout the GF system.
C
C$ Exceptions
C
C     1)  In order for this routine to produce correct results,
C         the step size must be appropriate for the problem at hand.
C         Step sizes that are too large may cause this routine to miss
C         roots; step sizes that are too small may cause this routine
C         to run unacceptably slowly and in some cases, find spurious
C         roots.
C
C         This routine does not diagnose invalid step sizes, except
C         that if the step size is non-positive, the error
C         SPICE(INVALIDSTEPSIZE) will be signaled.
C
C     2)  Due to numerical errors, in particular,
C
C            - Truncation error in time values
C            - Finite tolerance value
C            - Errors in computed geometric quantities
C
C         it is *normal* for the condition of interest to not always be
C         satisfied near the endpoints of the intervals comprising the
C         result window.
C
C         The result window may need to be contracted slightly by the
C         caller to achieve desired results. The SPICE window routine
C         WNCOND can be used to contract the result window.
C
C     3)  If name of either target or the observer cannot be translated
C         to a NAIF ID code, the error will be diagnosed by a routine
C         in the call tree of this routine.
C
C     4)  If the radii of a target body modeled as an ellipsoid cannot
C         be determined by searching the kernel pool for a kernel
C         variable having a name of the form
C
C            'BODYnnn_RADII'
C
C         where nnn represents the NAIF integer code associated with
C         the body, the error will be diagnosed by a routine in the
C         call tree of this routine.
C
C     5)  If either of the target bodies FRONT or BACK coincides with
C         the observer body OBSRVR, the error will be diagnosed by a
C         routine in the call tree of this routine.
C
C     6)  If the body designated by FRONT coincides with that
C         designated by BACK, the error will be diagnosed by a routine
C         in the call tree of this routine.
C
C     7)  If either of the body model specifiers FSHAPE or BSHAPE
C         is not recognized, the error will be diagnosed by a routine
C         in the call tree of this routine.
C
C     8)  If both of the body model specifiers FSHAPE and BSHAPE
C         specify point targets, the error will be diagnosed by a
C         routine in the call tree of this routine.
C
C     9)  If a target body-fixed reference frame associated with a
C         non-point target is not recognized, the error will be
C         diagnosed by a routine in the call tree of this routine.
C
C     10) If a target body-fixed reference frame is not centered at
C         the corresponding target body,  the error will be
C         diagnosed by a routine in the call tree of this routine.
C
C     11) If the loaded kernels provide insufficient data to
C         compute any required state vector, the deficiency will
C         be diagnosed by a routine in the call tree of this routine.
C
C     12) If an error occurs while reading an SPK or other kernel file,
C         the error will be diagnosed by a routine in the call tree
C         of this routine.
C
C     13) If a point target is specified and the occultation
C         type is set to a valid value other than 'ANY', the
C         error will be diagnosed by a routine in the call tree
C         of this routine.
C
C     14) If the output SPICE window RESULT has insufficient capacity
C         to contain the number of intervals on which the specified
C         occultation condition is met, the error will be diagnosed
C         by a routine in the call tree of this routine. If the result
C         window has size less than 2, the error SPICE(WINDOWTOOSMALL)
C         will be signaled by this routine.
C
C     15) Invalid occultation types will be diagnosed by a routine in
C         the call tree of this routine.
C
C     16) Invalid aberration correction specifications will be
C         diagnosed by a routine in the call tree of this routine.
C
C     17) If either FSHAPE or BSHAPE specifies that the target surface
C         is represented by DSK data, and no DSK files are loaded for
C         the specified target, the error is signaled by a routine in
C         the call tree of this routine.
C
C     18) If either FSHAPE or BSHAPE specifies that the target surface
C         is represented by DSK data, but the shape specification is
C         invalid, the error is signaled by a routine in the call tree
C         of this routine.
C
C
C$ Files
C
C     Appropriate SPICE kernels must be loaded by the calling program
C     before this routine is called.
C
C     The following data are required:
C
C        - SPK data: the calling application must load ephemeris data
C          for the targets, source and observer that cover the time
C          period specified by the window CNFINE. If aberration
C          corrections are used, the states of the target bodies and of
C          the observer relative to the solar system barycenter must be
C          calculable from the available ephemeris data. Typically
C          ephemeris data are made available by loading one or more SPK
C          files via FURNSH.
C
C        - PCK data: bodies modeled as triaxial ellipsoids must have
C          semi-axis lengths provided by variables in the kernel pool.
C          Typically these data are made available by loading a text
C          PCK file via FURNSH.
C
C        - FK data: if either of the reference frames designated by
C          BFRAME or FFRAME are not built in to the SPICE system,
C          one or more FKs specifying these frames must be loaded.
C
C     The following data may be required:
C
C        - DSK data: if either FSHAPE or BSHAPE indicates that DSK
C          data are to be used, DSK files containing topographic data
C          for the target body must be loaded. If a surface list is
C          specified, data for at least one of the listed surfaces must
C          be loaded.
C
C        - Surface name-ID associations: if surface names are specified
C          in FSHAPE or BSHAPE, the association of these names with
C          their corresponding surface ID codes must be established by
C          assignments of the kernel variables
C
C             NAIF_SURFACE_NAME
C             NAIF_SURFACE_CODE
C             NAIF_SURFACE_BODY
C
C          Normally these associations are made by loading a text
C          kernel containing the necessary assignments. An example
C          of such a set of assignments is
C
C             NAIF_SURFACE_NAME += 'Mars MEGDR 128 PIXEL/DEG'
C             NAIF_SURFACE_CODE += 1
C             NAIF_SURFACE_BODY += 499
C
C        - CK data: either of the body-fixed frames to which FFRAME or
C          BFRAME refer might be a CK frame. If so, at least one CK
C          file will be needed to permit transformation of vectors
C          between that frame and the J2000 frame.
C
C        - SCLK data: if a CK file is needed, an associated SCLK
C          kernel is required to enable conversion between encoded SCLK
C          (used to time-tag CK data) and barycentric dynamical time
C          (TDB).
C
C     Kernel data are normally loaded once per program run, NOT every
C     time this routine is called.
C
C$ Particulars
C
C     This routine provides a simpler, but less flexible, interface
C     than does the SPICELIB routine GFOCCE for conducting searches for
C     occultation events. Applications that require support for
C     progress reporting, interrupt handling, non-default step or
C     refinement functions, or non-default convergence tolerance should
C     call GFOCCE rather than this routine.
C
C     This routine determines a set of one or more time intervals
C     within the confinement window when a specified type of
C     occultation occurs. The resulting set of intervals is returned as
C     a SPICE window.
C
C     Below we discuss in greater detail aspects of this routine's
C     solution process that are relevant to correct and efficient
C     use of this routine in user applications.
C
C
C     The Search Process
C     ==================
C
C     The search for occultations is treated as a search for state
C     transitions: times are sought when the state of the BACK body
C     changes from "not occulted" to "occulted" or vice versa.
C
C     Step Size
C     =========
C
C     Each interval of the confinement window is searched as follows:
C     first, the input step size is used to determine the time
C     separation at which the occultation state will be sampled.
C     Starting at the left endpoint of the interval, samples of the
C     occultation state will be taken at each step. If a state change
C     is detected, a root has been bracketed; at that point, the
C     "root"--the time at which the state change occurs---is found by a
C     refinement process, for example, via binary search.
C
C     Note that the optimal choice of step size depends on the lengths
C     of the intervals over which the occultation state is constant:
C     the step size should be shorter than the shortest occultation
C     duration and the shortest period between occultations, within
C     the confinement window.
C
C     Having some knowledge of the relative geometry of the targets and
C     observer can be a valuable aid in picking a reasonable step size.
C     In general, the user can compensate for lack of such knowledge by
C     picking a very short step size; the cost is increased computation
C     time.
C
C     Note that the step size is not related to the precision with which
C     the endpoints of the intervals of the result window are computed.
C     That precision level is controlled by the convergence tolerance.
C
C
C     Convergence Tolerance
C     =====================
C
C     Once a root has been bracketed, a refinement process is used to
C     narrow down the time interval within which the root must lie.
C     This refinement process terminates when the location of the root
C     has been determined to within an error margin called the
C     "convergence tolerance." The default convergence tolerance
C     used by this routine is set by the parameter CNVTOL (defined
C     in gf.inc).
C
C     The value of CNVTOL is set to a "tight" value so that the
C     tolerance doesn't become the limiting factor in the accuracy of
C     solutions found by this routine. In general the accuracy of input
C     data will be the limiting factor.
C
C     The user may change the convergence tolerance from the default
C     CNVTOL value by calling the routine GFSTOL, e.g.
C
C        CALL GFSTOL( tolerance value )
C
C     Call GFSTOL prior to calling this routine. All subsequent
C     searches will use the updated tolerance value.
C
C     Setting the tolerance tighter than CNVTOL is unlikely to be
C     useful, since the results are unlikely to be more accurate.
C     Making the tolerance looser will speed up searches somewhat,
C     since a few convergence steps will be omitted. However, in most
C     cases, the step size is likely to have a much greater effect
C     on processing time than would the convergence tolerance.
C
C
C     The Confinement Window
C     ======================
C
C     The simplest use of the confinement window is to specify a time
C     interval within which a solution is sought.
C
C     The confinement window also can be used to restrict a search to
C     a time window over which required data (typically ephemeris
C     data, in the case of occultation searches) are known to be
C     available.
C
C     In some cases, the confinement window be used to make searches
C     more efficient. Sometimes it's possible to do an efficient search
C     to reduce the size of the time period over which a relatively
C     slow search of interest must be performed. See the "CASCADE"
C     example program in gf.req for a demonstration.
C
C
C     Using DSK data
C     ==============
C
C        DSK loading and unloading
C        -------------------------
C
C        DSK files providing data used by this routine are loaded by
C        calling FURNSH and can be unloaded by calling UNLOAD or
C        KCLEAR. See the documentation of FURNSH for limits on numbers
C        of loaded DSK files.
C
C        For run-time efficiency, it's desirable to avoid frequent
C        loading and unloading of DSK files. When there is a reason to
C        use multiple versions of data for a given target body---for
C        example, if topographic data at varying resolutions are to be
C        used---the surface list can be used to select DSK data to be
C        used for a given computation. It is not necessary to unload
C        the data that are not to be used. This recommendation presumes
C        that DSKs containing different versions of surface data for a
C        given body have different surface ID codes.
C
C
C        DSK data priority
C        -----------------
C
C        A DSK coverage overlap occurs when two segments in loaded DSK
C        files cover part or all of the same domain---for example, a
C        given longitude-latitude rectangle---and when the time
C        intervals of the segments overlap as well.
C
C        When DSK data selection is prioritized, in case of a coverage
C        overlap, if the two competing segments are in different DSK
C        files, the segment in the DSK file loaded last takes
C        precedence. If the two segments are in the same file, the
C        segment located closer to the end of the file takes
C        precedence.
C
C        When DSK data selection is unprioritized, data from competing
C        segments are combined. For example, if two competing segments
C        both represent a surface as sets of triangular plates, the
C        union of those sets of plates is considered to represent the
C        surface.
C
C        Currently only unprioritized data selection is supported.
C        Because prioritized data selection may be the default behavior
C        in a later version of the routine, the UNPRIORITIZED keyword is
C        required in the FSHAPE and BSHAPE arguments.
C
C
C        Syntax of the shape input arguments for the DSK case
C        ----------------------------------------------------
C
C        The keywords and surface list in the target shape arguments
C        FSHAPE and BSHAPE, when DSK shape models are specified, are
C        called "clauses." The clauses may appear in any order, for
C        example
C
C           DSK/<surface list>/UNPRIORITIZED
C           DSK/UNPRIORITIZED/<surface list>
C           UNPRIORITIZED/<surface list>/DSK
C
C        The simplest form of a target argument specifying use of
C        DSK data is one that lacks a surface list, for example:
C
C           'DSK/UNPRIORITIZED'
C
C        For applications in which all loaded DSK data for the target
C        body are for a single surface, and there are no competing
C        segments, the above string suffices. This is expected to be
C        the usual case.
C
C        When, for the specified target body, there are loaded DSK
C        files providing data for multiple surfaces for that body, the
C        surfaces to be used by this routine for a given call must be
C        specified in a surface list, unless data from all of the
C        surfaces are to be used together.
C
C        The surface list consists of the string
C
C           SURFACES =
C
C        followed by a comma-separated list of one or more surface
C        identifiers. The identifiers may be names or integer codes in
C        string format. For example, suppose we have the surface
C        names and corresponding ID codes shown below:
C
C           Surface Name                              ID code
C           ------------                              -------
C           'Mars MEGDR 128 PIXEL/DEG'                1
C           'Mars MEGDR 64 PIXEL/DEG'                 2
C           'Mars_MRO_HIRISE'                         3
C
C        If data for all of the above surfaces are loaded, then
C        data for surface 1 can be specified by either
C
C           'SURFACES = 1'
C
C        or
C
C           'SURFACES = "Mars MEGDR 128 PIXEL/DEG"'
C
C        Double quotes are used to delimit the surface name because
C        it contains blank characters.
C
C        To use data for surfaces 2 and 3 together, any
C        of the following surface lists could be used:
C
C           'SURFACES = 2, 3'
C
C           'SURFACES = "Mars MEGDR  64 PIXEL/DEG", 3'
C
C           'SURFACES = 2, Mars_MRO_HIRISE'
C
C           'SURFACES = "Mars MEGDR 64 PIXEL/DEG", Mars_MRO_HIRISE'
C
C        An example of a shape argument that could be constructed
C        using one of the surface lists above is
C
C          'DSK/UNPRIORITIZED/SURFACES = "Mars MEGDR 64 PIXEL/DEG", 3'
C
C
C$ Examples
C
C
C     The numerical results shown for these examples may differ across
C     platforms. The results depend on the SPICE kernels used as
C     input, the compiler and supporting libraries, and the machine
C     specific arithmetic implementation.
C
C     1) Find occultations of the Sun by the Moon (that is, solar
C        eclipses) as seen from the center of the Earth over the month
C        December, 2001.
C
C        Use light time corrections to model apparent positions of Sun
C        and Moon. Stellar aberration corrections are not specified
C        because they don't affect occultation computations.
C
C        We select a step size of 3 minutes, which means we
C        ignore occultation events lasting less than 3 minutes,
C        if any exist.
C
C        Use the meta-kernel shown below to load the required SPICE
C        kernels.
C
C           KPL/MK
C
C           File name: standard.tm
C
C           This meta-kernel is intended to support operation of SPICE
C           example programs. The kernels shown here should not be
C           assumed to contain adequate or correct versions of data
C           required by SPICE-based user applications.
C
C           In order for an application to use this meta-kernel, the
C           kernels referenced here must be present in the user's
C           current working directory.
C
C
C           \begindata
C
C              KERNELS_TO_LOAD = ( 'de421.bsp',
C                                  'pck00008.tpc',
C                                  'naif0009.tls'  )
C
C           \begintext
C
C
C       Example code begins here.
C
C
C           PROGRAM EX1
C
C           IMPLICIT NONE
C
C           INTEGER               WNCARD
C
C           CHARACTER*(*)         TIMFMT
C           PARAMETER           ( TIMFMT =
C          .   'YYYY MON DD HR:MN:SC.###### (TDB)::TDB' )
C
C           INTEGER               MAXWIN
C           PARAMETER           ( MAXWIN = 2 * 100 )
C
C           INTEGER               TIMLEN
C           PARAMETER           ( TIMLEN = 40 )
C
C           INTEGER               LBCELL
C           PARAMETER           ( LBCELL = -5 )
C
C           CHARACTER*(TIMLEN)    WIN0
C           CHARACTER*(TIMLEN)    WIN1
C           CHARACTER*(TIMLEN)    BEGSTR
C           CHARACTER*(TIMLEN)    ENDSTR
C
C           DOUBLE PRECISION      CNFINE ( LBCELL : MAXWIN )
C           DOUBLE PRECISION      ET0
C           DOUBLE PRECISION      ET1
C           DOUBLE PRECISION      LEFT
C           DOUBLE PRECISION      RESULT ( LBCELL : MAXWIN )
C           DOUBLE PRECISION      RIGHT
C           DOUBLE PRECISION      STEP
C
C           INTEGER               I
C
C     C
C     C     Load kernels.
C     C
C           CALL FURNSH ( 'standard.tm' )
C
C     C
C     C     Initialize the confinement and result windows.
C     C
C           CALL SSIZED ( MAXWIN, CNFINE )
C           CALL SSIZED ( MAXWIN, RESULT )
C
C     C
C     C     Obtain the TDB time bounds of the confinement
C     C     window, which is a single interval in this case.
C     C
C           WIN0 = '2001 DEC 01 00:00:00 TDB'
C           WIN1 = '2002 JAN 01 00:00:00 TDB'
C
C           CALL STR2ET ( WIN0, ET0 )
C           CALL STR2ET ( WIN1, ET1 )
C
C     C
C     C     Insert the time bounds into the confinement
C     C     window.
C     C
C           CALL WNINSD ( ET0, ET1, CNFINE )
C
C     C
C     C     Select a 3-minute step. We'll ignore any occultations
C     C     lasting less than 3 minutes. Units are TDB seconds.
C     C
C           STEP = 180.D0
C
C     C
C     C     Perform the search.
C     C
C           CALL GFOCLT ( 'ANY',
C          .              'MOON',  'ellipsoid', 'IAU_MOON',
C          .              'SUN',   'ellipsoid', 'IAU_SUN',
C          .              'LT',    'EARTH',     STEP,
C          .              CNFINE,  RESULT                  )
C
C
C           IF ( WNCARD(RESULT) .EQ. 0 ) THEN
C
C              WRITE (*,*) 'No occultation was found.'
C
C           ELSE
C
C              DO I = 1, WNCARD(RESULT)
C     C
C     C           Fetch and display each occultation interval.
C     C
C                 CALL WNFETD ( RESULT, I, LEFT, RIGHT )
C
C                 CALL TIMOUT ( LEFT,  TIMFMT, BEGSTR )
C                 CALL TIMOUT ( RIGHT, TIMFMT, ENDSTR )
C
C                 WRITE (*,*) 'Interval ', I
C                 WRITE (*,*) '   Start time: '//BEGSTR
C                 WRITE (*,*) '   Stop time:  '//ENDSTR
C
C              END DO
C
C           END IF
C
C           END
C
C
C     When this program was executed on a PC/Linux/g77 platform, the
C     output was:
C
C        Interval  1
C           Start time: 2001 DEC 14 20:10:14.195952 (TDB)
C           Stop time:  2001 DEC 14 21:35:50.317994 (TDB)
C
C
C
C     2) Find occultations of Titan by Saturn or of Saturn by
C        Titan as seen from the center of the Earth over the
C        last four months of 2008. Model both target bodies as
C        ellipsoids. Search for every type of occultation.
C
C        Use light time corrections to model apparent positions of
C        Saturn and Titan. Stellar aberration corrections are not
C        specified because they don't affect occultation computations.
C
C        We select a step size of 15 minutes, which means we
C        ignore occultation events lasting less than 15 minutes,
C        if any exist.
C
C        Use the meta-kernel shown below to load the required SPICE
C        kernels.
C
C
C           KPL/MK
C
C           File name: gfoclt_ex2.tm
C
C           This meta-kernel is intended to support operation of SPICE
C           example programs. The kernels shown here should not be
C           assumed to contain adequate or correct versions of data
C           required by SPICE-based user applications.
C
C           In order for an application to use this meta-kernel, the
C           kernels referenced here must be present in the user's
C           current working directory.
C
C           The names and contents of the kernels referenced
C           by this meta-kernel are as follows:
C
C              File name                     Contents
C              ---------                     --------
C              de421.bsp                     Planetary ephemeris
C              sat288.bsp                    Satellite ephemeris for
C                                            Saturn
C              pck00008.tpc                  Planet orientation and
C                                            radii
C              naif0009.tls                  Leapseconds
C
C           \begindata
C
C              KERNELS_TO_LOAD = ( 'de421.bsp',
C                                  'sat286.bsp',
C                                  'pck00008.tpc',
C                                  'naif0009.tls'  )
C
C           \begintext
C
C           End of meta-kernel
C
C
C       Example code begins here.
C
C
C           PROGRAM EX2
C           IMPLICIT NONE
C     C
C     C     SPICELIB functions
C     C
C           INTEGER               WNCARD
C     C
C     C     Local parameters
C     C
C           CHARACTER*(*)         TIMFMT
C           PARAMETER           ( TIMFMT =
C          .   'YYYY MON DD HR:MN:SC.###### (TDB)::TDB' )
C
C           INTEGER               MAXWIN
C           PARAMETER           ( MAXWIN = 2 * 100 )
C
C           INTEGER               TIMLEN
C           PARAMETER           ( TIMLEN = 40 )
C
C           INTEGER               BDNMLN
C           PARAMETER           ( BDNMLN = 36 )
C
C           INTEGER               FRNMLN
C           PARAMETER           ( FRNMLN = 32 )
C     C
C     C     Number of occultation types:
C     C
C           INTEGER               NTYPES
C           PARAMETER           ( NTYPES = 4 )
C     C
C     C     Occultation type name length:
C     C
C           INTEGER               OCNMLN
C           PARAMETER           ( OCNMLN = 10 )
C     C
C     C     Output line length:
C     C
C           INTEGER               LNSIZE
C           PARAMETER           ( LNSIZE = 80 )
C
C           INTEGER               LBCELL
C           PARAMETER           ( LBCELL = -5 )
C
C           CHARACTER*(BDNMLN)    BACK
C           CHARACTER*(FRNMLN)    BFRAME
C           CHARACTER*(FRNMLN)    FFRAME
C           CHARACTER*(BDNMLN)    FRONT
C           CHARACTER*(LNSIZE)    LINE
C           CHARACTER*(BDNMLN)    OBSRVR
C           CHARACTER*(OCNMLN)    OCCTYP ( NTYPES )
C           CHARACTER*(LNSIZE)    TEMPLT ( NTYPES )
C           CHARACTER*(TIMLEN)    TIMSTR
C           CHARACTER*(LNSIZE)    TITLE
C           CHARACTER*(TIMLEN)    WIN0
C           CHARACTER*(TIMLEN)    WIN1
C
C           DOUBLE PRECISION      CNFINE ( LBCELL : MAXWIN )
C           DOUBLE PRECISION      ET0
C           DOUBLE PRECISION      ET1
C           DOUBLE PRECISION      FINISH
C           DOUBLE PRECISION      RESULT ( LBCELL : MAXWIN )
C           DOUBLE PRECISION      START
C           DOUBLE PRECISION      STEP
C
C           INTEGER               I
C           INTEGER               J
C           INTEGER               K
C     C
C     C     Saved variables
C     C
C     C     The confinement and result windows CNFINE
C     C     and RESULT are saved because this practice
C     C     helps to prevent stack overflow.
C     C
C     C     The variables OCCTYP and TEMPLT are
C     C     saved to facilitate turning this main program into
C     C     a subroutine. In a main program, it's not
C     C     necessary to save these variables.
C     C
C           SAVE                  CNFINE
C           SAVE                  OCCTYP
C           SAVE                  RESULT
C           SAVE                  TEMPLT
C     C
C     C     Initial values
C     C
C           DATA                  OCCTYP / 'FULL',
C          .                               'ANNULAR',
C          .                               'PARTIAL',
C          .                               'ANY'     /
C
C           DATA                  TEMPLT /
C          .      'Condition: # occultation of # by #',
C          .      'Condition: # occultation of # by #',
C          .      'Condition: # occultation of # by #',
C          .      'Condition: # occultation of # by #'      /
C
C     C
C     C     Load kernels.
C     C
C           CALL FURNSH ( 'gfoclt_ex2.tm' )
C
C     C
C     C     Initialize the confinement and result windows.
C     C
C           CALL SSIZED ( MAXWIN, CNFINE )
C           CALL SSIZED ( MAXWIN, RESULT )
C
C     C
C     C     Obtain the TDB time bounds of the confinement
C     C     window, which is a single interval in this case.
C     C
C           WIN0 = '2008 SEP 01 00:00:00 TDB'
C           WIN1 = '2009 JAN 01 00:00:00 TDB'
C
C           CALL STR2ET ( WIN0, ET0 )
C           CALL STR2ET ( WIN1, ET1 )
C     C
C     C     Insert the time bounds into the confinement
C     C     window.
C     C
C           CALL WNINSD ( ET0, ET1, CNFINE )
C     C
C     C     Select a 15-minute step. We'll ignore any occultations
C     C     lasting less than 15 minutes. Units are TDB seconds.
C     C
C           STEP = 900.D0
C     C
C     C     The observation location is the Earth.
C     C
C           OBSRVR = 'EARTH'
C
C     C
C     C     Loop over the occultation types.
C     C
C           DO I = 1, NTYPES
C     C
C     C        For each type, do a search for both transits of
C     C        Titan across Saturn and occultations of Titan by
C     C        Saturn.
C     C
C              DO J = 1, 2
C
C                 IF ( J .EQ. 1 ) THEN
C
C                    FRONT  = 'TITAN'
C                    FFRAME = 'IAU_TITAN'
C                    BACK   = 'SATURN'
C                    BFRAME = 'IAU_SATURN'
C
C                 ELSE
C
C                    FRONT  = 'SATURN'
C                    FFRAME = 'IAU_SATURN'
C                    BACK   = 'TITAN'
C                    BFRAME = 'IAU_TITAN'
C
C                 END IF
C     C
C     C           Perform the search. The target body shapes
C     C           are modeled as ellipsoids.
C     C
C                 CALL GFOCLT ( OCCTYP(I),
C          .                    FRONT,  'ELLIPSOID', FFRAME,
C          .                    BACK,   'ELLIPSOID', BFRAME,
C          .                    'LT',   OBSRVR,      STEP,
C          .                    CNFINE, RESULT              )
C     C
C     C           Display the results.
C     C
C                 WRITE (*,*) ' '
C     C
C     C           Substitute the occultation type and target
C     C           body names into the title string:
C     C
C                 CALL REPMC ( TEMPLT(I), '#', OCCTYP(I), TITLE )
C                 CALL REPMC ( TITLE,     '#', BACK,      TITLE )
C                 CALL REPMC ( TITLE,     '#', FRONT,     TITLE )
C
C                 WRITE (*, '(A)' ) TITLE
C
C                 IF ( WNCARD(RESULT) .EQ. 0 ) THEN
C
C                    WRITE (*, '(A)' ) ' Result window is empty: '
C          .         //                'no occultation was found.'
C
C                 ELSE
C
C                    WRITE (*, '(A)' ) ' Result window start, '
C          .         //                'stop times:'
C
C                    DO K = 1, WNCARD(RESULT)
C     C
C     C                 Fetch the endpoints of the Kth interval
C     C                 of the result window.
C     C
C                       CALL WNFETD ( RESULT, K, START, FINISH )
C
C                       LINE = '  #  #'
C
C                       CALL TIMOUT ( START, TIMFMT, TIMSTR )
C
C                       CALL REPMC  ( LINE, '#', TIMSTR, LINE )
C
C                       CALL TIMOUT ( FINISH, TIMFMT, TIMSTR )
C
C                       CALL REPMC  ( LINE, '#', TIMSTR, LINE )
C
C                       WRITE ( *, '(A)' ) LINE
C
C                    END DO
C
C                 END IF
C     C
C     C           We've finished displaying the results of the
C     C           current search.
C     C
C              END DO
C     C
C     C        We've finished displaying the results of the
C     C        searches using the current occultation type.
C     C
C           END DO
C
C           WRITE (*,*) ' '
C
C           END
C
C     When this program was executed on a PC/Linux/g77 platform, the
C     output was:
C
C
C Condition: FULL occultation of SATURN by TITAN
C Result window is empty: no occultation was found.
C
C Condition: FULL occultation of TITAN by SATURN
C  Result window start, stop times:
C   2008 OCT 27 22:08:01.627053 (TDB)  2008 OCT 28 01:05:03.375236 (TDB)
C   2008 NOV 12 21:21:59.252262 (TDB)  2008 NOV 13 02:06:05.053051 (TDB)
C   2008 NOV 28 20:49:02.402832 (TDB)  2008 NOV 29 02:13:58.986344 (TDB)
C   2008 DEC 14 20:05:09.246177 (TDB)  2008 DEC 15 01:44:53.523002 (TDB)
C   2008 DEC 30 19:00:56.577073 (TDB)  2008 DEC 31 00:42:43.222909 (TDB)
C
C Condition: ANNULAR occultation of SATURN by TITAN
C  Result window start, stop times:
C   2008 OCT 19 21:29:20.599087 (TDB)  2008 OCT 19 22:53:34.518737 (TDB)
C   2008 NOV 04 20:15:38.620368 (TDB)  2008 NOV 05 00:18:59.139978 (TDB)
C   2008 NOV 20 19:38:59.647712 (TDB)  2008 NOV 21 00:35:26.725908 (TDB)
C   2008 DEC 06 18:58:34.073268 (TDB)  2008 DEC 07 00:16:17.647040 (TDB)
C   2008 DEC 22 18:02:46.288289 (TDB)  2008 DEC 22 23:26:52.712459 (TDB)
C
C Condition: ANNULAR occultation of TITAN by SATURN
C  Result window is empty: no occultation was found.
C
C Condition: PARTIAL occultation of SATURN by TITAN
C  Result window start, stop times:
C   2008 OCT 19 20:44:30.326771 (TDB)  2008 OCT 19 21:29:20.599087 (TDB)
C   2008 OCT 19 22:53:34.518737 (TDB)  2008 OCT 19 23:38:26.250580 (TDB)
C   2008 NOV 04 19:54:40.339331 (TDB)  2008 NOV 04 20:15:38.620368 (TDB)
C   2008 NOV 05 00:18:59.139978 (TDB)  2008 NOV 05 00:39:58.612935 (TDB)
C   2008 NOV 20 19:21:46.689523 (TDB)  2008 NOV 20 19:38:59.647712 (TDB)
C   2008 NOV 21 00:35:26.725908 (TDB)  2008 NOV 21 00:52:40.604703 (TDB)
C   2008 DEC 06 18:42:36.100544 (TDB)  2008 DEC 06 18:58:34.073268 (TDB)
C   2008 DEC 07 00:16:17.647040 (TDB)  2008 DEC 07 00:32:16.324244 (TDB)
C   2008 DEC 22 17:47:10.776722 (TDB)  2008 DEC 22 18:02:46.288289 (TDB)
C   2008 DEC 22 23:26:52.712459 (TDB)  2008 DEC 22 23:42:28.850542 (TDB)
C
C Condition: PARTIAL occultation of TITAN by SATURN
C  Result window start, stop times:
C   2008 OCT 27 21:37:16.970175 (TDB)  2008 OCT 27 22:08:01.627053 (TDB)
C   2008 OCT 28 01:05:03.375236 (TDB)  2008 OCT 28 01:35:49.266506 (TDB)
C   2008 NOV 12 21:01:47.105498 (TDB)  2008 NOV 12 21:21:59.252262 (TDB)
C   2008 NOV 13 02:06:05.053051 (TDB)  2008 NOV 13 02:26:18.227357 (TDB)
C   2008 NOV 28 20:31:28.522707 (TDB)  2008 NOV 28 20:49:02.402832 (TDB)
C   2008 NOV 29 02:13:58.986344 (TDB)  2008 NOV 29 02:31:33.691598 (TDB)
C   2008 DEC 14 19:48:27.094229 (TDB)  2008 DEC 14 20:05:09.246177 (TDB)
C   2008 DEC 15 01:44:53.523002 (TDB)  2008 DEC 15 02:01:36.360243 (TDB)
C   2008 DEC 30 18:44:23.485898 (TDB)  2008 DEC 30 19:00:56.577073 (TDB)
C   2008 DEC 31 00:42:43.222909 (TDB)  2008 DEC 31 00:59:17.030568 (TDB)
C
C Condition: ANY occultation of SATURN by TITAN
C  Result window start, stop times:
C   2008 OCT 19 20:44:30.326771 (TDB)  2008 OCT 19 23:38:26.250580 (TDB)
C   2008 NOV 04 19:54:40.339331 (TDB)  2008 NOV 05 00:39:58.612935 (TDB)
C   2008 NOV 20 19:21:46.689523 (TDB)  2008 NOV 21 00:52:40.604703 (TDB)
C   2008 DEC 06 18:42:36.100544 (TDB)  2008 DEC 07 00:32:16.324244 (TDB)
C   2008 DEC 22 17:47:10.776722 (TDB)  2008 DEC 22 23:42:28.850542 (TDB)
C
C Condition: ANY occultation of TITAN by SATURN
C  Result window start, stop times:
C   2008 OCT 27 21:37:16.970175 (TDB)  2008 OCT 28 01:35:49.266506 (TDB)
C   2008 NOV 12 21:01:47.105498 (TDB)  2008 NOV 13 02:26:18.227357 (TDB)
C   2008 NOV 28 20:31:28.522707 (TDB)  2008 NOV 29 02:31:33.691598 (TDB)
C   2008 DEC 14 19:48:27.094229 (TDB)  2008 DEC 15 02:01:36.360243 (TDB)
C   2008 DEC 30 18:44:23.485898 (TDB)  2008 DEC 31 00:59:17.030568 (TDB)
C
C
C
C     3) Find occultations of the Mars Reconaissance Orbiter (MRO)
C        by Mars or transits of the MRO spacecraft across Mars
C        as seen from the DSN station DSS-14 over a period of a
C        few hours on FEB 28 2015.
C
C        Use both ellipsoid and DSK shape models for Mars.
C
C        Use light time corrections to model apparent positions of
C        Mars and MRO. Stellar aberration corrections are not
C        specified because they don't affect occultation computations.
C
C        We select a step size of 3 minutes, which means we
C        ignore occultation events lasting less than 3 minutes,
C        if any exist.
C
C        Use the meta-kernel shown below to load the required SPICE
C        kernels.
C
C
C          KPL/MK
C
C          File: gfoclt_ex3.tm
C
C          This meta-kernel is intended to support operation of SPICE
C          example programs. The kernels shown here should not be
C          assumed to contain adequate or correct versions of data
C          required by SPICE-based user applications.
C
C          In order for an application to use this meta-kernel, the
C          kernels referenced here must be present in the user's
C          current working directory.
C
C          The names and contents of the kernels referenced
C          by this meta-kernel are as follows:
C
C             File name                        Contents
C             ---------                        --------
C             de410.bsp                        Planetary ephemeris
C             mar063.bsp                       Mars satellite ephemeris
C             pck00010.tpc                     Planet orientation and
C                                              radii
C             naif0011.tls                     Leapseconds
C             earthstns_itrf93_050714.bsp      DSN station ephemeris
C             earth_latest_high_prec.bpc       Earth orientation
C             mro_psp34.bsp                    MRO ephemeris
C             megr90n000cb_plate.bds           Plate model based on
C                                              MEGDR DEM, resolution
C                                              4 pixels/degree.
C
C          \begindata
C
C             PATH_SYMBOLS    = ( 'MRO', 'GEN' )
C
C             PATH_VALUES     = (
C                                 '/ftp/pub/naif/pds/data+'
C                                 '/mro-m-spice-6-v1.0/+'
C                                 'mrosp_1000/data/spk',
C                                 '/ftp/pub/naif/generic_kernels'
C                               )
C
C             KERNELS_TO_LOAD = ( '$MRO/de410.bsp',
C                                 '$MRO/mar063.bsp',
C                                 '$MRO/mro_psp34.bsp',
C                                 '$GEN/spk/stations/+'
C                                 'earthstns_itrf93_050714.bsp',
C                                 '$GEN/pck/earth_latest_high_prec.bpc',
C                                 'pck00010.tpc',
C                                 'naif0011.tls',
C                                 'megr90n000cb_plate.bds'
C                               )
C          \begintext
C
C
C       Example code begins here.
C
C
C              PROGRAM EX3
C
C              IMPLICIT NONE
C        C
C        C     SPICELIB functions
C        C
C              INTEGER               WNCARD
C        C
C        C     Local parameters
C        C
C              CHARACTER*(*)         META
C              PARAMETER           ( META   = 'gfoclt_ex3.tm' )
C
C              CHARACTER*(*)         TIMFMT
C              PARAMETER           ( TIMFMT =
C             .   'YYYY MON DD HR:MN:SC.###### (TDB)::TDB' )
C
C              INTEGER               MAXWIN
C              PARAMETER           ( MAXWIN = 2 * 100 )
C
C              INTEGER               CORLEN
C              PARAMETER           ( CORLEN = 10 )
C
C              INTEGER               TIMLEN
C              PARAMETER           ( TIMLEN = 40 )
C
C              INTEGER               BDNMLN
C              PARAMETER           ( BDNMLN = 36 )
C
C              INTEGER               FRNMLN
C              PARAMETER           ( FRNMLN = 32 )
C
C              INTEGER               SHPLEN
C              PARAMETER           ( SHPLEN = 100 )
C
C              INTEGER               OTYPLN
C              PARAMETER           ( OTYPLN = 20 )
C
C              INTEGER               LBCELL
C              PARAMETER           ( LBCELL = -5 )
C
C        C
C        C     Local variables
C        C
C              CHARACTER*(CORLEN)    ABCORR
C              CHARACTER*(BDNMLN)    BACK
C              CHARACTER*(FRNMLN)    BFRAME
C              CHARACTER*(SHPLEN)    BSHAPE
C              CHARACTER*(BDNMLN)    FRONT
C              CHARACTER*(SHPLEN)    FSHAPE
C              CHARACTER*(FRNMLN)    FFRAME
C              CHARACTER*(OTYPLN)    OCCTYP
C              CHARACTER*(BDNMLN)    OBSRVR
C              CHARACTER*(TIMLEN)    WIN0
C              CHARACTER*(TIMLEN)    WIN1
C              CHARACTER*(TIMLEN)    BEGSTR
C              CHARACTER*(TIMLEN)    ENDSTR
C
C              DOUBLE PRECISION      CNFINE ( LBCELL : MAXWIN )
C              DOUBLE PRECISION      ET0
C              DOUBLE PRECISION      ET1
C              DOUBLE PRECISION      LEFT
C              DOUBLE PRECISION      RESULT ( LBCELL : MAXWIN )
C              DOUBLE PRECISION      RIGHT
C              DOUBLE PRECISION      STEP
C
C              INTEGER               I
C              INTEGER               J
C              INTEGER               K
C        C
C        C     Load kernels.
C        C
C              CALL FURNSH ( META )
C
C        C
C        C     Initialize the confinement and result windows.
C        C
C              CALL SSIZED ( MAXWIN, CNFINE )
C              CALL SSIZED ( MAXWIN, RESULT )
C        C
C        C     Set the observer and aberration correction.
C        C
C              OBSRVR = 'DSS-14'
C              ABCORR = 'CN'
C        C
C        C     Set the occultation type.
C        C
C              OCCTYP = 'ANY'
C        C
C        C     Set the TDB time bounds of the confinement
C        C     window, which is a single interval in this case.
C        C
C              WIN0 = '2015 FEB 28 07:00:00 TDB'
C              WIN1 = '2015 FEB 28 12:00:00 TDB'
C
C              CALL STR2ET ( WIN0, ET0 )
C              CALL STR2ET ( WIN1, ET1 )
C        C
C        C     Insert the time bounds into the confinement
C        C     window.
C        C
C              CALL WNINSD ( ET0, ET1, CNFINE )
C        C
C        C     Select a 3-minute step. We'll ignore any occultations
C        C     lasting less than 3 minutes. Units are TDB seconds.
C        C
C              STEP = 180.D0
C
C        C
C        C     Perform both spacecraft occultation and spacecraft
C        C     transit searches.
C        C
C              WRITE (*,*) ' '
C
C              DO I = 1, 2
C
C                 IF ( I .EQ. 1 ) THEN
C        C
C        C           Perform a spacecraft occultation search.
C        C
C                    FRONT  = 'MARS'
C                    FFRAME = 'IAU_MARS'
C
C                    BACK   = 'MRO'
C                    BSHAPE = 'POINT'
C                    BFRAME = ' '
C
C                 ELSE
C        C
C        C           Perform a spacecraft transit search.
C        C
C                    FRONT  = 'MRO'
C                    FSHAPE = 'POINT'
C                    FFRAME = ' '
C
C                    BACK   = 'MARS'
C                    BFRAME = 'IAU_MARS'
C
C                 END IF
C
C
C                 DO J = 1, 2
C
C                    IF ( J .EQ. 1 ) THEN
C        C
C        C              Model the planet shape as an ellipsoid.
C        C
C                       IF ( I .EQ. 1 ) THEN
C                          FSHAPE = 'ELLIPSOID'
C                       ELSE
C                          BSHAPE = 'ELLIPSOID'
C                       END IF
C
C                    ELSE
C        C
C        C              Model the planet shape using DSK data.
C        C
C                       IF ( I .EQ. 1 ) THEN
C                          FSHAPE = 'DSK/UNPRIORITIZED'
C                       ELSE
C                          BSHAPE = 'DSK/UNPRIORITIZED'
C                       END IF
C
C                    END IF
C
C        C
C        C           Perform the spacecraft occultation or
C        C           transit search.
C
C                    IF ( I .EQ. 1 ) THEN
C                       CALL TOSTDO ( 'Using shape model '//FSHAPE     )
C                       CALL TOSTDO ( 'Starting occultation search...' )
C                    ELSE
C                       CALL TOSTDO ( 'Using shape model '//BSHAPE )
C                       CALL TOSTDO ( 'Starting transit search...' )
C                    END IF
C
C                    CALL GFOCLT ( OCCTYP,
C             .                    FRONT,  FSHAPE, FFRAME,
C             .                    BACK,   BSHAPE, BFRAME,
C             .                    ABCORR, OBSRVR, STEP,
C             .                    CNFINE, RESULT         )
C
C                    IF ( WNCARD(RESULT) .EQ. 0 ) THEN
C
C                       WRITE (*,*) 'No event was found.'
C
C                    ELSE
C
C                       DO K = 1, WNCARD(RESULT)
C        C
C        C                 Fetch and display each event interval.
C        C
C                          CALL WNFETD ( RESULT, K, LEFT, RIGHT )
C
C                          CALL TIMOUT ( LEFT,  TIMFMT, BEGSTR )
C                          CALL TIMOUT ( RIGHT, TIMFMT, ENDSTR )
C
C                          WRITE (*,*) '   Interval ', K
C                          WRITE (*,*) '      Start time: '//BEGSTR
C                          WRITE (*,*) '      Stop time:  '//ENDSTR
C
C                       END DO
C
C                    END IF
C
C                    WRITE (*,*) ' '
C
C                 END DO
C
C              END DO
C
C              END
C
C
C     When this program was executed on a PC/Linux/gfortran 64-bit
C     platform, the output was:
C
C
C        Using shape model ELLIPSOID
C        Starting occultation search...
C            Interval            1
C               Start time: 2015 FEB 28 07:17:35.379879 (TDB)
C               Stop time:  2015 FEB 28 07:50:37.710284 (TDB)
C            Interval            2
C               Start time: 2015 FEB 28 09:09:46.920140 (TDB)
C               Stop time:  2015 FEB 28 09:42:50.497193 (TDB)
C            Interval            3
C               Start time: 2015 FEB 28 11:01:57.845730 (TDB)
C               Stop time:  2015 FEB 28 11:35:01.489716 (TDB)
C
C        Using shape model DSK/UNPRIORITIZED
C        Starting occultation search...
C            Interval            1
C               Start time: 2015 FEB 28 07:17:38.130608 (TDB)
C               Stop time:  2015 FEB 28 07:50:38.310802 (TDB)
C            Interval            2
C               Start time: 2015 FEB 28 09:09:50.314903 (TDB)
C               Stop time:  2015 FEB 28 09:42:55.369626 (TDB)
C            Interval            3
C               Start time: 2015 FEB 28 11:02:01.756296 (TDB)
C               Stop time:  2015 FEB 28 11:35:08.368384 (TDB)
C
C        Using shape model ELLIPSOID
C        Starting transit search...
C            Interval            1
C               Start time: 2015 FEB 28 08:12:21.112018 (TDB)
C               Stop time:  2015 FEB 28 08:45:48.401746 (TDB)
C            Interval            2
C               Start time: 2015 FEB 28 10:04:32.682324 (TDB)
C               Stop time:  2015 FEB 28 10:37:59.920302 (TDB)
C            Interval            3
C               Start time: 2015 FEB 28 11:56:39.757564 (TDB)
C               Stop time:  2015 FEB 28 12:00:00.000000 (TDB)
C
C        Using shape model DSK/UNPRIORITIZED
C        Starting transit search...
C            Interval            1
C               Start time: 2015 FEB 28 08:12:15.750020 (TDB)
C               Stop time:  2015 FEB 28 08:45:43.406870 (TDB)
C            Interval            2
C               Start time: 2015 FEB 28 10:04:29.031706 (TDB)
C               Stop time:  2015 FEB 28 10:37:55.565509 (TDB)
C            Interval            3
C               Start time: 2015 FEB 28 11:56:34.634642 (TDB)
C               Stop time:  2015 FEB 28 12:00:00.000000 (TDB)
C
C
C$ Restrictions
C
C     The kernel files to be used by GFOCLT must be loaded (normally
C     via the SPICELIB routine FURNSH) before GFOCLT is called.
C
C$ Literature_References
C
C    None.
C
C$ Author_and_Institution
C
C    N. J. Bachman  (JPL)
C    L. S. Elson    (JPL)
C    E. D. Wright   (JPL)
C
C$ Version
C
C-    SPICELIB Version 2.0.0 29-FEB-2016 (NJB)
C
C        Header was updated. An example program demonstrating
C        DSK usage was added.
C
C        04-MAR-2015 (NJB)
C
C        Upgraded to support surfaces represented by DSKs.
C
C-    SPICELIB Version 1.1.0  31-AUG-2010 (EDW)
C
C        Implemented use of ZZHOLDD to allow user to alter convergence
C        tolerance.
C
C        Removed the STEP > 0 error check. The GFSSTP call includes
C        the check.
C
C-    SPICELIB Version 1.0.0  07-APR-2009 (NJB) (LSE) (EDW)
C
C-&

C$ Index_Entries
C
C     GF occultation search
C
C-&

C$ Revisions
C
C     None.
C
C-&

C
C     SPICELIB functions
C
      INTEGER               SIZED

      LOGICAL               RETURN

C
C     Local variables.
C
      DOUBLE PRECISION      TOL
      LOGICAL               OK

C
C     External routines
C
C
C     Interrupt handler:
C
      LOGICAL               GFBAIL
      EXTERNAL              GFBAIL

C
C     Routines to set step size, refine transition times
C     and report work:
C
      EXTERNAL              GFREFN
      EXTERNAL              GFREPF
      EXTERNAL              GFREPI
      EXTERNAL              GFREPU
      EXTERNAL              GFSTEP

C
C     Local parameters
C
C
C     Geometric quantity  bail switch:
C
      LOGICAL               BAIL
      PARAMETER           ( BAIL = .FALSE. )

C
C     Progress report switch:
C
      LOGICAL               RPT
      PARAMETER           ( RPT  = .FALSE. )

C
C     Standard SPICE error handling.
C
      IF ( RETURN () ) THEN
         RETURN
      END IF

      CALL CHKIN  ( 'GFOCLT' )

C
C     Note to maintenance programmer: input exception checks
C     are delegated to GFOCCE. If the implementation of that
C     routine changes, or if this routine is modified to call
C     a different routine in place of GFOCCE, then the error
C     handling performed by GFOCCE will have to be performed
C     here or in a routine called by this routine.
C
C     Check the result window's size.
C
      IF ( SIZED(RESULT) .LT. 2 ) THEN

         CALL SETMSG ( 'Result window size must be at least 2 '
     .   //            'but was #.'                            )
         CALL ERRINT ( '#',  SIZED(RESULT)                     )
         CALL SIGERR ( 'SPICE(WINDOWTOOSMALL)'                 )
         CALL CHKOUT ( 'GFOCLT'                                )
         RETURN

      END IF

C
C     Check and set the step size.
C
      CALL GFSSTP ( STEP )

C
C     Retrieve the convergence tolerance, if set.
C
      CALL ZZHOLDD ( ZZGET, GF_TOL, OK, TOL )

C
C     Use the default value CNVTOL if no stored tolerance value.
C
      IF ( .NOT. OK ) THEN

         TOL = CNVTOL

      END IF

C
C     Look for solutions.
C
      CALL GFOCCE ( OCCTYP,  FRONT,   FSHAPE,  FFRAME,
     .              BACK,    BSHAPE,  BFRAME,  ABCORR,
     .              OBSRVR,  TOL,     GFSTEP,  GFREFN,
     .              RPT,     GFREPI,  GFREPU,  GFREPF,
     .              BAIL,    GFBAIL,  CNFINE,  RESULT )

      CALL CHKOUT ( 'GFOCLT' )

      RETURN
      END


subroutine garadme(e,vru,p,dp,pe,dpe,ri_mat,jspin,kpot,ipr)
  USE param,  ONLY: lmax, nrad, nato, labc, nloat, clight, lomax
  USE loabc,  ONLY: Elo
  USE loabcr, ONLY: Elor2, pi2lor, pe2lor, elor, elor2
  USE lolog,  ONLY: mrf, lapw, ilo
  USE rlolog, ONLY: nrlo, loorext
  USE structure, ONLY: dx, jri, Rmt, ZZ
  USE hexpt,  ONLY: hexl, allocate_hexpt
  USE peic,   ONLY: pei, allocate_peic
  USE radovlp,ONLY: ruu, allocate_radovlp
  IMPLICIT NONE
  REAL*8, intent(in)   :: E(0:lmax,NATO,2)
  REAL*8, intent(in)   :: VRU(NRAD,NATO,jspin)
  REAL*8, intent(inout):: P(Labc+1,NATO,2), DP(Labc+1,NATO,2), PE(Labc+1,NATO,2), DPE(Labc+1,NATO,2)
  REAL*8, intent(out)  :: ri_mat(nloat,nloat,0:labc,nato,2,2)
  INTEGER, intent(in)  :: jspin, kpot, ipr
  ! external functions
  REAL*8 :: hscalc
  !
  !   The overlapp matrix and the radial matrix elements of the spin-orbit
  !   term as given in Koelling, Harmon (J. Phys. C (1976) ????) are calculated.
  !   A basis extension for an improved representation of p_{1/2} has been included.
  !
  !   Input:
  !        e
  !        vru          potential * r in Rydberg.
  !        p
  !        dp
  !        dpe
  !        zz(nato)     nuclear charge of the different atoms
  !        jspin        = 1 for unspinpolarized calculations
  !                     = 2 for spin-polarized calculations
  !         (Note that the present version is not intended for spin-polarized calculations,
  !          as some of the programming for this case might be wrong. )
  !        kpot
  !        ipr          = debugging option
  !
  !   Output
  !        ri_mat      matrix containing the radial overlap integrals.
  !
  real*8, allocatable:: radf(:,:,:,:,:)
  REAL*8 :: vrr(nrad,2),vder(nrad,2),rx(nrad)
  REAL*8 :: ame(nrad), uu(nrad), tota(3)
  REAL*8 :: enei, enej, TOT
  INTEGER:: iradf, irfi, irfj, jlo, jradf
  integer i,ic
  integer isj,isi
  integer jric,jatom
  integer ir,l,lpot
  integer lspin

  real*8 coc,coe,cin
  real*8 rmt2,dx2
  real*8 dnomi,dnomj,dnom
  real*8 vde

  allocate(radf(nrad,0:labc,2,2,nloat))

  CALL allocate_peic(labc,nato)
  CALL allocate_hexpt(lomax,nato)
  CALL allocate_radovlp(labc,nato,nloat)
  !    coc  : velocity of light in Rydberg units
  !    cin  : inverse velocity of light squared. (Hartree units)
  COC=2.d0*CLIGHT
  COE=2.D0
  CIN=1.d0/CLIGHT**2

  ri_mat=0.0d0
  !  jatom is a loop over all non-equivalent atoms.
  DO jatom=1,nato
     DX2  = DX(jatom)
     JRIc = JRI(jatom)
     RMT2= RMT(jatom)
     !  The logarithmic mesh is setup in RX for the respective atom.
     do i = 1, jric
        rx(i) = rmt2 * dexp(dfloat(i-jric)*dx2)
     enddo
     ! if lpot=3, averaged potential is used in spinpolarized calculations
     ! when calculating dV/dr (kpot=1, jspin=2)
     lpot=jspin+kpot
     if (lpot.eq.3) then
        lspin=1
     else
        lspin=jspin
     endif
     !  Setup potential ( V*r -> V ), do averaging and calculate
     !  derivative of potential
     call vderiv(lpot,jatom,lspin,rx,vru,vrr,vder,jric,jspin)

     do isi=1,jspin
        call atpar(e(:,jatom,isi),elo(:,:,jatom,isi),elor(:,jatom,isi),elor2(:,jatom,isi),vru(:,:,jspin),ZZ(jatom),ilo(:,jatom),labc+1,jatom,radf,p(:,jatom,isi),dp(:,jatom,isi),pe(:,jatom,isi),dpe(:,jatom,isi),pei(:,jatom,isi),isi)
        ! contribution of V(2,m) to <p1/2|H|p1/2>
        if (nrlo(jatom).gt.0) call vnsrint(jatom,isi,radf,mrf(1,jatom))
     enddo
     !  Calculate some radial integrals needed for the construction
     !  of the overlap matrix.
     do isi=1,jspin
        do isj = 1,jspin
           do l=0,labc
              do iradf=1,mrf(l,jatom)
                 do jradf=1,iradf
                    do ic=1,2
                       do ir=1,jric
                          uu(ir)=radf(ir,l,ic,isi,iradf)*radf(ir,l,ic,isj,jradf)
                       enddo
                       call cali(uu,tota(ic),rx(1),dx2,jric)
                    enddo
                    !   Note that ic = 2 is not the whole expression for
                    !   the small component. If eq. 10 of Koelling, Harmon
                    !   is used for the overlapp matrix and S_l is discarded
                    !   an additional angular momentum dependent contribution
                    !   has to be added.
                    !   This contribution amouts to approx. 0.05 mRyd for p states
                    !   in Au. (It has not been taken into account in other parts
                    !   of the code.) For excited states there are contributions
                    !   up to 0.1 mRyd.
                    if (l .le. lomax) then
                       if (loorext(l,jatom)) then
                          if (iradf.lt.mrf(l,jatom).and.jradf.lt.mrf(l,jatom)) then
                             ruu(l,jatom,isi,isj,iradf,jradf)=tota(1)+(cin)*tota(2)
                          else
                             ruu(l,jatom,isi,isj,iradf,jradf)=tota(1)+sqrt(cin)*tota(2)
                          endif
                          if (iradf.eq.mrf(l,jatom).and.jradf.eq.mrf(l,jatom)) then
                             ruu(l,jatom,isi,isj,iradf,jradf)=tota(1)+tota(2)
                          endif
                          if (iradf.eq.mrf(l,jatom).and.jradf.lt.3) then
                             ruu(l,jatom,isi,isj,iradf,jradf)=tota(1)+sqrt(cin)*tota(2)
                          endif
                       else
                          ruu(l,jatom,isi,isj,iradf,jradf)=tota(1)+(cin)*tota(2)
                       endif
                    else
                       ruu(l,jatom,isi,isj,iradf,jradf)=tota(1)+(cin)*tota(2)
                    endif
                    ruu(l,jatom,isi,isj,jradf,iradf)=ruu(l,jatom,isi,isj,iradf,jradf)
                    !write(300,'(6i4,f15.8)') l,jatom,isi,isj,iradf,jradf,ruu(l,jatom,isi,isj,iradf,jradf)
                 enddo
              enddo
           enddo
        enddo
     enddo

     do isi=1,jspin
        do isj=1,jspin
           !.........................................................................
           !.....CALCULATE THE MATRIX ELEMENT
           !
           DO L=0,LABC
              ic=1
              do irfi=1,mrf(l,jatom)
                 do irfj=1,mrf(l,jatom)
                    if (irfi.le.2) then
                       enei=E(L,jatom,isi)
                    else
                       if (loorext(l,jatom).and.irfi.eq.mrf(l,jatom)) then
                          !p1/2 local
                          enei=elor2(l,jatom,isi)
                       else
                          if (lapw(l,jatom)) then
                             jlo=irfi-2
                          else
                             jlo=irfi-1
                          endif
                          enei=ELO(L,jlo,jatom,isi)
                       endif
                    endif

                    if (irfj.le.2) then
                       enej=E(L,jatom,isj)
                    else
                       if (loorext(l,jatom).and.irfj.eq.mrf(l,jatom)) then
                          !p1/2 local
                          enej=elor2(l,jatom,isj)
                       else
                          if (lapw(l,jatom)) then
                             jlo=irfj-2
                          else
                             jlo=irfj-1
                          endif
                          enej=ELO(L,jlo,jatom,isj)
                       endif
                    endif

                    DO IR=1,JRIc
                       DNOMi=(COC+(enei-VRR(IR,isi))/COC)
                       DNOMj=(COC+(enej-VRR(IR,isj))/COC)
                       dnom=dnomi*dnomj

                       if (isi.eq.isj) then
                          vde=vder(ir,isi)
                       else
                          vde=(vder(ir,isi)+vder(ir,isj))/2.0d0
                       endif

                       AME(IR)=RADF(IR,L,IC,isi,irfi)*RADF(IR,L,IC,isj,irfj)*vde/RX(IR)/DNOM
                    enddo

                    CALL CALI(AME,TOT,RX,DX2,JRIc)

                    ri_mat(irfi,irfj,L,jatom,isi,isj)=COE*TOT
                 enddo
              enddo
           enddo
           !
           !   Calculate some integrals required for computation of
           !   < \phi_sc | H_dirac | \phi_sc >.
           do l=0,lomax
              if (isi.eq.isj.and.loorext(l,jatom)) then
                 !honza
                 hexl(l,jatom,isi,1)=e(l,jatom,isi)
                 hexl(l,jatom,isi,2)=1.d0
                 hexl(l,jatom,isi,3)=pi2lor(l,jatom,isi)*elor2(l,jatom,isi)+hscalc(radf(1,l,1,isi,1),radf(1,l,1,isi,mrf(l,jatom)),vrr(1,isi),elor2(l,jatom,isi),l,jric,dx2,rx(1))
                 hexl(l,jatom,isi,4)=0.d0
                 hexl(l,jatom,isi,5)=0.d0
                 hexl(l,jatom,isi,6)=pe2lor(l,jatom,isi)*elor2(l,jatom,isi)+hscalc(radf(1,l,1,isi,2),radf(1,l,1,isi,mrf(l,jatom)),vrr(1,isi),elor2(l,jatom,isi),l,jric,dx2,rx(1))
                 hexl(l,jatom,isi,7)=e(l,jatom,isi)*pi2lor(l,jatom,isi)
                 hexl(l,jatom,isi,8)=pi2lor(l,jatom,isi)
                 hexl(l,jatom,isi,9)=elor2(l,jatom,isi)+hscalc(radf(1,l,1,isi,mrf(l,jatom)),radf(1,l,1,isi,mrf(l,jatom)),vrr(1,isi),elor2(l,jatom,isi),l,jric,dx2,rx(1))
              end if
           enddo
!!! Only the upper part of the spin-matrix has yet been calculated.
        enddo
     enddo
  enddo
  deallocate(radf)
END subroutine garadme


!-------------------------------------------------------------------------------
!> module ATMOSPHERE / Physics Aerosol Microphysics
!!
!! @par Description
!!          Aerosol Microphysics driver
!!
!! @author Team SCALE
!!
!! @par History
!! @li      2013-12-06 (S.Nishizawa)  [new]
!<
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
module mod_atmos_phy_ae_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ATMOS_PHY_AE_driver_setup
  public :: ATMOS_PHY_AE_driver

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  !> Setup
  subroutine ATMOS_PHY_AE_driver_setup
    use scale_atmos_phy_ae, only: &
       ATMOS_PHY_AE_setup
    use mod_atmos_admin, only: &
       ATMOS_PHY_AE_TYPE, &
       ATMOS_sw_phy_ae
    implicit none
    !---------------------------------------------------------------------------

    if( IO_L ) write(IO_FID_LOG,*)
    if( IO_L ) write(IO_FID_LOG,*) '++++++ Module[DRIVER] / Categ[ATMOS PHY_AE] / Origin[SCALE-LES]'

    ! note: tentatively, aerosol module should be called at all time. we need dummy subprogram.
!    if ( ATMOS_sw_phy_ae ) then

       ! setup library component
       call ATMOS_PHY_AE_setup( ATMOS_PHY_AE_TYPE )

       ! run once (only for the diagnostic value)
       call PROF_rapstart('ATM_Aerosol', 1)
       call ATMOS_PHY_AE_driver( update_flag = .true. )
       call PROF_rapend  ('ATM_Aerosol', 1)

!    else
!       if( IO_L ) write(IO_FID_LOG,*) '*** this component is never called.'
!    endif

    return
  end subroutine ATMOS_PHY_AE_driver_setup

  !-----------------------------------------------------------------------------
  !> Driver
  subroutine ATMOS_PHY_AE_driver( update_flag )
    use scale_time, only: &
       dt_AE => TIME_DTSEC_ATMOS_PHY_AE
    use scale_les_statistics, only: &
       STATISTICS_checktotal, &
       STAT_total
    use scale_history, only: &
       HIST_in
    use scale_atmos_phy_ae, only: &
       ATMOS_PHY_AE
    use mod_atmos_vars, only: &
       DENS,              &
       MOMZ,              &
       MOMX,              &
       MOMY,              &
       RHOT,              &
       QTRC,              &
       RHOQ_t => RHOQ_tp
    use mod_atmos_phy_ae_vars, only: &
       RHOQ_t_AE => ATMOS_PHY_AE_RHOQ_t, &
       CCN       => ATMOS_PHY_AE_CCN,   &
       CCN_t     => ATMOS_PHY_AE_CCN_t, &
       AE_EMIT   => ATMOS_PHY_AE_EMIT
    use mod_atmos_phy_mp_vars, only: &
       EVAPORATE => ATMOS_PHY_MP_EVAPORATE
    implicit none

    logical, intent(in) :: update_flag

    real(RP) :: QTRC0(KA,IA,JA,QA)
    real(RP) :: CN(KA,IA,JA)
    real(RP) :: NREG(KA,IA,JA)

    real(RP) :: total ! dummy

    integer  :: k, i, j, iq
    !---------------------------------------------------------------------------

    if ( update_flag ) then

!OCL XFILL
       do iq = 1, QA
       do j  = JS, JE
       do i  = IS, IE
       do k  = KS, KE
          QTRC0(k,i,j,iq) = QTRC(k,i,j,iq) ! save
       enddo
       enddo
       enddo
       enddo

       CCN(:,:,:) = 0.0_RP ! reset
       CCN_t(:,:,:) = 0.0_RP ! reset
       RHOQ_t_AE(:,:,:,:) = 0.0_RP ! reset

       NREG(:,:,:) = EVAPORATE(:,:,:) * dt_AE

       call ATMOS_PHY_AE( DENS, & ! [IN]
                          MOMZ, & ! [IN]
                          MOMX, & ! [IN]
                          MOMY, & ! [IN]
                          RHOT, & ! [IN]
                          AE_EMIT, & ! [IN]
                          NREG,    & ! [IN]
                          CN ,  & ! [OUT]
                          CCN,  & ! [OUT]
                          QTRC0 ) ! [INOUT]

       do iq = 1, QA
       do j  = JS, JE
       do i  = IS, IE
       do k  = KS, KE
          RHOQ_t_AE(k,i,j,iq) = ( QTRC0(k,i,j,iq) - QTRC(k,i,j,iq) ) * DENS(k,i,j) / dt_AE
       enddo
       enddo
       enddo
       enddo

       CCN_t(:,:,:) = CCN(:,:,:) / dt_AE

!       CCN(:,:,:) = 0.0_RP ! tentative

       call HIST_in( CN(:,:,:)*1e-6_RP,  'CN',  'condensation nucrei', '/cc' )
       call HIST_in( CCN(:,:,:)*1e-6_RP, 'CCN', 'cloud condensation nucrei', '/cc' )

    endif

    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(3)
    do iq = 1, QA
    do j  = JS, JE
    do i  = IS, IE
    do k  = KS, KE
       RHOQ_t(k,i,j,iq) = RHOQ_t(k,i,j,iq) + RHOQ_t_AE(k,i,j,iq)
    enddo
    enddo
    enddo
    enddo

    if ( STATISTICS_checktotal ) then
       do iq = 1, QA
          call STAT_total( total, RHOQ_t_AE(:,:,:,iq), trim(AQ_NAME(iq))//'_t_AE' )
       enddo
    endif

    return
  end subroutine ATMOS_PHY_AE_driver

end module mod_atmos_phy_ae_driver


      subroutine dipoleconfig(maxdip,dipconfig)
************************************************************************
*                                                                      *
*     Given a process, return an array that specifies all the          *
*     dipole configurations that are present in the real subtractions  *
*                                                                      *
*          maxdip: maximum no. of dipoles for this process             *
*       dipconfig: array of dipole configs (i,j,k) in standard MCFM    *
*                  notation, i.e. (emitter, emitted, spectator)        *
*                                                                      *
*     Author: J.M.Campbell                                             *
*       Date: 19th March 2009                                          *
*                                                                      *
************************************************************************
      implicit none
      include 'constants.f'
      include 'process.f'
      include 'ptilde.f'
      include 'frag.f'
      integer maxdip,dipconfig(maxd,3)

      if    ((case .eq. 'W_only') .or. (case .eq. 'Z_only')) then
        maxdip=2
        dipconfig(1,:)= (/ 1,5,2 /)
        dipconfig(2,:)= (/ 2,5,1 /)
      elseif ((case .eq. 'WWqqbr') .or. (case .eq. 'WWnpol')
     .   .or. (case .eq. 'WZbbar') .or. (case .eq. 'ZZlept')
     .   .or. (case .eq. 'HZZ_4l') .or. (case .eq. 'HmZZ4l')) then
        maxdip=2
        dipconfig(1,:)= (/ 1,7,2 /)
        dipconfig(2,:)= (/ 2,7,1 /)
      elseif (case .eq. 'qq_Hqq') then
        maxdip=8
        dipconfig(1,:)= (/ 1,7,5 /)
        dipconfig(2,:)= (/ 5,7,1 /)
        dipconfig(3,:)= (/ 2,7,6 /)
        dipconfig(4,:)= (/ 6,7,2 /)
        dipconfig(5,:)= (/ 1,5,2 /)
        dipconfig(6,:)= (/ 2,6,1 /)
        dipconfig(7,:)= (/ 1,6,2 /)
        dipconfig(8,:)= (/ 2,7,1 /)
      elseif ((case .eq. 'W_1jet') .or. (case .eq. 'Z_1jet')
     &    .or.(case .eq. 'gmgmjt')) then
        dipconfig(1,:)= (/ 1,5,2 /)
        dipconfig(2,:)= (/ 2,5,1 /)
        dipconfig(3,:)= (/ 1,6,2 /)
        dipconfig(4,:)= (/ 2,6,1 /)
        dipconfig(5,:)= (/ 1,5,6 /)
        dipconfig(6,:)= (/ 5,6,1 /)
        dipconfig(7,:)= (/ 1,6,5 /)
        dipconfig(8,:)= (/ 2,6,5 /)
        dipconfig(9,:)= (/ 5,6,2 /)
        dipconfig(10,:)=(/ 2,5,6 /)
        if ((frag) .and. (case .eq. 'gmgmjt')) then
        dipconfig(11,:)=(/ 3,5,1 /)
        dipconfig(12,:)=(/ 3,6,1 /)
        dipconfig(13,:)=(/ 4,5,1 /)
        dipconfig(14,:)=(/ 4,6,1 /)
        maxdip=14
        else
        maxdip=10
        endif
      elseif ((case .eq. 'H_tjet') .or. (case .eq. 'Z_tjet')) then
        maxdip=8
        dipconfig(1,:)= (/ 1,7,6 /)
        dipconfig(2,:)= (/ 6,7,1 /)
        dipconfig(3,:)= (/ 2,7,6 /)
        dipconfig(4,:)= (/ 6,7,2 /)
        dipconfig(5,:)= (/ 1,7,2 /)
        dipconfig(6,:)= (/ 2,7,1 /)
        dipconfig(7,:)= (/ 1,6,2 /)
        dipconfig(8,:)= (/ 2,6,1 /)
      elseif ((case .eq. 'H_tdkj') .or. (case .eq. 'Z_tdkj')) then
        maxdip=8
        dipconfig(1,:)= (/ 1,9,8 /)
        dipconfig(2,:)= (/ 8,9,1 /)
        dipconfig(3,:)= (/ 2,9,8 /)
        dipconfig(4,:)= (/ 8,9,2 /)
        dipconfig(5,:)= (/ 1,9,2 /)
        dipconfig(6,:)= (/ 2,9,1 /)
        dipconfig(7,:)= (/ 1,8,2 /)
        dipconfig(8,:)= (/ 2,8,1 /)
      elseif (case .eq. 'hflgam') then
        maxdip=6
        dipconfig(1,:)= (/ 1,5,2 /)
        dipconfig(2,:)= (/ 2,5,1 /)
        dipconfig(3,:)= (/ 4,5,1 /)
        dipconfig(4,:)= (/ 1,5,4 /)
        dipconfig(5,:)= (/ 4,5,2 /)
        dipconfig(6,:)= (/ 2,5,4 /)
      elseif (case .eq.'gamgam') then
        dipconfig(1,:)= (/ 1,5,2 /)
        dipconfig(2,:)= (/ 2,5,1 /)
        if (frag) then
        dipconfig(3,:)= (/ 3,5,0 /)
        dipconfig(4,:)= (/ 4,5,0 /)
        maxdip=4
        else
        maxdip=2
        endif
      elseif (case .eq.'dirgam') then
        dipconfig(1,:)= (/ 1,4,2 /)
        dipconfig(2,:)= (/ 2,4,1 /)
        dipconfig(3,:)= (/ 1,5,2 /)
        dipconfig(4,:)= (/ 2,5,1 /)
        dipconfig(5,:)= (/ 4,5,2 /)
        dipconfig(6,:)= (/ 4,5,1 /)
        if (frag) then
        dipconfig(7,:)= (/ 3,4,1 /)
        dipconfig(8,:)= (/ 3,5,1 /)
        maxdip=8
        else
        maxdip=6
        endif
      elseif (case .eq. 'Wgamma') then
         dipconfig(1,:)= (/ 1,6,2 /)
         dipconfig(2,:)= (/ 2,6,1 /)
        if (frag) then
           dipconfig(3,:)= (/ 5,6,2 /)
           maxdip=3
        else
           maxdip=2
        endif
      elseif (case .eq. 'Zgamma') then
         dipconfig(1,:)= (/ 1,6,2 /)
         dipconfig(2,:)= (/ 2,6,1 /)
        if (frag) then
           dipconfig(3,:)= (/ 5,6,2 /)
           maxdip=3
        else
           maxdip=2
        endif
      elseif (case .eq. 'Zgajet') then
         dipconfig(1,:)= (/ 1,6,2 /)
         dipconfig(2,:)= (/ 2,6,1 /)
         dipconfig(3,:)= (/ 1,7,2 /)
         dipconfig(4,:)= (/ 2,7,1 /)
         dipconfig(5,:)= (/ 6,7,1 /)
         dipconfig(6,:)= (/ 6,7,2 /)
        if (frag) then
           dipconfig(7,:)= (/ 5,6,2 /)
           dipconfig(8,:)= (/ 5,7,2 /)
           maxdip=8
        else
           maxdip=6
        endif
      elseif ((case .eq. 'W_2gam') .or. (case .eq. 'Z_2gam')) then
         dipconfig(1,:)= (/ 1,7,2 /)
         dipconfig(2,:)= (/ 2,7,1 /)
        if (frag) then
           dipconfig(3,:)= (/ 5,7,2 /)
           dipconfig(4,:)= (/ 6,7,2 /)
           maxdip=4
        else
           maxdip=2
        endif
      elseif (case .eq. 'dm_gam') then
         dipconfig(1,:)= (/ 1,6,2 /)
         dipconfig(2,:)= (/ 2,6,1 /)
        if (frag) then
           dipconfig(3,:)= (/ 5,6,2 /)
           maxdip=3
        else
           maxdip=2
        endif
      elseif (case .eq. 'trigam') then
        dipconfig(1,:)= (/ 1,6,2 /)
        dipconfig(2,:)= (/ 2,6,1 /)
        if (frag) then
        dipconfig(3,:)= (/ 3,6,2 /)
        dipconfig(4,:)= (/ 4,6,2 /)
        dipconfig(5,:)= (/ 5,6,2 /)
        maxdip=5
        else
        maxdip=2
        endif
      elseif (case .eq. 'tottth') then
        dipconfig(1,:)= (/ 1,6,2 /)
        dipconfig(2,:)= (/ 2,6,1 /)
        maxdip=2
      elseif (case .eq. 'W_cjet') then
        dipconfig(1,:)= (/ 1,6,2 /)
        dipconfig(2,:)= (/ 2,6,1 /)
        maxdip=2
      elseif (case .eq. 'WW_jet') then
        dipconfig(1,:)= (/ 1,7,2 /)
        dipconfig(2,:)= (/ 2,7,1 /)
        dipconfig(3,:)= (/ 1,8,2 /)
        dipconfig(4,:)= (/ 2,8,1 /)
        dipconfig(5,:)= (/ 1,7,8 /)
        dipconfig(6,:)= (/ 7,8,1 /)
        dipconfig(7,:)= (/ 1,8,7 /)
        dipconfig(8,:)= (/ 2,8,7 /)
        dipconfig(9,:)= (/ 7,8,2 /)
        dipconfig(10,:)=(/ 2,7,8 /)
        maxdip=10
      elseif(case.eq.'fourga') then
        dipconfig(1,:)= (/ 1,7,2 /)
        dipconfig(2,:)= (/ 2,7,1 /)
        if (frag) then
           dipconfig(3,:)= (/ 3,7,1 /)
           dipconfig(4,:)= (/ 4,7,1 /)
           dipconfig(5,:)= (/ 5,7,1 /)
           dipconfig(6,:)= (/ 6,7,1 /)
           maxdip=6
        else
           maxdip=2
        endif
      else
        write(6,*) 'Dipole configurations for this process not'
        write(6,*) 'properly specified in dipoleconfig.f'
        stop
      endif

      return
      end