!-----------------------------------------------------------------------
!
      MODULE MODULE_MICROPHYSICS_NMM
!
!-----------------------------------------------------------------------
!
!***  THE MICROPHYSICS DRIVERS AND PACKAGES

!      11-06-2009 W. Wang put NAM micorphysics into a single module   
!      02-10-2010 W. Wang added wsm6 
!-----------------------------------------------------------------------
!
! HISTORY LOG:
!
!    11-06-2009 W. Wang - Put NAM/Ferrier microphysics into 
!                         a single module.  
!
!-----------------------------------------------------------------------
!
      USE MODULE_KINDS
!
      USE MODULE_CONSTANTS,ONLY : CICE,CLIQ,CPV,EP_1,EP_2,EPSILON,G     &
                                 ,P608,PSAT,R_D,R_V,RHOAIR0,RHOWATER    &
                                 ,SVPT0,XLF,XLV                         &
                                 ,CAPPA,CP,EPSQ                         &
!MONARCH
                                 ,PI
!MONARCH
!
      USE MODULE_CONTROL,ONLY : NMMB_FINALIZE
! MP options
      USE MODULE_MP_ETANEW
      USE MODULE_MP_FER_HIRES
      USE MODULE_MP_WSM6
      USE MODULE_MP_THOMPSON
      USE MODULE_MP_GFS
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      PRIVATE
!
!      PUBLIC :: FERRIER_INIT,FPVS,GSMDRIVE,WSM3INIT
      PUBLIC :: GSMDRIVE
!
!-----------------------------------------------------------------------
!
      INTEGER :: MYPE
      REAL, PRIVATE,PARAMETER ::                                     &
!--- Physical constants follow:
           XLS=2.834E6,R_G=1./G
!
      INTEGER,PUBLIC,PARAMETER :: MICRO_RESTART=7501
!
      CONTAINS
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE GSMDRIVE(ITIMESTEP,DT,NPHS                             &
                         ,DX,DY,SM,FIS                                  &
                         ,DSG2,SGML2,PDSG1,PSGML1,PT,PD                 &
                         ,T,Q,CWM,OMGALF                                &
                         ,TRAIN,SR                                      &
                         ,F_ICE,F_RAIN,F_RIMEF                          &
                         ,QC,QR,QI,QS,QG,NI,NR                          &
                         ,F_QC,F_QR,F_QI,F_QS,F_QG,F_NI,F_NR            &
                         ,PREC,ACPREC,AVRAIN,ACPREC_TOT                 &
                         ,acpcp_ra,acpcp_sn,acpcp_gr, refl_10cm         &
                         ,re_cloud,re_ice,re_snow                       &
                         ,has_reqc,has_reqi,has_reqs                    &
!MONARCH
                         ,AERO,NUM_AERO,NUM_ASH,NUM_DUST,NUM_SALT       &
                         ,NUM_BC,NUM_OM,NUM_SO4,NUM_NO3,NUM_NH4         &
                         ,NUM_UNSPC                                     &
                         ,AERO_ACPREC                                   &
                         ,INCLOUD_STRT,BCLOUD_STRT                      &
                         ,RHO_AERO,R_AERO_V,R_AERO_E,EPSI_AERO          &
                         ,BCL_MP_C,BCL_MP_M,BCL_MP_F,ICL_MP &
!MONARCH
                         ,MP_RESTART_STATE                              &
                         ,TBPVS_STATE,TBPVS0_STATE                      &
                         ,SPECIFIED,NESTED                              &
                         ,MICROPHYSICS                                  &
                         ,RHGRD                                         &
                         ,TP1,QP1,PSP1                                  &
                         ,USE_RADAR                                     &
                         ,DFI_TTEN                                      &
                         ,IDS,IDE,JDS,JDE,LM                            &
                         ,IMS,IME,JMS,JME                               &
                         ,ITS,ITE,JTS,JTE                               &
                         ,ITS_B1,ITE_B1,JTS_B1,JTE_B1,MPRATES,D_SS)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    GSMDRIVE    MICROPHYSICS OUTER DRIVER
