!Models-3/CMAQ code adapted for MONARCH

!***********************************************************************
!   Portions of Models-3/CMAQ software were developed or based on      *
!   information from various groups: Federal Government employees,     *
!   contractors working on a United States Government contract, and    *
!   non-Federal sources (including research institutions).  These      *
!   research institutions have given the Government permission to      *
!   use, prepare derivative works, and distribute copies of their      *
!   work in Models-3/CMAQ to the public and to permit others to do     *
!   so.  EPA therefore grants similar permissions for use of the       *
!   Models-3/CMAQ software, but users are requested to provide copies  *
!   of derivative works to the Government without restrictions as to   *
!   use by others.  Users are responsible for acquiring their own      *
!   copies of commercial software associated with Models-3/CMAQ and    *
!   for complying with vendor requirements.  Software copyrights by    *
!   the MCNC Environmental Modeling Center are used with their         *
!   permissions subject to the above restrictions.                     *
!***********************************************************************
! cmaq4.7.1
! RCS file, release, date & time of last delta, author, state, [and locker]
! $Header: /project/work/rep/CCTM/src/cloud/cloud_acm/convcld_acm.F,v 1.4 2008/09/03 16:19:39 sjr Exp $

! what(1) key, module and SID; SCCS file; date and time of last delta:
! %W% %P% %G% %U%

      MODULE MONARCH_CONVCLD_ACM
#ifdef DO_PARTMC
      USE MONARCH_COLUMN
      USE MONARCH_LAST_TIME_STEP
      USE MONARCH_UTIL

      IMPLICIT NONE
      PRIVATE

      PUBLIC :: CONVCLD_ACM_MOD_PMC, CONVCLD_INIT, CONVCLD_FINALIZE

      INTEGER :: NLAYS                            ! Number of vertical layers
      INTEGER :: NSPEC                            ! Number of mixing species

      REAL,ALLOCATABLE,DIMENSION(:,:) :: CCR
      REAL,ALLOCATABLE,DIMENSION(:,:) :: BCLDWT   ! below cloud weighting function
      REAL,ALLOCATABLE,DIMENSION(:,:) :: CONCMINL ! minimum concentrations for each
                                                  !    species and layer
      REAL,ALLOCATABLE,DIMENSION(:,:) :: INCLOUD  ! fin. in cloud conc. after mix and
                                                  !    chem moles/mole
      REAL,ALLOCATABLE,DIMENSION(:,:) :: OUTCLOUD ! fin. outside cld conc. " " moles/mole
      REAL,ALLOCATABLE,DIMENSION(:,:) :: PCLD     ! moles sp/mole air in cloud
      REAL,ALLOCATABLE,DIMENSION(:) :: SIGF   ! Full layer sigma (0...n_layers)
      REAL,ALLOCATABLE,DIMENSION(:) :: CBELOW
      REAL,ALLOCATABLE,DIMENSION(:) :: BMOL   ! moles/m2 species below cloud
      REAL,ALLOCATABLE,DIMENSION(:) :: CBASE0 ! initial ave trace gas mix rat below cld
      REAL,ALLOCATABLE,DIMENSION(:) :: CBASEF ! final ave trac gas mix rat blw cld (moles/mole)
      REAL,ALLOCATABLE,DIMENSION(:) :: CEND   ! ending equiv gas phase conc (moles/mole)
      REAL,ALLOCATABLE,DIMENSION(:) :: POLC   ! ave vert conc incloud moles sp/m2 and moles
                                              !    sp/ mole air
      REAL,ALLOCATABLE,DIMENSION(:) :: REMOV  ! moles/m2 or mm*mol/lit scavenged

      REAL,ALLOCATABLE,DIMENSION(:) :: F      ! cloud entrainment fraction to be solved for
      REAL,ALLOCATABLE,DIMENSION(:) :: FSIDE  ! sidewall entrainment vertical profile
      REAL,ALLOCATABLE,DIMENSION(:) :: LWC    ! liq wat cont of cloud in kg H2O/m3 air
      REAL,ALLOCATABLE,DIMENSION(:) :: QICE   ! ice mixing ratio in cloud
      REAL,ALLOCATABLE,DIMENSION(:) :: QLQD   ! actual liq. wat. mix ratio in cloud
      REAL,ALLOCATABLE,DIMENSION(:) :: QVC    ! saturation wat vap mix ratio at T1
      REAL,ALLOCATABLE,DIMENSION(:) :: QWAT   ! liq wat mix rat, taken as total condensed
                                              !    water (ice + liq) profile (Eq.4, W&T)
      REAL,ALLOCATABLE,DIMENSION(:) :: RHOM2  ! moles/m2 air
      REAL,ALLOCATABLE,DIMENSION(:) :: TCLD   ! temp of cloudy air parcel
      REAL,ALLOCATABLE,DIMENSION(:) :: ZH     ! FIXME - what is this???
      REAL,ALLOCATABLE,DIMENSION(:) :: QAD    ! moist adiab. sat. mix ratio
      REAL,ALLOCATABLE,DIMENSION(:) :: TSAT   ! parcel temp along moist adiabat @@ half level

      CONTAINS

!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!     Initialize the convective cloud arrays
      SUBROUTINE CONVCLD_INIT( NLAYS_IN, NSPEC_IN )

!       Number of vertical layers
        INTEGER, INTENT(IN) :: NLAYS_IN
!       Number of mixing species
        INTEGER, INTENT(IN) :: NSPEC_IN

        NLAYS  = NLAYS_IN
        NSPEC  = NSPEC_IN

        ALLOCATE(CCR     ( NSPEC, NLAYS ))
        ALLOCATE(CBELOW  ( NSPEC ))
        ALLOCATE(BMOL    ( NSPEC ))
        ALLOCATE(CBASE0  ( NSPEC ))
        ALLOCATE(CBASEF  ( NSPEC ))
        ALLOCATE(CEND    ( NSPEC ))
        ALLOCATE(POLC    ( NSPEC ))
        ALLOCATE(REMOV   ( NSPEC ))
        ALLOCATE(BCLDWT  ( NSPEC, NLAYS ))
        ALLOCATE(CONCMINL( NSPEC, NLAYS ))
        ALLOCATE(INCLOUD ( NSPEC, NLAYS ))
        ALLOCATE(OUTCLOUD( NSPEC, NLAYS ))
        ALLOCATE(PCLD    ( NSPEC, NLAYS ))
        ALLOCATE(SIGF    ( 0:NLAYS ))
        ALLOCATE(F       ( NLAYS ))
        ALLOCATE(FSIDE   ( NLAYS ))
        ALLOCATE(LWC     ( NLAYS ))
        ALLOCATE(QICE    ( NLAYS ))
        ALLOCATE(QLQD    ( NLAYS ))
        ALLOCATE(QVC     ( NLAYS ))
        ALLOCATE(QWAT    ( NLAYS ))
        ALLOCATE(RHOM2   ( NLAYS ))
        ALLOCATE(TCLD    ( NLAYS ))
        ALLOCATE(ZH      ( NLAYS ))
        ALLOCATE(QAD     ( NLAYS ))
        ALLOCATE(TSAT    ( NLAYS ))

        ! FIXME Can we eliminate this?
        CONCMINL( :,: ) = 1.0e-25

      END SUBROUTINE CONVCLD_INIT
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!     Finalize the convective cloud arrays
      SUBROUTINE CONVCLD_FINALIZE()

        DEALLOCATE(CCR     )
        DEALLOCATE(CBELOW  )
        DEALLOCATE(BMOL    )
        DEALLOCATE(CBASE0  )
        DEALLOCATE(CBASEF  )
        DEALLOCATE(CEND    )
        DEALLOCATE(POLC    )
        DEALLOCATE(REMOV   )
        DEALLOCATE(BCLDWT  )
        DEALLOCATE(CONCMINL)
        DEALLOCATE(INCLOUD )
        DEALLOCATE(OUTCLOUD)
        DEALLOCATE(PCLD    )
        DEALLOCATE(SIGF    )
        DEALLOCATE(F       )
        DEALLOCATE(FSIDE   )
        DEALLOCATE(LWC     )
        DEALLOCATE(QICE    )
        DEALLOCATE(QLQD    )
        DEALLOCATE(QVC     )
        DEALLOCATE(QWAT    )
        DEALLOCATE(RHOM2   )
        DEALLOCATE(TCLD    )
        DEALLOCATE(ZH      )
        DEALLOCATE(QAD     )
        DEALLOCATE(TSAT    )

      END SUBROUTINE CONVCLD_FINALIZE
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
      SUBROUTINE CONVCLD_ACM_MOD_PMC ( COLUMN, LAST_TIME_STEP, CONC,
     &                                 LOSS_RATES )
