!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.                     *
!***********************************************************************

! RCS file, release, date & time of last delta, author, state, [and locker]
! $Header: /gpfs/projects/bsc32/bsc32359/CMAQ-mat/models/CCTM/src/cloud/cloud_acm/rescld.F,v 1.1.1.1 2005/09/09 18:56:05 sjr Exp $

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

        SUBROUTINE RESCLD (CGRID,NTIMESTEP,DT,NPHS,NUM_CHEM            
     &  ,TA,DZZ,PRES,DENS,QC,QR,QI,QS,QG,RN,DEP,WDEP_MAP,N_SPC_WDEP
     &  ,MY_NCOLSS,MY_NCOLS,MY_NROWSS,MY_NROWS,NLAYS)
!-----------------------------------------------------------------------
!
!  FUNCTION: Resolved-scale CLOUD processor Models-3 science process:
!
!  Revision History:
!      No   Date   Who	What
!      -- -------- ---  -----------------------------------------
!       0 01/15/98 sjr  created program
!       1 03/09/98 sjr  made several revisions: fix to read sub-hourly
!                       rainfall data, reordered some of the code
!       2 12/15/98 David Wong at LM
!           -- changed division of GPKG to multiplication of GPKG reciprocal
!           -- interchanged loops structure in line 317
!       3 03/18/99 David Wong at LM
!           -- replace "* M2PHA * ONE_OVER_GPKG" by "* M2PHA_OVER_GPKG" which
!              is a new constant defined as M2PHA / GPKG
!       4 08/30/99 sjr  revised for new aerosol model (with 2nd moments)
!       5 Dec 00   Jeff move CGRID_MAP into f90 module
!       6 01/04/01 sjr  added QS and QI to total water content calcul.
!       7 Sep 01   Jeff Dyn Alloc - Use HGRD_DEFN
!       8 12/18/03 sjr & jp added QG in the water content calc
!       9 07 Dec 04 J.Young: Vert Dyn Alloc - Use VGRD_DEFN
!      10 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical
!                            domain specifications in one module
!      11 25 Mar 08 sjr fixed bug in the precipitation flux calculation:
!                       layer thickness now included in column integrated
!                       water content and in precipitation flux
!                       calculations (bug reported by Raymond D Wright)
!
!  Called by:  CLDPROC
!
!  Calls the following subroutines:  SCAVWDEP and AQ_MAP
!
!-----------------------------------------------------------------------

      USE MODULE_BSC_CHEM_DATA

      IMPLICIT NONE

!...........INCLUDES and their descriptions

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

!...........NMMB PARAMETERS
      INTEGER :: NPHS, NTIMESTEP, MY_NROWS, MY_NROWSS, MY_NCOLS, MY_NCOLSS,NLAYS

      INTEGER :: NUM_CHEM

      REAL :: DT

!...........CMAQ VARIABLES

      CHARACTER( 120 ) :: XMSG  = ' '         ! Exit status message

!...........PARAMETERS and their descriptions:

      REAL, PARAMETER :: GPKG = 1.0E+03  ! g/kg
      REAL, PARAMETER :: M2PHA = 1.0E+04 ! 1 hectare = 1.0e4 m**2
      REAL, PARAMETER :: M2PHA_OVER_GPKG = M2PHA / GPKG

! Number of species in CGRID
       INTEGER :: MXSPCS,NSPCSD
       INTEGER, PARAMETER :: GC_STRT = 1
!...........ARGUMENTS and their descriptions

      REAL,DIMENSION(MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS
     &    ,1:NLAYS,1:N_GC_SPCD) :: CGRID

       INTEGER :: N_SPC_WDEP
      INTEGER :: WDEP_MAP(1:N_SPC_WDEP) ! wet deposition map to CGRID
      REAL,DIMENSION(MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS
     &    ,1:N_SPC_WDEP+1) :: DEP
