C$Procedure ZZGFRRU ( Private --- GF, range rate utility routine )

      SUBROUTINE ZZGFRRU ( TARGET, ABCORR, OBSRVR, DT,
     .                     UDFUNC, ET,     DECRES, RVL,
     .                     XTARG, XABCOR, XOBS, XDT )

C$ Abstract
C
C     SPICE Private routine intended solely for the support of SPICE
C     routines.  Users should not call this routine directly due
C     to the volatile nature of this routine.
C
C     This is the umbrella routine for the entry points needed by
C     GFEVNT in order to find range rate events.
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     None.
C
C$ Keywords
C
C     RANGE RATE
C     EPHEMERIS
C     GEOMETRY
C     SEARCH
C
C$ Declarations

      IMPLICIT NONE

      INCLUDE 'zzabcorr.inc'

      CHARACTER*(*)         TARGET
      CHARACTER*(*)         ABCORR
      CHARACTER*(*)         OBSRVR
      DOUBLE PRECISION      ET
      DOUBLE PRECISION      DT
      LOGICAL               DECRES
      DOUBLE PRECISION      RVL
      INTEGER               XTARG
      CHARACTER*(*)         XABCOR
      INTEGER               XOBS
      DOUBLE PRECISION      XDT

C$ Brief_I/O
C
C     VARIABLE  I/O  Entry points
C     --------  ---  --------------------------------------------------
C     TARGET     I   ZZGFRRIN
C     ABCORR     I   ZZGFRRIN
C     OBSRVR     I   ZZGFRRIN
C     ET         I   ZZGFRRDC, ZZGFRRGQ
C     DT         I   ZZGFRRIN
C     UDFUNC     I   ZZGFRRDC
C     DECRES     O   ZZGFRRDC
C     RVL        O   ZZGFRRGQ
C     XTARG      O   ZZGFRRX
C     XABCOR     O   ZZGFRRX
C     XOBS       O   ZZGFRRX
C     XDT        O   ZZGFRRX
C
C$ Detailed_Input
C
C     TARGET   the string name of a target body.  Optionally, you may
C              supply the integer ID code for the object as an
C              integer string.  For example both 'MOON' and '301'
C              are legitimate strings that indicate the moon is the
C              target body.
C
C              The target and observer define a position vector
C              that points from the observer to the target.
C
C     ABCORR   the string description of the aberration corrections to
C              apply to the state evaluations to account for one-way
C              light time and stellar aberration.
C
C              Any aberration correction accepted by the SPICE
C              routine SPKEZR is accepted here. See the header
C              of SPKEZR for a detailed description of the
C              aberration correction options. For convenience,
C              the options are listed below:
C
C                 'NONE'     Apply no correction. Returns the "true"
C                            geometric state.
C
C                 'LT'       "Reception" case:  correct for
C                            one-way light time using a Newtonian
C                            formulation.
C
C                 'LT+S'     "Reception" case:  correct for
C                            one-way light time and stellar
C                            aberration using a Newtonian
C                            formulation.
C
C                 'CN'       "Reception" case:  converged
C                            Newtonian light time correction.
C
C                 'CN+S'     "Reception" case:  converged
C                            Newtonian light time and stellar
C                            aberration corrections.
C
C                 'XLT'      "Transmission" case:  correct for
C                            one-way light time using a Newtonian
C                            formulation.
C
C                 'XLT+S'    "Transmission" case:  correct for
C                            one-way light time and stellar
C                            aberration using a Newtonian
C                            formulation.
C
C                 'XCN'      "Transmission" case:  converged
C                            Newtonian light time correction.
C
C                 'XCN+S'    "Transmission" case:  converged
C                            Newtonian light time and stellar
C                            aberration corrections.
C
C              The ABCORR string lacks sensitivity to case, leading
C              and trailing blanks.
C
C     OBSRVR   the string name of an observing body.  Optionally, you
C              may supply the ID code of the object as an integer
C              string. For example, both 'EARTH' and '399' are
C              legitimate strings to indicate the observer as Earth.
C
C     ET       time in TDB seconds past J2000 at which to calculate
C              the value of or characteristic of the range rate of
C              the observer-target vector.
C
C     DT       a scalar double precision value representing half the
C              interval in TDB seconds separating the evaluation
C              epochs; the evaluations occur at epochs
C              (ET + DT) and (ET - DT).
C
C              DT may be negative but must be non-zero.
C
C     XTARG    SPICE ID value for the target body initialized
C              via ZZGFRRIN.
C
C     XABCOR   String value for the aberration correction initialized
C              via ZZGFRRIN.
C
C     XOBS     SPICE ID value for the observing body initialized
C              via ZZGFRRIN.
C
C     XDT      Saved value for DT.
C
C     For more information, see individual entry points.
C
C$ Detailed_Output
C
C     None.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     None.
C
C$ Files
C
C     None.
C
C$ Particulars
C
C     This routine serves as the umbrella routine for three entry points
C     needed by GFEVNT in solving for range rate conditions.
C
C     The three entry points are
C
C        ZZGFRRIN --- an initialization routine that must be called
C                     prior to attempting to solve for any range
C                     rate event.
C
C        ZZGFRRDC --- determines whether or not range rate is
C                     decreasing at some time.
C
C        ZZGFRRGQ --- returns the range rate of the two objects
C                     of concern as a function of ET.
C
C$ Examples
C
C     None.
C
C$ Restrictions
C
C     ZZGFRRIN must be called prior to use of any of the other
C     entry points (think constructor).
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     W.L. Taber     (JPL)
C     I.M. Underwood (JPL)
C     L.S. Elson     (JPL)
C
C$ Version
C
C-    SPICELIB version 2.0.0 21-APR-2014 (EDW)
C
C        Added BOGUSENTRY error check to call ZZGFRRU.
C
C        Additioned ZZGFRRX entry point for test family
C        retrieval of values saved by ZZGFRRIN.
C
C        Code edits to implement use of ZZGFRELX.
C        These edits include removal of unneeded routines:
C
C           ZZGFRRUR
C           ZZGFRRLT
C
C        and corresponding unused variables.
C
C        Update to header entries.
C
C-    SPICELIB version 1.0.1 08-JUL-2010 (EDW)
C
C        Minor typo corrections to headers.
C
C-    SPICELIB version 1.0.0 09-OCT-2009 (LSE)(EDW)
C
C-&

C$ Index_Entries
C
C     find range rate events
C
C-&

      EXTERNAL              UDFUNC

C
C     SPICELIB functions
C
      DOUBLE PRECISION      VDOT

      LOGICAL               FAILED
      LOGICAL               RETURN

C
C     Local Variables
C
      DOUBLE PRECISION      LT
      DOUBLE PRECISION      DRVEL
      DOUBLE PRECISION      SRHAT  ( 6 )
      DOUBLE PRECISION      STATE  ( 6 )
      DOUBLE PRECISION      DFDT   ( 6 )
      DOUBLE PRECISION      STATES ( 6, 2 )

      INTEGER               N

      LOGICAL               ATTBLK ( NABCOR )
      LOGICAL               FOUND

C
C     Saved Variables
C
      CHARACTER*(CORLEN)    SVABCO
      SAVE                  SVABCO

      INTEGER               SVTARG
      SAVE                  SVTARG

      CHARACTER*(32)        SVREF
      SAVE                  SVREF

      INTEGER               SVOBS
      SAVE                  SVOBS

      DOUBLE PRECISION      SVDT
      SAVE                  SVDT

      CALL CHKIN  ( 'ZZGFRRU'           )
      CALL SIGERR ( 'SPICE(BOGUSENTRY)' )
      CALL CHKOUT ( 'ZZGFRRU'           )

      RETURN

C$Procedure ZZGFRRIN ( Private --- GF, range rate initialization )

      ENTRY ZZGFRRIN ( TARGET, ABCORR, OBSRVR, DT )