!-----------------------------------------------------------------------
!
!  FUNCTION: Convective cloud processor Models-3 science process:
!       MAIN ROUTINE calculates cloud characteristics, and uses them
!       to generate cumulative and net timestep deposition, cloud top,
!       cloud bottom, and pressure at the lifting level.
!
!       ICLDTYPE = 1 => computes raining cloud physics, mixing, chemistry,
!                       wet dep
!       ICLDTYPE = 2 => does the same for non-precip clouds utilizing saved
!                       info from RNCLD in the case of co-existing clouds
!
!  PRECONDITIONS REQUIRED:
!       Dates and times represented YYYYDDD:HHMMSS.
!
!  IDEA:   Aqueous chemistry operates on the half-hour for an internal
!          time step of one hour.
!
!  REVISION  HISTORY:
!       Adapted 3/93 by CJC from science module template
!       Version 3/3/93 with complete LCM aqueous chem by JNY.
!       Modified 6/3-7/93 by CJC & JNY to correct treatment of half layers
!       vs. full layers in loop 255:  calculation of DTDP centered at
!       quarter-layers using PSTAR; corresponding revisions to TLCL, TSAT.
!       Uses 4th order R-K solver there.
!       Version 6/5/93 by CJC using relative rainout rates.
!       Version 7/6/93 by CJC using INTERP3()
!       Adapted from LCM aqueous chemistry, initial version, 9/93
!              by JNY and CJC
!       Completion of EM cloud mixing, JNY 12/93
!       Inclusion of EM aqueous chemistry JNY 12/93
!       UPGRADE TO FULL RADM CLOUD MODULE EMULATION, JNY 4/94
!       8/16/94 by Dongming Hwang Configuration management template
!       Adapted 10/96 by S.Roselle for Models-3
!       1/97 s.roselle added McHenry's well mixed assumption code
!       8/97 S.Roselle revised cgrid units, pressure units, rainfall
!              to hourly amounts, built indices for wet dep species,
!              scavenged species, and aqueous species, built wrapper
!              around aqueous chemistry module
!       10/97 S.Roselle removed McHenry's well mixed assumption code
!              and put back the below cloud concentration scaling
!       11/97 S.Roselle moved the wet deposition output to the calling
!              routine--CLDPROC
!       01/98 S.Roselle moved indexing code to AQINTER, also
!              moved scavenging to SCAVWDEP
!       03/98 S.Roselle read sub-hourly rainfall data
!       12/98 David Wong at LM:
!             -- changed division of 8000, 2, 1000 to its corresponding
!                reciprocal
!              -- added INT in the expression STEP * 0.5 when calling SEC2TIME
!       03/99 David Wong at LM:
!             -- replaced "/ FRAC * .001" by "/ ( FRAC * 1000.0 )" to minimize
!                lost of significant digits in calculation
!       Jeff - Dec 00 - move CGRID_MAP into f90 module
!       Jeff - Sep 01 - Dyn Alloc - Use HGRD_DEFN
!       4/02 S.Roselle changed minimum horizontal resolution for subgrid
!             clouds from 12km to 8km.
!       1/05 J.Young: dyn alloc - establish both horizontal & vertical
!                     domain specifications in one module
!       5/05 J.Pleim Replaced cloud mixing algorithm with ACM
!       6/05 S.Roselle added new cloud diagnostic variables
!       7/05 J.Young: clean up and mod for CMAQ-F
!       10/18 M. Dawson at BSC: update for use with MONARCH-CAMP
!-----------------------------------------------------------------------

      IMPLICIT NONE

!...........INCLUDES

      INCLUDE "monarch/CLDCHEM/CONST.EXT"! constants

!...........PARAMETERS

! critical rel humidity, lower bound (fraction)
      REAL, PARAMETER :: RCRIT1 = 0.7

! critical rel humidity, upper bound (fraction)
      REAL, PARAMETER :: RCRIT2 = 0.9

! param contlng sidewall entrainment function for raining clouds
      REAL, PARAMETER :: SIDEFAC = 0.5

! storm rainout efficiency
      REAL, PARAMETER :: STORME  = 0.3

! emp sat vapor press constant from RADM
      REAL, PARAMETER :: C303 = 19.83

! emp sat vapor press constant from RADM
      REAL, PARAMETER :: C302 = 5417.4

! g/kg
      REAL, PARAMETER :: GPKG = 1.0E+03

! 1 hectare = 1.0e4 m**2
      REAL, PARAMETER :: M2PHA = 1.0E+04

! subgrid scale temp perturb (deg K)
      REAL, PARAMETER :: PERT = 1.5

!  wvp mix ratio perturb (dimensionless)
      REAL, PARAMETER :: PERQ = 1.5E-3

! rainfall threshold in mm/hr (mm/hr)
      REAL, PARAMETER :: RTHRESH = 0.1

! vapor press of water at 0 C (Pa)
      REAL, PARAMETER :: VP0PA = 611.2

! 1.0 / (vapor press of water @@ 0 C) (1/Pa)
      REAL, PARAMETER :: VPINV = 1.0 / VP0PA

! converg. crit. for entrainment solver
      REAL, PARAMETER :: TST = 0.01

! assumed cloud lifetime for convective clouds (sec)
      REAL, PARAMETER :: TCLIFE = 3600.0

! ratio of mol wt of water vapor to mol wt of air
      REAL, PARAMETER :: MVOMA = MWWAT / MWAIR

! ratio of dry gas const to specific heat
      REAL, PARAMETER :: ROVCP = RDGAS / CPD

! ratio of latent heat of vap to specific heat
      REAL, PARAMETER :: LVOCP = LV0 / CPD

! dry adiabatic lapse rate (deg K/m)
      REAL, PARAMETER :: DALR = GRAV / CPD