!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 02-03-26
!
! ABSTRACT:
!     RADIATION SERVES AS THE INTERFACE BETWEEN THE NMMB PHYSICS COMPONENT
!     AND THE WRF MICROPHYSICS DRIVER.
!
! PROGRAM HISTORY LOG:
!   02-03-26  BLACK      - ORIGINATOR
!   04-11-18  BLACK      - THREADED
!   06-07-31  BLACK      - BUILT INTO NMMB PHYSICS COMPONENT
!   08-08     JANJIC     - Synchronize WATER array and Q.
!
! USAGE: CALL GSMDRIVE FROM PHY_RUN
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM
!$$$
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER,INTENT(IN) :: D_SS,ITIMESTEP,NPHS                         &
                           ,IDS,IDE,JDS,JDE,LM                          &
                           ,IMS,IME,JMS,JME                             &
                           ,ITS,ITE,JTS,JTE                             &
                           ,ITS_B1,ITE_B1,JTS_B1,JTE_B1
!
      LOGICAL,INTENT(IN) :: USE_RADAR
!
      REAL,INTENT(IN) :: DT,DX,DY,PT,RHGRD
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM,D_SS)  :: MPRATES
!
      REAL,DIMENSION(1:LM),INTENT(IN) :: DSG2,PDSG1,PSGML1,SGML2
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,PD,SM
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: OMGALF         &
                                                        ,DFI_TTEN
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,PREC      &
                                                      ,ACPREC_TOT       &
                                                      ,AVRAIN              !<-- Was a scalar
! G. Thompson added next 4 lines.
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: acpcp_ra,acpcp_sn,acpcp_gr
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT) :: refl_10cm
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT) :: re_cloud, re_ice, re_snow
      INTEGER,INTENT(IN):: has_reqc, has_reqi, has_reqs
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT) :: CWM,Q,T     &
                                                           ,TRAIN
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER,INTENT(INOUT) ::         &
     &                                          QC,QI,QR,QS,QG,NI,NR
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT) :: F_ICE       &
                                                           ,F_RAIN      &
                                                           ,F_RIMEF
!
      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: SR
!
      CHARACTER(99),INTENT(IN) :: MICROPHYSICS
!
      LOGICAL,INTENT(IN) :: NESTED,SPECIFIED
!
      LOGICAL,INTENT(IN) :: F_QC,F_QR,F_QI,F_QS,F_QG,F_NI,F_NR
!
!***  State Variables for ETAMPNEW Microphysics 
!
      REAL,DIMENSION(:),INTENT(INOUT) :: MP_RESTART_STATE               &
                                        ,TBPVS_STATE,TBPVS0_STATE
!MONARCH
!
      INTEGER,INTENT(IN) :: NUM_AERO,NUM_ASH,NUM_DUST,NUM_SALT
!
      INTEGER,INTENT(IN) :: NUM_BC,NUM_OM,NUM_SO4,NUM_NO3,NUM_NH4,NUM_UNSPC
!
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:MAX(1,NUM_AERO)),INTENT(INOUT) :: AERO_ACPREC
!
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM,1:MAX(1,NUM_AERO)),INTENT(INOUT) :: AERO
!
      LOGICAL,INTENT(IN) :: INCLOUD_STRT, BCLOUD_STRT
!
      REAL(KIND=KFPT),DIMENSION(1:MAX(1,NUM_AERO)),INTENT(IN) :: RHO_AERO ,R_AERO_V, R_AERO_E, EPSI_AERO
!
      REAL(KIND=KFPT),INTENT(IN) :: BCL_MP_C, BCL_MP_M, BCL_MP_F, ICL_MP