C$ Abstract
C
C     This is the initialization entry point used for describing
C     the event that is to be solved for by ZZGFSOLV.
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     None.
C
C$ Keywords
C
C     RANGE RATE
C     EPHEMERIS
C     GEOMETRY
C     SEARCH
C
C$ Declarations
C
C      CHARACTER*(*)         TARGET
C      CHARACTER*(*)         ABCORR
C      CHARACTER*(*)         OBSRVR
C      DOUBLE PRECISION      DT
C
C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     TARGET     I   Name of the target body
C     ABCORR     I   Aberration correction flag
C     OBSRVR     I   Name of the observing body
C     DT         I   Interval from ET for derivative calculation.
C
C$ Detailed_Input
C
C     TARGET   the string name of a target body.  Optionally, you may
C              supply the integer ID code for the object as an
C              integer string.  For example both 'MOON' and '301'
C              are legitimate strings that indicate the moon is the
C              target body.
C
C              The target and observer define a position vector
C              that points from the observer to the target.
C
C     ABCORR   the string description of the aberration corrections to
C              apply to the state evaluations to account for one-way
C              light time and stellar aberration.
C
C              Any aberration correction accepted by the SPICE
C              routine SPKEZR is accepted here. See the header
C              of SPKEZR for a detailed description of the
C              aberration correction options. For convenience,
C              the options are listed below:
C
C                 'NONE'     Apply no correction. Returns the "true"
C                            geometric state.
C
C                 'LT'       "Reception" case:  correct for
C                            one-way light time using a Newtonian
C                            formulation.
C
C                 'LT+S'     "Reception" case:  correct for
C                            one-way light time and stellar
C                            aberration using a Newtonian
C                            formulation.
C
C                 'CN'       "Reception" case:  converged
C                            Newtonian light time correction.
C
C                'CN+S'     "Reception" case:  converged
C                            Newtonian light time and stellar
C                            aberration corrections.
C
C                 'XLT'      "Transmission" case:  correct for
C                            one-way light time using a Newtonian
C                            formulation.
C
C                 'XLT+S'    "Transmission" case:  correct for
C                            one-way light time and stellar
C                            aberration using a Newtonian
C                            formulation.
C
C                 'XCN'      "Transmission" case:  converged
C                            Newtonian light time correction.
C
C                 'XCN+S'    "Transmission" case:  converged
C                            Newtonian light time and stellar
C                            aberration corrections.
C
C              The ABCORR string lacks sensitivity to case, leading
C              and trailing blanks.
C
C     OBSRVR   the string name of an observing body.  Optionally, you
C              may supply the ID code of the object as an integer
C              string. For example, both 'EARTH' and '399' are
C              legitimate strings to indicate the observer as Earth.
C
C     DT         a scalar double precision value representing half the
C                interval in TDB seconds separating the evaluation
C                epochs; the evaluations occur at epochs
C                (ET + DT) and (ET - DT).
C
C                DT may be negative but must be non-zero.
C
C$ Detailed_Output
C
C     None.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     1) SPICE(IDCODENOTFOUND) signals if the object name for the
C        target, TARGET, is not a recognized name.
C
C     2) SPICE(IDCODENOTFOUND) signals if the object name for the
C        observer, OBSRVR, is not a recognized name.
C
C     3) SPICE(BODIESNOTDISTINCT) signals if the two objects
C        associated with a range rate search are not distinct.
C
C     4) SPICE(INVALIDVALUE) signals for the delta, DT, equal to zero.
C
C$ Files
C
C     None.
C
C$ Particulars
C
C     None.
C
C$ Examples
C
C     None.
C
C$ Restrictions
C
C     None.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     W.L. Taber     (JPL)
C     I.M. Underwood (JPL)
C     L.S. Elson     (JPL)
C
C$ Version
C
C-    SPICELIB version 2.0.0 18-SEP-2012 (EDW)
C
C        Added proper Exceptions section.
C
C        Added error check on value of DT to ensure non-zero value.
C
C        REFVAL removed from routine argument list due to the use
C        of ZZGFRELX to calculate the events.
C
C        Minor typo correction to header.
C
C-    SPICELIB version 1.0.0 09-OCT-2009 (LSE)(EDW)
C
C-&

C$ Index_Entries
C
C     range rate initialization routine.
C
C-&

      IF ( RETURN() ) THEN
         RETURN
      END IF

      CALL CHKIN ( 'ZZGFRRIN' )