!...........ARGUMENTS

      TYPE(MONARCH_COLUMN_T),          INTENT(IN)    :: COLUMN         ! State of the vertical column
      TYPE(MONARCH_LAST_TIME_STEP_T),  INTENT(IN)    :: LAST_TIME_STEP ! Values at last chemistry time step
      REAL, DIMENSION( NSPEC, NLAYS ), INTENT(INOUT) :: CONC           ! Species concentrations [ppm]
      REAL, DIMENSION( NLAYS ),        INTENT(INOUT) :: LOSS_RATES     ! Rainout loss rates [s-1]

!...........LOCAL VARIABLES

      LOGICAL, SAVE :: FIRSTIME = .TRUE.! flag for first pass thru
      LOGICAL, SAVE :: CONVCLD = .TRUE. ! flag for modeling convective clds
      INTEGER       ICLDTYPE            ! 1: raining, 2: either CNP or PFW
      INTEGER       ATIME               ! time diff from half-hour
      INTEGER       CLTOP               ! model LAY containing cloud top
      INTEGER       CTOP                ! dummy variable for cloud top layer
      INTEGER       FINI                ! ending position
      INTEGER       I599C               ! entrainment solver iteration counter
      INTEGER       LAY                 ! layer loop counter
      INTEGER       MDATE               ! process date
      INTEGER       MTIME               ! process time (half-hour)
      INTEGER       SPC                 ! liquid species loop counter
      INTEGER       STRT                ! starting position
      INTEGER       VAR                 ! variable loop counter

      INTEGER       CLBASE              ! cld base layer
      INTEGER       CLTOPUSTBL          ! unstable cld top layer
      INTEGER       ISOUND              ! flag for sounding stability
      INTEGER       SRCLAY              ! cloud source level vert index

      REAL          AIRM                ! total air mass (moles/m2) in cloudy air
      REAL          AIRMB0              ! moles/m2 air below cloud
      REAL          AIRMBI              ! inverse moles/m2 air below cloud
      REAL          ALFA0               ! aitken mode number scavenging coef
      REAL          ALFA2               ! aitken mode sfc area scavenging coef
      REAL          ALFA3               ! aitken mode mass scavenging coef
      REAL          ARPRES              ! ave cloud pres in atm
      REAL          CONDIS              !
      REAL          CTHK                ! cloud thickness (m)
      REAL          CTHK1               ! aq chem calc cloud thickness
      REAL          DAMDP               ! dry adiabatic minus dew point lapse rate
      REAL          DP                  ! pressure increment along moist adiabat
      REAL          DPLR                ! dew point lapse rate
      REAL          DQI                 ! change in ice mix ratio due to melting
                                        !   caused by entrainment
      REAL          DQL                 ! change in liq wat mix ratio due to evap
                                        !   caused by entrainment
      REAL          DTCLD               ! cloud integration timestep (s)
      REAL          DTDP                ! moist adiabatic lapse rate
      REAL          DZLCL               ! height increment to LCL above source level
      REAL          ZLCL                ! height of LCL above ground
      REAL          EMAX                ! water vapor pressure at source level
      REAL          EQTH                ! parcel equivalent potential temperature
      REAL          EQTHM               ! parcel equivalent potential temp
      REAL          FA                  ! entrainment functional value at TEMPA
      REAL          FB                  ! entrainment functional value at TEMPB
      REAL          FRAC                ! cloud fractional coverage
      REAL          FTST                ! functional product in Walcek bisection solver
      REAL          HTST                ! temp diff in Walcek bisection solver
      REAL          METSTEP             ! timestep on the met file
      SAVE          METSTEP
      REAL          P1                  ! intermediate pressure used in calculating WL
      REAL          P2                  ! intermediate pressure used in calculating WL
      REAL          P3                  ! intermediate pressure used in calculating WL
      REAL          PBAR                ! mean pressure in vertical increments up from
                                        !    LCL along moist adiabat
      REAL          PBARC               ! mean cloud pressure (Pa)
      REAL          PMAX                ! parcel pressure
      REAL          PP                  ! scratch pressure variable
      REAL          PRATE               ! total rainfall (mm/hr)
      REAL          PRATE1              ! storm rainfall rate (mm/hr)
      REAL          QENT                ! wat vap mix ratio due to cld sidewall entrainmt
      REAL          QP                  ! perturbed water vap mix ratio of parcel
      REAL          QXS                 ! int. excess wat ov grid cell needed for rainout
      REAL          REMOVAC             ! variable storing H+ deposition
      REAL          RHOAIR              ! air density in kg/m3
      REAL          RLH                 ! relative humidity
      REAL          RLHSRC              ! relative humidity at cld src level
      REAL          RTCH                ! chemical gas const times temp
      REAL          T1                  ! perturbed temp to calc neutral buoyancy also
                                        !    used as max temp in cell comparing cloud
                                        !    with environment
      REAL          TBAR                ! mean temp in vertical increments up from LCL
                                        !    along moist adiabat
      REAL          TBARC               ! mean cloud temp (K)
      REAL          TBASE               ! iterative temp along moist adiabat
      REAL          TDMAX               ! dew point at source level
      REAL          TEMPA               ! lower limit on temp for entrainment solver
      REAL          TEMPB               ! upper limit on temp for entrainment solver
      REAL          TEMPC               ! scratch temp solved for cloudy air parcel
      REAL          TENT                ! temp accounting for cld sidewall entrainment
      REAL          THMAX               ! parcel potential temperature
      REAL          TI                  ! init temp of cloud air before evap of water
      REAL          TLCL                ! temp at LCL
      REAL          TMAX                ! perturbed temp of parcel
      REAL          TP                  ! perturbed temp of parcel
      REAL          TTOP                ! scr vbl used in application of Eq. 7, W&T
      REAL          TWASH               ! washout time [s]
      REAL          TWC                 ! tot wat cont in cloud (kg H2O/m3 air)
      REAL          WCBAR               ! liq water content of cloud (kg/m3)
      REAL          WL                  ! Warner profile (an earlier version appears
                                        !    appears in Walcek and Taylor (JAS, 1986))
      REAL          WTBAR               ! total wat cont (kg/m2) int. thru cloud depth
      REAL          X1                  ! intermediate vbles in lapse rate calculation
                                        !    X1 also reused as scratch vble in mixing
      REAL          XXXX                ! scratch vbl used in entrainment solver
      REAL          FRACMAX             ! max frac cov for NP cld
      REAL          PLCL                ! pressure at LCL
      REAL          QMAX                ! pertbd w.. mix rat of parcel
      REAL          RAIN                ! rainfall this timestep [mm] ! FIXME check this


      INTEGER      ALLOCSTAT

!...........STATEMENT FUNCTIONS

      REAL          ESAT                ! sat vap pres (Pa) as fn of T (deg K)
      REAL          QSAT                ! sat water vapor mixing ratio

      REAL          T                   ! temperature dummy arg
      REAL          E                   ! sat vapor pressure dummy arg
      REAL          P                   ! pressure dummy arg

      ESAT( T ) = VP0PA * EXP( C303 - ( C302 / T ) )
      QSAT( E, P ) = MVOMA * ( E / ( P - E ) )

!-----------------------------------------------------------------------
!  begin body of subroutine CONVCLD_ACM