!MONARCH
!*** GFS microphysics
      REAL, DIMENSION(IMS:IME,JMS:JME,1:LM), INTENT(INOUT) :: TP1,QP1
      REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT)      :: PSP1
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER :: I,IJ,J,K,MP_PHYSICS,N,NTSD
      INTEGER :: ITSLOC,ITELOC,JTSLOC,JTELOC 
!
      INTEGER,DIMENSION(IMS:IME,JMS:JME) :: LOWLYR
!
      REAL :: DPL,DTPHS,PCPCOL,PDSL,PHMID,QW,RDTPHS,TNEW
      REAL :: MP_TTEN,mytten
!
      REAL,DIMENSION(1:LM) :: QL,TL
!
      REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,RAINNC,RAINNCV     &
                                        ,SNOWNC,SNOWNCV,XLAND           &
                                        ,graupelnc,graupelncv
!
      REAL,DIMENSION(IMS:IME,JMS:JME,1:LM) :: DZ                        &
                                             ,P_PHY,PI_PHY              &
                                             ,RR,TH_PHY,QV
!
      LOGICAL :: WARM_RAIN,F_QT,USE_QV
!MONARCH
      REAL(KIND=KFPT) :: AERO_PCPCOL
      REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:MAX(1,NUM_AERO)) :: AERO_RAINNCV, AERO_SNOWNCV
!MONARCH
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      NTSD=ITIMESTEP
      DTPHS=NPHS*DT
      RDTPHS=1./DTPHS
!
!-- AVRAIN was a scalar but changed to a 2D array to allow for updates in ESMF
!
      DO J=JTS,JTE
      DO I=ITS,ITE
         AVRAIN(I,J)=AVRAIN(I,J)+1.
      ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!***  NOTE:  THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP.
!***         THE WRF PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1
!***         AT THE BOTTOM.
!-----------------------------------------------------------------------
!
!!!   DO J=JTS_B1,JTE_B1
!!!   DO I=ITS_B1,ITE_B1
!.......................................................................
!$omp parallel do                                                       &
!$omp& private(j,i,k,pdsl,dpl,phmid,ql,tl)
!.......................................................................
      DO J=JTS,JTE
      DO I=ITS,ITE
!
        PDSL=PD(I,J)
        LOWLYR(I,J)=1
        XLAND(I,J)=SM(I,J)+1.
!
!-----------------------------------------------------------------------
!***   FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE
!***                          ACCUMULATED RAIN BUT NOT YET USED BY NMM)
!***   COULD BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC)
!-----------------------------------------------------------------------
!..The NC variables were designed to hold simulation total accumulations
!.. whereas the NCV variables hold timestep only values, so change below
!.. to zero out only the timestep amount preparing to go into each
!.. micro routine while allowing NC vars to accumulate continually.
!.. But, the fact is, the total accum variables are local, never saved
!.. nor written so they go nowhere at the moment.
!
        RAINNC (I,J)=0. ! NOT YET USED BY NMM
        RAINNCv(I,J)=0.
        SNOWNCv(I,J)=0.
        graupelncv(i,j) = 0.0
!
!-----------------------------------------------------------------------
!***  FILL THE SINGLE-COLUMN INPUT
!-----------------------------------------------------------------------
!
        DO K=LM,1,-1   ! We are moving down from the top in the flipped arrays
!
          DPL=DSG2(K)*PDSL+PDSG1(K)
          PHMID=SGML2(K)*PDSL+PSGML1(K)
          TL(K)=T(I,J,K)
          QL(K)=AMAX1(Q(I,J,K),EPSQ)
!
          RR(I,J,K)=PHMID/(R_D*TL(K)*(P608*QL(K)+1.))
          PI_PHY(I,J,K)=(PHMID*1.E-5)**CAPPA
          TH_PHY(I,J,K)=TL(K)/PI_PHY(I,J,K)
          P_PHY(I,J,K)=PHMID
          DZ(I,J,K)=DPL*R_G/RR(I,J,K)