!...........SCRATCH LOCAL VARIABLES and their descriptions:

      LOGICAL, SAVE :: FIRSTIME = .TRUE.   ! flag for first pass thru

      INTEGER       COL                 ! column loop counter
      INTEGER       ROW                 ! row loop counter
      INTEGER       LAY                 ! layer loop counter
      INTEGER       FINI                ! ending position
      INTEGER       SPC                 ! liquid species loop counter
      INTEGER       STRT                ! starting position
      INTEGER       TCLD                ! cloud lifetime (sec)
      INTEGER       VAR                 ! variable loop counter

      REAL          AIRM                ! total airmass (mol/m2) in cloudy air
      REAL          CTHK1               ! cloud thickness (m)
      REAL          PBARC               ! mean cloud pressure (Pa)
      REAL          PRATE1              ! storm rainfall rate (mm/hr)
      REAL          QCRGCOL             ! vert column integrated liquid water content
      REAL          QCRISGCOL           ! vert column integrated total water content
      REAL          QRSGCOL             ! vert column integrated precip content
      REAL          RAIN                ! non-conv rainfall rate (mm/hr)
      REAL          REMOVAC             ! variable storing H+ deposition
      REAL          TAUCLD              ! cloud lifetime (sec)
      REAL          TBARC               ! mean cloud temp (K)
      REAL          WCBAR               ! liq water content of cloud (kg/m3)
      REAL          WPBAR               ! precipitation water content (kg/m3)
      REAL          WTBAR               ! total water content of cloud (kg/m3)

      REAL,ALLOCATABLE,DIMENSION(:) :: POLC,CEND,REMOV
      REAL RN (MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS) ! non-convective rainfall (cm)
      REAL DENS (MY_NCOLSS:MY_NCOLS,1:NLAYS,MY_NROWSS:MY_NROWS) ! air density (kg/m3)
      REAL DZZ  (MY_NCOLSS:MY_NCOLS,1:NLAYS,MY_NROWSS:MY_NROWS) ! layer thickness (m)
      REAL PRES (MY_NCOLSS:MY_NCOLS,1:NLAYS,MY_NROWSS:MY_NROWS) ! air pressure (Pa)
      REAL QC   (MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS,1:NLAYS) ! cloud water content (kg/kg)
      REAL QG   (MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS,1:NLAYS) ! graupel content (kg/kg)
      REAL QI   (MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS,1:NLAYS) ! ice content (kg/kg)
      REAL QR   (MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS,1:NLAYS) ! rain water content (kg/kg)
      REAL QS   (MY_NCOLSS:MY_NCOLS,MY_NROWSS:MY_NROWS,1:NLAYS) ! snow content (kg/kg)
      REAL TA   (MY_NCOLSS:MY_NCOLS,1:NLAYS,MY_NROWSS:MY_NROWS) ! air temperature (K)


       INTEGER         KFLIP

!-----------------------------------------------------------------------
!  begin body of subroutine RESCLD

!****use module_CHEM_DATA
      MXSPCS = N_GC_SPCD
      NSPCSD = MXSPCS-1 !N_GC_SPC

      ALLOCATE(POLC(MXSPCS))
      ALLOCATE(CEND(MXSPCS))
      ALLOCATE(REMOV(MXSPCS))

!...INITIALIZATION

      IF ( FIRSTIME ) THEN
!

!
        FIRSTIME = .FALSE.

      END IF  ! FIRSTIME
!
!...set the cloud lifetime (=adv timestep)
!
      TCLD = DT*NPHS
      TAUCLD = REAL( TCLD )

!...ACTUAL SCIENCE PROCESS (loop on internal process time steps):
!...Loop through all grid cells

      DO ROW = MY_NROWSS, MY_NROWS
        DO COL = MY_NCOLSS, MY_NCOLS

!...Convert the rainfall into a rainfall rate (mm/hr)

          RAIN = 1000.0 * RN( COL, ROW ) / TAUCLD * 3600.

          IF ( RAIN .LT. 0.0 ) THEN
            XMSG = 'NEGATIVE RAIN RESCLD...PROBABLE BAD MET DATA...'
             PRINT *,ROW, COL, RAIN,XMSG
          END IF

!...calculate the integrated column cloud+rain water content
!... JP & SJR:  treat graupel as rainwater until we have a more
!...            advanced cloud microphysics scheme
!... include layer thickness in the column integration

          QCRGCOL   = 0.0
          QCRISGCOL = 0.0
          QRSGCOL   = 0.0
          DO LAY = 1, NLAYS
            QC( COL, ROW, LAY ) = MAX( QC( COL, ROW, LAY ), 0.0 )
            QR( COL, ROW, LAY ) = MAX( QR( COL, ROW, LAY ), 0.0 )
            QI( COL, ROW, LAY ) = MAX( QI( COL, ROW, LAY ), 0.0 )
            QS( COL, ROW, LAY ) = MAX( QS( COL, ROW, LAY ), 0.0 )
            QG( COL, ROW, LAY ) = MAX( QG( COL, ROW, LAY ), 0.0 )
            QCRGCOL   = QCRGCOL   + DENS( COL, LAY, ROW )
     &                * DZZ( COL, LAY, ROW )
     &                * ( QC( COL, ROW, LAY ) + QR( COL, ROW, LAY )
     &                +   QG( COL, ROW, LAY ) )
            QCRISGCOL = QCRISGCOL + DENS( COL, LAY, ROW )
     &                * DZZ( COL, LAY, ROW )
     &                * ( QC( COL, ROW, LAY ) + QR( COL, ROW, LAY )
     &                +   QI( COL, ROW, LAY ) + QS( COL, ROW, LAY )
     &                +   QG( COL, ROW, LAY ) )
            QRSGCOL   = QRSGCOL   + DENS( COL, LAY, ROW )
     &                * DZZ( COL, LAY, ROW )
     &                * ( QR( COL, ROW, LAY ) + QS( COL, ROW, LAY )
     &                +   QG( COL, ROW, LAY ) )
          END DO