!... Reset local arrays
        CCR      = 0.0
        CBELOW   = 0.0
        BMOL     = 0.0
        CBASE0   = 0.0
        CBASEF   = 0.0
        CEND     = 0.0
        POLC     = 0.0
        REMOV    = 0.0
        BCLDWT   = 0.0
        INCLOUD  = 0.0
        OUTCLOUD = 0.0
        PCLD     = 0.0
        SIGF     = 0.0
        F        = 0.0
        FSIDE    = 0.0
        LWC      = 0.0
        QICE     = 0.0
        QLQD     = 0.0
        QVC      = 0.0
        QWAT     = 0.0
        RHOM2    = 0.0
        TCLD     = 0.0
        ZH       = 0.0
        QAD      = 0.0
        TSAT     = 0.0
        CONCMINL = 1.0e-25

!...INITIALIZATION for the CONVCLD_ACM module:
!...  event-statistics variables.
      IF ( FIRSTIME ) THEN
        FIRSTIME = .FALSE.
        ! FIXME Make sure this is right - old code used DT*NPHS/3600
        METSTEP = COLUMN%DIAG%PHYSICS_TIME_STEP__S() / 3600. ![hours]
      END IF   ! Firstime

!... Set the full-layer sigma values (0...n_layers)
      DO LAY = 1, NLAYS
        SIGF( LAY ) = ( COLUMN%BTW_LAYER_HEIGHT__M( NLAYS + 1 ) -
     &      COLUMN%BTW_LAYER_HEIGHT__M( LAY + 1 ) )             /
     &      COLUMN%BTW_LAYER_HEIGHT__M( NLAYS + 1 )
        ZH( LAY ) = ( COLUMN%BTW_LAYER_HEIGHT__M( NLAYS + 1 )   -
     &      COLUMN%BTW_LAYER_HEIGHT__M( LAY ) ) / 2.0           +
     &      COLUMN%BTW_LAYER_HEIGHT__M( LAY )
      END DO
      SIGF( 0 ) = 1.0

!...set the cloud timestep (=adv timestep)

      DTCLD = COLUMN%DIAG%PHYSICS_TIME_STEP__S() ! [s]

!...ACTUAL SCIENCE PROCESS (loop on internal process time steps):
!...  Interpolate time dependent layered input variables
!...  (reading those variables for which it is necessary)


!... MLD rain and convective deposition?

      ! FIXME check this - it's different than the original calculation
      RAIN = COLUMN%CONVECTIVE_PRECIP__M(LAST_TIME_STEP) * 1000.0 /
     &       ( DTCLD / 3600.0 ) ! [mm hr-1]

      CALL WARN_ASSERT_MSG( 470895167, RAIN .GE. 0.0,
     &                      "Negative convective rain " )

      CLBASE = NLAYS
      CLTOPUSTBL = NLAYS
      QMAX  = 0.0
      PLCL  = 0.0
      SRCLAY = NLAYS

      DO LAY = 1, NLAYS
        QAD( LAY ) = 0.0
      END DO

!... FIXME This minimum concentration is larger than in other parts of the
!...       code. Should we use a consistent minimmum throughout?
      FORALL( LAY = 1:NLAYS, SPC = 1:NSPEC )
     &  CONC( SPC, LAY ) = MAX( CONC( SPC, LAY ), CONCMINL( SPC, LAY ) )

!...first test for raining clouds
      IF ( RAIN .GE. RTHRESH ) THEN
        ICLDTYPE = 1
      ELSE
        ICLDTYPE = 2
      END IF

!...if the rainfall amount is below the specified threshold, then set
!...  values for some of the parameters which will be used when the
!...  routine is called again for non-precipitating clouds...then
!...  skip to the next grid cell.
      IF ( ICLDTYPE .EQ. 1 ) THEN
        PRATE  = RAIN
        FRACMAX = 0.0
      ELSE
        FRACMAX = 0.5
      END IF              ! end of cld type test

!...Determine cloud source level by determining equivalent
!...   potential temperature profile given perturbed temperature
!...   and water vapor to account for local hot spots which
!...   initiate convection.  Layer with maximum equivalent
!...   potential temperature is cloud source layer.

      SRCLAY = 1
      TMAX   = COLUMN%TEMPERATURE__K( 1 ) + PERT
      QMAX   = COLUMN%SPECIFIC_HUMIDITY__KGKG( 1 ) + PERQ
      PMAX   = COLUMN%MID_LAYER_PRESSURE__PA( 1 )
      THMAX  = TMAX * ( 100000.0 / PMAX ) ** ROVCP
      EQTHM  = THMAX * EXP( LVOCP * QMAX / TMAX )

      DO LAY = 2, NLAYS

        PP = COLUMN%MID_LAYER_PRESSURE__PA( LAY )

        IF ( ZH( LAY ).GT.3000.) EXIT

        TP    = COLUMN%TEMPERATURE__K( LAY ) + PERT
        QP    = COLUMN%SPECIFIC_HUMIDITY__KGKG( LAY ) + PERQ
        THMAX = TP * ( 100000.0 / PP )**ROVCP
        EQTH  = THMAX * EXP( LVOCP * QP / TP )

        IF ( EQTH .GT. EQTHM ) THEN
          TMAX   = TP
          SRCLAY = LAY
          QMAX   = QP
          PMAX   = PP
          EQTHM  = EQTH
        END IF

      END DO

!...Equivalent potential temp max is now known  between LAY 1
!...   and 650 mb. We now proceed to compute lifting condensation
!...   level.  First,  compute vapor pressure at the source level.
!...   Find dewpoint using empirical relationship, avoiding
!...   supersaturation.   Then compute dew point lapse rate -
!...   see Walcek and Taylor, 1986.

      EMAX  = QMAX * PMAX / ( MVOMA + QMAX )
      TDMAX = C302 / ( C303 - ALOG( EMAX * VPINV ) )            !??????
      TDMAX = MIN( TDMAX, TMAX )
      DPLR  = ( GRAV * TDMAX * TDMAX ) / ( MVOMA * LV0 * TMAX )

!...Compute difference between dry adiabatic and dew point lapse
!...   rate, height increment above source level to reach LCL,
!...   then calculate value of pressure at LCL.

      DAMDP = DALR - DPLR

      IF ( DAMDP .LE. 0.0 ) THEN
        DZLCL = 0.0
        PLCL = PMAX
        TLCL = TMAX                        !... walcek formula
      ELSE
        DZLCL = ( TMAX - TDMAX ) / DAMDP
        TLCL = TMAX - DALR * DZLCL         !...walcek formula
        TBAR = TMAX - 0.5 * DALR * DZLCL   !  midpt of TMAX, TLCL
        TBAR = MAX( TBAR , 150.0 )
        PLCL = PMAX * EXP( -( GRAV / RDGAS ) * DZLCL / TBAR )
        ZLCL = DZLCL + ZH( SRCLAY )
      END IF

!...Determine cloud base at LAY in  which LCL resides,
!...  but not below layer 2.

!...plcl above middle of top layer

      IF ( COLUMN%MID_LAYER_PRESSURE__PA( NLAYS ) .GE. PLCL ) THEN
        PLCL = COLUMN%MID_LAYER_PRESSURE__PA( NLAYS )
        CLBASE = NLAYS
        CLTOP = CLBASE
        PRINT *, ' WARNING: PLCL above top: Continuing'