!
        ENDDO    !- DO K=LM,1,-1
!
      ENDDO    !- DO I=ITS,ITE
      ENDDO    !- DO J=JTS,JTE
!.......................................................................
!$omp end parallel do
!.......................................................................
!
!-----------------------------------------------------------------------
!***  IF NEEDED, UPDATE WATER VAPOR RATIO FROM SPECIFIC HUMIDITY.
!-----------------------------------------------------------------------
!
      IF(TRIM(MICROPHYSICS)=='wsm6' .OR. TRIM(MICROPHYSICS)=='thompson')THEN
        USE_QV=.TRUE.    !-- Initialize QV, update Q & CWM at the end
      ELSE    
        USE_QV=.FALSE.
      ENDIF   
!
      IF(USE_QV) THEN
!.......................................................................
!$omp parallel do                                                       &
!$omp& private(i,j,k)
!.......................................................................
        DO K=1,LM
          DO J=JTS_B1,JTE_B1
          DO I=ITS_B1,ITE_B1
            QV(I,J,K)=Q(I,J,K)/(1.-Q(I,J,K))
          ENDDO
          ENDDO
        ENDDO
!.......................................................................
!$omp end parallel do
!.......................................................................
      ENDIF
!
!-----------------------------------------------------------------------
!
!***  CALL MICROPHYSICS
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!***  TRANSLATE THE MICROPHYSICS OPTIONS IN THE CONFIG FILE TO THEIR
!***  ANALOGS IN THE WRF REGISTRY SO THAT THE WRF MICROPHYSICS DRIVER
!***  REMAINS UNTOUCHED.
!-----------------------------------------------------------------------
!
!     SELECT CASE (TRIM(MICROPHYSICS))
!       CASE ('fer')
!          MP_PHYSICS=5
!       CASE ('kes')
!         MP_PHYSICS=1
!       CASE ('lin')
!         MP_PHYSICS=2
!       CASE ('wsm3')
!         MP_PHYSICS=3
!       CASE ('tho')
!         MP_PHYSICS=8
!       CASE DEFAULT
!         WRITE(0,*)' User selected MICROPHYSICS=',MICROPHYSICS
!         WRITE(0,*)' Improper selection of Microphysics scheme in GSMDRIVE'
!!!       CALL ESMF_Finalize(endflag=ESMF_END_ABORT)
!         CALL NMMB_FINALIZE
!     END SELECT
!
!---------------------------------------------------------------------
!  Check for microphysics type.  We need a clean way to
!  specify these things!
!---------------------------------------------------------------------


        ITSLOC = MAX(ITS_B1,IDS)
        ITELOC = MIN(ITE_B1,IDE-1)
        JTSLOC = MAX(JTS_B1,JDS)
        JTELOC = MIN(JTE_B1,JDE-1)

        micro_select: SELECT CASE (TRIM(MICROPHYSICS))