!...loop through layers

          IF ( QCRGCOL .GT. 0.0 ) THEN
            DO LAY = 1, NLAYS
               KFLIP=NLAYS-LAY+1
!...Compute cloud quantities

              IF ( ( QC( COL, ROW, LAY ) + QR( COL, ROW, LAY )
     &               + QG( COL, ROW, LAY ) ) .GT. 0.00005 ) THEN

                TBARC = TA( COL, LAY, ROW )

                PBARC = PRES( COL, LAY, ROW )

                CTHK1 = DZZ( COL, LAY, ROW )

                AIRM = PBARC * CTHK1 * 1.0E3 / ( RDGAS * MWAIR * TBARC )

                WCBAR = ( QC( COL, ROW, LAY ) + QR( COL, ROW, LAY )
     &                +   QG( COL, ROW, LAY ) ) * DENS( COL, LAY, ROW )

                WTBAR = ( QC( COL, ROW, LAY ) + QR( COL, ROW, LAY )
     &                +   QI( COL, ROW, LAY ) + QS( COL, ROW, LAY ) 
     &                +   QG( COL, ROW, LAY ) ) * DENS( COL, LAY, ROW )

!...Compute precipitation flux
!...  include layer thickness in the calculation

                IF ( QRSGCOL .GT. 0.0 ) THEN
                  WPBAR = ( QR( COL, ROW, LAY ) + QS( COL, ROW, LAY )
     &                  +   QG( COL, ROW, LAY ) ) * DENS( COL, LAY, ROW )
                  PRATE1 = RAIN * WPBAR * CTHK1 / QRSGCOL  ! convert to mm/hr
                ELSE
                  PRATE1 = RAIN * WTBAR * CTHK1 / QCRISGCOL  ! convert to mm/hr
                END IF

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

                DO SPC = 1, NSPCSD
                  POLC ( SPC ) = CGRID( COL, ROW, KFLIP, SPC )
                  CEND ( SPC ) = POLC( SPC )
                  REMOV( SPC ) = 0.0
                END DO

!...perform scavenging and aqueous chemistry within the cloud
!...  and re-adjust the ending and removed amounts for those species
!...  that were scavenged or that participated in cloud chemistry

                CALL SCAVWDEP ( WTBAR, WCBAR, TBARC,
     &                          PBARC, CTHK1, AIRM, PRATE1, TAUCLD,
     &                          POLC, CEND, REMOV, REMOVAC, !)
     &                          N_GC_SPCD,N_GC_SCAVD,N_GC_SCAV)


!...convert from moles/m**2 to kg/m**2 and kg/m**2 to kg/hectare

!...  for gases

                SPC = 0
                STRT = GC_STRT
                FINI = GC_STRT - 1 + N_GC_SPCD !!!N_GC_SPC
                DO VAR = STRT, FINI
                  SPC = SPC + 1
                  REMOV( VAR ) = REMOV( VAR ) * GC_MOLWT( SPC )
     &                         * M2PHA_OVER_GPKG
                END DO

!...load deposition amounts into the DEP array

                DO VAR = 1, N_SPC_WDEP
                  DEP( COL, ROW, VAR ) = DEP( COL, ROW, VAR )
     &                                 + REMOV( WDEP_MAP( VAR ) )
                END DO

                DO SPC = 1, NSPCSD
                  IF ( SPC .NE. N_GC_SPCD ) THEN
                    CGRID( COL, ROW, KFLIP, SPC ) = CEND( SPC )
                  END IF

                    if(CGRID( COL, ROW, KFLIP, SPC ).lt.0)then
            print *,'Problem rescld:',COL, ROW, KFLIP, SPC,CGRID( COL, ROW, KFLIP, SPC )
                      CGRID( COL, ROW, KFLIP, SPC )=1.e-36
                    endif

                END DO

              END IF
            END DO
          END IF

        END DO   ! col
      END DO   ! row


      DEALLOCATE(POLC)
      DEALLOCATE(CEND)
      DEALLOCATE(REMOV)

      RETURN

      END