!...search loop to find CLBASE
      ELSE
        DO LAY = 2, NLAYS
          IF ( COLUMN%MID_LAYER_PRESSURE__PA( LAY ) .LE. PLCL ) THEN
            CLBASE = LAY
            GO TO 245
          END IF
        END DO
        CLBASE = NLAYS   ! if you get here base never found
245     CONTINUE

      END IF      ! if plcl < ptop or , or ...

!...CLBASE is LAY of LCL. Now, determine cloud top by following
!...   moist adiabat up from CLBASE. Assume a stable sounding
!...   (ISOUND=0) at first.  Moist adiabat solver calculates
!...   saturation temperatures TF at the full levels and TSAT( COL, ROW, LAY )
!...   at the half-levels, using a 2nd order Runge method employing
!...   temperatures and pressures at the quarter-levels.

      ISOUND = 0
      DO LAY = CLBASE, NLAYS
!...walcek formulas
        DP   = COLUMN%MID_LAYER_PRESSURE__PA( LAY - 1 ) -
     &         COLUMN%MID_LAYER_PRESSURE__PA( LAY )
        PBAR = COLUMN%MID_LAYER_PRESSURE__PA( LAY - 1 ) - DP * 0.5
        IF ( LAY .EQ. CLBASE ) THEN
          DP    = PLCL - COLUMN%MID_LAYER_PRESSURE__PA( LAY )
          PBAR  = PLCL - DP * 0.5
          TBASE = TLCL
        END IF

        TBAR = MAX( TBASE - 0.00065 * DP, 150.0 )
        X1 = LV0 * QSAT( ESAT( TBAR ), PBAR ) / ( RDGAS * TBAR )  ! Walcek's
        DTDP = ( ( RDGAS * TBAR ) / ( PBAR * CPD ) )              ! original
     &         * ( ( 1.0 + X1 )                                   ! formulas
     &             / ( 1.0 + ( 0.622 * LVOCP / TBAR ) * X1 ) )
        TSAT( LAY ) = MAX( TBASE - DP * DTDP, 150.0 )
        QAD ( LAY ) = QSAT( ESAT( TSAT( LAY ) ),
     &                      COLUMN%MID_LAYER_PRESSURE__PA( LAY ) )
        TBASE = TSAT( LAY )

!...end Walcek formulas

!...QAD is the moist adiabatic saturation mixing ratio, needed
!...  for the entrainment solver
!...  Now make choice on stability of sounding, comparing parcel
!...  temperature TSAT with environmental temperature TA.
!...  ISOUND is index for sounding stability. If ISOUND=0,
!...  moist adiabat never warmer than environment (stable).
!...  ISOUND=1, moist adiabat becomes warmer than environment
!...  (unstable).

        IF ( ISOUND .EQ. 0 ) THEN
          IF ( TSAT( LAY ) .GT. COLUMN%TEMPERATURE__K( LAY ) ) THEN
            ISOUND = 1
          END IF
        ELSE           ! cloud top determined by neutral bouyancy
          T1 = TSAT( LAY ) ! - 0.5 * PERT
          IF ( T1 .LT. COLUMN%TEMPERATURE__K( LAY ) ) THEN
            CLTOP = LAY - 1
            GO TO 256
          END IF
        END IF
      END DO
      CLTOP = NLAYS - 1   !  if you get to here:  cloud stable or no top
256   CONTINUE

!...At this point, if ISOUND has not been set to 1, we have a
!...  "stable" cloud. In this case, we find cloud top by relative
!...   humidity criterion, or, not let cloud top go above 600mb.

      IF ( ISOUND .EQ. 0 ) THEN
        IF ( ICLDTYPE.NE.1 ) GO TO 299

          DO 265 LAY = CLBASE + 1, NLAYS
            IF ( COLUMN%MID_LAYER_PRESSURE__PA( LAY ) .LE. 60000.0 ) THEN
              CLTOP = LAY - 1
              GO TO 267        !  loop exit
            END IF
            RLH = COLUMN%SPECIFIC_HUMIDITY__KGKG( LAY )
     &            / QSAT( ESAT( COLUMN%TEMPERATURE__K( LAY ) ),
     &                    COLUMN%MID_LAYER_PRESSURE__PA( LAY ) )
            IF ( RLH .LT. 0.65 ) THEN
              CLTOP = LAY - 1
              GO TO 267        !  to loop exit
            END IF
265       CONTINUE

          CLTOP = NLAYS - 1   !  if you get to here:  top never found

        ELSE

          CLTOPUSTBL = CLTOP  ! store unstable cloud top

        END IF

267     CONTINUE    !  loop exit target

        IF ( ICLDTYPE .NE. 1 ) THEN !  get cloud top for either CNP or PFW

          IF ( ZLCL .GT. COLUMN%MIXED_LAYER_HEIGHT__M() ) GO TO 299

!...compute relative humidity at the cloud source level

          RLHSRC = COLUMN%SPECIFIC_HUMIDITY__KGKG( SRCLAY )
     &             / QSAT( ESAT( COLUMN%TEMPERATURE__K( SRCLAY ) ),
     &                     COLUMN%MID_LAYER_PRESSURE__PA( SRCLAY ) )


!...Distiguish between CNP and PFW by whether rain is falling
!...  in the cell; if PFW, limit depth and find new CLTOP,
!...  else leave CLTOP alone

          IF ( CLTOP .EQ. CLBASE ) THEN
            GO TO 322
          ELSE                   ! confine PFW to 1500 meters
            CTOP = CLTOP

            DO LAY = CTOP, CLBASE, -1
              IF ( ZH( LAY ) - ZH( CLBASE ) .LE. 3000.0) THEN
                CLTOP = LAY
                GO TO 322
              END IF
            END DO

          END IF

322       CONTINUE     ! exit target for PFW cloud

!...If unstable CNP or PFW, limit CLTOP to CLTOPUSTBL so that
!...  QAD profile is known through cloud depth for entrainment
!...  solver

          IF ( ISOUND .EQ. 1 )
     &      CLTOP = MIN( CLTOP, CLTOPUSTBL )

!...Now compute fractional coverage for either CNP or PFW:

          IF ( RLHSRC .GE. RCRIT2 ) THEN
            FRAC = FRACMAX
          ELSE
            FRAC = FRACMAX * ( ( RLHSRC - RCRIT1 ) / ( RCRIT2 - RCRIT1 ) )
          END IF
          IF(FRAC.LT.0.01) GO TO 299

        END IF  !! end of existence, depth and frac cov calc for
                !! either PFW or CNP clouds

!...Now cloud existence is established, initialize various
!...  variables needed for rest of computations

!...First, get moles air/m2 at each layer, initialize FSIDE

        DO LAY = 1, NLAYS
          RHOM2( LAY ) = COLUMN%MID_LAYER_PRESSURE__PA( LAY ) *
     &                   COLUMN%LAYER_THICKNESS__M( LAY ) * 1.0E3
     &                 / ( RDGAS * MWAIR * COLUMN%TEMPERATURE__K( LAY ) )
          FSIDE( LAY ) = 0.0
        END DO

        DO SPC = 1, NSPEC
          REMOV   ( SPC ) = 0.0  ! moles/m2 or mm*mol/lit scavenged
          CEND    ( SPC ) = 0.0  ! ending equiv gas phase conc (moles/mole)
          BMOL    ( SPC ) = 0.0  ! moles/m2 species below cloud
          POLC    ( SPC ) = 0.0  ! moles/m2 species in cloud

          DO LAY = 1, NLAYS
            BCLDWT( SPC, LAY ) = 0.0 ! below cloud weighting function
            PCLD  ( SPC, LAY ) = 0.0  ! moles sp/mole air in cloud
          END DO

        END DO