C
C     Find NAIF IDs for TARGET and OBSRVR.
C
      CALL BODS2C ( TARGET, SVTARG, FOUND )

      IF ( .NOT. FOUND ) THEN

         CALL SETMSG ( 'The target object, '
     .   //            '''#'', is not a recognized name for an '
     .   //            'ephemeris object. The cause of this '
     .   //            'problem may be that you need an updated '
     .   //            'version of the SPICE Toolkit. '           )
         CALL ERRCH  ( '#', TARGET                                )
         CALL SIGERR ( 'SPICE(IDCODENOTFOUND)'                    )
         CALL CHKOUT ( 'ZZGFRRIN'                                 )
         RETURN

      END IF

      CALL BODS2C ( OBSRVR, SVOBS, FOUND )

      IF ( .NOT. FOUND ) THEN

         CALL SETMSG ( 'The observer, '
     .   //            '''#'', is not a recognized name for an '
     .   //            'ephemeris object. The cause of this '
     .   //            'problem may be that you need an updated '
     .   //            'version of the SPICE toolkit. '           )
         CALL ERRCH  ( '#', OBSRVR                                )
         CALL SIGERR ( 'SPICE(IDCODENOTFOUND)'                    )
         CALL CHKOUT ( 'ZZGFRRIN'                                 )
         RETURN

      END IF

C
C     Make sure the observer and target are distinct.
C
      IF ( SVTARG .EQ. SVOBS ) THEN

         CALL SETMSG ( 'The observer and target must be '
     .   //            'distinct objects, but are not: '
     .   //            'OBSRVR = #; TARGET = #.'           )
         CALL ERRCH  ( '#', OBSRVR                         )
         CALL ERRCH  ( '#', TARGET                         )
         CALL SIGERR ( 'SPICE(BODIESNOTDISTINCT)'          )
         CALL CHKOUT ( 'ZZGFRRIN'                          )
         RETURN

      END IF

C
C     Squeeze all blanks out of the aberration correction
C     string; ensure the string is in upper case.
C
      CALL CMPRSS ( ' ', 0, ABCORR, SVABCO )
      CALL UCASE  ( SVABCO,         SVABCO )

C
C     Check the aberration correction. If SPKEZR can't handle it,
C     neither can we.
C
      CALL ZZVALCOR ( SVABCO, ATTBLK )

      IF ( FAILED() ) THEN

         CALL CHKOUT ( 'ZZGFRRIN' )
         RETURN

      END IF

C
C     The "delta" argument for QDERIV, DT, must have a non-zero value.
C
      IF ( DT .EQ. 0.D0 ) THEN

         CALL SETMSG ( 'Delta value for QDERIV is zero; a non-zero ' //
     .                 'value is required.'                        )
         CALL SIGERR ( 'SPICE(INVALIDVALUE)'                       )
         CALL CHKOUT ( 'ZZGFRRIN' )
         RETURN

      END IF

C
C     Save the DT value.
C
      SVREF  = 'J2000'
      SVDT   = DT

      CALL CHKOUT ( 'ZZGFRRIN' )
      RETURN

C$Procedure ZZGFRRDC (  Private --- GF, when range rate is decreasing )

      ENTRY ZZGFRRDC ( UDFUNC, ET, DECRES )

C$ Abstract
C
C     Computes whether or not the range rate between the observer
C     and the target is decreasing at time ET.
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     None.
C
C$ Keywords
C
C     RANGE RATE
C     EPHEMERIS
C     GEOMETRY
C     SEARCH
C
C$ Declarations
C
C     DOUBLE PRECISION      ET
C     LOGICAL               DECRES
C
C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     ET         I   Ephemeris seconds past J2000 TDB.
C     DECRES     O   true if range rate is decreasing, false
C                    otherwise.
C
C$ Detailed_Input
C
C     ET         time in seconds past J2000 at which to calculate
C                whether the range rate of the observer-target vector
C                is decreasing.
C
C$ Detailed_Output
C
C     DECRES     is true if the range rate between the objects
C                is decreasing, false otherwise.
C
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     None.
C
C$ Files
C
C     None.
C
C$ Particulars
C
C     A function f(x) is strictly decreasing at x0 if and only if there
C     exists some delta > 0 such that for all dx satisfying
C
C        0  <  dx  < delta
C
C     we have
C
C        f(x0)       <  f(x0 + dx)
C
C     and
C
C        f(x0 - dx)  <  f(x)
C
C     Note that a strictly decreasing function need not be
C     differentiable in a neighborhood of x0; it can have jump
C     discontinuities in any neighborhood of x0 and even at x0.
C
C$ Examples
C
C     None.
C
C$ Restrictions
C
C     None.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     W.L. Taber     (JPL)
C     I.M. Underwood (JPL)
C     L.S. Elson     (JPL)
C
C$ Version
C
C-    SPICELIB version 2.0.0 18-FEB-2011 (EDW)
C
C        Added UDFUNC to argument list for use of ZZGFRELX when
C        calculating the events.
C
C        Minor typo correction to comments.
C
C-    SPICELIB version 1.0.0 09-OCT-2009 (LSE)(EDW)
C
C-&

C$ Index_Entries
C
C     when range rate is decreasing
C
C-&

C
C     Standard SPICE error handling.
C

      IF ( RETURN () ) THEN
         RETURN
      END IF

      CALL CHKIN  ( 'ZZGFRRDC' )

      N  = 6

C
C     The range rate of interest is of SVTARG relative to the SVOBS.
C     The function requires the acceleration of SVTARG relative
C     to SVOBS.
C

      CALL SPKEZ (SVTARG, ET-SVDT, SVREF, SVABCO, SVOBS,
     .                                            STATES(1,1), LT)
      CALL SPKEZ (SVTARG, ET+SVDT, SVREF, SVABCO, SVOBS,
     .                                            STATES(1,2), LT)

C
C     Approximate the derivative of the position and velocity by
C     finding the derivative of a quadratic approximating function.
C
C        DFDT(1) = Vx
C        DFDT(2) = Vy
C        DFDT(3) = Vz
C        DFDT(4) = Ax
C        DFDT(5) = Ay
C        DFDT(6) = Az
C
      CALL QDERIV ( N, STATES(1,1), STATES(1,2), SVDT, DFDT )

      CALL SPKEZ ( SVTARG, ET, SVREF, SVABCO, SVOBS, STATE, LT )

      IF (  FAILED() ) THEN
         CALL CHKOUT (  'ZZGFRRDC' )
         RETURN
      END IF

C
C        d ||r||     ^
C        ------- = < r, v >
C        dt
C
C         2           ^          ^
C        d ||r||   < dr, v > + < r, dv >
C        ------- =   --             --
C          2
C        dt          dt             dt
C
      CALL DVHAT ( STATE, SRHAT )

      DRVEL  =  VDOT( DFDT(4), SRHAT ) + VDOT( STATE(4), SRHAT(4) )
      DECRES =  DRVEL .LT. 0.D0

      CALL CHKOUT ( 'ZZGFRRDC' )
      RETURN

C$Procedure ZZGFRRGQ ( Private --- GF, get range rate between bodies )

      ENTRY ZZGFRRGQ ( ET, RVL )

C$ Abstract
C
C     Determine the range rate between the centers of the two
C     bodies.
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     None.
C
C$ Keywords
C
C     RANGE RATE
C     EPHEMERIS
C     GEOMETRY
C     SEARCH
C
C$ Declarations
C
C      DOUBLE PRECISION      ET
C      DOUBLE PRECISION      RVL
C
C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     ET         I   Ephemeris seconds past J2000 TDB.
C     RVL        O   Range rate at time ET.
C
C$ Detailed_Input
C
C     ET         time in ephemeris seconds past J2000 when the range
C                rate between the two bodies is to be computed.
C
C$ Detailed_Output
C
C     RVL        is the range rate of SVTARG as seen from SVOBS at
C                time ET.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     None.
C
C$ Files
C
C     None.
C
C$ Particulars
C
C     None.
C
C$ Examples
C
C     None.
C
C$ Restrictions
C
C     None.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     W.L. Taber     (JPL)
C     I.M. Underwood (JPL)
C     L.S. Elson     (JPL)
C
C$ Version
C
C-    SPICELIB version 1.0.0 09-JUN-2009 (LSE)(EDW)
C
C-&

C$ Index_Entries
C
C     get range rate between two bodies
C
C-&

      CALL ZZGFRRQ ( ET, SVTARG, SVOBS, SVABCO, RVL )

      RETURN

C$Procedure ZZGFRRX ( Private -- GF, retrieve ZZGFRRIN values )

      ENTRY ZZGFRRX ( XTARG, XABCOR, XOBS, XDT )

C$ Abstract
C
C     Retrieve values set in ZZGFRRIN.
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     None.
C
C$ Keywords
C
C     None.
C
C$ Declarations
C
C     None.
C
C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     XTARG      O   Saved value for the target body.
C     XABCOR     O   Saved value for the aberration correction.
C     XOBS       O   Saved value for the observing body.
C     XDT        O   Saved value for DT.
C
C$ Detailed_Input
C
C     None.
C
C$ Detailed_Output
C
C     XTARG    SPICE ID value for the target body initialized
C              via ZZGFRRIN.
C
C     XABCOR   String value for the aberration correction initialized
C              via ZZGFRRIN.
C
C     XOBS     SPICE ID value for the observing body initialized
C              via ZZGFRRIN.
C
C     XDT      Saved value for DT.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     None.
C
C$ Files
C
C     None.
C
C$ Particulars
C
C     None.
C
C$ Examples
C
C     None.
C
C$ Restrictions
C
C     None.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     N.J. Bachman   (JPL)
C     E.D. Wright    (JPL)
C
C$ Version
C
C-    SPICELIB version 1.0.0 16-SEP-2012 (EDW)
C
C-&

C$ Index_Entries
C
C     get saved range rate parameters
C
C-&

         XTARG  = SVTARG
         XABCOR = SVABCO
         XOBS   = SVOBS
         XDT    = SVDT

      RETURN
      END


MODULE shared_data
!
!  Purpose:
!    To declare data to share between two routines.

IMPLICIT NONE
SAVE

INTEGER, PARAMETER :: NUM_VALS = 5       ! Max number of values in array
REAL, DIMENSION(NUM_VALS) :: values      ! Data values

END MODULE shared_data


 module module_data_mosaic_asect
 implicit none
 integer, parameter :: maxd_atype = 1
 integer, parameter :: maxd_asize = 8
 integer, parameter :: maxd_acomp = 120
 integer, parameter :: maxd_aphase = 2
 integer, save :: ai_phase = -999888777
 integer, save :: cw_phase = -999888777
 integer, save :: ci_phase = -999888777
 integer, save :: rn_phase = -999888777
 integer, save :: sn_phase = -999888777
 integer, save :: gr_phase = -999888777
 integer, save :: ntype_aer = 0
 integer, save :: ntot_mastercomp_aer = 0
 integer, save :: nphase_aer = 0
 integer, save :: &
         nsize_aer( maxd_atype ), &
         ncomp_aer( maxd_atype ), &
         ncomp_plustracer_aer( maxd_atype ), &
          mastercompptr_aer(maxd_acomp, maxd_atype), &
         massptr_aer( maxd_acomp, maxd_asize, maxd_atype, maxd_aphase ), &
         waterptr_aer( maxd_asize, maxd_atype ), &
         hyswptr_aer( maxd_asize, maxd_atype ), &
         numptr_aer( maxd_asize, maxd_atype, maxd_aphase ), &
          mprognum_aer(maxd_asize,maxd_atype,maxd_aphase)
 integer, save :: mastercompindx_so4_aer = -999888777
 integer, save :: mastercompindx_no3_aer = -999888777
 integer, save :: mastercompindx_cl_aer = -999888777
 integer, save :: mastercompindx_msa_aer = -999888777
 integer, save :: mastercompindx_co3_aer = -999888777
 integer, save :: mastercompindx_nh4_aer = -999888777
 integer, save :: mastercompindx_na_aer = -999888777
 integer, save :: mastercompindx_ca_aer = -999888777
 integer, save :: mastercompindx_oin_aer = -999888777
 integer, save :: mastercompindx_oc_aer = -999888777
 integer, save :: mastercompindx_bc_aer = -999888777
        integer, save :: mastercompindx_pcg1_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg2_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg3_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg4_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg5_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg6_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg7_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg8_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg9_b_c_aer = -999888777
        integer, save :: mastercompindx_pcg1_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg2_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg3_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg4_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg5_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg6_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg7_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg8_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg9_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg1_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg2_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg3_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg4_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg5_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg6_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg7_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg8_b_c_aer = -999888777
        integer, save :: mastercompindx_opcg1_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg2_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg3_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg4_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg5_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg6_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg7_b_o_aer = -999888777
        integer, save :: mastercompindx_opcg8_b_o_aer = -999888777
        integer, save :: mastercompindx_pcg1_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg2_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg3_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg4_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg5_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg6_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg7_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg8_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg9_f_c_aer = -999888777
        integer, save :: mastercompindx_pcg1_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg2_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg3_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg4_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg5_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg6_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg7_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg8_f_o_aer = -999888777
        integer, save :: mastercompindx_pcg9_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg1_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg2_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg3_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg4_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg5_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg6_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg7_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg8_f_c_aer = -999888777
        integer, save :: mastercompindx_opcg1_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg2_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg3_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg4_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg5_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg6_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg7_f_o_aer = -999888777
        integer, save :: mastercompindx_opcg8_f_o_aer = -999888777
        integer, save :: mastercompindx_smpa_aer = -999888777
        integer, save :: mastercompindx_smpbb_aer = -999888777
        integer, save :: mastercompindx_ant1_c_aer = -999888777
        integer, save :: mastercompindx_ant2_c_aer = -999888777
        integer, save :: mastercompindx_ant3_c_aer = -999888777
        integer, save :: mastercompindx_ant4_c_aer = -999888777
        integer, save :: mastercompindx_ant1_o_aer = -999888777
        integer, save :: mastercompindx_ant2_o_aer = -999888777
        integer, save :: mastercompindx_ant3_o_aer = -999888777
        integer, save :: mastercompindx_ant4_o_aer = -999888777
        integer, save :: mastercompindx_biog1_c_aer = -999888777
        integer, save :: mastercompindx_biog2_c_aer = -999888777
        integer, save :: mastercompindx_biog3_c_aer = -999888777
        integer, save :: mastercompindx_biog4_c_aer = -999888777
        integer, save :: mastercompindx_biog1_o_aer = -999888777
        integer, save :: mastercompindx_biog2_o_aer = -999888777
        integer, save :: mastercompindx_biog3_o_aer = -999888777
        integer, save :: mastercompindx_biog4_o_aer = -999888777
 real, save :: &
          dens_aer( maxd_acomp, maxd_atype ), &
          dens_mastercomp_aer( maxd_acomp ), &
         mw_mastercomp_aer( maxd_acomp ), &
         mw_aer( maxd_acomp, maxd_atype ), &
         hygro_mastercomp_aer( maxd_acomp ), &
         hygro_aer( maxd_acomp, maxd_atype )
 real, save :: &
          volumcen_sect( maxd_asize, maxd_atype ), &
          volumlo_sect( maxd_asize, maxd_atype ), &
          volumhi_sect( maxd_asize, maxd_atype ), &
          dcen_sect( maxd_asize, maxd_atype ), &
          dlo_sect( maxd_asize, maxd_atype ), &
          dhi_sect( maxd_asize, maxd_atype ), &
          sigmag_aer(maxd_asize, maxd_atype)
 character*20, save :: &
         name_mastercomp_aer( maxd_acomp ), &
         name_aer( maxd_acomp, maxd_atype )
 integer, save :: &
         lptr_so4_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_msa_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_no3_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_cl_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_co3_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_nh4_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_na_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_ca_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_oin_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_oc_aer(maxd_asize, maxd_atype, maxd_aphase), &
         lptr_bc_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg1_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg2_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg3_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg4_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg5_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg6_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg7_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg8_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg9_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg1_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg2_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg3_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg4_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg5_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg6_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg7_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg8_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg9_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg1_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg2_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg3_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg4_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg5_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg6_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg7_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg8_b_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg1_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg2_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg3_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg4_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg5_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg6_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg7_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg8_b_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg1_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg2_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg3_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg4_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg5_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg6_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg7_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg8_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg9_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg1_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg2_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg3_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg4_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg5_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg6_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg7_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg8_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_pcg9_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg1_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg2_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg3_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg4_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg5_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg6_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg7_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg8_f_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg1_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg2_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg3_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg4_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg5_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg6_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg7_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_opcg8_f_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_smpa_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_smpbb_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant1_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant2_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant3_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant4_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant1_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant2_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant3_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_ant4_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog1_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog2_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog3_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog4_c_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog1_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog2_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog3_o_aer(maxd_asize, maxd_atype, maxd_aphase), &
          lptr_biog4_o_aer(maxd_asize, maxd_atype, maxd_aphase)
 real, parameter :: mw_so4_aer = 96.066
 real, parameter :: mw_no3_aer = 62.007
 real, parameter :: mw_cl_aer = 35.450
 real, parameter :: mw_msa_aer = 96.109
 real, parameter :: mw_co3_aer = 60.007
 real, parameter :: mw_nh4_aer = 18.042
 real, parameter :: mw_na_aer = 22.990
 real, parameter :: mw_ca_aer = 40.080
 real, parameter :: mw_oin_aer = 1.0
 real, parameter :: mw_oc_aer = 250.0
 real, parameter :: mw_bc_aer = 1.0
 real, parameter :: mw_water_aer = 18.016
        real, parameter :: mw_pcg1_b_c_aer = 250.0
        real, parameter :: mw_pcg2_b_c_aer = 250.0
        real, parameter :: mw_pcg3_b_c_aer = 250.0
        real, parameter :: mw_pcg4_b_c_aer = 250.0
        real, parameter :: mw_pcg5_b_c_aer = 250.0
        real, parameter :: mw_pcg6_b_c_aer = 250.0
        real, parameter :: mw_pcg7_b_c_aer = 250.0
        real, parameter :: mw_pcg8_b_c_aer = 250.0
        real, parameter :: mw_pcg9_b_c_aer = 250.0
        real, parameter :: mw_pcg1_b_o_aer = 250.0
        real, parameter :: mw_pcg2_b_o_aer = 250.0
        real, parameter :: mw_pcg3_b_o_aer = 250.0
        real, parameter :: mw_pcg4_b_o_aer = 250.0
        real, parameter :: mw_pcg5_b_o_aer = 250.0
        real, parameter :: mw_pcg6_b_o_aer = 250.0
        real, parameter :: mw_pcg7_b_o_aer = 250.0
        real, parameter :: mw_pcg8_b_o_aer = 250.0
        real, parameter :: mw_pcg9_b_o_aer = 250.0
        real, parameter :: mw_opcg1_b_c_aer = 250.0
        real, parameter :: mw_opcg2_b_c_aer = 250.0
        real, parameter :: mw_opcg3_b_c_aer = 250.0
        real, parameter :: mw_opcg4_b_c_aer = 250.0
        real, parameter :: mw_opcg5_b_c_aer = 250.0
        real, parameter :: mw_opcg6_b_c_aer = 250.0
        real, parameter :: mw_opcg7_b_c_aer = 250.0
        real, parameter :: mw_opcg8_b_c_aer = 250.0
        real, parameter :: mw_opcg1_b_o_aer = 250.0
        real, parameter :: mw_opcg2_b_o_aer = 250.0
        real, parameter :: mw_opcg3_b_o_aer = 250.0
        real, parameter :: mw_opcg4_b_o_aer = 250.0
        real, parameter :: mw_opcg5_b_o_aer = 250.0
        real, parameter :: mw_opcg6_b_o_aer = 250.0
        real, parameter :: mw_opcg7_b_o_aer = 250.0
        real, parameter :: mw_opcg8_b_o_aer = 250.0
        real, parameter :: mw_pcg1_f_c_aer = 250.0
        real, parameter :: mw_pcg2_f_c_aer = 250.0
        real, parameter :: mw_pcg3_f_c_aer = 250.0
        real, parameter :: mw_pcg4_f_c_aer = 250.0
        real, parameter :: mw_pcg5_f_c_aer = 250.0
        real, parameter :: mw_pcg6_f_c_aer = 250.0
        real, parameter :: mw_pcg7_f_c_aer = 250.0
        real, parameter :: mw_pcg8_f_c_aer = 250.0
        real, parameter :: mw_pcg9_f_c_aer = 250.0
        real, parameter :: mw_pcg1_f_o_aer = 250.0
        real, parameter :: mw_pcg2_f_o_aer = 250.0
        real, parameter :: mw_pcg3_f_o_aer = 250.0
        real, parameter :: mw_pcg4_f_o_aer = 250.0
        real, parameter :: mw_pcg5_f_o_aer = 250.0
        real, parameter :: mw_pcg6_f_o_aer = 250.0
        real, parameter :: mw_pcg7_f_o_aer = 250.0
        real, parameter :: mw_pcg8_f_o_aer = 250.0
        real, parameter :: mw_pcg9_f_o_aer = 250.0
        real, parameter :: mw_opcg1_f_c_aer = 250.0
        real, parameter :: mw_opcg2_f_c_aer = 250.0
        real, parameter :: mw_opcg3_f_c_aer = 250.0
        real, parameter :: mw_opcg4_f_c_aer = 250.0
        real, parameter :: mw_opcg5_f_c_aer = 250.0
        real, parameter :: mw_opcg6_f_c_aer = 250.0
        real, parameter :: mw_opcg7_f_c_aer = 250.0
        real, parameter :: mw_opcg8_f_c_aer = 250.0
        real, parameter :: mw_opcg1_f_o_aer = 250.0
        real, parameter :: mw_opcg2_f_o_aer = 250.0
        real, parameter :: mw_opcg3_f_o_aer = 250.0
        real, parameter :: mw_opcg4_f_o_aer = 250.0
        real, parameter :: mw_opcg5_f_o_aer = 250.0
        real, parameter :: mw_opcg6_f_o_aer = 250.0
        real, parameter :: mw_opcg7_f_o_aer = 250.0
        real, parameter :: mw_opcg8_f_o_aer = 250.0
        real, parameter :: mw_smpa_aer = 250.0
        real, parameter :: mw_smpbb_aer = 250.0
        real, parameter :: mw_ant1_c_aer = 250.0
        real, parameter :: mw_ant2_c_aer = 250.0
        real, parameter :: mw_ant3_c_aer = 250.0
        real, parameter :: mw_ant4_c_aer = 250.0
        real, parameter :: mw_ant1_o_aer = 250.0
        real, parameter :: mw_ant2_o_aer = 250.0
        real, parameter :: mw_ant3_o_aer = 250.0
        real, parameter :: mw_ant4_o_aer = 250.0
        real, parameter :: mw_biog1_c_aer = 250.0
        real, parameter :: mw_biog2_c_aer = 250.0
        real, parameter :: mw_biog3_c_aer = 250.0
        real, parameter :: mw_biog4_c_aer = 250.0
        real, parameter :: mw_biog1_o_aer = 250.0
        real, parameter :: mw_biog2_o_aer = 250.0
        real, parameter :: mw_biog3_o_aer = 250.0
        real, parameter :: mw_biog4_o_aer = 250.0
 real, parameter :: dens_so4_aer = 1.80
 real, parameter :: dens_no3_aer = 1.80
 real, parameter :: dens_cl_aer = 2.20
 real, parameter :: dens_msa_aer = 1.80
 real, parameter :: dens_co3_aer = 2.60
 real, parameter :: dens_nh4_aer = 1.80
 real, parameter :: dens_na_aer = 2.20
 real, parameter :: dens_ca_aer = 2.60
 real, parameter :: dens_oin_aer = 2.60
 real, parameter :: dens_oc_aer = 1.00
 real, parameter :: dens_bc_aer = 1.70
        real, parameter :: dens_pcg1_b_c_aer = 1.0
        real, parameter :: dens_pcg2_b_c_aer = 1.0
        real, parameter :: dens_pcg3_b_c_aer = 1.0
        real, parameter :: dens_pcg4_b_c_aer = 1.0
        real, parameter :: dens_pcg5_b_c_aer = 1.0
        real, parameter :: dens_pcg6_b_c_aer = 1.0
        real, parameter :: dens_pcg7_b_c_aer = 1.0
        real, parameter :: dens_pcg8_b_c_aer = 1.0
        real, parameter :: dens_pcg9_b_c_aer = 1.0
        real, parameter :: dens_pcg1_b_o_aer = 1.0
        real, parameter :: dens_pcg2_b_o_aer = 1.0
        real, parameter :: dens_pcg3_b_o_aer = 1.0
        real, parameter :: dens_pcg4_b_o_aer = 1.0
        real, parameter :: dens_pcg5_b_o_aer = 1.0
        real, parameter :: dens_pcg6_b_o_aer = 1.0
        real, parameter :: dens_pcg7_b_o_aer = 1.0
        real, parameter :: dens_pcg8_b_o_aer = 1.0
        real, parameter :: dens_pcg9_b_o_aer = 1.0
        real, parameter :: dens_opcg1_b_c_aer = 1.0
        real, parameter :: dens_opcg2_b_c_aer = 1.0
        real, parameter :: dens_opcg3_b_c_aer = 1.0
        real, parameter :: dens_opcg4_b_c_aer = 1.0
        real, parameter :: dens_opcg5_b_c_aer = 1.0
        real, parameter :: dens_opcg6_b_c_aer = 1.0
        real, parameter :: dens_opcg7_b_c_aer = 1.0
        real, parameter :: dens_opcg8_b_c_aer = 1.0
        real, parameter :: dens_opcg1_b_o_aer = 1.0
        real, parameter :: dens_opcg2_b_o_aer = 1.0
        real, parameter :: dens_opcg3_b_o_aer = 1.0
        real, parameter :: dens_opcg4_b_o_aer = 1.0
        real, parameter :: dens_opcg5_b_o_aer = 1.0
        real, parameter :: dens_opcg6_b_o_aer = 1.0
        real, parameter :: dens_opcg7_b_o_aer = 1.0
        real, parameter :: dens_opcg8_b_o_aer = 1.0
        real, parameter :: dens_pcg1_f_c_aer = 1.0
        real, parameter :: dens_pcg2_f_c_aer = 1.0
        real, parameter :: dens_pcg3_f_c_aer = 1.0
        real, parameter :: dens_pcg4_f_c_aer = 1.0
        real, parameter :: dens_pcg5_f_c_aer = 1.0
        real, parameter :: dens_pcg6_f_c_aer = 1.0
        real, parameter :: dens_pcg7_f_c_aer = 1.0
        real, parameter :: dens_pcg8_f_c_aer = 1.0
        real, parameter :: dens_pcg9_f_c_aer = 1.0
        real, parameter :: dens_pcg1_f_o_aer = 1.0
        real, parameter :: dens_pcg2_f_o_aer = 1.0
        real, parameter :: dens_pcg3_f_o_aer = 1.0
        real, parameter :: dens_pcg4_f_o_aer = 1.0
        real, parameter :: dens_pcg5_f_o_aer = 1.0
        real, parameter :: dens_pcg6_f_o_aer = 1.0
        real, parameter :: dens_pcg7_f_o_aer = 1.0
        real, parameter :: dens_pcg8_f_o_aer = 1.0
        real, parameter :: dens_pcg9_f_o_aer = 1.0
        real, parameter :: dens_opcg1_f_c_aer = 1.0
        real, parameter :: dens_opcg2_f_c_aer = 1.0
        real, parameter :: dens_opcg3_f_c_aer = 1.0
        real, parameter :: dens_opcg4_f_c_aer = 1.0
        real, parameter :: dens_opcg5_f_c_aer = 1.0
        real, parameter :: dens_opcg6_f_c_aer = 1.0
        real, parameter :: dens_opcg7_f_c_aer = 1.0
        real, parameter :: dens_opcg8_f_c_aer = 1.0
        real, parameter :: dens_opcg1_f_o_aer = 1.0
        real, parameter :: dens_opcg2_f_o_aer = 1.0
        real, parameter :: dens_opcg3_f_o_aer = 1.0
        real, parameter :: dens_opcg4_f_o_aer = 1.0
        real, parameter :: dens_opcg5_f_o_aer = 1.0
        real, parameter :: dens_opcg6_f_o_aer = 1.0
        real, parameter :: dens_opcg7_f_o_aer = 1.0
        real, parameter :: dens_opcg8_f_o_aer = 1.0
        real, parameter :: dens_smpa_aer = 1.0
        real, parameter :: dens_smpbb_aer = 1.0
        real, parameter :: dens_ant1_c_aer = 1.0
        real, parameter :: dens_ant2_c_aer = 1.0
        real, parameter :: dens_ant3_c_aer = 1.0
        real, parameter :: dens_ant4_c_aer = 1.0
        real, parameter :: dens_ant1_o_aer = 1.0
        real, parameter :: dens_ant2_o_aer = 1.0
        real, parameter :: dens_ant3_o_aer = 1.0
        real, parameter :: dens_ant4_o_aer = 1.0
        real, parameter :: dens_biog1_c_aer = 1.0
        real, parameter :: dens_biog2_c_aer = 1.0
        real, parameter :: dens_biog3_c_aer = 1.0
        real, parameter :: dens_biog4_c_aer = 1.0
        real, parameter :: dens_biog1_o_aer = 1.0
        real, parameter :: dens_biog2_o_aer = 1.0
        real, parameter :: dens_biog3_o_aer = 1.0
        real, parameter :: dens_biog4_o_aer = 1.0
 real, parameter :: dens_water_aer = 1.0
 real, parameter :: hygro_so4_aer = 0.5
 real, parameter :: hygro_no3_aer = 0.5
 real, parameter :: hygro_ca_aer = 0.1
 real, parameter :: hygro_co3_aer = 0.1
 real, parameter :: hygro_nh4_aer = 0.5
 real, parameter :: hygro_msa_aer = 0.58
 real, parameter :: hygro_cl_aer = 1.16
 real, parameter :: hygro_na_aer = 1.16
 real, parameter :: hygro_oin_aer = 0.14
 real, parameter :: hygro_oc_aer = 0.20
 real, parameter :: hygro_bc_aer = 1.e-6
         real, parameter :: hygro_smpa_aer = 0.10
        real, parameter :: hygro_smpbb_aer = 0.10
        real, parameter :: hygro_pcg1_b_c_aer = 0.04
        real, parameter :: hygro_pcg2_b_c_aer = 0.04
        real, parameter :: hygro_pcg3_b_c_aer = 0.04
        real, parameter :: hygro_pcg4_b_c_aer = 0.04
        real, parameter :: hygro_pcg5_b_c_aer = 0.04
        real, parameter :: hygro_pcg6_b_c_aer = 0.04
        real, parameter :: hygro_pcg7_b_c_aer = 0.04
        real, parameter :: hygro_pcg8_b_c_aer = 0.04
        real, parameter :: hygro_pcg9_b_c_aer = 0.04
        real, parameter :: hygro_pcg1_b_o_aer = 0.04
        real, parameter :: hygro_pcg2_b_o_aer = 0.04
        real, parameter :: hygro_pcg3_b_o_aer = 0.04
        real, parameter :: hygro_pcg4_b_o_aer = 0.04
        real, parameter :: hygro_pcg5_b_o_aer = 0.04
        real, parameter :: hygro_pcg6_b_o_aer = 0.04
        real, parameter :: hygro_pcg7_b_o_aer = 0.04
        real, parameter :: hygro_pcg8_b_o_aer = 0.04
        real, parameter :: hygro_pcg9_b_o_aer = 0.04
        real, parameter :: hygro_opcg1_b_c_aer = 0.10
        real, parameter :: hygro_opcg2_b_c_aer = 0.10
        real, parameter :: hygro_opcg3_b_c_aer = 0.10
        real, parameter :: hygro_opcg4_b_c_aer = 0.10
        real, parameter :: hygro_opcg5_b_c_aer = 0.10
        real, parameter :: hygro_opcg6_b_c_aer = 0.10
        real, parameter :: hygro_opcg7_b_c_aer = 0.10
        real, parameter :: hygro_opcg8_b_c_aer = 0.10
        real, parameter :: hygro_opcg1_b_o_aer = 0.10
        real, parameter :: hygro_opcg2_b_o_aer = 0.10
        real, parameter :: hygro_opcg3_b_o_aer = 0.10
        real, parameter :: hygro_opcg4_b_o_aer = 0.10
        real, parameter :: hygro_opcg5_b_o_aer = 0.10
        real, parameter :: hygro_opcg6_b_o_aer = 0.10
        real, parameter :: hygro_opcg7_b_o_aer = 0.10
        real, parameter :: hygro_opcg8_b_o_aer = 0.10
        real, parameter :: hygro_pcg1_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg2_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg3_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg4_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg5_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg6_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg7_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg8_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg9_f_c_aer = 1.0e-6
        real, parameter :: hygro_pcg1_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg2_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg3_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg4_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg5_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg6_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg7_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg8_f_o_aer = 1.0e-6
        real, parameter :: hygro_pcg9_f_o_aer = 1.0e-6
        real, parameter :: hygro_opcg1_f_c_aer = 0.10
        real, parameter :: hygro_opcg2_f_c_aer = 0.10
        real, parameter :: hygro_opcg3_f_c_aer = 0.10
        real, parameter :: hygro_opcg4_f_c_aer = 0.10
        real, parameter :: hygro_opcg5_f_c_aer = 0.10
        real, parameter :: hygro_opcg6_f_c_aer = 0.10
        real, parameter :: hygro_opcg7_f_c_aer = 0.10
        real, parameter :: hygro_opcg8_f_c_aer = 0.10
        real, parameter :: hygro_opcg1_f_o_aer = 0.10
        real, parameter :: hygro_opcg2_f_o_aer = 0.10
        real, parameter :: hygro_opcg3_f_o_aer = 0.10
        real, parameter :: hygro_opcg4_f_o_aer = 0.10
        real, parameter :: hygro_opcg5_f_o_aer = 0.10
        real, parameter :: hygro_opcg6_f_o_aer = 0.10
        real, parameter :: hygro_opcg7_f_o_aer = 0.10
        real, parameter :: hygro_opcg8_f_o_aer = 0.10
        real, parameter :: hygro_ant1_c_aer = 0.10
        real, parameter :: hygro_ant2_c_aer = 0.10
        real, parameter :: hygro_ant3_c_aer = 0.10
        real, parameter :: hygro_ant4_c_aer = 0.10
        real, parameter :: hygro_ant1_o_aer = 0.10
        real, parameter :: hygro_ant2_o_aer = 0.10
        real, parameter :: hygro_ant3_o_aer = 0.10
        real, parameter :: hygro_ant4_o_aer = 0.10
        real, parameter :: hygro_biog1_c_aer = 0.10
        real, parameter :: hygro_biog2_c_aer = 0.10
        real, parameter :: hygro_biog3_c_aer = 0.10
        real, parameter :: hygro_biog4_c_aer = 0.10
        real, parameter :: hygro_biog1_o_aer = 0.10
        real, parameter :: hygro_biog2_o_aer = 0.10
        real, parameter :: hygro_biog3_o_aer = 0.10
        real, parameter :: hygro_biog4_o_aer = 0.10
 integer, save :: &
         msectional, maerosolincw, &
         maerocoag, maerchem, maeroptical, maerchem_boxtest_output
 integer, parameter :: kmaxd_asize = 100
 integer, parameter :: nsubareamaxd_asize = 5
 real, save :: aqvoldry_sub( maxd_asize,maxd_atype,kmaxd_asize,nsubareamaxd_asize)
 real, save :: aqmassdry_sub(maxd_asize,maxd_atype,kmaxd_asize,nsubareamaxd_asize)
 real, save :: adrydens_sub( maxd_asize,maxd_atype,kmaxd_asize,nsubareamaxd_asize)
 real, save :: awetdens_sub( maxd_asize,maxd_atype,kmaxd_asize,nsubareamaxd_asize)
 real, save :: admeandry_sub(maxd_asize,maxd_atype,kmaxd_asize,nsubareamaxd_asize)
 real, save :: admeanwet_sub(maxd_asize,maxd_atype,kmaxd_asize,nsubareamaxd_asize)
 real, save :: drymass_pregrow(maxd_asize,maxd_atype)
 real, save :: drydens_pregrow(maxd_asize,maxd_atype)
 real, save :: drymass_aftgrow(maxd_asize,maxd_atype)
 real, save :: drydens_aftgrow(maxd_asize,maxd_atype)
 real dlndg_nimptblgrow
 integer nimptblgrow_mind, nimptblgrow_maxd
 parameter (nimptblgrow_mind=-7, nimptblgrow_maxd=12)
      real scavimptblnum(4, nimptblgrow_mind:nimptblgrow_maxd, maxd_asize, maxd_atype), &
           scavimptblvol(4, nimptblgrow_mind:nimptblgrow_maxd, maxd_asize, maxd_atype)
 end module module_data_mosaic_asect


      SUBROUTINE DFPSAV(TOTIME,XPARAM,GD,XLAST,FUNCT1,MDFP,XDFP)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INCLUDE 'SIZES/NOLIST'
      DIMENSION XPARAM(*), GD(*), XLAST(*), MDFP(9),XDFP(9)
**********************************************************************
*
* DFPSAV STORES AND RESTORES DATA USED IN THE D-F-P GEOMETRY
*        OPTIMISATION.
*
*  ON INPUT TOTIME = TOTAL CPU TIME ELAPSED DURING THE CALCULATION.
*           XPARAM = CURRENT VALUE OF PARAMETERS.
*           GD     = OLD GRADIENT.
*           XLAST  = OLD VALUE OF PARAMETERS.
*           FUNCT1 = CURRENT VALUE OF HEAT OF FORMATION.
*           MDFP   = INTEGER CONSTANTS USED IN D-F-P.
*           XDFP   = REAL CONSTANTS USED IN D-F-P.
*           MDFP(9)= 1 FOR DUMP, 0 FOR RESTORE.
**********************************************************************
      COMMON /KEYWRD/ KEYWRD
      COMMON /TITLES/ KOMENT,TITLE
      COMMON /GRADNT/ GRAD(MAXPAR),GNORM
      COMMON /GEOVAR/ NVAR,LOC(2,MAXPAR), DUMY(MAXPAR)
      COMMON /DENSTY/ P(MPACK), PA(MPACK), PB(MPACK)
      COMMON /ALPARM/ ALPARM(3,MAXPAR),ILOOP,X0, X1, X2
      COMMON /REACTN/ STEP, GEOA(3,NUMATM), GEOVEC(3,NUMATM),CALCST
      COMMON /GMETRY/ GEO(3,NUMATM)
      COMMON /GEOKST/ NATOMS,LABELS(NUMATM),
     +                NA(NUMATM),NB(NUMATM),NC(NUMATM)
      COMMON /PATH  / LATOM,LPARAM,REACT(100)
      COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
     +                NLAST(NUMATM), NORBS, NELECS,
     1                NALPHA, NBETA, NCLOSE, NOPEN
      COMMON /FMATRX/ HESINV(MAXHES)
      COMMON /GEOSYM/ NDEP,LOCPAR(200),IDEPFN(200),LOCDEP(200)
      DIMENSION IEL1(3),Q(3)
      CHARACTER ELEMNT(99)*2, KEYWRD*80,KOMENT*80, TITLE*80
      LOGICAL FIRST
      DATA FIRST /.TRUE./
      DATA ELEMNT/' H','He',
     2 'Li','Be',' B',' C',' N',' O',' F','Ne',
     3 'Na','Mg','Al','Si',' P',' S','Cl','Ar',
     4 ' K','Ca','Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu',
     4 'Zn','Ga','Ge','As','Se','Br','Kr',
     5 'Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag',
     5 'Cd','In','Sn','Sb','Te',' I','Xe',
     6 'Cs','Ba','La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy',
     6 'Ho','Er','Tm','Yb','Lu','Hf','Ta',' W','Re','Os','Ir','Pt',
     6 'Au','Hg','Tl','Pb','Bi','Po','At','Rn',
     7 'Fr','Ra','Ac','Th','Pa',' U','Np','Pu','Am','Cm','Bk','Cf','XX'/
      DEGREE=57.29577951D0
      IR=9
      REWIND 10
      REWIND IR
      IF(MDFP(9) .EQ. 1) THEN
        WRITE(6,'(//10X,''- - - - - - - TIME UP - - - - - - -'',//)')
        IF(INDEX(KEYWRD,'SADDLE') .NE. 0) THEN
        WRITE(6,'(//10X,'' NO RESTART EXISTS FOR SADDLE'',//
     +  10X,'' HERE IS A DATA-FILE FILES THAT MIGHT BE SUITABLE'',/
     +  10X,'' FOR RESTARTING THE CALCULATION'',///)')
      WRITE(6,'(1X,A)')KEYWRD,KOMENT,TITLE
      DO 44 ILOOP=1,2
      GEO(2,1)=0.D0
      GEO(3,1)=0.D0
      GEO(1,1)=0.D0
      GEO(2,2)=0.D0
      GEO(3,2)=0.D0
      GEO(3,3)=0.D0
      IVAR=1
      NA(1)=0
      DO 112 I=1,NATOMS
          DO 122 J=1,3
  122         IEL1(J)=0
  123         CONTINUE
          IF(LOC(1,IVAR).EQ.I) THEN
              IEL1(LOC(2,IVAR))=1
              IVAR=IVAR+1
              GOTO 123
          ENDIF
      IF(I.LT.4) THEN
          IEL1(3)=0
          IF(I.LT.3) THEN
              IEL1(2)=0
              IF(I.LT.2) THEN
                  IEL1(1)=0
              ENDIF
          ENDIF
      ENDIF
      IF(I.EQ.LATOM)IEL1(LPARAM)=-1
      Q(1)=GEO(1,I)
      Q(2)=GEO(2,I)*DEGREE
      Q(3)=GEO(3,I)*DEGREE
  112     WRITE(6,'(2X,A2,3(F12.6,I3),I4,2I3)')
     +    ELEMNT(LABELS(I)),(Q(K),IEL1(K),K=1,3),NA(I),NB(I),NC(I)
          I=0
          X=0.D0
          WRITE(6,'(I4,3(F12.6,I3),I4,2I3)')
     +    I,X,I,X,I,X,I,I,I,I
      DO 45 I=1,NATOMS
      DO 45 J=1,3
  45  GEO(J,I)=GEOA(J,I)
  44  CONTINUE
      WRITE(6,'(///10X,''CALCULATION TERMINATED HERE'')')
      STOP
      ENDIF
        WRITE(6,'(//10X,'' - THE CALCULATION IS BEING DUMPED TO DISK'',
     +  /10X,''   RESTART IT USING THE MAGIC WORD "RESTART"'')')
        WRITE(6,'(//10X,''CURRENT VALUE OF HEAT OF FORMATION =''
     +  ,F12.6)')FUNCT1
      GEO(2,1)=0.D0
      GEO(3,1)=0.D0
      GEO(1,1)=0.D0
      GEO(2,2)=0.D0
      GEO(3,2)=0.D0
      GEO(3,3)=0.D0
      IVAR=1
      NA(1)=0
      WRITE(6,'(A)')KEYWRD,KOMENT,TITLE
      DO 110 I=1,NATOMS
          DO 120 J=1,3
  120         IEL1(J)=0
  121         CONTINUE
          IF(LOC(1,IVAR).EQ.I) THEN
              IEL1(LOC(2,IVAR))=1
              IVAR=IVAR+1
              GOTO 121
          ENDIF
      IF(I.LT.4) THEN
          IEL1(3)=0
          IF(I.LT.3) THEN
              IEL1(2)=0
              IF(I.LT.2) THEN
                  IEL1(1)=0
              ENDIF
          ENDIF
      ENDIF
      IF(I.EQ.LATOM)IEL1(LPARAM)=-1
      Q(1)=GEO(1,I)
      Q(2)=GEO(2,I)*DEGREE
      Q(3)=GEO(3,I)*DEGREE
  110     WRITE(6,'(2X,A2,3(F12.6,I3),I4,2I3)')
     +    ELEMNT(LABELS(I)),(Q(K),IEL1(K),K=1,3),NA(I),NB(I),NC(I)
          I=0
          X=0.D0
          WRITE(6,'(I4,3(F12.6,I3),I4,2I3)')
     +    I,X,I,X,I,X,I,I,I,I
      IF(NDEP.NE.0)THEN
        DO 130 I=1,NDEP
  130   WRITE(6,'(3(I4,'',''))')LOCPAR(I),IDEPFN(I),LOCDEP(I)
      WRITE(6,*)
      ENDIF
        WRITE(IR)MDFP,XDFP,TOTIME,FUNCT1
        WRITE(IR)(XPARAM(I),I=1,NVAR),(GD(I),I=1,NVAR)
        WRITE(IR)(XLAST(I),I=1,NVAR),(GRAD(I),I=1,NVAR)
        LINEAR=(NVAR*(NVAR+1))/2
        WRITE(IR)(HESINV(I),I=1,LINEAR)
        LINEAR=(NORBS*(NORBS+1))/2
        WRITE(10)(PA(I),I=1,LINEAR)
        IF(NALPHA.NE.0)WRITE(10)(PB(I),I=1,LINEAR)
        IF(LATOM .NE. 0) THEN
          WRITE(IR)((ALPARM(J,I),J=1,3),I=1,NVAR)
          WRITE(IR)ILOOP,X0, X1, X2
        ENDIF
        STOP
      ELSE
        IF (FIRST) WRITE(6,'(//10X,'' RESTORING DATA FROM DISK''/)')
        READ(IR)MDFP,XDFP,TOTIME,FUNCT1
        IF (FIRST) WRITE(6,'(10X,''FUNCTION ='',F13.6//)')FUNCT1
        READ(IR)(XPARAM(I),I=1,NVAR),(GD(I),I=1,NVAR)
        READ(IR)(XLAST(I),I=1,NVAR),(GRAD(I),I=1,NVAR)
        LINEAR=(NVAR*(NVAR+1))/2
        READ(IR)(HESINV(I),I=1,LINEAR)
        LINEAR=(NORBS*(NORBS+1))/2
        READ(10)(PA(I),I=1,LINEAR)
        IF(NALPHA.NE.0)READ(10)(PB(I),I=1,LINEAR)
        IF(LATOM.NE.0) THEN
          READ(IR)((ALPARM(J,I),J=1,3),I=1,NVAR)
          READ(IR)ILOOP,X0, X1, X2
        ENDIF
        FIRST=.FALSE.
        RETURN
      ENDIF
      END


Quantitative Biology and Bioinformatics is a recently introduced interdisciplinary minors minor designed for people who want to go to graduate school in biology, mathematical biology, or biostatistics. The tools acquired from this minor are becoming more and more necessary to graduate study in biological fields.  However, even if you are not going to graduate school, this may be an interesting minor if you are a science student who likes math and/or statistics or a math student who likes biology science.  Studying bioinformatics will give you a competitive edge in the field of science.

Quantitative Biology is redefining biology as we know it today, and is considered to be the new foundation of modern biological research.  This minor will teach students the strengths and limitations of computational methods in studying problems pertaining to evolutionary biology, ecology, genetics, Neurobiology, physiology, and molecular and cell biology.  The minor is very connected to the CLIMB program, since it focuses on the mathematical tools used in various fields of biology.

Preparatory work includes:

  Either the MAT 16, 17, or 21 series.
  A lower division biology course.
  A lower division computer programming course (ECS 10 or 30, or Engineering 6).

The upper division course plan includes:

  Computer Science ECS 124 or 129: Theory and Practice of Bioinformatics, or, Computational Structural Bioinformatics
  Biological Sciences BIS 132 or Mathematics MAT 124: Mathematical Biology (MAT 124 has more math prereqs but is only offered once every other year, so even some math majors end up taking BIS 132)
  Choice of one: ECS 110, Applied Science Engineering 115, Stats 130A, 131A, 141A, MAT 128ABC, 135A
  Restricted Electives, choose two: Animal Genetics 120, ECS 122A, 165A, Environmental Policy and Analysis 121 or Wildlife Fish and Conservation Biology 122, Evolution and Ecology 102, 103, 104, 175, Molecular and Cellular Biology 123, 143, 182, NPB 105, 131, 165


PROGRAM scratch_file
!
!  Purpose:
!    To illustrate the use of a scratch file and positioning
!    commands as follows:
!    1.  Read in an arbitrary number of positive or zero
!        values, saving them in a scratch file.  Stop
!        reading when a negative value is encountered.
!    2.  Ask the user for a record number to display.
!    3.  Rewind the file, get that value, and display it.
!
!  Record of revisions:
!      Date       Programmer          Description of change
!      ====       ==========          =====================
!    11/19/06    S. J. Chapman        Original code
!
IMPLICIT NONE

! Data dictionary: declare constants
INTEGER, PARAMETER :: LU = 8  ! i/o unit for scratch file

! Data dictionary: declare variable types, definitions, & units
REAL :: data           ! Data value stored in a disk file
INTEGER :: icount = 0  ! The number of input data records
INTEGER :: irec        ! Record number to recover and display
INTEGER :: j           ! Loop index

! Open the scratch file
OPEN (UNIT=LU, STATUS='SCRATCH' )

! Prompt user and get input data.
WRITE (*, 100)
100 FORMAT (1X,'Enter positive or zero input values. ',/, &
            1X,'A negative value terminates input.' )

! Get the input values, and write them to the scratch file
DO
   WRITE (*, 110) icount + 1     ! Prompt for next value
   110 FORMAT (1X,'Enter sample ',I4,':' )
   READ (*,*) data               ! Read value
   IF ( data < 0. ) EXIT         ! Exit on negative numbers
   icount = icount + 1           ! Valid value: bump count
   WRITE (LU,120) data           ! Write data to scratch file
   120 FORMAT (1X, ES16.6)
END DO

! Now we have all of the records.  Ask which record to see.
! icount records are in the file.
WRITE (*,130) icount
130 FORMAT (1X,'Which record do you want to see (1 to ',I4, ')? ')
READ (*,*) irec

! Do we have a legal record number?  If so, get the record.
! If not, tell the user and stop.
IF ( (irec >= 1) .AND. (irec <= icount) ) THEN

   ! This is a legal record.  Rewind the scratch file.
   REWIND (UNIT=LU)

   ! Read forward to the desired record.
   DO j = 1, irec
      READ (LU,*) data
   END DO

   ! Tell user.
   WRITE (*,140) irec, data
   140 FORMAT (1X,'The value of record ', I4, ' is ', ES14.5 )

ELSE

   ! We have an illegal record number.  Tell user.
   WRITE (*,150) irec
   150 FORMAT (1X,'Illegal record number entered: ', I8)

END IF

! Close file
CLOSE(LU)

END PROGRAM scratch_file


!-------------------------------------------------------------------
! Program Labels
!-------------------------------------------------------------------
! Program name: tryPreprocess.f90
! Try preprocess in c language format
! Compiler command: ifort -cpp tryPreprocess.f90 -o tryPreprocess
! or ifort -fpp tryPreprocess.f90 -o tryPreprocess
! -cpp / -fpp  means C Pre-processor / Fortran Pre Processor
!-------------------------------------------------------------------

!-------------------------------------------------------------------
! Define macros
!-------------------------------------------------------------------
#define FLOAT REAL(KIND=8)     ! define 8-byte double-precision float
!#define FLOAT real(kind=4)    ! define 4-byte single-precision float
!-------------------------------------------------------------------

!-------------------------------------------------------------------
! Program main
!-------------------------------------------------------------------
PROGRAM main
IMPLICIT NONE

FLOAT i          ! define a float of single-precision or double-precision

i = 3.14159265358979323846D0

WRITE(*,200)  i
200 FORMAT(1x,'i = ',ES30.20)

WRITE(*,300)
300 FORMAT(1x,'i = 3.14159265358979323846D0')

END PROGRAM main
!--------------------------------------------------------------------