!
          CASE ('fer')
            CALL ETAMP_NEW(                                                   &
                   ITIMESTEP=ntsd,DT=dtphs,DX=dx,DY=dy                        &
                  ,DZ8W=dz,RHO_PHY=rr,P_PHY=p_phy,PI_PHY=pi_phy,TH_PHY=th_phy &
                  ,Q=Q                                                        &
                  ,QC=QC                                                      &
                  ,QS=QS                                                      &
                  ,QR=QR                                                      &
                  ,QT=cwm                                                     &
                  ,LOWLYR=LOWLYR,SR=SR                                        &
                  ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN                          &
                  ,F_RIMEF_PHY=F_RIMEF                                        &
                  ,RAINNC=rainnc,RAINNCV=rainncv                              &
!MONARCH
                  ,AERO_PHY=AERO,NUM_AERO=NUM_AERO                            &
                  ,NUM_ASH=NUM_ASH,NUM_DUST=NUM_DUST,NUM_SALT=NUM_SALT        &
                  ,NUM_BC=NUM_BC,NUM_OM=NUM_OM,NUM_SO4=NUM_SO4                &
                  ,NUM_NO3=NUM_NO3,NUM_NH4=NUM_NH4                            &
                  ,NUM_UNSPC=NUM_UNSPC                                        &
                  ,AERO_RAINNCV=AERO_RAINNCV                                  &
                  ,INCLOUD_STRT=INCLOUD_STRT,BCLOUD_STRT=BCLOUD_STRT          &
                  ,RHO_AERO=RHO_AERO,R_AERO_V=R_AERO_V                        &
                  ,R_AERO_E=R_AERO_E,EPSI_AERO=EPSI_AERO                      &
                  ,BCL_MP_C=BCL_MP_C                                    &
                  ,BCL_MP_M=BCL_MP_M                                    &
                  ,BCL_MP_F=BCL_MP_F                                    &
                  ,ICL_MP=ICL_MP   &
!MONARCH
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=1,KDE=LM+1           &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=LM             &
                  ,ITS=itsloc,ITE=iteloc, JTS=jtsloc,JTE=jteloc, KTS=1,KTE=LM &
                  ,MP_RESTART_STATE=mp_restart_state                          &
                  ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state          &
                  ,D_SS=d_ss,MPRATES=mprates                                  &
                                                                            )
          CASE ('fer_hires')
            CALL FER_HIRES(                                                   &
                   ITIMESTEP=ntsd,DT=dtphs,DX=dx,DY=dy,RHgrd=RHGRD            &
                  ,DZ8W=dz,RHO_PHY=rr,P_PHY=p_phy,PI_PHY=pi_phy,TH_PHY=th_phy &
                  ,Q=Q                                                        &
                  ,QC=QC                                                      &
                  ,QS=QS                                                      &
                  ,QR=QR                                                      &
                  ,QT=cwm                                                     &
                  ,LOWLYR=LOWLYR,SR=SR                                        &
                  ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN                          &
                  ,F_RIMEF_PHY=F_RIMEF                                        &
                  ,RAINNC=rainnc,RAINNCV=rainncv                              &
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=1,KDE=LM+1           &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=LM             &
                  ,ITS=itsloc,ITE=iteloc, JTS=jtsloc,JTE=jteloc, KTS=1,KTE=LM &
                  ,MP_RESTART_STATE=mp_restart_state                          &
                  ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state          &
                  ,D_SS=d_ss,MPRATES=mprates                                  &
                  ,refl_10cm=refl_10cm                                        &
                                                                            )
          CASE ('gfs')
            CALL GFSMP(DT=dtphs,                                               &
                   dz8w=dz,rho_phy=rr,p_phy=p_phy,pi_phy=pi_phy,th_phy=th_phy, &
                   SR=SR,QT=CWM, F_ICE_PHY=F_ICE,                              &
                   RAINNC=RAINNC,RAINNCV=RAINNCV,                              &
                   Q=Q,QC=QC,QI=QI,                                            &
                   F_QC=F_QC,F_QI=F_QI,                                        &
                   TP1=TP1,QP1=QP1,PSP1=PSP1,                                  &
                   IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=1,KDE=LM+1,           &
                   IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=LM ,            &
                   ITS=itsloc,ITE=iteloc, JTS=jtsloc,JTE=jteloc, KTS=1,KTE=LM )
          CASE ('wsm6')
             CALL wsm6(                                             &
                  TH=th_phy                                         &
                 ,Q=QV                                              &
                 ,QC=QC                                             &
                 ,QR=QR                                             &
                 ,QI=QI                                             &
                 ,QS=QS                                             &
                 ,QG=QG                                             &
                 ,DEN=rr,PII=pi_phy,P=p_phy,DELZ=dz                 &
                 ,DELT=dtphs,G=g,CPD=cp,CPV=cpv                     &
                 ,RD=r_d,RV=r_v,T0C=svpt0                           &
                 ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
                 ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
                 ,DEN0=rhoair0, DENR=rhowater                       &
                 ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
                 ,RAIN=rainnc ,RAINNCV=rainncv                      &
                 ,SNOW=snownc ,SNOWNCV=snowncv                      &
                 ,SR=sr                                             &
                 ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv          &
                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=1,KDE=LM+1  &
                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=LM    &
                 ,ITS=itsloc,ITE=iteloc, JTS=jtsloc,JTE=jteloc, KTS=1,KTE=LM &
                 ,D_SS=d_ss,MPRATES=mprates)
          CASE ('thompson')