!...compute no. of moles air below cloud base and inverse

        AIRMB0 = 0.0
        DO LAY = 1, CLBASE - 1
          AIRMB0 = AIRMB0 + RHOM2( LAY )
        END DO

!...take the inverse

        AIRMBI = 1.0 / AIRMB0

!...below cloud base

        DO LAY = 1, CLBASE - 1

!...   determine no. of moles/m2 of trace gas

          DO SPC = 1, NSPEC
            BMOL( SPC ) = BMOL( SPC )
     &                    + CONC( SPC, LAY ) * RHOM2( LAY )
          END DO

        END DO

!...determine average trace gas mixing ratio below cloud level

        DO SPC = 1, NSPEC
          CBASE0( SPC ) = BMOL( SPC ) * AIRMBI
          CBASEF( SPC ) = CBASE0( SPC )
        END DO

!...Initialize variables needed for entrainment and in-cloud properties solver

        QXS =   0.0  ! integrated excess water over grid cell nec. for rnout
        AIRM =  0.0  ! total air mass (moles/m2) in cloudy layers
        PBARC = 0.0  ! in-cloud average pressure
        CTHK  = 0.0  ! cloud thickness (meters)
        WCBAR = 0.0  ! condensed wat cont (kg/m2) integ. thru cloud depth
        WTBAR = 0.0  ! total wat cont (kg/m2) integrated thru cloud depth
        TBARC = 0.0  ! cloud mean temp (K)

!...Determine condensed water content and entrainment at each cloud level
!...  Determine FSIDE profile for raining clouds; side entrainment
!...  only for PFW and CNP clouds

        IF ( ICLDTYPE .EQ. 1 ) THEN  !! raining cloud

          IF ( CLBASE .EQ. CLTOP ) THEN
            FSIDE( CLBASE ) = 1.0
          ELSE
            DO LAY = CLBASE, CLTOP
              FSIDE( LAY ) = 1.0
            END DO
          END IF

        ELSE                    !! then CNP or PFW

          DO LAY = CLBASE, CLTOP
            FSIDE( LAY ) = 1.0
          END DO

        END IF

!...Use Warner profile to close system of conservation and
!...  thermodynamic equations solved iteratively, using Secant solver

        DO LAY = CLBASE, CLTOP
          WL = 0.7 * EXP( ( COLUMN%MID_LAYER_PRESSURE__PA( LAY ) - PLCL )
     &                      * 0.000125 ) + 0.2

          IF ( LAY .EQ. CLBASE ) THEN
            P1 = 0.5 * ( COLUMN%MID_LAYER_PRESSURE__PA( LAY ) +
     &                   COLUMN%MID_LAYER_PRESSURE__PA( LAY - 1 ) )

            IF ( PLCL .LT. P1 ) THEN
              P2 = 0.5 * ( COLUMN%MID_LAYER_PRESSURE__PA( LAY + 1 ) +
     &                     COLUMN%MID_LAYER_PRESSURE__PA( LAY ) )
              P3 = ( P2 + PLCL ) * 0.5
              WL = 0.7 * EXP( ( P3 - PLCL ) * 0.000125 ) + 0.2
            END IF

          END IF

!...original Walcek bisection solver

          QWAT( LAY ) = WL * ( QMAX - QAD( LAY ) )
          QWAT( LAY ) = MAX( QWAT( LAY ), 1.0E-20 )

          TEMPA = TSAT( LAY ) - 20.0
          TEMPB = TSAT( LAY ) + 10.0

          QENT = FSIDE( LAY ) * COLUMN%SPECIFIC_HUMIDITY__KGKG( LAY )
     &           + ( 1.0 - FSIDE( LAY ) ) *
     &             COLUMN%SPECIFIC_HUMIDITY__KGKG( CLTOP )
          XXXX = QENT - QMAX
          IF ( XXXX .EQ. 0.0 ) XXXX = 1.0E-10
          F( LAY ) = ( QSAT( ESAT( TEMPA ),
     &                       COLUMN%MID_LAYER_PRESSURE__PA( LAY ) )
     &                 + QWAT( LAY ) - QMAX ) / XXXX
          F( LAY ) = MIN( F( LAY ), 1.0 )
          F( LAY ) = MAX( F( LAY ), 0.0 )

          TTOP = COLUMN%TEMPERATURE__K( CLTOP ) *
     &           ( COLUMN%MID_LAYER_PRESSURE__PA( LAY )
     &             / COLUMN%MID_LAYER_PRESSURE__PA( CLTOP ) ) ** ROVCP
          TENT = TTOP * ( 1.0 - FSIDE( LAY ) )
     &         + COLUMN%TEMPERATURE__K( LAY ) * FSIDE( LAY )

          TI = TSAT( LAY ) * ( 1.0 - F( LAY ) )
     &       + TENT * F( LAY )
          DQL = ( QMAX - QAD( LAY ) )
     &        * ( 1.0 - F( LAY ) - WL )
          DQI = 0.0

          IF ( TEMPA .LT. 273.15 ) THEN
            DQI = -QWAT( LAY ) * ( TEMPA - 273.15 ) / 18.0
            IF ( TEMPA .LE. 255.15 ) DQI = QWAT( LAY )
          END IF

          FA = CPD * ( TEMPA - TI ) + LV0 * DQL + LF0 * DQI

!...test for convergence, then cut the interval in half

          I599C = 0

599       CONTINUE

          HTST = TEMPB - TEMPA
          IF ( HTST .LT. TST ) GO TO 595
          I599C = I599C + 1

          CALL WARN_ASSERT_MSG( 458913314, I599C .LE. 10000,
     &           "NO CONVERGENCE IN ENTRAINMENT SOLVER" )

          TEMPC = ( TEMPA + TEMPB ) * 0.5
          QENT = FSIDE( LAY ) * COLUMN%SPECIFIC_HUMIDITY__KGKG( LAY )
     &         + ( 1.0 - FSIDE( LAY ) ) *
     &           COLUMN%SPECIFIC_HUMIDITY__KGKG( CLTOP )
          XXXX = QENT - QMAX
          IF ( XXXX .EQ. 0.0 ) XXXX = 1.0E-10
          F( LAY ) = ( QSAT( ESAT( TEMPC ),
     &                       COLUMN%MID_LAYER_PRESSURE__PA( LAY ) )
     &                 + QWAT( LAY ) - QMAX ) / XXXX
          F( LAY ) = MIN( F( LAY ), 0.99 )
          F( LAY ) = MAX( F( LAY ), 0.01 )
          TTOP = COLUMN%TEMPERATURE__K( CLTOP )
     &         * ( COLUMN%MID_LAYER_PRESSURE__PA( LAY ) /
     &             COLUMN%MID_LAYER_PRESSURE__PA( CLTOP ) ) ** ROVCP
          TENT = TTOP * ( 1.0 - FSIDE( LAY ) )
     &         + COLUMN%TEMPERATURE__K( LAY ) * FSIDE( LAY )
          TI = TSAT( LAY ) * ( 1.0 - F( LAY ) )
     &       + TENT * F( LAY )
          DQL = ( QMAX - QAD( LAY ) )
     &        * ( 1.0 - F( LAY ) - WL )
          DQI = 0.0

          IF ( TEMPC .LT. 273.15 ) THEN
            DQI = -QWAT( LAY ) * ( TEMPC - 273.15 ) / 18.0
            IF ( TEMPC .LE. 255.15 ) DQI = QWAT( LAY )
          END IF

          FB = CPD * ( TEMPC - TI ) + LV0 * DQL + LF0 * DQI

          FTST = FA * FB

!...if fa*fb < 0 then zero lies between ta & tc
!...  if fa*fb > 0 then zero lies between tc & tb

          IF ( FTST ) 590, 590, 591
590         TEMPB = TEMPC
            GO TO 599
591         TEMPA = TEMPC
            FA = FB
            GO TO 599

595       CONTINUE   ! exit from iterator, convergence achieved

!...we have obtained parcel temp TEMPC at layer LAY
!...  and entrainment fraction F(LAY)

!...end of Walcek bisection solver

          TCLD( LAY ) = MAX( TEMPC, 150.0 )

!...ice load in cloud is a function of temperature below freezing

          QICE( LAY ) = 0.0
          IF ( TCLD( LAY ) .LT. 273.15 ) THEN
            QICE( LAY ) = -QWAT( LAY ) * ( TCLD( LAY ) - 273.15 )
     &                  / 18.0
            IF ( TCLD( LAY ) .LE. 255.15 ) QICE( LAY ) = QWAT( LAY )
          END IF

!...After determining the ice fraction, compute the actual
!...  liquid water mixing ratio:

          QLQD( LAY ) = QWAT( LAY ) - QICE( LAY )

!...compute the Liquid Water Content (LWC) by taking the
!...  product of the liquid wat mix ratio and the air density
!...  LWC in kg H2O per m**3 air:

          RHOAIR = COLUMN%MID_LAYER_PRESSURE__PA( LAY ) /
     &             ( RDGAS * TCLD( LAY ) )
          LWC( LAY ) = QLQD( LAY ) * RHOAIR
          LWC( LAY ) = MAX( 5.0E-6, LWC( LAY ) )    ! lower limit
          TWC        = QWAT( LAY ) * RHOAIR         ! total water content

!...Now perform vertical integration, weighting by liquid water
!...  content so that averaged quantities (used in Aqueous
!...  Chemistry) get the greatest weight where the liquid
!...  water content is greatest.

!...weighted cloud temp

          TBARC = TBARC + TCLD( LAY ) * COLUMN%LAYER_THICKNESS__M( LAY ) * LWC( LAY )

!...weighted cloud pres

          PBARC = PBARC + COLUMN%MID_LAYER_PRESSURE__PA( LAY ) *
     &                    COLUMN%LAYER_THICKNESS__M( LAY ) * LWC( LAY )

!...integrated liquid water content (kg/m3)

          WCBAR = WCBAR + COLUMN%LAYER_THICKNESS__M( LAY ) * LWC( LAY )

!...integrated total water content

          WTBAR = WTBAR + COLUMN%LAYER_THICKNESS__M( LAY ) * TWC
          CTHK = CTHK + COLUMN%LAYER_THICKNESS__M( LAY )   ! Cloud thickness

!...Now compute integrated excess water over grid cell
!...  average necessary for rainout, through cloud depth.
!...  First, get max temp in the cell (either in cloud or env.)

          T1 = MAX( TCLD( LAY ), COLUMN%TEMPERATURE__K( LAY ) )

!...get saturation water vapor mixing ratio at that temp:

          QVC( LAY ) = QSAT( ESAT( T1 ),
     &                       COLUMN%MID_LAYER_PRESSURE__PA( LAY ) )

!...excess water is the sum of total condensed and saturated
!...  vapor minus grid cell average mixing ratio: QXS in kg/m2:
!...  integrated through cloud depth

          QXS = QXS
     &        + ( QWAT( LAY ) + QVC( LAY ) -
     &            COLUMN%SPECIFIC_HUMIDITY__KGKG( LAY ) )
     &        * RHOAIR * COLUMN%LAYER_THICKNESS__M( LAY )

!...get total air mass in cloudy layers:

          AIRM = AIRM + RHOM2( LAY )

      END DO

!...Now begin to split calculations for non-raining and raining
!...  clouds depending on inner loop index ICLDTYPE (1 = raining,
!...  2 = nonraining: either CNP of PFW:)

      IF ( ICLDTYPE .EQ. 2 ) THEN   ! no precip or excess water
        PRATE1 = 1.0E-30
        PRATE  = 1.0E-30
        QXS    = 1.0E-30
        GO TO 7000       ! branch for further CNP or PFW calculations
      END IF

!...continue here for raining cloud...

!...get PRATE1, storm rainout rate in mm/hour, noting that 1kg
!...  of water occupies a 1mm thick layer of water in a square meter
!...  of ground (accounts for density of water = 1000kg/m3)

      PRATE1 = STORME * QXS * 3600.0 / TCLIFE
      IF ( PRATE1 .LE. 1.001*PRATE ) THEN
        FRAC = 0.999                ! Changed back to .999 - jp 6/05
        PRATE1 = PRATE / FRAC
      ELSE
        FRAC = PRATE / PRATE1
      END IF
      IF(FRAC.LT.0.01) GO TO 299

!...for raining cloud, compute water properties of interest
!...  below cloud base. First, parameterize total water content

      TWC = ( 0.067 * PRATE**( 0.846 ) ) / ( FRAC * 1000.0 ) ! tot wat cont kg/m3

      DO LAY = 1, CLBASE - 1
        TCLD( LAY ) = COLUMN%TEMPERATURE__K( LAY )
        RHOAIR = COLUMN%MID_LAYER_PRESSURE__PA( LAY ) /
     &           ( RDGAS * TCLD( LAY ) )
        QWAT( LAY ) = TWC / RHOAIR    ! kg H2O / kg air

!...again partition into ice and liquid

        QICE( LAY ) = 0.0

        IF ( TCLD( LAY ) .LT. 273.15 ) THEN
          QICE( LAY) = -QWAT( LAY ) * ( TCLD( LAY ) - 273.15 )
     &               / 18.0
          IF ( TCLD( LAY ) .LE. 255.15 ) QICE( LAY ) = QWAT( LAY )
        END IF

        QLQD( LAY ) = QWAT( LAY ) - QICE( LAY )
        LWC ( LAY ) = QLQD( LAY ) * RHOAIR
        LWC ( LAY ) = MAX( 0.000005, LWC( LAY ) )         ! lower limit
        PBARC = PBARC + COLUMN%MID_LAYER_PRESSURE__PA( LAY ) *
     &                  COLUMN%LAYER_THICKNESS__M( LAY ) * LWC( LAY )
        TBARC = TBARC + TCLD( LAY ) * COLUMN%LAYER_THICKNESS__M( LAY ) *
     &                  LWC( LAY )
        WCBAR = WCBAR + COLUMN%LAYER_THICKNESS__M( LAY ) * LWC( LAY )
        WTBAR = WTBAR + COLUMN%LAYER_THICKNESS__M( LAY ) * TWC
        CTHK = CTHK + COLUMN%LAYER_THICKNESS__M( LAY )