!+---+-----------------------------------------------------------------+
!            write(6,*)'DEBUG-GT, calling mp_gt_driver'
             CALL mp_gt_driver(                                     &
                  qv=qv                                             &
                 ,qc=qc                                             &
                 ,qr=qr                                             &
                 ,qi=qi                                             &
                 ,qs=qs                                             &
                 ,qg=qg                                             &
                 ,ni=ni                                             &
                 ,nr=nr                                             &
                 ,TH=th_phy,PII=pi_phy,P=p_phy,dz=dz,dt_in=dtphs    &
                 ,itimestep=ntsd                                    &
                 ,RAINNC=rainnc ,RAINNCV=rainncv                    &
                 ,SNOWNC=snownc ,SNOWNCV=snowncv                    &
                 ,GRAUPELNC=graupelnc ,GRAUPELNCV=graupelncv        &
                 ,SR=sr                                             &
                 ,refl_10cm=refl_10cm(ims,jms,1)                    &
                 ,diagflag=.true.                                   &
                 ,do_radar_ref=1                                    &
                 ,re_cloud=re_cloud(ims,jms,1)                      &
                 ,re_ice=re_ice(ims,jms,1)                          &
                 ,re_snow=re_snow(ims,jms,1)                        &
                 ,has_reqc=has_reqc                                 &
                 ,has_reqi=has_reqi                                 &
                 ,has_reqs=has_reqs                                 &
                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=1,KDE=LM+1  &
                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=LM    &
                 ,ITS=itsloc,ITE=iteloc, JTS=jtsloc,JTE=jteloc, KTS=1,KTE=LM &
                 ,D_SS=d_ss,MPRATES=mprates                         )
!
!..rainncv is actually all precip, so need to subtract snow/graupel to isolate rain only
!
                DO J=JMS,JME
                DO I=IMS,IME
                   acpcp_sn(I,J) = acpcp_sn(I,J) + snowncv(i,j)
                   acpcp_gr(I,J) = acpcp_gr(I,J) + graupelncv(i,j)
                   acpcp_ra(I,J) = acpcp_ra(I,J)                        &
                    + MAX(0., rainncv(i,j)-snowncv(i,j)-graupelncv(i,j))
                ENDDO
                ENDDO
!+---+-----------------------------------------------------------------+

          CASE DEFAULT
            WRITE(0,*)' The microphysics option does not exist: MICROPHYSICS = ',TRIM(MICROPHYSICS)
            CALL NMMB_FINALIZE

        END SELECT micro_select

!            
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!***  THE FOLLOWING MUST BE RECONCILED WHEN THREADING IS TURNED ON.
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!jaa!$omp parallel do                                                       &
!jaa!$omp& private(ij)
!     DO IJ=1,NUM_TILES
!       CALL MICROPHYSICS_ZERO_OUT(                                     &
!                    WATER,N_MOIST,CONFIG_FLAGS                         &
!                   ,IDS,IDE,JDS,JDE,KDS,KDE                            &
!                   ,IMS,IME,JMS,JME,KMS,KME                            &
!                   ,GRID%I_START(IJ),GRID%I_END(IJ)                    &
!                   ,GRID%J_START(IJ),GRID%J_END(IJ)                    &
!                   ,KTS,KTE                                       )
!     ENDDO
!
!-----------------------------------------------------------------------
!
      IF(USE_QV) THEN    !-- Update Q & CWM for WSM6 & Thompson microphysics