!...excess water is all rain

        QXS = QXS + QWAT( LAY ) * RHOAIR * COLUMN%LAYER_THICKNESS__M( LAY )

      END DO

!...Final calc of storm rainfall rate and frac area (RAINING CLDS)

      PRATE1 = STORME * QXS * 3600.0 / TCLIFE

      IF ( PRATE1 .LE. 1.001*PRATE ) THEN
        FRAC = 0.999        ! Changed back to .999 - jp 6/05
        PRATE1 = PRATE / FRAC
      ELSE
        FRAC = PRATE / PRATE1
      END IF
      IF(FRAC.LT.0.01) GO TO 299

7000  CONTINUE                        ! target of cloudtype split

!...Begin mixing section, perform first for raining clouds using
!...  modified form of original Walcek mixing for RADM: mixing
!...  limited to 1 layer above cloud top; next for CNP or PFW clouds
!...  using direct exchange mixing mechanism by McHenry.
      DO SPC = 1, NSPEC
        DO LAY = 1, NLAYS
          CCR( SPC, LAY ) = CONC( SPC, LAY )
        END DO
        CBELOW( SPC ) = CBASE0( SPC )
      END DO

      CALL ACMCLD ( F, CCR, SIGF, CBELOW, CLBASE, CLTOP,
     &              FRAC, NSPEC, NLAYS, TCLIFE, DTCLD )

      DO SPC = 1, NSPEC
        CBASEF( SPC ) =  CBELOW( SPC )
      END DO

      DO LAY = CLTOP, CLBASE, -1
        DO SPC = 1, NSPEC
          CONDIS = CONC( SPC, LAY )
          PCLD( SPC, LAY ) = F( LAY ) * ( FSIDE( LAY ) * CONDIS )
     &                     + ( 1.0 - F( LAY ) ) * CBASE0( SPC )
          PCLD( SPC, LAY ) = MIN( PCLD( SPC, LAY ), CCR( SPC, LAY ) / FRAC )

!...POLC in moles sp/m2

          POLC( SPC ) = POLC( SPC )
     &                + PCLD( SPC, LAY ) * RHOM2( LAY )
        END DO
      END DO

!...Now compute for raining region below cloud which is also considered
!...  to be part of the aqueous reaction chamber

      DO LAY = 1, CLBASE - 1
        AIRM = AIRM + RHOM2( LAY )

        DO SPC = 1, NSPEC
          IF ( CBASE0( SPC ) .EQ. 0.0 ) THEN
            BCLDWT( SPC, LAY ) = 1.0 / CLBASE
          ELSE
            BCLDWT( SPC, LAY ) = CONC( SPC, LAY )
     &                         / MAX( CBASE0( SPC ), 1.0E-30 )
          END IF
          PCLD( SPC, LAY ) = CBASEF( SPC ) * BCLDWT( SPC, LAY )

!...Necessary because CBASEF and CBASE0 are the ending vertical averages
!...  below cloud concentrations in moles sp/mole air

          IF ( ICLDTYPE .EQ. 1 ) THEN
            POLC( SPC ) = POLC( SPC )
     &                  + PCLD( SPC, LAY ) * RHOM2( LAY )
          END IF
        END DO
      END DO

!...Compute cloud mean quantities

      AIRM  = MAX( AIRM, 1.0E-30 )     ! tot. air mass in cloudy layers
                                       ! moles/m2
      WCBAR = MAX( WCBAR, 1.0E-30 )    ! liq.wat. content in kg/m3 * CTHK

      WTBAR = MAX( WTBAR, 1.0E-30 )    ! condensed wat cnt: kg/m3 * CTHK

      CTHK  = MAX( CTHK, 1.0E-30)      ! cloud thickness, meters

      TBARC = TBARC / WCBAR            ! deg K (note WCBAR has hidden
                                       ! factor CTHK in it)
      PBARC = PBARC / WCBAR            ! ave cloud pres, Pa

      WCBAR = WCBAR / CTHK             ! ave liq wat content in kg/m3

      WTBAR = WTBAR / CTHK             ! ave con wat content in kg/m3

!...Finally, get in cloud pollutant concentrations in moles sp
!...  per mole air

      DO SPC = 1, NSPEC
        POLC ( SPC ) = POLC( SPC ) / AIRM
        CEND ( SPC ) = POLC( SPC )
        REMOV( SPC ) = 0.0
      END DO

      REMOVAC = 0.0

      ARPRES = PBARC / STDATMPA
      RTCH = ( MOLVOL / STDTEMP ) * TBARC
      CTHK1 = AIRM * RTCH / ( ARPRES * 1000.0 )

!... Calculate the cloud washout time [s], noting that 1kg
!...  of water occupies a 1mm thick layer of water in a square meter
!...  of ground (using a density of water = 1000kg/m3, as above)
      TWASH = WTBAR * CTHK1 * 3600.0 / AMAX1( 1.0E-20, PRATE1 )
      TWASH = AMAX1( TWASH, DTCLD )

!...weight the removed amount by the cloud fraction and convert
!...  from moles/m**2 to kg/m**2 and kg/m**2 to kg/hectare

!...Compute concentration changes in the grid column resulting
!...  from subgrid scale vertical mixing:

!...first, below cloud base,
!...   include raining region below cld base


!...only loss through rainout below the cloud
!...FIXME Is this right??? Is the loss rate constant vertically???
      DO LAY = 1, CLBASE - 1
        IF ( ICLDTYPE .EQ. 1 ) THEN ! raining cloud:
          LOSS_RATES( LAY ) = 1.0 / TWASH * FRAC
        ELSE
          LOSS_RATES( LAY ) = 0.0
        ENDIF
      END DO

!...Now do changes in cloudy layers :

!...FIXME Is this right??? Is the loss rate constant vertically???
      DO LAY = CLBASE, CLTOP
        LOSS_RATES( LAY ) = 1.0 / TWASH * FRAC
        DO SPC = 1, NSPEC
          INCLOUD( SPC, LAY ) = PCLD( SPC, LAY ) * CEND( SPC )
     &                        / MAX( POLC( SPC ), CONCMINL( SPC, LAY ) )
          OUTCLOUD( SPC, LAY ) = ( CCR( SPC, LAY ) - PCLD( SPC,LAY ) * FRAC )
     &                         / ( 1.0 - FRAC )
          OUTCLOUD( SPC, LAY ) = MAX( OUTCLOUD( SPC,LAY ), CONCMINL( SPC, LAY ) )
          CONC( SPC, LAY ) = INCLOUD ( SPC, LAY ) * FRAC
     &                     + OUTCLOUD( SPC, LAY ) * ( 1.0 - FRAC )
        END DO
      END DO

299   CONTINUE

      RETURN          !  from main routine CLDPROC

      END SUBROUTINE CONVCLD_ACM_MOD_PMC
!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#endif
      END MODULE MONARCH_CONVCLD_ACM