!.......................................................................
!$omp parallel do                                                       &
!$omp& private(i,j,k)
!.......................................................................
        DO K=1,LM
          DO J=JTS_B1,JTE_B1
          DO I=ITS_B1,ITE_B1
            Q(I,J,K)=QV(I,J,K)/(1.+QV(I,J,K))
            CWM(I,J,K)=QC(i,j,k)+QR(i,j,k)+QI(i,j,k)+QS(i,j,k)+QG(i,j,k)
          ENDDO
          ENDDO
        ENDDO
!.......................................................................
!$omp end parallel do
!.......................................................................
      ENDIF
!
!.......................................................................
!$omp parallel do                                                       &
!$omp& private(i,j,k,TNEW,MP_TTEN)
!.......................................................................
      DO K=1,LM
        DO J=JTS_B1,JTE_B1
        DO I=ITS_B1,ITE_B1
!
!-----------------------------------------------------------------------
!***  UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING.
!-----------------------------------------------------------------------
!
          TNEW=TH_PHY(I,J,K)*PI_PHY(I,J,K)
          TRAIN(I,J,K)=TRAIN(I,J,K)+(TNEW-T(I,J,K))*RDTPHS
          IF (USE_RADAR) THEN
            MP_TTEN=(TNEW-T(I,J,K))*RDTPHS              
            IF(DFI_TTEN(I,J,K)>MP_TTEN.AND.DFI_TTEN(I,J,K)<0.01        &
                                      .AND.MP_TTEN<0.0018)THEN 
              MP_TTEN=DFI_TTEN(I,J,K)                              
            END IF                                                
            T(I,J,K)=T(I,J,K)+MP_TTEN/RDTPHS
          ELSE
            T(I,J,K)=TNEW
          ENDIF
        ENDDO
        ENDDO
      ENDDO
!.......................................................................
!$omp end parallel do
!.......................................................................
!
!-----------------------------------------------------------------------
!***  UPDATE PRECIPITATION
!-----------------------------------------------------------------------
!
!jaa!$omp parallel do                                                       &
!jaa!$omp& private(i,j,pcpcol)
      DO J=JTS_B1,JTE_B1
      DO I=ITS_B1,ITE_B1
        PCPCOL=RAINNCV(I,J)*1.E-3
        PREC(I,J)=PREC(I,J)+PCPCOL
        ACPREC(I,J)=ACPREC(I,J)+PCPCOL
        ACPREC_TOT(I,J)=ACPREC_TOT(I,J)+PCPCOL
!
! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE
!       SINCE IT IS ONLY A LOCAL ARRAY FOR NOW
!
      ENDDO
      ENDDO
!MONARCH
!-----------------------------------------------------------------------
!***  UPDATE AEROSOL WET SCAVENGING
!-----------------------------------------------------------------------
      IF(NUM_AERO>0)THEN
      DO N=1,NUM_AERO
!$omp parallel do                                                       &
!$omp& private(i,j,aero_pcpcol)
      DO J=JTS_B1,JTE_B1
      DO I=ITS_B1,ITE_B1
        AERO_PCPCOL=AERO_RAINNCV(I,J,N)                                        !!!kg/m2
        AERO_ACPREC(I,J,N)=AERO_ACPREC(I,J,N)+AERO_PCPCOL
!
! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE
!       SINCE IT IS ONLY A LOCAL ARRAY FOR NOW
!
      ENDDO
      ENDDO
      ENDDO
      ENDIF
!MONARCH
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE GSMDRIVE
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------

      END MODULE MODULE_MICROPHYSICS_NMM

!-----------------------------------------------------------------------
