diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON
index 6eb6ee2..d701e37 100644
--- a/Registry/Registry.EM_COMMON
+++ b/Registry/Registry.EM_COMMON
@@ -1054,6 +1054,25 @@ state  real   sulfate   ikjf            aerod       1    -   df=(p2c)     "sulfa
 state  real   upperaer  ikjf            aerod       1    -   df=(p2c)     "upperaer"        "volcanic ash"            -
 state  real   aodtot    ij              misc        1    -      r         "aodtot"          "TOTAL AEROSOL OPTICAL DEPTH"  -
 
+# incoming aerosol data for multiscale Kain Fritsch [PSH/TWG  - 6/11/16]
+ state  real   aeromcu    i{lsc}jm{tyc}    misc        1    -   -     -
+ state  real   aeropcu    i{lsc}jm         misc        1    -   -      "AEROPCU"     "PRESSURE LEVEL OF AEROSOL DATA"  "millibar"
+
+# array to hold aerosol data that has been interpolated to model levels and time [PSH/TWG  - 6/11/16]
+ state  real   -            ikjf            aerocu      1    -   -             -
+ state  real   cu_dust1     ikjf            aerocu      1    -   hdf=(p2c)     "cudust1"           "dust 1"                     "ug m-3"
+ state  real   cu_dust2     ikjf            aerocu      1    -   hdf=(p2c)     "cudust2"           "dust 2"                     "ug m-3"
+ state  real   cu_dust3     ikjf            aerocu      1    -   hdf=(p2c)     "cudust3"           "dust 3"                     "ug m-3"
+ state  real   cu_dust4     ikjf            aerocu      1    -   hdf=(p2c)     "cudust4"           "dust 4"                     "ug m-3"
+ state  real   cu_seasalt   ikjf            aerocu      1    -   hdf=(p2c)     "cuseasalt"         "sea salt"                   "ug m-3"
+ state  real   cu_sulfate   ikjf            aerocu      1    -   hdf=(p2c)     "cusulfate"         "sulfate"                    "ug m-3"
+ state  real   cu_phobcar   ikjf            aerocu      1    -   hdf=(p2c)     "cuphobcar"         "hydrophobic black carbon"   "ug m-3"
+ state  real   cu_phibcar   ikjf            aerocu      1    -   hdf=(p2c)     "cuphibcar"         "hydrophilic black carbon"   "ug m-3"
+ state  real   cu_phoocar   ikjf            aerocu      1    -   hdf=(p2c)     "cuphoocar"         "hydrophobic organic carbon"   "ug m-3"
+ state  real   cu_phiocar   ikjf            aerocu      1    -   hdf=(p2c)     "cuphiocar"         "hydrophilic organic carbon"   "ug m-3"
+ state  real   aerovar      ikj             misc        1    -      hr         "AEROVAR"           "Aerosol variable for MSKF"  "ug m-3"
+             
+
 # cam radiation variables
 state  real    -       i{ls}jf ozmixm      1    -   -     -
 state  real   mth01    i{ls}jf ozmixm      1    -   -     -
@@ -1344,6 +1363,30 @@ state    real  GD_CLOUD_A        ikj      misc        1         -      r      "G
 state    real  GD_CLOUD2_A       ikj      misc        1         -      r      "GD_CLOUD2_A"          "taveragd cloud ice mix ratio in GD"         "kg kg-1"
 state    real  QC_CU             ikj      misc        1         -      r      "QC_CU"                "CLOUD WATER MIXING RATIO FROM A CU SCHEME"         "kg kg-1"
 state    real  QI_CU             ikj      misc        1         -      r      "QI_CU"                "CLOUD ICE MIXUNG RATIO FROM A CU SCHEME"         "kg kg-1"
+#TWG
+state    real  QR_CU            ikj      misc        1         -      rh      "QR_CU"               "RAIN MIXING RATIO FROM A CU SCHEME"         "kg kg-1"
+state    real  QS_CU            ikj      misc        1         -      rh      "QS_CU"               "SNOW MIXING RATIO FROM A CU SCHEME"         "kg kg-1"
+state    real  NC_CU            ikj      misc        1         -      rh      "NC_CU"               "CLOUD WATER NUMBER CONCENTRATION FROM A CU SCHEME"         "kg-1"
+state    real  NI_CU            ikj      misc        1         -      rh      "NI_CU"               "CLOUD ICE NUMBER CONCENTRATION FROM A CU SCHEME"         "kg-1"
+state    real  NR_CU            ikj      misc        1         -      rh      "NR_CU"               "RAIN NUMBER CONCENTRATION FROM A CU SCHEME"         "kg-1"
+state    real  NS_CU            ikj      misc        1         -      rh      "NS_CU"               "SNOW NUMBER CONCENTRATION FROM A CU SCHEME"         "kg-1"
+state    real  CCN_CU           ikj      misc        1         -      rh      "CCN_CU"              "CLOUD CONDENSATION NUCLEI CONCENTRATION FROM A CU SCHEME"         "kg-1"
+state    real  CU_UAF            ij      misc        1         -      rh      "CU_UAF"              "CU Updraft Area Fraction"         ""
+state    real  EFCS             ikj      misc        1         -      rh      "EFCS"                "Sub-grid Scale Cloud Effective Radius"         "um"
+state    real  EFIS             ikj      misc        1         -      rh      "EFIS"                "Sub-grid Scale Ice Effective Radius"       "um"
+state    real  EFCG             ikj      misc        1         -      rh      "EFCG"                "Grid Scale Cloud Effective Radius"         "um"
+state    real  EFIG             ikj      misc        1         -      rh      "EFIG"                "Grid Scale Ice Effective Radius"       "um"
+state    real  EFSG             ikj      misc        1         -      rh      "EFSG"                "Grid Scale Snow Effective Radius"       "um"
+state    real  EFSS             ikj      misc        1         -      rh      "EFSS"                "Subgrid Scale Snow Effective Radius"       "um"
+state    real  WACT             ikj      misc        1         -      rh      "WACT"                "Aerosol Activation Updraft"       "m s-1"
+state    real  CCN1_GS          ikj      misc        1         -      rh      "CCN1_GS"             "Grid Scale Cloud Condensation Nuclei at S=0.02%"       "#/cm-3"
+state    real  CCN2_GS          ikj      misc        1         -      rh      "CCN2_GS"             "Grid Scale Cloud Condensation Nuclei at S=0.05%"       "#/cm-3"
+state    real  CCN3_GS          ikj      misc        1         -      rh      "CCN3_GS"             "Grid Scale Cloud Condensation Nuclei at S=0.1%"       "#/cm-3"
+state    real  CCN4_GS          ikj      misc        1         -      rh      "CCN4_GS"             "Grid Scale Cloud Condensation Nuclei at S=0.2%"       "#/cm-3"
+state    real  CCN5_GS          ikj      misc        1         -      rh      "CCN5_GS"             "Grid Scale Cloud Condensation Nuclei at S=0.3%"       "#/cm-3"
+state    real  CCN6_GS          ikj      misc        1         -      rh      "CCN6_GS"             "Grid Scale Cloud Condensation Nuclei at S=0.5%"       "#/cm-3"
+state    real  CCN7_GS          ikj      misc        1         -      rh      "CCN7_GS"             "Grid Scale Cloud Condensation Nuclei at S=1.0%"       "#/cm-3"
+#END TWG
 state    real  QC_BL             ikj      misc        1         -      r      "QC_BL"                "CLOUD WATER MIXING RATIO IN PBL schemes"          "kg kg-1"
 state integer  STEPAVE_COUNT     -        misc        1         -      r      "STEPAVE_COUNT"        "time steps contained in averages for convective transport" ""
 
@@ -2244,6 +2287,12 @@ rconfig   real    aer_angexp_val          namelist,physics      max_domains   1.
 rconfig   real    aer_ssa_val             namelist,physics      max_domains   0.85    irh    "aer_ssa_val"    "fixed value for aerosol single-scattering albedo. Valid when aer_ssa_opt=1" ""
 rconfig   real    aer_asy_val             namelist,physics      max_domains   0.90    irh    "aer_asy_val"    "fixed value for aerosol asymmetry parameter. Valid when aer_asy_opt=1" ""
 rconfig   logical cu_rad_feedback         namelist,physics      max_domains   .false. irh    "feedback of cumulus cloud to radiation"  ""
+#[PSH/TWG - 6/11/16]
+rconfig   integer no_src_types_cu         namelist,physics      1             1       -      "no_src_types_cu" "Number of aerosoal species in global aerosol data"  ""
+rconfig   integer alevsiz_cu              namelist,physics      1             1       -      "alevsiz_cu" "Number of levels in global aerosol data"  ""
+rconfig   integer aercu_opt               namelist,physics      1             0       -      "aercu_opt"    "aerosol input option for multiscale KF"      ""
+rconfig   real    aercu_fct               namelist,physics      1             1.0     -      "aercu_fct"    "aerosol multiplication factor"               ""
+
 
 #BSINGH - added shallowcu_forced_ra, numBins, thBinSize, rBinSize, minDeepFreq, minShallowFreq, shcu_aerosols_opt for CuP scheme
 
@@ -2632,6 +2681,9 @@ package   nssl_2momg      mp_physics==22               -             moist:qv,qc
 package   thompsonaero    mp_physics==28               -             moist:qv,qc,qr,qi,qs,qg;scalar:qni,qnr,qnc,qnwfa,qnifa;state:re_cloud,re_ice,re_snow,qnwfa2d,taod5503d,taod5502d
 package   p3_1category    mp_physics==50               -             moist:qv,qc,qr,qi;scalar:qni,qnr,qir,qib;state:re_cloud,re_ice,vmi3d,rhopo3d,di3d,refl_10cm,th_old,qv_old
 package   p3_1category_nc mp_physics==51               -             moist:qv,qc,qr,qi;scalar:qnc,qni,qnr,qir,qib;state:re_cloud,re_ice,vmi3d,rhopo3d,di3d,refl_10cm,th_old,qv_old
+#TWG add
+package   morr_tm_aero    mp_physics==40               -             moist:qv,qc,qr,qi,qs,qg;scalar:qnc,qni,qns,qnr,qng;state:rqrcuten,rqscuten,rqicuten,EFCG,EFIG,EFSG,WACT,CCN1_GS,CCN2_GS,CCN3_GS,CCN4_GS,CCN5_GS,CCN6_GS,CCN7_GS,re_cloud,re_ice,re_snow
+#TWG end
 package   etampnew        mp_physics==95               -             moist:qv,qc,qr,qs;scalar:qt;state:f_ice_phy,f_rain_phy,f_rimef_phy
 
 package   radar_refl      compute_radar_ref==1         -             state:refl_10cm,refd_max
@@ -2742,7 +2794,9 @@ package   g3scheme       cu_physics==5               -             state:cugd_qv
 package   tiedtkescheme  cu_physics==6               -             -
 package   camzmscheme    cu_physics==7               -             state:precz,zmdt,zmdq,zmdice,zmdliq,evaptzm,fzsntzm,evsntzm,evapqzm,zmflxprc,zmflxsnw,zmntprpd,zmntsnpd,zmeiheat,cmfmc,cmfmcdzm,preccdzm,pconvb,pconvt,cape,zmmtu,zmmtv,zmmu,zmmd,zmupgu,zmupgd,zmvpgu,zmvpgd,zmicuu,zmicud,zmicvu,zmicvd,evapcdp3d,icwmrdp3d,rprddp3d,dp3d,du3d,ed3d,eu3d,md3d,mu3d,dsubcld2d,ideep2d,jt2d,maxg2d,lengath2d,dlf,rliq,tpert2d
 package   kfcupscheme    cu_physics==10              -             state:cldfratend_cup,cldfra_cup,updfra_cup,qc_iu_cup,qc_ic_cup,qndrop_ic_cup,wup_cup,mfup_cup,mfup_ent_cup,mfdn_cup,mfdn_ent_cup,fcvt_qc_to_pr_cup,fcvt_qc_to_qi_cup,fcvt_qi_to_pr_cup,lnterms,w0avg
-package   mskfscheme     cu_physics==11              -             state:w0avg,w_up
+#PSH/TWG 06/10/16
+package   mskfscheme   cu_physics==11              -             state:w0avg,w_up;aerocu:cu_sulfate,cu_seasalt,cu_dust1,cu_dust2,cu_dust3,cu_dust4,cu_phoocar,cu_phiocar,cu_phobcar,cu_phibcar,QC_KF,QI_KF,CU_UAF,EFCS,EFIS,EFSS
+#END/TWG
 package   nsasscheme     cu_physics==14              -             -
 package   ntiedtkescheme cu_physics==16              -             -
 package   gdscheme       cu_physics==93              -             -
@@ -2784,6 +2838,12 @@ package   fasdas         grid_sfdda==2              -              state:u10_ndg
 package   aeropt1        aer_opt==1                 -              state:aerodm
 package   aeropt2        aer_opt==2                 -              state:aod5503d
 
+#PSH/TWG 06/10/16
+package   aercuopt       aerocu_opt==1              -              state:aeromcu
+package   aercufct       aerocu_fct==1.0            -              state:aeromcu
+#END TWG
+
+
 package   slopeopt       slope_rad==1               -              -
 package   gwdopt         gwd_opt==1                 -              state:oc12d,oa1,oa2,oa3,oa4,ol1,ol2,ol3,ol4,dtaux3d,dtauy3d,dusfcg,dvsfcg
 package   omlscheme      sf_ocean_physics==1        -              state:tml,t0ml,hml,h0ml,huml,hvml,tmoml
diff --git a/Registry/Registry.NMM b/Registry/Registry.NMM
index 43b7476..7c23dbe 100644
--- a/Registry/Registry.NMM
+++ b/Registry/Registry.NMM
@@ -1532,6 +1532,12 @@ rconfig   integer alevsiz                 namelist,physics      1             1
 rconfig   integer o3input                 namelist,physics      1             2       -      "o3input"      "ozone input option for radiation"      ""
 rconfig   integer aer_opt                 namelist,physics      1             0       -      "aer_opt"      "aerosol input option for radiation"      ""
 rconfig   logical cu_rad_feedback         namelist,physics      max_domains  .false.  -      "feedback of cumulus cloud to radiation"
+#added to accommodate aerosol-cumulus interactive code
+#rconfig   integer no_src_types_cu         namelist,physics      1             1       -      "no_src_types_cu" "Number of aerosoal species in global aerosol data"  ""
+#rconfig   integer alevsiz_cu              namelist,physics      1             1       -      "alevsiz_cu" "Number of levels in global aerosol data"  ""
+rconfig   integer aercu_opt               namelist,physics      1             0       -      "aercu_opt"    "aerosol input option for multiscale KF"      ""
+rconfig   real    aercu_fct               namelist,physics      1             1.0     -      "aercu_fct"    "aerosol multiplication factor"               ""
+
 rconfig   integer ICLOUD_CU               derived               1             0        -     "ICLOUD_CU"                     ""      ""
 rconfig   real h_diff                     namelist,physics      max_domains  0.1      irh    "nmm input 9"
 
diff --git a/Registry/registry.dimspec b/Registry/registry.dimspec
index cb1925a..d639737 100644
--- a/Registry/registry.dimspec
+++ b/Registry/registry.dimspec
@@ -70,6 +70,8 @@ dimspec    ls      2     namelist=levsiz                   z     levsiz
 dimspec    d       2     namelist=paerlev                  z     paerlev
 dimspec    lsa     2     namelist=alevsiz                  z     alevsiz
 dimspec    ty      -     namelist=no_src_types             c     no_src_types
+dimspec    lsc     2     namelist=alevsiz_cu               z     alevsiz_cu # PSH/TWG 06/10/16
+dimspec    tyc     -     namelist=no_src_types_cu          c     no_src_types_cu #PSH 06/10/16
 dimspec    ?       -     namelist=ts_buf_size              c     ts_buf_size
 dimspec    !       -     namelist=max_ts_locs              c     max_ts_locs
 dimspec    v       -     constant=1                        z     one
diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F
index 655422a..56d478c 100644
--- a/dyn_em/module_first_rk_step_part1.F
+++ b/dyn_em/module_first_rk_step_part1.F
@@ -32,6 +32,7 @@ CONTAINS
                              , ipsy,ipey,jpsy,jpey,kpsy,kpey    &
                              , k_start , k_end                  &
                              , f_flux                           &
+                             , aerocu                           & !PSH/TWG06/10/16 
                             )
     USE module_state_description
     USE module_model_constants
@@ -84,6 +85,7 @@ CONTAINS
     REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT)  :: fdda3d
     REAL    ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT)      :: fdda2d
     REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_aerod),INTENT(INOUT)   :: aerod
+    REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_aerocu),INTENT(INOUT)  ::aerocu !PSH/TWG 06/10/16
     REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: psim
     REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: psih
     REAL    ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT)         :: wspd
@@ -388,7 +390,10 @@ BENCH_START(rad_driver_tim)
      &         ,shadowmask=grid%shadowmask,ht=grid%ht,dx=grid%dx,dy=grid%dy &           
      &         ,diffuse_frac=grid%diffuse_frac &           
      &         ,IS_CAMMGMP_USED = grid%is_CAMMGMP_used    &
-     &         ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS )
+     &         ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS        &
+     &         ,EFCG=grid%EFCG,EFCS=grid%EFCS,EFIG=grid%EFIG &
+     &         ,EFIS=grid%EFIS,EFSG=grid%EFSG,aercu_opt=config_flags%aercu_opt & 
+     &         ,EFSS=grid%EFSS,QS_CU=grid%QS_CU)
 
 BENCH_END(rad_driver_tim)
 
@@ -1060,7 +1065,9 @@ BENCH_START(cu_driver_tim)
      &             ,RAINC=grid%rainc   ,RAINCV=grid%raincv   ,PRATEC=grid%pratec       &
      &             ,NCA=grid%nca                                                       &
      &             ,CLDFRA_DP=grid%cldfra_dp  ,CLDFRA_SH=grid%cldfra_sh,W_UP=grid%w_up & ! ckay for subgrid cloud
-     &             ,QC_CU=grid%QC_CU ,QI_CU=grid%QI_CU                                 &
+     &             ,QC_CU=grid%QC_CU, QI_CU=grid%QI_CU, QR_CU=grid%QR_CU, QS_CU=grid%QS_CU & ! TWG
+     &             ,NC_CU=grid%NC_CU, NI_CU=grid%NI_CU, NR_CU=grid%NR_CU, NS_CU=grid%NS_CU & ! TWG
+     &             ,CCN_CU=grid%CCN_CU, CU_UAF=grid%CU_UAF                                 & ! TWG 
      &             ,UDR_KF=grid%udr_kf,DDR_KF=grid%ddr_kf                              & ! kf_edrates
      &             ,UER_KF=grid%uer_kf,DER_KF=grid%der_kf,TIMEC_KF=grid%timec_kf       &
      &             ,KF_EDRATES=config_flags%kf_edrates                                 &
@@ -1194,7 +1201,17 @@ BENCH_START(cu_driver_tim)
 #if ( WRF_DFI_RADAR == 1 )
      &             ,DO_CAPSUPPRESS=do_capsupress                          &
 #endif
-     &             ,cfu1=grid%cfu1,cfd1=grid%cfd1,dfu1=grid%dfu1,efu1=grid%efu1,dfd1=grid%dfd1,efd1=grid%efd1,f_flux=l_flux)
+     &             ,cfu1=grid%cfu1,cfd1=grid%cfd1,dfu1=grid%dfu1,efu1=grid%efu1,dfd1=grid%dfd1,efd1=grid%efd1,f_flux=l_flux &
+! PSH/TWG 06/10/16
+                   ,alevsiz_cu=grid%alevsiz_cu,num_months=grid%num_months               &
+                   ,no_src_types_cu=grid%no_src_types_cu                                &
+                   ,aercu_opt=config_flags%aercu_opt                                    &
+                   ,aercu_fct=config_flags%aercu_fct                                    &
+                   ,aeromcu=grid%aeromcu,aerocu=aerocu(:,:,:,P_cu_sulfate:P_cu_phibcar) &
+                   ,aeropcu=grid%aeropcu,ID=grid%id                                     &
+                   ,JULDAY=grid%julday, JULIAN=grid%julian                              &
+                   ,aerovar=grid%aerovar,EFCS=grid%EFCS,EFIS=grid%EFIS,EFSS=grid%EFSS)
+! PSH/TWG END
 BENCH_END(cu_driver_tim)
 !
 ! this for calculating (G3 scheme only)  time averaged variables for online (WRF-CHem) or offline (other models) chem runs
diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F
index a386590..a45acb6 100644
--- a/dyn_em/solve_em.F
+++ b/dyn_em/solve_em.F
@@ -749,6 +749,7 @@ BENCH_END(set_phys_bc_tim)
                              , ipsy, ipey, jpsy, jpey, kpsy, kpey    &
                              , k_start , k_end                  &
                              , f_flux                           &
+                             , aerocu                           & !PSH/TWG 06/10/16
                             )
 
 #ifdef DM_PARALLEL
@@ -3840,8 +3841,14 @@ BENCH_START(micro_driver_tim)
       &        ,height=grid%height                                         &
       &        ,tempc=grid%tempc                                         &
       &        ,ccn_conc=grid%ccn_conc                                   & ! RAS
-
-                                                                          )
+      &        ,aerocu=aerocu                                            & ! TWG 
+      &        ,aercu_opt=config_flags%aercu_opt                         & ! TWG
+      &        ,no_src_types_cu=grid%no_src_types_cu                     & ! TWG
+      &        ,PBL=grid%bl_pbl_physics,EFCG=grid%EFCG,EFIG=grid%EFIG,EFSG=grid%EFSG & !TWG
+      &        ,WACT=grid%WACT,CCN1_GS=grid%CCN1_GS,CCN2_GS=grid%CCN2_GS,CCN3_GS=grid%CCN3_GS  & !TWG
+      &        ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &  !TWG
+      &        ,CCN7_GS=grid%CCN7_GS) !TWG/amy                  
+                                                                          
 BENCH_END(micro_driver_tim)
 
 #if 0
diff --git a/dyn_em/start_em.F b/dyn_em/start_em.F
index 848c4fb..425d8c8 100644
--- a/dyn_em/start_em.F
+++ b/dyn_em/start_em.F
@@ -1279,6 +1279,10 @@ endif
                       ,grid%G_URB2D_mosaic,grid%RN_URB2D_mosaic                                      & ! danli mosaic 
                       ,grid%TS_URB2D_mosaic                                                          & ! danli mosaic 
                       ,grid%TS_RUL2D_mosaic                                                          & ! danli mosaic
+                      ,grid%QR_CU, grid%QS_CU                                                        & ! TWG
+                      ,grid%NC_CU, grid%NI_CU, grid%NR_CU, grid%NS_CU,grid%CCN_CU                    & ! TWG
+                      ,grid%alevsiz_cu,grid%num_months,grid%no_src_types_cu,grid%aeromcu             & ! PSH/TWG 06/10/16
+                      ,grid%aeropcu,grid%EFCG,grid%EFCS,grid%EFIG,grid%EFIS,grid%EFSG                & ! TWG
                       )
        ENDDO ! loop of tiles for phy_init
     ENDIF   ! no phy_init for the backwards part of the DFI
diff --git a/dyn_nmm/module_PHYSICS_CALLS.F b/dyn_nmm/module_PHYSICS_CALLS.F
index 394bae6..e11768c 100644
--- a/dyn_nmm/module_PHYSICS_CALLS.F
+++ b/dyn_nmm/module_PHYSICS_CALLS.F
@@ -199,8 +199,8 @@
 
 !
 !..Additions for coupling cloud physics effective radii and radiation.  G. Thompson
-      REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN):: re_cloud, re_ice, re_snow
-      INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs
+      REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT):: re_cloud, re_ice, re_snow
+      INTEGER, INTENT(INOUT):: has_reqc, has_reqi, has_reqs
 !
       LOGICAL,INTENT(IN) :: RESTRT
 !
@@ -507,6 +507,7 @@
      &                 ,QG=MOIST_TRANS(IMS,KMS,JMS,P_QG),F_QG=F_QG      &
      &                 ,IS_CAMMGMP_USED=IS_CAMMGMP_USED                 &
      &                 ,EXPLICIT_CONVECTION=config_flags%cu_physics==0  &
+     &                 ,AERCU_OPT=config_flags%aercu_opt                &
      &                 ,CU_PHYSICS=config_flags%cu_physics              &
      &                 ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS)
 
@@ -3355,6 +3356,7 @@
      &                 ,has_reqi=has_reqi                               & ! G. Thompson
      &                 ,has_reqs=has_reqs                               & ! G. Thompson
      &                 ,ccn_conc=config_flags%ccn_conc                  &
+     &                 ,aercu_opt=config_flags%aercu_opt                &
                                                                         )
 
 !$omp parallel do                                                       &
diff --git a/main/depend.common b/main/depend.common
index 9be153c..0f961ca 100644
--- a/main/depend.common
+++ b/main/depend.common
@@ -624,6 +624,7 @@ module_cumulus_driver.o: \
 		module_cu_camzm_driver.o \
 		module_cu_tiedtke.o \
 		module_cu_ntiedtke.o \
+		module_cu_mskf.o \
 		module_cu_kfcup.o \
 		../frame/module_state_description.o \
 		../frame/module_configure.o \
diff --git a/phys/Makefile b/phys/Makefile
index a629af7..0817fce 100644
--- a/phys/Makefile
+++ b/phys/Makefile
@@ -86,6 +86,7 @@ MODULES = \
 	module_mp_gsfcgce.o \
 	module_mp_morr_two_moment.o \
         module_mp_p3.o \
+        module_mp_morr_two_moment_aero.o \
 	module_mp_milbrandt2mom.o \
 	module_mp_nssl_2mom.o \
 	module_mp_wdm5.o \
diff --git a/phys/module_cu_mskf.F b/phys/module_cu_mskf.F
index 3216dc9..41b2d84 100644
--- a/phys/module_cu_mskf.F
+++ b/phys/module_cu_mskf.F
@@ -1,7 +1,3326 @@
+! begin double moment convective microphysics for MSKF
+
+ module module_cu_mp
+
+!module  zm_microphysics
+! Adapted to WRF3.8 by Kiran Alapaty
+!ckay = !dkay = Kiran Alapaty, EPA
+! PSH : Sep 2015: copuled with CESM global climatological aerosol data
+! TWG : Jun 2016: porting to WRFV3.8 
+
+! Purpose:
+!!!!#define WRF_PORT
+!   CAM Interface for cumulus microphysics
+!
+! Authors: Xiaoliang Song and Guang Jun Zhang, June 2010
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Adapted to KF scheme: Kiran Alapaty at EPA March 2013 (WRF version)
+!
+!---------------------------------------------------------------------------------
+  use shr_kind_mod,  only: r8=>shr_kind_r8
+
+  use error_function, only: erf,erfc
+
+!wrf  use rad_constituents, only: rad_cnst_get_clim_info,
+!rad_cnst_get_clim_aer_props 
+!xsong 2013-08-22  use module_ra_cam_support, only: naer_cu, idxsul,
+!idxDUSTfirst, idxbcphi 
+
+  implicit none
+  private
+  save
+
+  public :: zm_mphyi, zm_mphy, kf_GAMMA, kf_polysvp
+
+! Private module data
+
+  integer, parameter :: naer_cu = 10        !xsong 2013-08-22    !ckay changed from 10 to 11
+  integer, parameter :: pcols = 1
+
+!constants remaped
+  real(r8), private::  g              !gravity
+  real(r8), private::  mw             !molecular weight of water
+  real(r8), private::   r        !Dry air Gas constant
+  real(r8), private::   rv       !water vapor gas contstant
+  real(r8), private::   rr   !universal gas constant
+  real(r8), private::   cpp                  !specific heat of dry air
+  real(r8), private::   rhow               !density of liquid water
+  real(r8), private::  xlf !latent heat of freezing
+
+!from physconst 
+  real(r8), private, parameter ::  gravit = 9.80616_r8      ! acceleration of gravity ~ m/s^2
+  real(r8), private, parameter ::  rair   = 287.04239_r8    ! Dry air gas constant     ~ J/K/kg 
+  real(r8), private, parameter ::  tmelt  = 273.15_r8       ! freezing T of fresh water  ~ K
+  real(r8), private, parameter ::  cpair  = 1.00464e3_r8    ! specific heat of dry air   ~ J/kg/K
+  real(r8), private, parameter ::  rh2o   = 461.915_r8      ! Water vapor gas constant ~ J/K/kg
+  real(r8), private, parameter ::  r_universal = 8.31447e3_r8  ! Universal gas constant ~ J/K/kmole
+  real(r8), private, parameter ::  mwh2o  = 18._r8          ! molecular weight h2o
+  real(r8), private, parameter ::  rhoh2o = 1.000e3_R8      ! density of fresh water     ~ kg/m^3
+  real(r8), private, parameter ::  latvap = 2.501e6_r8      ! latent heat of evaporation ~ J/kg
+  real(r8), private, parameter ::  latice = 3.337e5_r8      ! latent heat of fusion      ~ J/kg
+  real(r8), private, parameter ::  epsilo = 0.622_r8        ! ratio of h2o to dry air molecular weights         
+
+!from 'microconstants'
+  real(r8), private:: rhosn  ! bulk density snow
+  real(r8), private:: rhoi   ! bulk density ice
+
+  real(r8), private:: ac,bc,as,bs,ai,bi,ar,br  !fall speed parameters 
+  real(r8), private:: ci,di    !ice mass-diameter relation parameters
+  real(r8), private:: cs,ds    !snow mass-diameter relation parameters
+  real(r8), private:: cr,dr    !drop mass-diameter relation parameters
+  real(r8), private:: Eii      !collection efficiency aggregation of ice
+  real(r8), private:: Ecc      !collection efficiency
+  real(r8), private:: Ecr      !collection efficiency cloud droplets/rain
+  real(r8), private:: DCS      !autoconversion size threshold
+  real(r8), private:: qsmall   !min mixing ratio 
+  real(r8), private:: bimm,aimm !immersion freezing
+  real(r8), private:: rhosu     !typical 850mn air density
+  real(r8), private:: mi0       ! new crystal mass
+  real(r8), private:: rin       ! radius of contact nuclei
+  real(r8), private:: pi       ! pi
+
+  real(r8), private:: rn_dst1, rn_dst2, rn_dst3, rn_dst4  !dust number mean radius for contact freezing
+!..........................................................................
+
+!needed for findsp
+real(r8), private:: t0       ! Freezing temperature
+
+! activate parameters
+
+      integer, private:: psat
+      parameter (psat=6) ! number of supersaturations to calc ccn concentration
+      real(r8), private:: aten
+!      
+      real(r8), private:: alogsig(naer_cu) ! natl log of geometric standard dev of aerosol
+      real(r8), private:: exp45logsig(naer_cu)
+      real(r8), private:: argfactor(naer_cu)
+      real(r8), private:: amcube(naer_cu) ! cube of dry mode radius (m)
+      real(r8), private:: smcrit(naer_cu) ! critical supersatuation for activation
+      real(r8), private:: lnsm(naer_cu) ! ln(smcrit)
+      real(r8), private:: amcubesulfate(pcols) ! cube of dry mode radius (m) of sulfate
+      real(r8), private:: smcritsulfate(pcols) ! critical supersatuation for activation of sulfate
+      real(r8), private:: amcubefactor(naer_cu) ! factors for calculating mode radius
+      real(r8), private:: smcritfactor(naer_cu) ! factors for calculating critical supersaturation
+      real(r8), private:: super(psat)
+      real(r8), private:: alogten,alog2,alog3,alogaten
+      real(r8), private, parameter :: supersat(psat)= &! supersaturation (%) to determine ccn concentration
+               (/0.02,0.05,0.1,0.2,0.5,1.0/)
+      real(r8), private:: ccnfact(psat,naer_cu)
+
+      real(r8), private:: f1(naer_cu),f2(naer_cu) ! abdul-razzak functions of width
+      real(r8), private:: third, sixth,zero
+      real(r8), private:: sq2, sqpi
+
+
+!wrf      integer :: naer_all    ! number of aerosols affecting climate
+!xsong 2013-08-22---------------
+      integer :: idxsul = 1 ! index in aerosol list for sulfate  
+      integer :: idxdst1 = 3 ! index in aerosol list for dust1
+      integer :: idxdst2 = 4 ! index in aerosol list for dust2
+      integer :: idxdst3 = 5 ! index in aerosol list for dust3
+      integer :: idxdst4 = 6 ! index in aerosol list for dust4
+      integer :: idxbcphi = 10 ! index in aerosol list for Soot (BCPHI)
+!xsong 2013-08-22---------------
+      ! aerosol properties
+      character(len=20)  aername(naer_cu)
+      real(r8) dryrad_aer(naer_cu)
+      real(r8) density_aer(naer_cu)
+      real(r8) hygro_aer(naer_cu)
+      real(r8) dispersion_aer(naer_cu)
+      real(r8) num_to_mass_aer(naer_cu)
+
+!xsong 2013-08-22--------------------
+   data aername /"SULFATE","SEASALT2","DUST1","DUST2","DUST3","DUST4","OCPHO","BCPHO",   &
+                 "OCPHI","BCPHI"/
+   data dryrad_aer /0.695E-7_r8,0.200E-5_r8,0.151E-5_r8,0.151E-5_r8,0.151E-5_r8,0.151E-5_r8,     &
+                    0.212E-7_r8,0.118E-7_r8,0.212E-7_r8, 0.118E-7_r8/
+   data density_aer /1770._r8,2200._r8,2600._r8,2600._r8,2600._r8,2600._r8,1800._r8,  &
+                     1000._r8,2600._r8,1000._r8/
+   data hygro_aer /0.507_r8,1.160_r8,0.140_r8,0.140_r8,0.140_r8,0.140_r8,0.100_r8,0.100_r8,  &
+                   0.140_r8,0.100_r8/
+   data dispersion_aer /2.030_r8,1.3732_r8,1.900_r8,1.900_r8,1.900_r8,1.900_r8,2.240_r8,  &
+                        2.000_r8,2.240_r8,2.000_r8/
+   data num_to_mass_aer /42097098109277080._r8,8626504211623._r8,3484000000000000._r8,213800000000000._r8,&
+                         22050000000000._r8,3165000000000._r8,0.745645E+18_r8,0.167226E+20_r8,&
+                         0.516216E+18_r8,0.167226E+20_r8/
+!xsong 2013-08-22-----------------------
+
+
+contains
+
+!===============================================================================
+
+subroutine zm_mphyi
+
+!----------------------------------------------------------------------- 
+! 
+! Purpose:
+! initialize constants for the cumulus microphysics
+! called from zm_conv_init() in zm_conv_intr.F90
+!
+! Author: Xiaoliang Song, June 2010
+! 
+!-----------------------------------------------------------------------
+
+      save    ! sep6
+!wrf   use pmgrid, only: plev, plevp
+      integer k
+
+      integer l,m, iaer
+      real(r8) surften       ! surface tension of water w/respect to air (N/m)
+!      real(r8) arg
+
+! hm modify to use my error function
+
+
+!declarations for morrison codes (transforms variable names)
+
+!   g= gravit                  !gravity
+!   mw = mwh2o / 1000._r8      !molecular weight of water
+!   r= rair                   !Dry air Gas constant: note units(phys_constants
+!   are in J/K/kmol)
+!   rv= rh2o                   !water vapor gas contstant
+!   rr = r_universal           !universal gas constant
+!   cpp = cpair                 !specific heat of dry air
+!   rhow = rhoh2o              !density of liquid water
+
+!NOTE:
+! latent heats should probably be fixed with temperature 
+! for energy conservation with the rest of the model
+! (this looks like a +/- 3 or 4% effect, but will mess up energy balance)
+
+   xlf = latice          ! latent heat freezing
+
+
+! from microconstants
+
+! parameters below from Reisner et al. (1998)
+! density parameters (kg/m3)
+
+      rhosn = 100._r8    ! bulk density snow
+      rhoi = 500._r8     ! bulk density ice
+      rhow = 1000._r8    ! bulk density liquid
+
+! fall speed parameters, V = aD^b
+! V is in m/s
+
+! droplets
+        ac = 3.e7_r8
+        bc = 2._r8
+
+! snow
+        as = 11.72_r8
+        bs = 0.41_r8
+
+! cloud ice
+        ai = 700._r8
+        bi = 1._r8
+
+! rain
+        ar = 841.99667_r8
+        br = 0.8_r8
+
+! particle mass-diameter relationship
+! currently we assume spherical particles for cloud ice/snow
+! m = cD^d
+
+        pi= 3.1415927_r8
+
+! cloud ice mass-diameter relationship
+
+        ci = rhoi*pi/6._r8
+        di = 3._r8
+
+! snow mass-diameter relationship
+
+        cs = rhosn*pi/6._r8
+        ds = 3._r8
+
+! drop mass-diameter relationship
+
+        cr = rhow*pi/6._r8
+        dr = 3._r8
+
+! collection efficiency, aggregation of cloud ice and snow
+
+        Eii = 0.1_r8
+
+! collection efficiency, accretion of cloud water by rain
+
+        Ecr = 1.0_r8
+
+! autoconversion size threshold for cloud ice to snow (m)
+
+!        Dcs = 100.e-6_r8
+        Dcs = 200.e-6_r8
+
+! smallest mixing ratio considered in microphysics
+
+        qsmall = 1.e-28_r8 !Shaocai   !1.e-18_r8  
+
+! immersion freezing parameters, bigg 1953
+
+        bimm = 100._r8
+        aimm = 0.66_r8
+
+! contact freezing due to dust
+! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius
+! of 0.6 micron, sigma=2
+
+        rn_dst1=0.258e-6_r8
+        rn_dst2=0.717e-6_r8
+        rn_dst3=1.576e-6_r8
+        rn_dst4=3.026e-6_r8
+
+! typical air density at 850 mb
+
+        rhosu = 85000._r8/(rair * tmelt)
+
+! mass of new crystal due to aerosol freezing and growth (kg)
+
+        mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8)
+
+! radius of contact nuclei aerosol (m)
+
+        rin = 0.1e-6_r8
+
+! freezing temperature
+        t0=273.15_r8
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! set parameters for droplet activation, following abdul-razzak and ghan 2000,
+! JGR
+
+!      mathematical constants
+
+      zero=0._r8
+      third=1./3._r8
+      sixth=1./6._r8
+      sq2=sqrt(2._r8)
+      pi=4._r8*atan(1.0_r8)
+      sqpi=sqrt(pi)
+
+      surften=0.076_r8
+      aten=2.*mwh2o*surften/(r_universal*t0*rhoh2o)
+      alogaten=log(aten)
+      alog2=log(2._r8)
+      alog3=log(3._r8)
+      super(:)=0.01*supersat(:)
+
+      do m=1,naer_cu
+!         use only if width of size distribution is prescribed
+          alogsig(m)=log(dispersion_aer(m))
+          exp45logsig(m)=exp(4.5*alogsig(m)*alogsig(m))
+          argfactor(m)=2./(3.*sqrt(2.)*alogsig(m))
+          f1(m)=0.5*exp(2.5*alogsig(m)*alogsig(m))
+          f2(m)=1.+0.25*alogsig(m)
+          amcubefactor(m)=3._r8/(4._r8*pi*exp45logsig(m)*density_aer(m))
+          smcritfactor(m)=2._r8*aten*sqrt(aten/(27._r8*max(1.e-10_r8,hygro_aer(m))))
+!         use only if mode radius of size distribution is prescribed
+          amcube(m)=amcubefactor(m)/(num_to_mass_aer(m))
+!         use only if only one component per mode
+          if(hygro_aer(m).gt.1.e-10) then
+             smcrit(m)=smcritfactor(m)/sqrt(amcube(m))
+          else
+             smcrit(m)=100.
+          endif
+          lnsm(m)=log(smcrit(m))
+
+      end do
+
+   return
+ end subroutine zm_mphyi
+
+!===============================================================================
+
+subroutine zm_mphy(su,    qu,   mu,   du,   cmel, cmei, zf,  pm,  te,   qe, eps0,    &
+                   jb,    jt,   jlcl, msg,  il2g, grav, cp,  rd,  qc,   qi, qr, qni, & ! TWG
+                    rprd,  wu,    eu,   nc,   ni, nr, ns, dum2l, sprd, frz, aer_mmr, deltat, & !TWG
+                   Pver,PverP,gamhat,qsatzm,wu_kf_act,qc_kf_act,qi_kf_act,effc,effi,effs)
+
+! Purpose:
+! microphysic parameterization for Zhang-McFarlane convection scheme
+! called from cldprp() in zm_conv.F90
+!
+! Author: Xiaoliang Song, June 2010
+
+!wrf  use time_manager,    only: get_nstep, get_step_size
+
+! variable declarations
+
+  implicit none
+
+! input variables
+!ckay
+  real :: zmVMFLCL,zmTRPPT,a1kay, a2kay
+
+  integer, parameter :: naer_cu = 10   ! danger
+  integer, parameter :: pcols = 1
+
+  integer :: pver                  ! number of vertical levels(mid-layer)
+  integer :: pverp                 ! number of vertical levels(interface)      
+  real(r8) :: su(pcols,pver)        ! normalized dry stat energy of updraft
+  real(r8) :: qu(pcols,pver)        ! spec hum of updraft
+  real(r8) :: mu(pcols,pver)        ! updraft mass flux
+  real(r8) :: du(pcols,pver)        ! detrainement rate of updraft
+  real(r8) :: cmel(pcols,pver)      ! condensation rate of updraft
+  real(r8) :: cmei(pcols,pver)      ! condensation rate of updraft
+  real(r8) :: zf(pcols,pverp)       ! height of interfaces
+  real(r8) :: pm(pcols,pver)        ! pressure of env
+  real(r8) :: te(pcols,pver)        ! temp of env
+  real(r8) :: qe(pcols,pver)        ! spec. humidity of env
+  real(r8) :: eps0(pcols)
+  real(r8) :: eu(pcols,pver)        ! entrainment rate of updraft
+!ckay  real(r8) :: aer_mmr(:,:,:)        ! aerosol mass mixing ratio
+  real(r8) :: aer_mmr(Pcols,Pver,naer_cu)        ! aerosol mass mixing ratio
+!  real(r8) :: gamhat(pcols,pver)    ! kf_GAMMA=L/cp(dq*/dT) at interface
+!ckay
+  real(r8) :: qsatzm(pcols,pver)        ! spec hum of updraft
+  real(r8) :: wu_kf_act(pver)        ! KF incloud updraft velocity
+  real(r8) :: qc_kf_act(pver)        ! KF incloud updraft velocity
+  real(r8) :: qi_kf_act(pver)        ! KF incloud updraft velocity
+
+  integer :: jb(pcols)              ! updraft base level
+  integer :: jt(pcols)              ! updraft plume top
+  integer :: jlcl(pcols)            ! updraft lifting cond level
+  integer :: msg                    ! missing moisture vals
+  integer :: il2g                   ! CORE GROUP REMOVE
+
+  real(r8) grav                                 ! gravity
+  real(r8) cp                                   ! heat capacity of dry air
+  real(r8) rd                                   ! gas constant for dry air
+
+! output variables
+!ckay
+  real(r8) qc(pcols,pver)       ! cloud water mixing ratio (kg/kg)
+  real(r8) qi(pcols,pver)       ! cloud ice mixing ratio (kg/kg)
+  real(r8) nc(pcols,pver)       ! cloud water number conc (1/kg)
+  real(r8) ni(pcols,pver)       ! cloud ice number conc (1/kg)
+  real(r8)  qni(pcols,pver)      ! snow mixing ratio
+  real(r8)  qr(pcols,pver)       ! rain mixing ratio
+  real(r8)  ns(pcols,pver)       ! snow number conc
+  real(r8)  nr(pcols,pver)       ! rain number conc
+  real(r8) rprd(pcols,pver)     ! rate of production of precip at that layer
+!ckay  real(r8), intent(out) :: rprd(pcols,pver)     ! rate of production of
+!precip at that layer
+  real(r8) sprd(pcols,pver)     ! rate of production of snow at that layer
+  real(r8) frz(pcols,pver)      ! rate of freezing
+
+! tendency for output
+
+  real(r8) :: autolm(pcols,pver)    !mass tendency due to autoconversion of droplets to rain
+  real(r8) :: accrlm(pcols,pver)    !mass tendency due to accretion of droplets by rain
+  real(r8) :: bergnm(pcols,pver)    !mass tendency due to Bergeron process
+  real(r8) :: fhtimm(pcols,pver)    !mass tendency due to immersion freezing
+  real(r8) :: fhtctm(pcols,pver)    !mass tendency due to contact freezing
+  real(r8) :: fhmlm (pcols,pver)    !mass tendency due to homogeneous freezing
+  real(r8) :: hmpim (pcols,pver)    !mass tendency due to HM process
+  real(r8) :: accslm(pcols,pver)    !mass tendency due to accretion of droplets by snow
+  real(r8) :: dlfm  (pcols,pver)    !mass tendency due to detrainment of droplet
+  real(r8) :: autoln(pcols,pver)    !num tendency due to autoconversion of droplets to rain
+  real(r8) :: accrln(pcols,pver)    !num tendency due to accretion of droplets by rain
+  real(r8) :: bergnn(pcols,pver)    !num tendency due to Bergeron process
+  real(r8) :: fhtimn(pcols,pver)    !num tendency due to immersion freezing
+  real(r8) :: fhtctn(pcols,pver)    !num tendency due to contact freezing
+  real(r8) :: fhmln (pcols,pver)    !num tendency due to homogeneous freezing
+  real(r8) :: accsln(pcols,pver)    !num tendency due to accretion of droplets by snow
+  real(r8) :: activn(pcols,pver)    !num tendency due to droplets activation
+  real(r8) :: dlfn  (pcols,pver)    !num tendency due to detrainment of droplet
+  real(r8) :: autoim(pcols,pver)    !mass tendency due to autoconversion of cloud ice to snow
+  real(r8) :: accsim(pcols,pver)    !mass tendency due to accretion of cloud ice by snow
+  real(r8) :: difm  (pcols,pver)    !mass tendency due to detrainment of cloud ice 
+  real(r8) :: nuclin(pcols,pver)    !num tendency due to ice nucleation
+  real(r8) :: autoin(pcols,pver)    !num tendency due to autoconversion of cloud ice to snow
+  real(r8) :: accsin(pcols,pver)    !num tendency due to accretion of cloud ice by snow
+  real(r8) :: hmpin (pcols,pver)    !num tendency due to HM process
+  real(r8) :: difn  (pcols,pver)    !num tendency due to detrainment of cloud ice
+  real(r8) :: trspcm(pcols,pver)    !LWC tendency due to convective transport
+  real(r8) :: trspcn(pcols,pver)    !droplet num tendency due to convective transport
+  real(r8) :: trspim(pcols,pver)    !IWC tendency due to convective transport
+  real(r8) :: trspin(pcols,pver)    !ice crystal num tendency due to convective transport
+
+  real(r8) :: ncadj(pcols,pver)     !droplet num tendency due to adjustment
+  real(r8) :: niadj(pcols,pver)     !ice crystal num tendency due to adjustment
+  real(r8) :: qcadj(pcols,pver)     !droplet mass tendency due to adjustment
+  real(r8) :: qiadj(pcols,pver)     !ice crystal mass tendency due to adjustment
+
+! output for ice nucleation
+  real(r8) :: nimey(pcols,pver)     !output number conc of ice nuclei due to meyers deposition (1/m3)
+  real(r8) :: nihf(pcols,pver)      !output number conc of ice nuclei due to heterogenous freezing (1/m3)
+  real(r8) :: nidep(pcols,pver)     !output number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3)
+  real(r8) :: niimm(pcols,pver)     !output number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3)
+  real(r8) :: effc(pcols,pver)    ! droplet effective radius (micron)
+  real(r8) :: effi(pcols,pver)    ! cloud ice effective radius (micron)
+  real(r8) :: effs(pcols,pver)    ! snow effective radius (micron)
+
+!................................................................................
+! local workspace
+! all units mks unless otherwise stated
+  real(r8) :: deltat                ! time step (s)
+  real(r8) :: omsm                  ! number near unity for round-off issues
+  real(r8) :: dum                   ! temporary dummy variable
+  real(r8) :: arg                   ! argument of erfc
+  real(r8) :: dum1                  ! temporary dummy variable 
+  real(r8) :: dum2                  ! temporary dummy variable
+
+  real(r8) :: q(pcols,pver)         ! water vapor mixing ratio (kg/kg)
+  real(r8) :: t(pcols,pver)         ! temperature (K)
+  real(r8) :: rho(pcols,pver)       ! air density (kg m-3)
+  real(r8) :: dz(pcols,pver)        ! height difference across model verticallevel
+
+  real(r8) :: qcic(pcols,pver)      ! in-cloud cloud liquid mixing ratio
+  real(r8) :: qiic(pcols,pver)      ! in-cloud cloud ice mixing ratio
+!dkay
+  real (r8) :: tot_qc_qi
+  real(r8) :: qniic(pcols,pver)     ! in-precip snow mixing ratio
+  real(r8) :: qric(pcols,pver)      ! in-precip rain mixing ratio
+  real(r8) :: ncic(pcols,pver)      ! in-cloud droplet number conc
+  real(r8) :: niic(pcols,pver)      ! in-cloud cloud ice number conc
+  real(r8) :: nsic(pcols,pver)      ! in-precip snow number conc
+  real(r8) :: nric(pcols,pver)      ! in-precip rain number conc
+
+  real(r8) :: lami(pver)            ! slope of cloud ice size distr
+  real(r8) :: n0i(pver)             ! intercept of cloud ice size distr
+  real(r8) :: lamc(pver)            ! slope of cloud liquid size distr
+  real(r8) :: n0c(pver)             ! intercept of cloud liquid size distr
+  real(r8) :: lams(pver)            ! slope of snow size distr
+  real(r8) :: n0s(pver)             ! intercept of snow size distr
+  real(r8) :: lamr(pver)            ! slope of rain size distr
+  real(r8) :: n0r(pver)             ! intercept of rain size distr
+  real(r8) :: cdist1(pver)          ! size distr parameter to calculate droplet freezing
+  real(r8) :: pgam(pver)            ! spectral width parameter of droplet size distr
+  real(r8) :: lammax                ! maximum allowed slope of size distr
+  real(r8) :: lammin                ! minimum allowed slope of size distr
+
+  real(r8) :: mnuccc(pver)          ! mixing ratio tendency due to freezing of cloud water
+  real(r8) :: nnuccc(pver)          ! number conc tendency due to freezing of cloud water
+  real(r8) :: mnucct(pver)          ! mixing ratio tendency due to contact freezing of cloud water
+  real(r8) :: nnucct(pver)          ! number conc tendency due to contact freezing of cloud water
+  real(r8) :: msacwi(pver)          ! mixing ratio tendency due to HM ice multiplication
+  real(r8) :: nsacwi(pver)          ! number conc tendency due to HM ice multiplication
+  real(r8) :: prf(pver)             ! mixing ratio tendency due to fallout of rain
+  real(r8) :: psf(pver)             ! mixing ratio tendency due to fallout of snow
+  real(r8) :: pnrf(pver)            ! number conc tendency due to fallout of rain
+  real(r8) :: pnsf(pver)            ! number conc tendency due to fallout of snow
+  real(r8) :: prc(pver)             ! mixing ratio tendency due to autoconversion of cloud droplets
+  real(r8) :: nprc(pver)            ! number conc tendency due to autoconversion of cloud droplets
+  real(r8) :: nprc1(pver)           ! qr tendency due to autoconversion of cloud droplets
+  real(r8) :: nsagg(pver)           ! ns tendency due to self-aggregation of snow
+  real(r8) :: dc0                   ! mean size droplet size distr
+  real(r8) :: ds0                   ! mean size snow size distr (area weighted)
+  real(r8) :: eci                   ! collection efficiency for riming of snow by droplets
+  real(r8) :: dv(pcols,pver)        ! diffusivity of water vapor in air
+  real(r8) :: mua(pcols,pver)       ! viscocity of air
+  real(r8) :: psacws(pver)          ! mixing rat tendency due to collection of droplets by snow
+  real(r8) :: npsacws(pver)         ! number conc tendency due to collection of droplets by snow
+  real(r8) :: pracs(pver)           ! mixing rat tendency due to collection of rain by snow
+  real(r8) :: npracs(pver)          ! number conc tendency due to collection of rain by snow
+  real(r8) :: mnuccr(pver)          ! mixing rat tendency due to freezing of rain
+  real(r8) :: nnuccr(pver)          ! number conc tendency due to freezing of rain
+  real(r8) :: pra(pver)             ! mixing rat tendnency due to accretion of droplets by rain
+  real(r8) :: npra(pver)            ! nc tendnency due to accretion of droplets by rain
+  real(r8) :: nragg(pver)           ! nr tendency due to self-collection of rain
+  real(r8) :: prci(pver)            ! mixing rat tendency due to autoconversion of cloud ice to snow
+  real(r8) :: nprci(pver)           ! number conc tendency due to autoconversion of cloud ice to snow
+  real(r8) :: prai(pver)            ! mixing rat tendency due to accretion of cloud ice by snow
+  real(r8) :: nprai(pver)           ! number conc tendency due to accretion of cloud ice by snow
+  real(r8) :: prb(pver)             ! rain mixing rat tendency due to Bergeron process
+  real(r8) :: nprb(pver)            ! number conc tendency due to Bergeron process
+
+
+! fall speed
+  real(r8) :: arn(pcols,pver)       ! air density corrected rain fallspeed
+  real(r8) :: asn(pcols,pver)       ! air density corrected snow fallspeed
+  real(r8) :: acn(pcols,pver)       ! air density corrected cloud droplet fallspeed parameter
+  real(r8) :: ain(pcols,pver)       ! air density corrected cloud ice fallspeed
+  real(r8) :: uns(pver)             ! number-weighted snow fallspeed
+  real(r8) :: ums(pver)             ! mass-weighted snow fallspeed
+  real(r8) :: unr(pver)             ! number-weighted rain fallspeed
+  real(r8) :: umr(pver)             ! mass-weighted rain fallspeed
+
+! conservation check
+  real(r8) :: qce                   ! dummy qc for conservation check
+  real(r8) :: qie                   ! dummy qi for conservation check
+  real(r8) :: nce                   ! dummy nc for conservation check
+  real(r8) :: nie                   ! dummy ni for conservation check
+  real(r8) :: qre                   ! dummy qr for conservation check
+  real(r8) :: nre                   ! dummy nr for conservation check
+  real(r8) :: qnie                  ! dummy qni for conservation check
+  real(r8) :: nse                   ! dummy ns for conservation check      
+  real(r8) :: ratio                 ! parameter for conservation check
+
+! sum of source/sink terms for cloud hydrometeor
+  real(r8) :: qctend(pcols,pver)    ! microphysical tendency qc (1/s)
+  real(r8) :: qitend(pcols,pver)    ! microphysical tendency qi (1/s)
+  real(r8) :: nctend(pcols,pver)    ! microphysical tendency nc (1/(kg*s))
+  real(r8) :: nitend(pcols,pver)    ! microphysical tendency ni (1/(kg*s))
+  real(r8) :: qnitend(pcols,pver)   ! snow mixing ratio source/sink term
+  real(r8) :: nstend(pcols,pver)    ! snow number concentration source/sink term
+  real(r8) :: qrtend(pcols,pver)    ! rain mixing ratio source/sink term
+  real(r8) :: nrtend(pcols,pver)    ! rain number concentration source/sink term
+
+! terms for Bergeron process
+  real(r8) :: bergtsf               !bergeron timescale to remove all liquid
+  real(r8) :: plevap                ! cloud liquid water evaporation rate
+
+! aerosol variables
+  real(r8) :: naermod(naer_cu)      ! aerosol number concentration (/m3)
+  real(r8) :: naer2(pcols,pver,naer_cu)    ! new aerosol number concentration (/m3)
+  real(r8) :: naer2h(pcols,pver,naer_cu)   ! new aerosol number concentration (/m3) 
+  real(r8) :: maerosol(1,naer_cu)   ! aerosol mass conc (kg/m3)
+  real(r8) naer(pcols)
+
+! droplet activation
+  real(r8) :: dum2l(pcols,pver)     ! number conc of CCN (1/kg)
+  real(r8) :: npccn(pver)           ! droplet activation rate
+  real(r8) :: ncmax
+  real(r8) :: mtimec                ! factor to account for droplet activation timescale
+
+! ice nucleation
+  real(r8) :: dum2i(pcols,pver)     ! number conc of ice nuclei available (1/kg)
+  real(r8) :: qs(pcols,pver)        ! liquid-ice weighted sat mixing rat (kg/kg)
+  real(r8) :: es(pcols,pver)        ! sat vapor press (pa) over water
+  real(r8) :: relhum(pcols,pver)    ! relative humidity
+  real(r8) :: esi(pcols,pver)       ! sat vapor press (pa) over ice
+  real(r8) :: nnuccd(pver)          ! ice nucleation rate from deposition/cond.-freezing
+  real(r8) :: mnuccd(pver)          ! mass tendency from ice nucleation
+  real(r8) :: nimax
+  real(r8) :: mtime                 ! factor to account for ice nucleation timescale
+  real(r8) :: gamhat(pcols,pver)    ! kf_GAMMA=L/cp(dq*/dT) at interface
+
+
+! loop array variables
+  integer i,k,nstep,n, l
+  integer ii,kk, m
+
+! loop variables for iteration solution
+  integer iter,it,ltrue(pcols)
+
+! used in contact freezing via dust particles
+  real(r8)  tcnt, viscosity, mfp
+  real(r8)  slip1, slip2, slip3, slip4
+  real(r8)  dfaer1, dfaer2, dfaer3, dfaer4
+  real(r8)  nacon1,nacon2,nacon3,nacon4
+
+! used in immersion freezing via soot
+  real(r8) ttend(pver)
+  real(r8) naimm
+  real(r8) :: ntaer(pcols,pver)
+  real(r8) :: ntaerh(pcols,pver)
+
+! used in secondary ice production
+  real(r8) ni_secp
+
+! used in vertical velocity calculation
+  real(r8) th(pcols,pver)
+  real(r8) qh(pcols,pver)
+  real(r8) wu(pcols,pver)
+  real(r8) zkine(pcols,pver)
+  real(r8) zbuo(pcols,pver)
+  real(r8) zfacbuo, cwdrag, cwifrac, retv,  zbuoc
+  real(r8) zbc, zbe,  zdkbuo, zdken
+  real(r8) arcf(pcols,pver)
+  real(r8) p(pcols,pver)
+  real(r8) ph(pcols,pver)
+
+  real(r8) :: rhoh(pcols,pver)    ! air density (kg m-3) at interface 
+  real(r8) :: rhom(pcols,pver)    ! air density (kg m-3) at mid-level
+  real(r8) :: tu(pcols,pver)      ! temperature in updraft (K)
+
+  real(r8) :: fhmrm (pcols,pver)  !mass tendency due to homogeneous freezing of rain
+
+  real(r8) ncorg,niorg,qcorg,qiorg
+
+  integer  kqi(pcols),kqc(pcols)
+  logical  lcbase(pcols), libase(pcols)
+
+!ckay introduced save sep6
+  save
+
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! initialization
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+! parameters for scheme
+        omsm=0.99999_r8
+        zfacbuo = 0.5_r8/(1._r8+0.5_r8)
+        cwdrag  = 1.875_r8*0.506_r8
+        cwifrac = 0.5_r8
+        retv    = 0.608_r8
+        bergtsf = 1800._r8
+
+! initialize multi-level fields
+        do i=1,il2g
+          do k=1,pver
+            q(i,k)= qu(i,k)
+            tu(i,k)= su(i,k) - grav/cp*zf(i,k)
+            t(i,k)= su(i,k) - grav/cp*zf(i,k)
+            p(i,k) = 100._r8*pm(i,k)
+            wu(i,k)  = 0._r8
+            zkine(i,k)= 0._r8
+            arcf(i,k) = 0._r8
+            zbuo(i,k) = 0._r8
+            nc(i,k) = 0._r8
+            ni(i,k) = 0._r8
+            qc(i,k) = 0._r8
+            qi(i,k) = 0._r8
+            qcic(i,k) = 0._r8
+            qiic(i,k) = 0._r8
+            ncic(i,k) = nc(i,k)
+            niic(i,k) = ni(i,k)
+            qr(i,k) = 0._r8
+            qni(i,k)= 0._r8
+            nr(i,k) = 0._r8
+            ns(i,k) = 0._r8
+            qric(i,k) = qr(i,k)
+            qniic(i,k) = qni(i,k)
+            nric(i,k) = nr(i,k)
+            nsic(i,k) = ns(i,k)
+            nimey(i,k) = 0._r8
+            nihf(i,k)  = 0._r8
+            nidep(i,k) = 0._r8
+            niimm(i,k) = 0._r8
+
+            autolm(i,k) = 0._r8
+            accrlm(i,k) = 0._r8
+            bergnm(i,k) = 0._r8
+            fhtimm(i,k) = 0._r8
+            fhtctm(i,k) = 0._r8
+            fhmlm (i,k) = 0._r8
+            hmpim (i,k) = 0._r8
+            accslm(i,k) = 0._r8
+            dlfm  (i,k) = 0._r8
+
+            autoln(i,k) = 0._r8
+
+            accrln(i,k) = 0._r8
+            bergnn(i,k) = 0._r8
+            fhtimn(i,k) = 0._r8
+            fhtctn(i,k) = 0._r8
+            fhmln (i,k) = 0._r8
+            accsln(i,k) = 0._r8
+            activn(i,k) = 0._r8
+            dlfn  (i,k) = 0._r8
+            ncadj (i,k) = 0._r8
+            qcadj (i,k) = 0._r8
+!cloud ice------------------------
+           autoim(i,k) = 0._r8
+            accsim(i,k) = 0._r8
+            difm  (i,k) = 0._r8
+            nuclin(i,k) = 0._r8
+            autoin(i,k) = 0._r8
+            accsin(i,k) = 0._r8
+            hmpin (i,k) = 0._r8
+            difn  (i,k) = 0._r8
+            niadj (i,k) = 0._r8
+            qiadj (i,k) = 0._r8
+
+            trspcm(i,k) = 0._r8
+            trspcn(i,k) = 0._r8
+            trspim(i,k) = 0._r8
+            trspin(i,k) = 0._r8
+
+            effc(i,k) = 0._r8
+            effi(i,k) = 0._r8
+            effs(i,k) = 0._r8
+
+            fhmrm (i,k) = 0._r8
+          end do
+        end do
+
+
+! initialize time-varying parameters
+        do k=1,pver
+          do i=1,il2g
+!-------------Shaocai Yu
+             if (k .eq.1) then
+                rhoh(i,k) = p(i,k)/(t(i,k)*rd)
+                rhom(i,k) = p(i,k)/(t(i,k)*rd)
+                th (i,k) = te(i,k)
+                qh (i,k) = qe(i,k)
+                dz (i,k)  = zf(i,k) - zf(i,k+1)
+                ph(i,k)   = p(i,k)
+             else
+
+               rhoh(i,k) = 0.5_r8*(p(i,k)+p(i,k-1))/(t(i,k)*rd)
+                if (k .eq. pver) then
+                  rhom(i,k) = p(i,k)/(rd*t(i,k))
+                else
+                  rhom(i,k) = 2.0_r8*p(i,k)/(rd*(t(i,k)+t(i,k+1)))
+                end if
+                th (i,k) = 0.5_r8*(te(i,k)+te(i,k-1))
+                qh (i,k) = 0.5_r8*(qe(i,k)+qe(i,k-1))
+                dz(i,k)  = zf(i,k-1) - zf(i,k)
+                ph(i,k)  = 0.5_r8*(p(i,k) + p(i,k-1))
+             end if
+
+            dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/ph(i,k)
+            mua(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/ &
+                     (t(i,k)+120._r8)
+
+            rho(i,k) = rhoh(i,k)
+
+! air density adjustment for fallspeed parameters
+! add air density correction factor to the power of 
+! 0.54 following Heymsfield and Bansemer 2006
+
+            arn(i,k)=ar*(rhosu/rho(i,k))**0.54
+            asn(i,k)=as*(rhosu/rho(i,k))**0.54
+            acn(i,k)=ac*(rhosu/rho(i,k))**0.54
+            ain(i,k)=ai*(rhosu/rho(i,k))**0.54
+
+          end do
+        end do
+
+! initialize aerosol number
+        do k=1,pver
+          do i=1,il2g
+            naer2(i,k,:)=0._r8
+            naer2h(i,k,:)=0._r8
+            dum2l(i,k)=0._r8
+            dum2i(i,k)=0._r8
+          end do
+        end do
+
+        do k=1,pver
+          do i=1,il2g
+            ntaer(i,k) = 0.0_r8
+            ntaerh(i,k) = 0.0_r8
+            do m=1,naer_cu
+
+              maerosol(1,m)=aer_mmr(i,k,m)*rhom(i,k)
+
+!------------------------------------------------------------------           
+        
+! set number nucleated for sulfate based on Lohmann et al. 2000 (JGR) Eq.2
+!    Na=340.*(massSO4)^0.58  where Na=cm-3 and massSO4=ug/m3
+! convert units to Na [m-3] and SO4 [kgm-3]
+!    Na(m-3)= 1.e6 cm3 m-3 Na(cm-3)=340. *(massSO4[kg/m3]*1.e9ug/kg)^0.58
+!    or Na(m-3)= 1.e6* 340.*(1.e9ug/kg)^0.58 * (massSO4[kg/m3])^0.58
+              if(m .eq. idxsul) then
+                naer2(i,k,m)= 5.64259e13_r8 * maerosol(1,m)**0.58
+              else
+                naer2(i,k,m)=maerosol(1,m)*num_to_mass_aer(m)
+              endif
+                ntaer(i,k) = ntaer(i,k) + naer2(i,k,m)
+            enddo
+          end do ! i loop
+        end do ! k loop
+
+        do i=1,il2g
+          ltrue(i)=0
+          do k=1,pver
+            if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmel(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1
+!            print *,'qc flag =',ltrue(i)
+          end do
+        end do
+
+! skip microphysical calculations if no cloud water
+      do i=1,il2g
+        if (ltrue(i).eq.0) then
+          do k=1,pver
+            qctend(i,k)=0._r8
+            qitend(i,k)=0._r8
+            qnitend(i,k)=0._r8
+            qrtend(i,k)=0._r8
+            nctend(i,k)=0._r8
+            nitend(i,k)=0._r8
+            nrtend(i,k)=0._r8
+            nstend(i,k)=0._r8
+            qniic(i,k)=0._r8
+            qric(i,k)=0._r8
+            nsic(i,k)=0._r8
+            nric(i,k)=0._r8
+            qni(i,k)=0._r8
+            qr(i,k)=0._r8
+            ns(i,k)=0._r8
+            nr(i,k)=0._r8
+            qc(i,k) = 0._r8
+            qi(i,k) = 0._r8
+            nc(i,k) = 0._r8
+            ni(i,k) = 0._r8
+            rprd(i,k) = 0._r8
+            sprd(i,k) = 0._r8
+            frz(i,k) = 0._r8
+          end do
+          goto 300
+        end if
+
+        kqc(i) = 1
+        kqi(i) = 1
+        lcbase(i) = .true.
+        libase(i) = .true.
+
+! assign number of steps for iteration
+! use 2 steps following Song and Zhang, 2011, J. Clim.
+        iter = 2  !5 !Shaocai Yu !2
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!  iteration
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+        do it=1,iter
+! initialize sub-step microphysical tendencies
+         do k=1,pver
+           qctend(i,k)=0._r8
+           qitend(i,k)=0._r8
+           qnitend(i,k)=0._r8
+           qrtend(i,k)=0._r8
+           nctend(i,k)=0._r8
+           nitend(i,k)=0._r8
+           nrtend(i,k)=0._r8
+           nstend(i,k)=0._r8
+           rprd(i,k) = 0._r8
+           sprd(i,k) = 0._r8
+           frz(i,k)  = 0._r8
+           qniic(i,k)=0._r8
+           qric(i,k)=0._r8
+           nsic(i,k)=0._r8
+           nric(i,k)=0._r8
+           qiic(i,k)=0._r8
+           qcic(i,k)=0._r8
+           niic(i,k)=0._r8
+           ncic(i,k)=0._r8
+!<songxl 2012-01-06---------------
+            accrlm(i,k) = 0._r8
+            bergnm(i,k) = 0._r8
+            fhtimm(i,k) = 0._r8
+            fhtctm(i,k) = 0._r8
+            fhmlm (i,k) = 0._r8
+            hmpim (i,k) = 0._r8
+            accslm(i,k) = 0._r8
+            dlfm  (i,k) = 0._r8
+
+            autoln(i,k) = 0._r8
+            accrln(i,k) = 0._r8
+            bergnn(i,k) = 0._r8
+            fhtimn(i,k) = 0._r8
+            fhtctn(i,k) = 0._r8
+            fhmln (i,k) = 0._r8
+            accsln(i,k) = 0._r8
+            activn(i,k) = 0._r8
+            dlfn  (i,k) = 0._r8
+            ncadj (i,k) = 0._r8
+            qcadj (i,k) = 0._r8
+
+            autoim(i,k) = 0._r8
+            accsim(i,k) = 0._r8
+            difm  (i,k) = 0._r8
+
+            nuclin(i,k) = 0._r8
+            autoin(i,k) = 0._r8
+            accsin(i,k) = 0._r8
+            hmpin (i,k) = 0._r8
+            difn  (i,k) = 0._r8
+            niadj (i,k) = 0._r8
+            qiadj (i,k) = 0._r8
+
+            trspcm(i,k) = 0._r8
+            trspcn(i,k) = 0._r8
+            trspim(i,k) = 0._r8
+            trspin(i,k) = 0._r8
+
+            effc(i,k) = 0._r8
+            effi(i,k) = 0._r8
+            effs(i,k) = 0._r8
+
+            fhmrm (i,k) = 0._r8
+!songxl 2012-01-06>---------------
+!songxl 2012-01-06>---------------
+         end do
+
+!---------------------Shaocai
+!        goto 9910  !Stop2
+        
+         do k = pver,msg+2,-1
+
+!within the cloud processing...
+            if (k > jt(i) .and. k <= jb(i) .and. eps0(i) > 0._r8      &
+              .and.mu(i,k).gt.0._r8 .and. mu(i,k-1).gt.0._r8) then
+
+! initialize precip fallspeeds to zero
+            ums(k)=0._r8
+            uns(k)=0._r8
+            umr(k)=0._r8
+            unr(k)=0._r8
+            prf(k)=0._r8
+            pnrf(k)=0._r8
+            psf(k) =0._r8
+            pnsf(k) = 0._r8
+            ttend(k)=0._r8
+            nnuccd(k)=0._r8
+            npccn(k)=0._r8
+
+!************************************************************************************
+! obtain values of cloud water/ice mixing ratios and number concentrations in
+! updraft
+! for microphysical process calculations
+! units are kg/kg for mixing ratio, 1/kg for number conc
+!************************************************************************************
+
+! limit values to 0.005 kg/kg
+!dkay      qc(i,k)=min(qc(i,k),5.e-3_r8)
+!dkay      qi(i,k)=min(qi(i,k),5.e-3_r8)
+           nc(i,k)=max(nc(i,k),0._r8)
+           ni(i,k)=max(ni(i,k),0._r8)
+           if (it.eq.1) then
+             qcic(i,k) = qc(i,k)
+             qiic(i,k) = qi(i,k)
+!             print *,'at it=1',qcic(i,k),k,it
+!dkay
+!            qcic(i,k) = qc_kf_act(k)
+!            qiic(i,k) = qi_kf_act(k)
+!dkay
+             ncic(i,k) = nc(i,k)
+             niic(i,k) = ni(i,k)
+             qniic(i,k)= qni(i,k)
+             qric(i,k) = qr(i,k)
+             nsic(i,k) = ns(i,k)
+             nric(i,k) = nr(i,k)
+           else  ! for it 
+             if (k.le.kqc(i)) then
+                qcic(i,k) = qc(i,k)
+                ncic(i,k) = nc(i,k)
+                if (k.eq.kqc(i)) then
+                  qcic(i,k) = qc(i,k-1)
+                  ncic(i,k) = nc(i,k-1)
+                end if
+! consider rain falling from above
+                do kk= k,jt(i)+2,-1
+                   qric(i,k) = qr(i,k) + max(0._r8, qr(i,kk-1)-qr(i,kk-2) )
+                   if (qr(i,kk-1) .gt. 0._r8)  &
+                   nric(i,k) = nr(i,k) + max(0._r8,qr(i,kk-1)-qr(i,kk-2))/qr(i,kk-1)*nr(i,kk-1)
+                end do
+             end if
+             if(k.le.kqi(i)) then
+                qiic(i,k) = qi(i,k)
+                niic(i,k) = ni(i,k)
+                if(k.eq.kqi(i)) then
+                  qiic(i,k) = qi(i,k-1)
+                  niic(i,k) = ni(i,k-1)
+                end if
+! consider snow falling from above
+                do kk= k,jt(i)+2,-1
+                  qniic(i,k) = qni(i,k) + max(0._r8, qni(i,kk-1)-qni(i,kk-2) )
+                  if (qni(i,kk-1) .gt. 0._r8)  &
+                  nsic(i,k) = ns(i,k) + max(0._r8,qni(i,kk-1)-qni(i,kk-2))/qni(i,kk-1)*ns(i,kk-1)
+                end do
+             end if
+           end if
+
+            if(it.eq.1) then
+!              print
+!              *,'qcic,qiic=',qcic(i,k),qiic(i,k),i,k,cmel(i,k),cmei(i,k),tu(i,k),it
+            end if
+!**********************************************************************
+! boundary condition for cloud liquid water and cloud ice
+!***********************************************************************
+
+! boundary condition for provisional cloud water
+        if (cmel(i,k-1).gt.qsmall .and. lcbase(i) .and. it.eq.1 ) then
+             kqc(i) = k
+             lcbase(i) = .false.
+             qcic(i,k) = dz(i,k)*cmel(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1))
+             if(qcic(i,k).eq.0.0) then
+              if(it.eq.1) then
+!              print *,'dz,cmel...',
+!              dz(i,k),cmel(i,k+1),mu(i,k+1),dz(i,k),du(i,k+1)
+              end if
+             end if
+             ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*11.e-6_r8**3*rhow)
+         end if
+
+! boundary condition for provisional cloud ice
+         if (qiic(i,k).gt.qsmall .and. libase(i) .and. it.eq.1 ) then
+             kqi(i) = k
+             libase(i) = .false.
+         else if ( cmei(i,k-1).gt.qsmall .and.   &
+             cmei(i,k).lt.qsmall .and. k.lt.jb(i) .and. libase(i) .and. it.eq.1) then
+             kqi(i)=k
+             libase(i) = .false.
+             qiic(i,k) = dz(i,k)*cmei(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1))
+             niic(i,k) = qiic(i,k)/(4._r8/3._r8*pi*25.e-6_r8**3*rhoi)
+         end if
+
+!***************************************************************************
+! get size distribution parameters based on in-cloud cloud water/ice 
+! these calculations also ensure consistency between number and mixing ratio
+!***************************************************************************
+! cloud ice
+           if (qiic(i,k).ge.qsmall) then
+! add upper limit to in-cloud number concentration to prevent numerical error
+              niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8)
+              lami(k) = (kf_GAMMA(1._r8+di)*ci* &
+                  niic(i,k)/qiic(i,k))**(1._r8/di)
+              n0i(k) = niic(i,k)*lami(k)
+! check for slope
+              lammax = 1._r8/10.e-6_r8
+              lammin = 1._r8/(2._r8*dcs)
+! adjust vars
+              if (lami(k).lt.lammin) then
+                lami(k) = lammin
+                n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*kf_GAMMA(1._r8+di))
+                niic(i,k) = n0i(k)/lami(k)
+              else if (lami(k).gt.lammax) then
+                lami(k) = lammax
+                n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*kf_GAMMA(1._r8+di))
+                niic(i,k) = n0i(k)/lami(k)
+              end if
+           else
+              lami(k) = 0._r8
+              n0i(k) = 0._r8
+           end if
+
+!cloud water
+           if (qcic(i,k).ge.qsmall) then
+
+! add upper limit to in-cloud number concentration to prevent numerical error
+              ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8)
+
+! get pgam from fit to observations of martin et al. 1994
+
+              pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8/rho(i,k))+0.2714_r8
+              pgam(k)=1._r8/(pgam(k)**2)-1._r8
+              pgam(k)=max(pgam(k),2._r8)
+              pgam(k)=min(pgam(k),15._r8)
+
+! calculate lamc
+              lamc(k) = (pi/6._r8*rhow*ncic(i,k)*kf_GAMMA(pgam(k)+4._r8)/ &
+                 (qcic(i,k)*kf_GAMMA(pgam(k)+1._r8)))**(1._r8/3._r8)
+
+! lammin, 50 micron diameter max mean size
+              lammin = (pgam(k)+1._r8)/50.e-6_r8
+              lammax = (pgam(k)+1._r8)/2.e-6_r8
+
+              if (lamc(k).lt.lammin) then
+                 lamc(k) = lammin
+                 ncic(i,k) = 6._r8*lamc(k)**3*qcic(i,k)* &
+                      kf_GAMMA(pgam(k)+1._r8)/ &
+                      (pi*rhow*kf_GAMMA(pgam(k)+4._r8))
+              else if (lamc(k).gt.lammax) then
+                 lamc(k) = lammax
+                 ncic(i,k) = 6._r8*lamc(k)**3*qcic(i,k)* &
+                       kf_GAMMA(pgam(k)+1._r8)/ &
+                      (pi*rhow*kf_GAMMA(pgam(k)+4._r8))
+              end if
+
+! parameter to calculate droplet freezing
+
+              cdist1(k) = ncic(i,k)/kf_GAMMA(pgam(k)+1._r8)
+           else
+              lamc(k) = 0._r8
+              cdist1(k) = 0._r8
+           end if
+! boundary condition for cloud liquid water
+         if ( kqc(i) .eq. k  ) then
+              qc(i,k) =  0._r8
+              nc(i,k) = 0._r8
+          end if
+! boundary condition for cloud ice
+          if (kqi(i).eq.k  ) then
+             qi(i,k) = 0._r8
+             ni(i,k) = 0._r8
+          end if
+
+!**************************************************************************
+! begin micropysical process calculations 
+!**************************************************************************
+
+!.................................................................
+! autoconversion of cloud liquid water to rain
+! formula from Khrouditnov and Kogan (2000)
+! minimum qc of 1 x 10^-8 prevents floating point error
+
+           if (qcic(i,k).ge.1.e-8_r8) then
+
+! nprc is increase in rain number conc due to autoconversion
+! nprc1 is decrease in cloud droplet conc due to autoconversion
+
+              prc(k) = 1350._r8*qcic(i,k)**2.47_r8*    &
+                    (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8)
+              nprc(k) = prc(k)/(4._r8/3._r8*pi*rhow*(25.e-6_r8)**3)
+              nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k))
+           else
+              prc(k)=0._r8
+              nprc(k)=0._r8
+              nprc1(k)=0._r8
+           end if
+
+! provisional rain mixing ratio and number concentration (qric and nric)
+! at boundary are estimated via autoconversion
+
+         if (k.eq.kqc(i) .and. it.eq.1) then
+             qric(i,k) = prc(k)*dz(i,k)/0.55_r8
+             nric(i,k) = nprc(k)*dz(i,k)/0.55_r8
+             qr(i,k) = 0.0_r8
+             nr(i,k) = 0.0_r8
+         end if
+!          print *,'qric,nric,qr,nr afer autoconversion cld water to rain'
+!          print *, 'qric=',qric
+!          print *,
+!          'nric=',nric(i,15),i,nprc(15),prc(15),ncic(i,15),rhow,qcic(i,15)
+!          print *, 'qr=',qr
+!          print *, 'qr=',qr
+
+!.......................................................................
+! Autoconversion of cloud ice to snow
+! similar to Ferrier (1994)
+
+           if (t(i,k).le.273.15_r8.and.qiic(i,k).ge.qsmall) then
+
+! note: assumes autoconversion timescale of 180 sec
+              nprci(k) = n0i(k)/(lami(k)*180._r8)*exp(-lami(k)*dcs)
+              prci(k) = pi*rhoi*n0i(k)/(6._r8*180._r8)* &
+                  (dcs**3/lami(k)+3._r8*dcs**2/lami(k)**2+ &
+                  6._r8*dcs/lami(k)**3+6._r8/lami(k)**4)*exp(-lami(k)*dcs)
+           else
+              prci(k)=0._r8
+              nprci(k)=0._r8
+           end if
+
+! provisional snow mixing ratio and number concentration (qniic and nsic) 
+! at boundary are estimated via autoconversion
+
+           if (k.eq.kqi(i) .and. it.eq.1) then
+              qniic(i,k)= prci(k)*dz(i,k)*0.25_r8
+              nsic(i,k)= nprci(k)*dz(i,k)*0.25_r8
+              qni(i,k)= 0.0_r8
+              ns(i,k)= 0.0_r8
+           end if
+! if precip mix ratio is zero so should number concentration
+           if (qniic(i,k).lt.qsmall) then
+              qniic(i,k)=0._r8
+              nsic(i,k)=0._r8
+           end if
+           if (qric(i,k).lt.qsmall) then
+              qric(i,k)=0._r8
+              nric(i,k)=0._r8
+           end if
+
+! make sure number concentration is a positive number to avoid 
+! taking root of negative later
+           nric(i,k)=max(nric(i,k),0._r8)
+           nsic(i,k)=max(nsic(i,k),0._r8)
+
+!**********************************************************************
+! get size distribution parameters for precip
+!**********************************************************************
+! rain
+
+           if (qric(i,k).ge.qsmall) then
+             lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8)
+             n0r(k) = nric(i,k)*lamr(k)
+! check for slope
+             lammax = 1._r8/20.e-6_r8
+             lammin = 1._r8/500.e-6_r8
+! adjust vars
+             if (lamr(k).lt.lammin) then
+               lamr(k) = lammin
+               n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+               nric(i,k) = n0r(k)/lamr(k)
+             else if (lamr(k).gt.lammax) then
+               lamr(k) = lammax
+               n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+               nric(i,k) = n0r(k)/lamr(k)
+             end if
+
+! provisional rain number and mass weighted mean fallspeed (m/s)
+! Eq.18 of Morrison and Gettelman, 2008, J. Climate
+             unr(k) = min(arn(i,k)*kf_GAMMA(1._r8+br)/lamr(k)**br,10._r8)
+             umr(k) = min(arn(i,k)*kf_GAMMA(4._r8+br)/(6._r8*lamr(k)**br),10._r8)
+           else
+             lamr(k) = 0._r8
+             n0r(k) = 0._r8
+             umr(k) = 0._r8
+             unr(k) = 0._r8
+           end if
+!......................................................................
+! snow
+           if (qniic(i,k).ge.qsmall) then
+             lams(k) = (kf_GAMMA(1._r8+ds)*cs*nsic(i,k)/ &
+                       qniic(i,k))**(1._r8/ds)
+             n0s(k) = nsic(i,k)*lams(k)
+
+! check for slope
+             lammax = 1._r8/10.e-6_r8
+             lammin = 1._r8/2000.e-6_r8
+! adjust vars
+             if (lams(k).lt.lammin) then
+               lams(k) = lammin
+               n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*kf_GAMMA(1._r8+ds))
+               nsic(i,k) = n0s(k)/lams(k)
+             else if (lams(k).gt.lammax) then
+               lams(k) = lammax
+               n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*kf_GAMMA(1._r8+ds))
+               nsic(i,k) = n0s(k)/lams(k)
+             end if
+
+! provisional snow number and mass weighted mean fallspeed (m/s)
+             ums(k) = min(asn(i,k)*kf_GAMMA(4._r8+bs)/(6._r8*lams(k)**bs),3.6_r8)
+             uns(k) = min(asn(i,k)*kf_GAMMA(1._r8+bs)/lams(k)**bs,3.6_r8)
+           else
+             lams(k) = 0._r8
+             n0s(k) = 0._r8
+             ums(k) = 0._r8
+             uns(k) = 0._r8
+           end if
+
+!.......................................................................
+! snow self-aggregation from passarelli, 1978, used by Reisner(1998,Eq.A.35)
+! this is hard-wired for bs = 0.4 for now
+! ignore self-collection of cloud ice
+
+          if (qniic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8) then
+              nsagg(k) = -1108._r8*asn(i,k)*Eii* &
+                   pi**((1._r8-bs)/3._r8)*rhosn**((-2._r8-bs)/3._r8)*rho(i,k)** &
+                   ((2._r8+bs)/3._r8)*qniic(i,k)**((2._r8+bs)/3._r8)* &
+                   (nsic(i,k)*rho(i,k))**((4._r8-bs)/3._r8)/ &
+                   (4._r8*720._r8*rho(i,k))
+           else
+              nsagg(k)=0._r8
+           end if
+
+!.......................................................................
+! accretion of cloud droplets onto snow/graupel
+! here use continuous collection equation with
+! simple gravitational collection kernel
+! ignore collisions between droplets/cloud ice
+
+! ignore collision of snow with droplets above freezing
+
+           if (qniic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8 .and. &
+              qcic(i,k).ge.qsmall) then
+
+! put in size dependent collection efficiency
+! mean diameter of snow is area-weighted, since
+! accretion is function of crystal geometric area
+! collection efficiency is from stoke's law (Thompson et al. 2004)
+
+              dc0 = (pgam(k)+1._r8)/lamc(k)
+              ds0 = 1._r8/lams(k)
+              dum = dc0*dc0*uns(k)*rhow/(9._r8*mua(i,k)*ds0)
+              eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8))
+              eci = max(eci,0._r8)
+              eci = min(eci,1._r8)
+
+              psacws(k) = pi/4._r8*asn(i,k)*qcic(i,k)*rho(i,k)* &
+                  n0s(k)*Eci*kf_GAMMA(bs+3._r8)/ &
+                  lams(k)**(bs+3._r8)   
+              npsacws(k) = pi/4._r8*asn(i,k)*ncic(i,k)*rho(i,k)* &
+                  n0s(k)*Eci*kf_GAMMA(bs+3._r8)/ &
+                  lams(k)**(bs+3._r8)
+           else
+              psacws(k)=0._r8
+              npsacws(k)=0._r8
+           end if
+
+! secondary ice production due to accretion of droplets by snow 
+! (Hallet-Mossop process) (from Cotton et al., 1986)
+           if((t(i,k).lt.270.16_r8) .and. (t(i,k).ge.268.16_r8)) then
+              ni_secp   = 3.5e8_r8*(270.16_r8-t(i,k))/2.0_r8*psacws(k)
+              nsacwi(k) = ni_secp
+              msacwi(k) = min(ni_secp*mi0,psacws(k))
+           else if((t(i,k).lt.268.16_r8) .and. (t(i,k).ge.265.16_r8)) then
+              ni_secp   = 3.5e8_r8*(t(i,k)-265.16_r8)/3.0_r8*psacws(k)
+              nsacwi(k) = ni_secp
+              msacwi(k) = min(ni_secp*mi0,psacws(k))
+           else
+              ni_secp   = 0.0_r8
+              nsacwi(k) = 0.0_r8
+              msacwi(k) = 0.0_r8
+           endif
+           psacws(k) = max(0.0_r8,psacws(k)-ni_secp*mi0)
+
+!.......................................................................
+! accretion of rain water by snow
+! formula from ikawa and saito, 1991, used by reisner et al., 1998
+
+           if (qric(i,k).ge.1.e-8_r8 .and. qniic(i,k).ge.1.e-8_r8 .and. &
+              t(i,k).le.273.15_r8) then
+
+              pracs(k) = pi*pi*ecr*(((1.2_r8*umr(k)-0.95_r8*ums(k))**2+ &
+                  0.08_r8*ums(k)*umr(k))**0.5_r8*rhow*rho(i,k)* &
+                  n0r(k)*n0s(k)* &
+                  (5._r8/(lamr(k)**6*lams(k))+ &
+                  2._r8/(lamr(k)**5*lams(k)**2)+ &
+                  0.5_r8/(lamr(k)**4*lams(k)**3)))
+
+              npracs(k) = pi/2._r8*rho(i,k)*ecr*(1.7_r8*(unr(k)-uns(k))**2+ &
+                  0.3_r8*unr(k)*uns(k))**0.5_r8*n0r(k)*n0s(k)* &
+                  (1._r8/(lamr(k)**3*lams(k))+ &
+                  1._r8/(lamr(k)**2*lams(k)**2)+ &
+                  1._r8/(lamr(k)*lams(k)**3))
+           else
+              pracs(k)=0._r8
+              npracs(k)=0._r8
+           end if
+
+!.......................................................................
+! heterogeneous freezing of rain drops
+! follows from Bigg (1953)
+
+           if (t(i,k).lt.269.15_r8 .and. qric(i,k).ge.qsmall) then
+
+              mnuccr(k) = 20._r8*pi*pi*rhow*nric(i,k)*bimm* &
+                  exp(aimm*(273.15_r8-t(i,k)))/lamr(k)**3 &
+                  /lamr(k)**3
+
+              nnuccr(k) = pi*nric(i,k)*bimm* &
+                   exp(aimm*(273.15_r8-t(i,k)))/lamr(k)**3
+           else
+              mnuccr(k)=0._r8
+              nnuccr(k)=0._r8
+           end if
+
+!.......................................................................
+! accretion of cloud liquid water by rain
+! formula from Khrouditnov and Kogan (2000)
+! gravitational collection kernel, droplet fall speed neglected
+
+           if (qric(i,k).ge.qsmall .and. qcic(i,k).ge.qsmall) then
+              pra(k) = 67._r8*(qcic(i,k)*qric(i,k))**1.15_r8
+              npra(k) = pra(k)/(qcic(i,k)/ncic(i,k))
+           else
+              pra(k)=0._r8
+              npra(k)=0._r8
+           end if
+
+!.......................................................................
+! Self-collection of rain drops
+! from Beheng(1994)
+
+           if (qric(i,k).ge.qsmall) then
+              nragg(k) = -8._r8*nric(i,k)*qric(i,k)*rho(i,k)
+           else
+              nragg(k)=0._r8
+           end if
+
+!.......................................................................
+! Accretion of cloud ice by snow
+! For this calculation, it is assumed that the Vs >> Vi
+! and Ds >> Di for continuous collection
+
+           if (qniic(i,k).ge.qsmall.and.qiic(i,k).ge.qsmall &
+              .and.t(i,k).le.273.15_r8) then
+              prai(k) = pi/4._r8*asn(i,k)*qiic(i,k)*rho(i,k)* &
+                   n0s(k)*Eii*kf_GAMMA(bs+3._r8)/ &
+                   lams(k)**(bs+3._r8)  
+              nprai(k) = pi/4._r8*asn(i,k)*niic(i,k)* &
+                   rho(i,k)*n0s(k)*Eii*kf_GAMMA(bs+3._r8)/ &
+                   lams(k)**(bs+3._r8)
+           else
+              prai(k)=0._r8
+              nprai(k)=0._r8
+           end if
+
+!.......................................................................
+! fallout term
+        prf(k)  = -umr(k)*qric(i,k)/dz(i,k)
+        pnrf(k) = -unr(k)*nric(i,k)/dz(i,k)
+        psf(k)  = -ums(k)*qniic(i,k)/dz(i,k)
+        pnsf(k) = -uns(k)*nsic(i,k)/dz(i,k)
+
+!........................................................................
+! calculate vertical velocity in cumulus updraft
+
+     if (k.eq.jb(i)) then
+       zkine(i,jb(i)) = 0.5_r8
+       wu   (i,jb(i)) = 1._r8
+       zbuo (i,jb(i)) = (tu(i,jb(i))*(1._r8+retv*qu(i,jb(i)))-    &
+                     th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))/   &
+                     (th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))
+     else
+       if (.true.) then
+!          print *,'before ecmwf qcs=',qc(i,k),qi(i,k),qr(i,k),k
+! ECMWF formula
+  !          print *,'using ecmwrf CKE, retv=',retv
+           zbc = tu(i,k)*(1._r8+retv*qu(i,k)-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k))
+           zbe = th(i,k)*(1._r8+retv*qh(i,k))
+           zbuo(i,k) = (zbc-zbe)/zbe
+           zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8
+           zdkbuo = dz(i,k+1)*grav*zfacbuo*zbuoc
+           zdken = min(.99_r8,(1._r8+cwdrag)*max(du(i,k),eu(i,k))*dz(i,k+1)/ &
+                      max(1.e-10_r8,mu(i,k+1)))
+           zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/      &
+                      (1._r8+zdken)
+!        print *,'zkine=',(zkine(i,k)),dz(i,k),k
+        else
+! Gregory formula
+           write(*,*) "Gregory vertical velocity"
+           zbc = tu(i,k)*(1._r8+retv*qu(i,k))
+           zbe = th(i,k)*(1._r8+retv*qh(i,k))
+           zbuo(i,k) = (zbc-zbe)/zbe-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k)
+           zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8
+           zdkbuo = dz(i,k+1)*grav*zbuoc*(1.0-0.25)/6.
+           zdken = du(i,k)*dz(i,k+1)/max(1.e-10_r8,mu(i,k+1))
+           zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/      &
+                      (1._r8+zdken)
+         end if
+              wu(i,k) = min(15._r8,sqrt(2._r8*max(0.1_r8,zkine(i,k) )))
+!dkay         wu(i,k) = wu_kf_act(k)
+       end if
+!             print *,'wu from cke= & kf',wu(i,k),wu_kf_act(k),k
+!ckay
+       arcf(i,k)= mu(i,k)/wu(i,k)
+
+!............................................................................
+! droplet activation
+! calculate potential for droplet activation if cloud water is present
+! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998),
+! AR98
+
+       naer2h(i,k,:) = 0.5_r8*(naer2(i,k,:) + naer2(i,k+1,:))
+       ntaerh(i,k)   = 0.5_r8*(ntaer(i,k) + ntaer(i,k+1))
+
+!      write(*,*)'naer2h(i,k,:)',naer2h(i,k,:)
+
+       if (qcic(i,k).ge.qsmall.or.cmel(i,k+1).ge.qsmall ) then
+
+!dkay
+! added qsatzm
+!         print *, 'before activate'
+         call kf_activate(wu(i,k),t(i,k),rho(i,k), &
+                 naer2h(i,k,:), naer_cu,naer_cu, maerosol,  &
+                 dispersion_aer,hygro_aer, density_aer, dum2,qsatzm(i,k))
+!             print *,'ccn, massmixing ratio of aerosols='
+!            print *, dum2, maerosol
+         dum2l(i,k) = dum2
+       else
+         dum2l(i,k) = 0._r8
+       end if
+
+! get droplet activation rate
+       if (qcic(i,k).ge.qsmall .and. t(i,k).gt.238.15_r8 .and. k.gt.jt(i)+2) then
+
+! assume aerosols already activated are equal number of existing droplets for
+! simplicity
+         if (k.eq.kqc(i))  then
+              npccn(k) = dum2l(i,k)/deltat
+         else
+              npccn(k) = (dum2l(i,k)-ncic(i,k))/deltat
+         end if
+! make sure number activated > 0
+         npccn(k) = max(0._r8,npccn(k))
+         ncmax = dum2l(i,k)
+       else
+         npccn(k)=0._r8
+         ncmax = 0._r8
+       end if
+
+!..............................................................................
+!ice nucleation
+
+       esi(i,k)= kf_polysvp(t(i,k),1)      ! over ice          
+       es(i,k) = kf_polysvp(t(i,k),0)
+       qs(i,k) = 0.622_r8*es(i,k)/(ph(i,k) - (1.0_r8-0.622_r8)*es(i,k))
+       qs(i,k) = min(1.0_r8,qs(i,k))
+       if (qs(i,k) < 0.0_r8)  qs(i,k) = 1.0_r8
+
+       relhum(i,k)= 1.0_r8
+
+       if (t(i,k).lt.tmelt ) then
+         if (.true.) then
+
+! Liu et al.,J. climate, 2007
+!         print *, 'before ice nuke'
+
+            call kf_nucleati(wu(i,k),t(i,k),relhum(i,k),qcic(i,k),rho(i,k),  &
+!           call kf_nucleati(wu(i,k),t(i,k),relhum(i,k),qcic(i,k),rho(i,k),  &
+!            tot_qc_qi = qc_kf_act(k) + qi_kf_act(k)  ! danger
+!           call kf_nucleati(wu(i,k),t(i,k),relhum(i,k),tot_qc_qi,rho(i,k),  &
+                         naer2h(i,k,:),naer_cu,dum2i(i,k) &
+                        , nihf(i,k),     &
+                        niimm(i,k),nidep(i,k),nimey(i,k))
+
+             nihf(i,k)=nihf(i,k)*rho(i,k)           !  convert from #/kg -> #/m3)
+             niimm(i,k)=niimm(i,k)*rho(i,k)
+             nidep(i,k)=nidep(i,k)*rho(i,k)
+             nimey(i,k)=nimey(i,k)*rho(i,k)
+          else
+
+! cooper curve (factor of 1000 is to convert from L-1 to m-3)
+            dum2i(i,k)=0.005_r8*exp(0.304_r8*(273.15_r8-t(i,k)))*1000._r8
+! put limit on number of nucleated crystals, set to number at T=-30 C
+! cooper (limit to value at -35 C)
+            dum2i(i,k)=min(dum2i(i,k),208.9e3_r8)/rho(i,k) ! convert from m-3 to kg-1
+          endif
+        else
+          dum2i(i,k)=0._r8
+        end if
+!ckay
+!       print *,'nucleated ccn=',dum2i(i,k),k
+
+! ice nucleation if activated nuclei exist at t<0C 
+
+        if (dum2i(i,k).gt.0._r8.and.t(i,k).lt.tmelt.and. &
+           relhum(i,k)*es(i,k)/esi(i,k).gt. 1.05_r8  .and. k.gt.jt(i)+1) then
+
+           if (k.eq.kqi(i)) then
+                nnuccd(k)=dum2i(i,k)/deltat
+           else
+                nnuccd(k)=(dum2i(i,k)-niic(i,k))/deltat
+           end if
+           nnuccd(k)=max(nnuccd(k),0._r8)
+           nimax = dum2i(i,k)
+
+!Calc mass of new particles using new crystal mass...
+!also this will be multiplied by mtime as nnuccd is...
+           mnuccd(k) = nnuccd(k) * mi0
+         else
+           nnuccd(k)=0._r8
+           nimax = 0._r8
+           mnuccd(k) = 0._r8
+         end if
+!................................................................................
+! Bergeron process
+! If 0C< T <-40C and both ice and liquid exist
+
+         if (t(i,k).le.273.15_r8 .and. t(i,k).gt.233.15_r8 .and.  &
+              qiic(i,k).gt.0.5e-6_r8 .and. qcic(i,k).gt. qsmall)  then
+              plevap = qcic(i,k)/bergtsf
+              prb(k) = max(0._r8,plevap)
+              nprb(k) = prb(k)/(qcic(i,k)/ncic(i,k))
+         else
+              prb(k)=0._r8
+              nprb(k)=0._r8
+         end if
+
+!................................................................................
+! heterogeneous freezing of cloud water (-5C < T < -35C)
+
+        if (qcic(i,k).ge.qsmall .and.ncic(i,k).gt.0._r8 .and. ntaerh(i,k).gt.0._r8 .and.  &
+              t(i,k).le.268.15_r8 .and. t(i,k).gt.238.15_r8 ) then
+
+          if (.false.)  then
+! immersion freezing (Diehl and Wurzler, 2004)
+              ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k))
+              naimm = (0.00291_r8*naer2h(i,k,idxbcphi)+32.3_r8*(naer2h(i,k,idxdst1)  &
+                      +naer2h(i,k,idxdst2)+naer2h(i,k,idxdst3)+              &
+                       naer2h(i,k,idxdst4)))/ntaerh(i,k)             !m-3
+              if (ttend(k) .lt. 0._r8) then
+                 nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow   ! kg-1s-1                        
+                 mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k)
+              end if
+          else
+
+
+! immersion freezing (Bigg, 1953)
+              mnuccc(k) = pi*pi/36._r8*rhow* &
+                    cdist1(k)*kf_GAMMA(7._r8+pgam(k))* &
+                    bimm*exp(aimm*(273.15_r8-t(i,k)))/ &
+                    lamc(k)**3/lamc(k)**3
+
+              nnuccc(k) = pi/6._r8*cdist1(k)*kf_GAMMA(pgam(k)+4._r8) &
+                    *bimm*exp(aimm*(273.15_r8-t(i,k)))/lamc(k)**3
+           end if
+
+! contact freezing (Young, 1974) with hooks into simulated dust
+
+           tcnt=(270.16_r8-t(i,k))**1.3_r8
+           viscosity=1.8e-5_r8*(t(i,k)/298.0_r8)**0.85_r8    ! Viscosity (kg/m/s)          
+           mfp=2.0_r8*viscosity/(ph(i,k)  &                  ! Mean free path (m)
+               *sqrt(8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i,k))))
+
+           slip1=1.0_r8+(mfp/rn_dst1)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst1/mfp))))! Slip correction factor
+           slip2=1.0_r8+(mfp/rn_dst2)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst2/mfp))))
+           slip3=1.0_r8+(mfp/rn_dst3)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst3/mfp))))
+           slip4=1.0_r8+(mfp/rn_dst4)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst4/mfp))))
+
+           dfaer1=1.381e-23_r8*t(i,k)*slip1/(6._r8*pi*viscosity*rn_dst1)  !aerosol diffusivity (m2/s)
+           dfaer2=1.381e-23_r8*t(i,k)*slip2/(6._r8*pi*viscosity*rn_dst2)
+           dfaer3=1.381e-23_r8*t(i,k)*slip3/(6._r8*pi*viscosity*rn_dst3)
+           dfaer4=1.381e-23_r8*t(i,k)*slip4/(6._r8*pi*viscosity*rn_dst4)
+
+           nacon1=0.0_r8
+           nacon2=0.0_r8
+           nacon3=0.0_r8
+           nacon4=0.0_r8
+
+
+           if (idxdst1.gt.0) then
+              nacon1=naer2(i,k,idxdst1)*tcnt *0.0_r8
+           endif
+           if (idxdst2.gt.0) then
+              nacon2=naer2(i,k,idxdst2)*tcnt ! 1/m3
+           endif
+           if (idxdst3.gt.0) then
+              nacon3=naer2(i,k,idxdst3)*tcnt
+           endif
+           if (idxdst4.gt.0) then
+              nacon4=naer2(i,k,idxdst4)*tcnt
+           endif
+
+           mnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*pi*pi/3._r8*rhow* &
+                       cdist1(k)*kf_GAMMA(pgam(k)+5._r8)/lamc(k)**4
+
+           nnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*2._r8*pi*  &
+                       cdist1(k)*kf_GAMMA(pgam(k)+2._r8)/lamc(k)
+
+!              if (nnuccc(k).gt.nnuccd(k)) then
+!                 dum=nnuccd(k)/nnuccc(k)
+! scale mixing ratio of droplet freezing with limit
+!                 mnuccc(k)=mnuccc(k)*dum
+!                 nnuccc(k)=nnuccd(k)
+!              end if
+
+           else
+             mnuccc(k) = 0._r8
+             nnuccc(k) = 0._r8
+             mnucct(k) = 0._r8
+             nnucct(k) = 0._r8
+           end if
+
+!****************************************************************************************
+! conservation to ensure no negative values of cloud water/precipitation
+! in case microphysical process rates are large
+! note: for check on conservation, processes are multiplied by omsm
+! to prevent problems due to round off error
+
+! since activation/nucleation processes are fast, need to take into account
+! factor mtime = mixing timescale in cloud / model time step
+! for now mixing timescale is assumed to be 15 min
+!*****************************************************************************************
+
+       mtime=deltat/900._r8
+       mtimec=deltat/900._r8
+
+! conservation of qc
+
+        qce = mu(i,k)*qc(i,k)+dz(i,k)*(cmel(i,k-1)-du(i,k-1)*qc(i,k))
+        dum = arcf(i,k)*(pra(k)+prc(k)+prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+   &
+                         psacws(k)  )*dz(i,k)
+        if( qce.lt.0._r8)  then
+          prc(k) = 0._r8
+          pra(k) = 0._r8
+          prb(k) = 0._r8
+          mnuccc(k) = 0._r8
+          mnucct(k) = 0._r8
+          msacwi(k) = 0._r8
+          psacws(k) = 0._r8
+        else  if (dum.gt.qce) then
+          ratio = qce/dum*omsm
+          prc(k) = prc(k)*ratio
+          pra(k) = pra(k)*ratio
+          prb(k) = prb(k)*ratio
+          mnuccc(k) = mnuccc(k)*ratio
+          mnucct(k) = mnucct(k)*ratio
+          msacwi(k) = msacwi(k)*ratio
+          psacws(k) = psacws(k)*ratio
+        end if
+
+! conservation of nc
+        nce = mu(i,k)*nc(i,k)+(arcf(i,k)*npccn(k)*mtimec-du(i,k-1)*nc(i,k))*dz(i,k)
+        dum = arcf(i,k)*dz(i,k)*(nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ &
+              npsacws(k)+ nprb(k) )
+        if (nce.lt.0._r8) then
+          nprc1(k) = 0._r8
+!          nprc(k) = 0._r8
+          npra(k) = 0._r8
+          nnuccc(k) = 0._r8
+          nnucct(k) = 0._r8
+          npsacws(k) = 0._r8
+          nprb(k) = 0._r8
+        else if (dum.gt.nce) then
+          ratio = nce/dum*omsm
+          nprc1(k) = nprc1(k)*ratio
+          npra(k) = npra(k)*ratio
+          nnuccc(k) = nnuccc(k)*ratio
+          nnucct(k) = nnucct(k)*ratio
+          npsacws(k) = npsacws(k)*ratio
+          nprb(k) = nprb(k)*ratio
+        end if
+
+! conservation of qi
+        qie = mu(i,k)*qi(i,k)+dz(i,k)*(cmei(i,k-1)-du(i,k-1)*qi(i,k)+  &
+                   ( mnuccc(k)+mnucct(k)+msacwi(k)+prb(k))*arcf(i,k) )
+        dum = arcf(i,k)*(prci(k)+ prai(k))*dz(i,k)
+        if (qie.lt.0._r8) then
+          prci(k) = 0._r8
+          prai(k) = 0._r8
+        else if (dum.gt.qie) then
+          ratio = qie/dum*omsm
+          prci(k) = prci(k)*ratio
+          prai(k) = prai(k)*ratio
+        end if
+
+! conservation of ni
+         nie = mu(i,k)*ni(i,k)+dz(i,k)*(nnuccd(k)*mtime*arcf(i,k)-du(i,k-1)*ni(i,k)  &
+                       + nnucct(k)*arcf(i,k) )
+         dum = arcf(i,k)*dz(i,k)*(-nsacwi(k)+nprci(k)+ &
+               nprai(k))
+         if( nie.lt.0._r8) then
+           nsacwi(k)= 0._r8
+           nprci(k) = 0._r8
+           nprai(k) = 0._r8
+         else  if (dum.gt.nie) then
+           ratio = nie/dum*omsm
+           nsacwi(k)= nsacwi(k)*ratio
+           nprci(k) = nprci(k)*ratio
+           nprai(k) = nprai(k)*ratio
+         end if
+
+! conservation of qr
+
+        qre = mu(i,k)*qr(i,k)+dz(i,k)*(pra(k)+prc(k))*arcf(i,k)
+        dum = arcf(i,k)*dz(i,k)*(pracs(k)+ mnuccr(k)-prf(k))
+        if (qre.lt.0._r8) then
+           prf(k) = 0._r8
+           pracs(k) = 0._r8
+           mnuccr(k) = 0._r8
+        else if (dum.gt.qre) then
+           ratio = qre/dum*omsm
+           prf(k) = prf(k)*ratio
+           pracs(k) = pracs(k)*ratio
+           mnuccr(k) = mnuccr(k)*ratio
+        end if
+
+! conservation of nr
+         nre = mu(i,k)*nr(i,k)
+         dum = arcf(i,k)*dz(i,k)*(-nprc(k)+npracs(k)+nnuccr(k) &
+                   -nragg(k)-pnrf(k))
+         if(nre.lt.0._r8) then
+           nprc(k) = 0._r8
+           npracs(k)= 0._r8
+           nnuccr(k)= 0._r8
+           nragg(k) = 0._r8
+           pnrf(k) = 0._r8
+         else if (dum.gt.nre) then
+           ratio = nre/dum*omsm
+           nprc(k) = nprc(k)*ratio
+           npracs(k)= npracs(k)*ratio
+           nnuccr(k)= nnuccr(k)*ratio
+           nragg(k) = nragg(k)*ratio
+           pnrf(k) = pnrf(k)*ratio
+         end if
+
+! conservation of qni
+
+        qnie = mu(i,k)*qni(i,k)+dz(i,k)*( (prai(k)+psacws(k)+prci(k)+     &
+                   pracs(k)+mnuccr(k))*arcf(i,k) )
+        dum = arcf(i,k)*dz(i,k)*(-psf(k))
+
+        if(qnie.lt.0._r8) then
+           psf(k) = 0._r8
+        else if (dum.gt.qnie) then
+           ratio = qnie/dum*omsm
+           psf(k) = psf(k)*ratio
+        end if
+
+! conservation of ns
+        nse = mu(i,k)*ns(i,k)+dz(i,k)*(nprci(k)+nnuccr(k))*arcf(i,k)
+        dum = arcf(i,k)*dz(i,k)*(-nsagg(k)-pnsf(k))
+        if (nse.lt.0._r8) then
+           nsagg(k) = 0._r8
+           pnsf(k) = 0._r8
+        else if (dum.gt.nse) then
+           ratio = nse/dum*omsm
+           nsagg(k) = nsagg(k)*ratio
+           pnsf(k) = pnsf(k)*ratio
+        end if
+
+!*****************************************************************************
+! get tendencies due to microphysical conversion processes
+!*****************************************************************************
+
+      if (k.le.kqc(i))   then
+        qctend(i,k) = qctend(i,k)+  &
+                 (-pra(k)-prc(k)-prb(k)-mnuccc(k)-mnucct(k)-msacwi(k)- &
+                  psacws(k))
+
+!             print *,'qctend components=',qctend(i,k),pra(k),prc(k), &
+!             mnuccc(k)-mnucct(k)-msacwi(k),psacws(k)
+
+        qitend(i,k) = qitend(i,k)+  &
+                  (prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)-prci(k)- &
+                  prai(k)+mnuccd(k)*mtimec) !TWG ice nucleation change
+
+        qrtend(i,k) = qrtend(i,k)+ &
+                 (pra(k)+prc(k))+(-pracs(k)- &
+                  mnuccr(k))
+
+
+        qnitend(i,k) = qnitend(i,k)+ &
+                (prai(k)+psacws(k)+prci(k))+( &
+                   pracs(k)+mnuccr(k))
+
+! multiply activation/nucleation by mtime to account for fast timescale
+
+        nctend(i,k) = nctend(i,k)+ npccn(k)*mtimec+&
+                  (-nnuccc(k)-nnucct(k)-npsacws(k) &
+                  -npra(k)-nprc1(k)-nprb(k))
+
+        nitend(i,k) = nitend(i,k)+ nnuccd(k)*mtime+&
+                  (nnuccc(k)+ nnucct(k)+nsacwi(k)-nprci(k)- &
+                  nprai(k))
+
+        nstend(i,k) = nstend(i,k)+( &
+                  nsagg(k)+nnuccr(k))+nprci(k)
+
+        nrtend(i,k) = nrtend(i,k)+ &
+                  nprc(k)+(-npracs(k)-nnuccr(k) +nragg(k))
+
+! for output
+! cloud liquid water-------------
+        autolm(i,k) = -prc(k)*arcf(i,k)
+        accrlm(i,k) = -pra(k)*arcf(i,k)
+        bergnm(i,k) = -prb(k)*arcf(i,k)
+        fhtimm(i,k) = -mnuccc(k)*arcf(i,k)
+        fhtctm(i,k) = -mnucct(k)*arcf(i,k)
+        hmpim (i,k) = -msacwi(k)*arcf(i,k)
+        accslm(i,k) = -psacws(k)*arcf(i,k)
+        dlfm  (i,k) = -du(i,k)*qc(i,k)
+
+        autoln(i,k) = -nprc1(k)*arcf(i,k)*rho(i,k)
+        accrln(i,k) = -npra(k)*arcf(i,k)*rho(i,k)
+        bergnn(i,k) = -nprb(k)*arcf(i,k)*rho(i,k)
+        fhtimn(i,k) = -nnuccc(k)*arcf(i,k)*rho(i,k)
+        fhtctn(i,k) = -nnucct(k)*arcf(i,k)*rho(i,k)
+        accsln(i,k) = -npsacws(k)*arcf(i,k)*rho(i,k)
+        activn(i,k) = npccn(k)*mtimec*arcf(i,k)*rho(i,k)
+        dlfn  (i,k) = -du(i,k)*nc(i,k)*rho(i,k)
+!cloud ice------------------------        
+        autoim(i,k) = -prci(k)*arcf(i,k)
+        accsim(i,k) = -prai(k)*arcf(i,k)
+        difm  (i,k) = -du(i,k+1)*qi(i,k)
+
+        nuclin(i,k) = nnuccd(k)*mtime*arcf(i,k)*rho(i,k)
+        autoin(i,k) = -nprci(k)*arcf(i,k)*rho(i,k)
+        accsin(i,k) = -nprai(k)*arcf(i,k)*rho(i,k)
+        hmpin (i,k)  = nsacwi(k)*arcf(i,k)*rho(i,k)
+        difn  (i,k) = -du(i,k)*ni(i,k)*rho(i,k)
+      else
+        qctend(i,k) = 0._r8
+        qitend(i,k) = 0._r8
+        qrtend(i,k) = 0._r8
+        qnitend(i,k) = 0._r8
+        nctend(i,k) = 0._r8
+        nitend(i,k) = 0._r8
+        nstend(i,k) = 0._r8
+        nrtend(i,k) = 0._r8
+      end if
+
+!********************************************************************************
+!  vertical integration
+!********************************************************************************
+! snow
+        if ( k.le.kqi(i) ) then
+          qni(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*qni(i,k)+dz(i,k)*(qnitend(i,k)+psf(k))*arcf(i,k) )
+
+          ns(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*ns(i,k)+dz(i,k)*(nstend(i,k)+pnsf(k))*arcf(i,k) )
+
+         else
+           qni(i,k-1)=0._r8
+           ns(i,k-1)=0._r8
+         end if
+
+         if (qni(i,k-1).le.0._r8) then
+          qni(i,k-1)=0._r8
+          ns(i,k-1)=0._r8
+         end if
+
+! rain
+         if (k.le.kqc(i) ) then
+          qr(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*qr(i,k)+dz(i,k)*(qrtend(i,k)+prf(k))*arcf(i,k) )
+
+          nr(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*nr(i,k)+dz(i,k)*(nrtend(i,k)+pnrf(k))*arcf(i,k) )
+
+        else
+          qr(i,k-1)=0._r8
+          nr(i,k-1)=0._r8
+        end if
+
+        if( qr(i,k-1) .le. 0._r8) then
+          qr(i,k-1)=0._r8
+          nr(i,k-1)=0._r8
+        end if
+
+! freeze rain homogeneously at -40 C
+
+         if (t(i,k-1) < 233.15_r8 .and. qr(i,k-1) > 0._r8) then
+
+! make sure freezing rain doesn't increase temperature above threshold
+          dum = xlf/cp*qr(i,k-1)
+          if (t(i,k-1)+dum.gt.233.15_r8) then
+              dum = -(t(i,k-1)-233.15_r8)*cp/xlf
+!bugfix 2012-01-06              dum = dum/(xlf/cp*qr(i,k-1))
+              dum = dum/qr(i,k-1)
+              dum = max(0._r8,dum)
+              dum = min(1._r8,dum)
+          else
+              dum = 1._r8
+          end if
+          qni(i,k-1)=qni(i,k-1)+dum*qr(i,k-1)
+          ns(i,k-1)=ns(i,k-1)+dum*nr(i,k-1)
+          qr(i,k-1)=(1._r8-dum)*qr(i,k-1)
+          nr(i,k-1)=(1._r8-dum)*nr(i,k-1)
+          fhmrm(i,k-1) = -mu(i,k-1)*dum*qr(i,k-1)/dz(i,k)
+        end if
+
+!        if( qr(i,k-1) .le. 0._r8) then
+!          qr(i,k-1)=0._r8
+!          nr(i,k-1)=0._r8
+!        end if  
+
+! cloud water
+         if ( k.le.kqc(i) ) then
+          qc(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*qc(i,k)-dz(i,k)*du(i,k-1)*qc(i,k)             &
+                    +dz(i,k)*qctend(i,k)*arcf(i,k)+dz(i,k)*cmel(i,k-1) )
+
+          nc(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*nc(i,k)-dz(i,k)*du(i,k-1)*nc(i,k)             &
+                    +dz(i,k)*nctend(i,k)*arcf(i,k) )
+
+        else
+          qc(i,k-1)=0._r8
+          nc(i,k-1)=0._r8
+        end if
+
+        qcorg = qc(i,k-1)
+        ncorg = nc(i,k-1)
+        if (qc(i,k-1).le. 0._r8) then
+          qc(i,k-1)=0._r8
+          nc(i,k-1)=0._r8
+        end if
+        qcadj(i,k-1)= (qc(i,k-1)- qcorg)*mu(i,k-1)/dz(i,k)*rho(i,k)
+        ncadj(i,k-1)= (nc(i,k-1)- ncorg)*mu(i,k-1)/dz(i,k)*rho(i,k)
+
+! cloud ice
+         if( k.le.kqi(i)) then
+           qi(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*qi(i,k)-dz(i,k)*du(i,k-1)*qi(i,k)             &
+                    +dz(i,k)*qitend(i,k)*arcf(i,k)+dz(i,k)*cmei(i,k-1) )
+
+           ni(i,k-1) = 1._r8/mu(i,k-1)*                                    &
+                   (mu(i,k)*ni(i,k)-dz(i,k)*du(i,k-1)*ni(i,k)             &
+                    +dz(i,k)*nitend(i,k)*arcf(i,k) )
+
+         else
+          qi(i,k-1)=0._r8
+          ni(i,k-1)=0._r8
+         end if
+
+        qiorg = qi(i,k-1)
+        niorg = ni(i,k-1)
+        if (qi(i,k-1).le. 0._r8) then
+          qi(i,k-1)=0._r8
+          ni(i,k-1)=0._r8
+        end if
+        qiadj(i,k-1)= (qi(i,k-1)- qiorg)*mu(i,k-1)/dz(i,k)*rho(i,k)
+        niadj(i,k-1)= (ni(i,k-1)- niorg)*mu(i,k-1)/dz(i,k)*rho(i,k)
+
+!        trspcm(i,k-1) = (mu(i,k)*qc(i,k) - mu(i,k-1)*qc(i,k-1))/dz(i,k)
+!        trspcn(i,k-1) = (mu(i,k)*nc(i,k) -
+!        mu(i,k-1)*nc(i,k-1))/dz(i,k)*rho(i,k)
+!        trspim(i,k-1) = (mu(i,k)*qi(i,k) - mu(i,k-1)*qi(i,k-1))/dz(i,k)
+!        trspin(i,k-1) = (mu(i,k)*ni(i,k) -
+!        mu(i,k-1)*ni(i,k-1))/dz(i,k)*rho(i,k)
+
+
+! freeze rain homogeneously at -38 C
+         if (t(i,k-1) < 233.15_r8 .and. qc(i,k-1) > 0._r8) then
+! make sure freezing rain doesn't increase temperature above threshold
+          dum = xlf/cp*qc(i,k-1)
+          if (t(i,k-1)+dum.gt.233.15_r8) then
+              dum = -(t(i,k-1)-233.15_r8)*cp/xlf
+!bugfix 2012-01-06      dum = dum/(xlf/cp*qc(i,k-1))
+              dum = dum/qc(i,k-1)
+              dum = max(0._r8,dum)
+              dum = min(1._r8,dum)
+          else
+              dum = 1._r8
+          end if
+          qi(i,k-1)=qi(i,k-1)+dum*qc(i,k-1)
+          ni(i,k-1)=ni(i,k-1)+dum*nc(i,k-1)
+          fhmlm(i,k-1) = -mu(i,k-1)*dum*qc(i,k-1)/dz(i,k)
+          fhmln(i,k-1) = -mu(i,k-1)*dum*nc(i,k-1)/dz(i,k)*rho(i,k)
+          qc(i,k-1)=(1._r8-dum)*qc(i,k-1)
+          nc(i,k-1)=(1._r8-dum)*nc(i,k-1)
+        end if
+
+        frz(i,k-1) = cmei(i,k-1) + arcf(i,k)*(prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+   &
+                     pracs(k)+mnuccr(k)+psacws(k) )-fhmlm(i,k-1)-fhmrm(i,k-1)
+
+!******************************************************************************
+! get size distribution parameters based on in-cloud cloud water/ice
+! these calculations also ensure consistency between number and mixing ratio
+
+! following equation(2,3,4) of Morrison and Gettelman, 2008, J. Climate.
+! Gamma(n)= (n-1)! 
+! lamc <-> lambda for cloud liquid water
+! pgam <-> meu    for cloud liquid water
+! meu=0 for ice,rain and snow         
+!*******************************************************************************
+!songxl 2011-12-31
+
+           niorg = ni(i,k-1)
+
+! cloud ice
+           if (qi(i,k-1).ge.qsmall) then
+! add upper limit to in-cloud number concentration to prevent numerical error
+              ni(i,k-1)=min(ni(i,k-1),qi(i,k-1)*1.e20_r8)
+              lami(k-1) = (gamma(1._r8+di)*ci* &
+                  ni(i,k-1)/qi(i,k-1))**(1._r8/di)
+              n0i(k-1) = ni(i,k-1)*lami(k-1)
+! check for slope
+              lammax = 1._r8/10.e-6_r8
+              lammin = 1._r8/(2._r8*dcs)
+! adjust vars
+              if (lami(k-1).lt.lammin) then
+                lami(k-1) = lammin
+                n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di))
+                ni(i,k-1) = n0i(k-1)/lami(k-1)
+              else if (lami(k-1).gt.lammax) then
+                lami(k-1) = lammax
+                n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di))
+                ni(i,k-1) = n0i(k-1)/lami(k-1)
+              end if
+              effi(i,k-1) = 1.5_r8/lami(k-1)*1.e6_r8
+           else
+              lami(k-1) = 0._r8
+              n0i(k-1) = 0._r8
+              effi(i,k-1) = 0._r8
+           end if
+
+!songxl 2011-12-31-----
+           niadj(i,k-1)= niadj(i,k-1)+(ni(i,k-1)-niorg)*mu(i,k-1)/dz(i,k)*rho(i,k)
+!................................................................................
+!songxl 2011-12-31
+              ncorg = nc(i,k-1)
+
+!cloud water
+           if (qc(i,k-1).ge.qsmall) then
+
+! add upper limit to in-cloud number concentration to prevent numerical error
+              nc(i,k-1)=min(nc(i,k-1),qc(i,k-1)*1.e20_r8)
+
+! get pgam from fit to observations of martin et al. 1994
+
+              pgam(k-1)=0.0005714_r8*(nc(i,k-1)/1.e6_r8/rho(i,k-1))+0.2714_r8
+              pgam(k-1)=1._r8/(pgam(k-1)**2)-1._r8
+              pgam(k-1)=max(pgam(k-1),2._r8)
+              pgam(k-1)=min(pgam(k-1),15._r8)
+! calculate lamc
+
+              lamc(k-1) = (pi/6._r8*rhow*nc(i,k-1)*gamma(pgam(k-1)+4._r8)/ &
+                 (qc(i,k-1)*gamma(pgam(k-1)+1._r8)))**(1._r8/3._r8)
+
+! lammin, 50 micron diameter max mean size
+              lammin = (pgam(k)+1._r8)/50.e-6_r8
+              lammax = (pgam(k-1)+1._r8)/2.e-6_r8
+
+              if (lamc(k-1).lt.lammin) then
+                 lamc(k-1) = lammin
+                 nc(i,k-1) = 6._r8*lamc(k-1)**3*qc(i,k-1)* &
+                      gamma(pgam(k-1)+1._r8)/ &
+                      (pi*rhow*gamma(pgam(k-1)+4._r8))
+              else if (lamc(k-1).gt.lammax) then
+                 lamc(k-1) = lammax
+                 nc(i,k-1) = 6._r8*lamc(k-1)**3*qc(i,k-1)* &
+                       gamma(pgam(k-1)+1._r8)/ &
+                      (pi*rhow*gamma(pgam(k-1)+4._r8))
+              end if
+              effc(i,k-1) = gamma(pgam(k-1)+4._r8)/ &
+                            gamma(pgam(k-1)+3._r8)/lamc(k-1)/2._r8*1.e6_r8
+! parameter to calculate droplet freezing
+
+              cdist1(k-1) = nc(i,k-1)/gamma(pgam(k-1)+1._r8)
+           else
+              lamc(k-1) = 0._r8
+              cdist1(k-1) = 0._r8
+              effc(i,k-1) = 0._r8
+           end if
+
+!songxl 2011-12-31-----
+           ncadj(i,k-1) = ncadj(i,k-1)+ (nc(i,k-1)-ncorg)*mu(i,k-1)/dz(i,k)*rho(i,k)
+
+           trspcm(i,k-1) = (mu(i,k)*qc(i,k) - mu(i,k-1)*qc(i,k-1))/dz(i,k)
+           trspcn(i,k-1) = (mu(i,k)*nc(i,k) - mu(i,k-1)*nc(i,k-1))/dz(i,k)*rho(i,k)
+           trspim(i,k-1) = (mu(i,k)*qi(i,k) - mu(i,k-1)*qi(i,k-1))/dz(i,k)
+           trspin(i,k-1) = (mu(i,k)*ni(i,k) - mu(i,k-1)*ni(i,k-1))/dz(i,k)*rho(i,k)
+
+           if (k-1 .eq. jt(i)+1)  then
+             trspcm(i,k-2) =  mu(i,k-1)*qc(i,k-1)/dz(i,k)
+             trspcn(i,k-2) =  mu(i,k-1)*nc(i,k-1)/dz(i,k)*rho(i,k)
+             trspim(i,k-2) =  mu(i,k-1)*qi(i,k-1)/dz(i,k)
+             trspin(i,k-2) =  mu(i,k-1)*ni(i,k-1)/dz(i,k)*rho(i,k)
+             dlfm  (i,k-2) = -du(i,k-2)*qc(i,k-1)
+             dlfn  (i,k-2) = -du(i,k-2)*nc(i,k-1)*rho(i,k)
+             difm  (i,k-2) = -du(i,k-2)*qi(i,k-1)
+             difn  (i,k-2) = -du(i,k-2)*ni(i,k-1)*rho(i,k)
+           end if
+!.......................................................................
+! get size distribution parameters for precip
+!......................................................................
+! rain
+           if (qr(i,k-1).ge.qsmall) then
+
+             lamr(k-1) = (pi*rhow*nr(i,k-1)/qr(i,k-1))**(1._r8/3._r8)
+             n0r(k-1) = nr(i,k-1)*lamr(k-1)
+! check for slope
+             lammax = 1._r8/20.e-6_r8
+             lammin = 1._r8/500.e-6_r8
+! adjust vars
+             if (lamr(k-1).lt.lammin) then
+               lamr(k-1) = lammin
+               n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow)
+               nr(i,k-1) = n0r(k-1)/lamr(k-1)
+             else if (lamr(k-1).gt.lammax) then
+               lamr(k-1) = lammax
+               n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow)
+               nr(i,k-1) = n0r(k-1)/lamr(k-1)
+             end if
+           else
+             lamr(k-1) = 0._r8
+             n0r(k-1) = 0._r8
+           end if
+!......................................................................
+! snow
+           if (qni(i,k-1).ge.qsmall) then
+             lams(k-1) = (gamma(1._r8+ds)*cs*ns(i,k-1)/ &
+                       qni(i,k-1))**(1._r8/ds)
+             n0s(k-1) = ns(i,k-1)*lams(k-1)
+
+! check for slope
+             lammax = 1._r8/10.e-6_r8
+             lammin = 1._r8/2000.e-6_r8
+! adjust vars
+             if (lams(k-1).lt.lammin) then
+               lams(k-1) = lammin
+               n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds))
+               ns(i,k-1) = n0s(k-1)/lams(k-1)
+             else if (lams(k-1).gt.lammax) then
+               lams(k-1) = lammax
+               n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds))
+               ns(i,k-1) = n0s(k-1)/lams(k-1)
+             end if
+             effs(i,k-1) = 1.5_r8/lams(k-1)*1.e6_r8
+           else
+             lams(k-1) = 0._r8
+             n0s(k-1) = 0._r8
+             effs(i,k-1) = 0._r8
+           end if
+
+!dkay : since KF treats rain and snow separately, no need to add snow to the
+!rprd (kg/kg/m)
+!dkay        rprd(i,k-1)= (qnitend(i,k) + qrtend(i,k))*arcf(i,k)    ! original
+!line  danger
+        rprd(i,k-1)=  qrtend(i,k)  *arcf(i,k)
+        sprd(i,k-1)=  qnitend(i,k) *arcf(i,k)
+
+!dkay
+!dkay       print *,'k,rprd,qrtend,qcic
+!=',k,rprd(i,k-1),qrtend(i,k-1),qcic(i,k-1)
+!dkay 
+     end if  ! k<jlcl
+
+! if rain/snow mix ratio is zero so should number concentration
+
+         if (qni(i,k-1).lt.qsmall) then
+           qni(i,k-1)=0._r8
+           ns(i,k-1)=0._r8
+         end if
+
+         if (qr(i,k-1).lt.qsmall) then
+           qr(i,k-1)=0._r8
+           nr(i,k-1)=0._r8
+         end if
+         if (qi(i,k-1).lt.qsmall) then
+           qi(i,k-1)=0._r8
+           ni(i,k-1)=0._r8
+         end if
+
+         if (qc(i,k-1).lt.qsmall) then
+           qc(i,k-1)=0._r8
+           nc(i,k-1)=0._r8
+         end if
+
+! make sure number concentration is a positive number to avoid 
+! taking root of negative
+
+         nr(i,k-1)=max(nr(i,k-1),0._r8)
+         ns(i,k-1)=max(ns(i,k-1),0._r8)
+         ni(i,k-1)=max(ni(i,k-1),0._r8)
+         nc(i,k-1)=max(nc(i,k-1),0._r8)
+!!......................................................................
+!dkay
+        frz(i,k) = amin1(1.E-07, frz(i,k))  ! constrain frz 
+       end do ! k loop
+!dkay          print *,'jb, jt=',jb(i), jt(i)
+       end do ! it loop, iteration
+300    continue  ! continue if no cloud water
+       end do ! i loop
+!........................................................................
+
+!        deallocate( &
+!         naermod,  &
+!         naer2,    &
+!         naer2h,    &
+!         maerosol)
+
+!        deallocate( &
+!         naermod,  &
+!         naer2,    &
+!         naer2h,    &
+!         maerosol)
+
+!dkay get the TRPPT here
+      do k=jt(1),jb(1)
+      a1kay = rprd(1,k)*zf(1,k)*zmVMFLCL
+       a2kay = sprd(1,k)*zf(1,k)*zmVMFLCL
+       zmTRPPT = zmTRPPT + a1kay + a2kay
+!            print *,'a1kay,a2kay,zmTrppt=',a1kay,a2kay,zmTRPPT
+!            print *,'rprd,zf,zmVMFLCL=',rprd(1,k),zf(1,k),zmVMFLCL
+      end do
+        if (zmTRPPT.ge.1.0) then
+!            print *,'jt, jb,zmTrppt=',jt(1),jb(1),zmTRPPT
+         end if
+
+return
+end subroutine zm_mphy
+
+!##############################################################################
+
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      FUNCTION kf_GAMMA(X)
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+!D    DOUBLE PRECISION FUNCTION DGAMMA(X)
+!----------------------------------------------------------------------
+!
+! THIS ROUTINE CALCULATES THE GAMMA FUNCTION FOR A REAL ARGUMENT X.
+!   COMPUTATION IS BASED ON AN ALGORITHM OUTLINED IN REFERENCE 1.
+!   THE PROGRAM USES RATIONAL FUNCTIONS THAT APPROXIMATE THE GAMMA
+!   FUNCTION TO AT LEAST 20 SIGNIFICANT DECIMAL DIGITS.  COEFFICIENTS
+!   FOR THE APPROXIMATION OVER THE INTERVAL (1,2) ARE UNPUBLISHED.
+!   THOSE FOR THE APPROXIMATION FOR X .GE. 12 ARE FROM REFERENCE 2.
+!   THE ACCURACY ACHIEVED DEPENDS ON THE ARITHMETIC SYSTEM, THE
+!   COMPILER, THE INTRINSIC FUNCTIONS, AND PROPER SELECTION OF THE
+!   MACHINE-DEPENDENT CONSTANTS.
+!
+!
+!*******************************************************************
+!*******************************************************************
+!
+! EXPLANATION OF MACHINE-DEPENDENT CONSTANTS
+!
+! BETA   - RADIX FOR THE FLOATING-POINT REPRESENTATION
+! MAXEXP - THE SMALLEST POSITIVE POWER OF BETA THAT OVERFLOWS
+! XBIG   - THE LARGEST ARGUMENT FOR WHICH GAMMA(X) IS REPRESENTABLE
+!          IN THE MACHINE, I.E., THE SOLUTION TO THE EQUATION
+!                  GAMMA(XBIG) = BETA**MAXEXP
+! XINF   - THE LARGEST MACHINE REPRESENTABLE FLOATING-POINT NUMBER;
+!          APPROXIMATELY BETA**MAXEXP
+! EPS    - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT
+!          1.0+EPS .GT. 1.0
+! XMININ - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT
+!          1/XMININ IS MACHINE REPRESENTABLE
+!
+!     APPROXIMATE VALUES FOR SOME IMPORTANT MACHINES ARE:
+!
+!                            BETA       MAXEXP        XBIG
+!
+! CRAY-1         (S.P.)        2         8191        966.961
+! CYBER 180/855
+!   UNDER NOS    (S.P.)        2         1070        177.803
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (S.P.)        2          128        35.040
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (D.P.)        2         1024        171.624
+! IBM 3033       (D.P.)       16           63        57.574
+! VAX D-FORMAT   (D.P.)        2          127        34.844
+! VAX G-FORMAT   (D.P.)        2         1023        171.489
+!
+!                            XINF         EPS        XMININ
+!
+! CRAY-1         (S.P.)   5.45E+2465   7.11E-15    1.84E-2466
+! CYBER 180/855
+!   UNDER NOS    (S.P.)   1.26E+322    3.55E-15    3.14E-294
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (S.P.)   3.40E+38     1.19E-7     1.18E-38
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (D.P.)   1.79D+308    2.22D-16    2.23D-308
+! IBM 3033       (D.P.)   7.23D+75     2.22D-16    1.39D-76
+! VAX D-FORMAT   (D.P.)   1.70D+38     1.39D-17    5.88D-39
+! VAX G-FORMAT   (D.P.)   8.98D+307    1.11D-16    1.12D-308
+!
+!*******************************************************************
+!*******************************************************************
+!
+! ERROR RETURNS
+!
+!  THE PROGRAM RETURNS THE VALUE XINF FOR SINGULARITIES OR
+!     WHEN OVERFLOW WOULD OCCUR.  THE COMPUTATION IS BELIEVED
+!     TO BE FREE OF UNDERFLOW AND OVERFLOW.
+!
+!
+!  INTRINSIC FUNCTIONS REQUIRED ARE:
+!
+!     INT, DBLE, EXP, LOG, REAL, SIN
+!
+!
+! REFERENCES:  AN OVERVIEW OF SOFTWARE DEVELOPMENT FOR SPECIAL
+!              FUNCTIONS   W. J. CODY, LECTURE NOTES IN MATHEMATICS,
+!              506, NUMERICAL ANALYSIS DUNDEE, 1975, G. A. WATSON
+!              (ED.), SPRINGER VERLAG, BERLIN, 1976.
+!
+!              COMPUTER APPROXIMATIONS, HART, ET. AL., WILEY AND
+!              SONS, NEW YORK, 1968.
+!
+!  LATEST MODIFICATION: OCTOBER 12, 1989
+!
+!  AUTHORS: W. J. CODY AND L. STOLTZ
+!           APPLIED MATHEMATICS DIVISION
+!           ARGONNE NATIONAL LABORATORY
+!           ARGONNE, IL 60439
+!
+!----------------------------------------------------------------------
+      INTEGER I,N
+      LOGICAL PARITY
+
+      real(r8) kf_GAMMA
+      REAL(r8) &
+!D    DOUBLE PRECISION
+         C,CONV,EPS,FACT,HALF,ONE,P,PI,Q,RES,SQRTPI,SUM,TWELVE, &
+         TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO
+      DIMENSION C(7),P(8),Q(8)
+!----------------------------------------------------------------------
+!  MATHEMATICAL CONSTANTS
+!----------------------------------------------------------------------
+      DATA ONE,HALF,TWELVE,TWO,ZERO/1.0E0_r8,0.5E0_r8,12.0E0_r8,2.0E0_r8,0.0E0_r8/, &
+          SQRTPI/0.9189385332046727417803297E0_r8/, &
+          PI/3.1415926535897932384626434E0_r8/
+!D    DATA ONE,HALF,TWELVE,TWO,ZERO/1.0D0,0.5D0,12.0D0,2.0D0,0.0D0/,
+!D   1     SQRTPI/0.9189385332046727417803297D0/,
+!D   2     PI/3.1415926535897932384626434D0/
+!----------------------------------------------------------------------
+!  MACHINE DEPENDENT PARAMETERS
+!----------------------------------------------------------------------
+      DATA XBIG,XMININ,EPS/35.040E0_r8,1.18E-38_r8,1.19E-7_r8/, &
+          XINF/3.4E38_r8/
+!D    DATA XBIG,XMININ,EPS/171.624D0,2.23D-308,2.22D-16/,
+!D   1     XINF/1.79D308/
+!----------------------------------------------------------------------
+!  NUMERATOR AND DENOMINATOR COEFFICIENTS FOR RATIONAL MINIMAX
+!     APPROXIMATION OVER (1,2).
+!----------------------------------------------------------------------
+      DATA P/-1.71618513886549492533811E+0_r8,2.47656508055759199108314E+1_r8,&
+            -3.79804256470945635097577E+2_r8,6.29331155312818442661052E+2_r8,&
+            8.66966202790413211295064E+2_r8,-3.14512729688483675254357E+4_r8,&
+            -3.61444134186911729807069E+4_r8,6.64561438202405440627855E+4_r8/
+      DATA Q/-3.08402300119738975254353E+1_r8,3.15350626979604161529144E+2_r8,&
+           -1.01515636749021914166146E+3_r8,-3.10777167157231109440444E+3_r8,&
+             2.25381184209801510330112E+4_r8,4.75584627752788110767815E+3_r8,&
+           -1.34659959864969306392456E+5_r8,-1.15132259675553483497211E+5_r8/
+!D    DATA P/-1.71618513886549492533811D+0,2.47656508055759199108314D+1,
+!D   1       -3.79804256470945635097577D+2,6.29331155312818442661052D+2,
+!D   2       8.66966202790413211295064D+2,-3.14512729688483675254357D+4,
+!D   3       -3.61444134186911729807069D+4,6.64561438202405440627855D+4/
+!D    DATA Q/-3.08402300119738975254353D+1,3.15350626979604161529144D+2,
+!D   1      -1.01515636749021914166146D+3,-3.10777167157231109440444D+3,
+!D   2        2.25381184209801510330112D+4,4.75584627752788110767815D+3,
+!D   3      -1.34659959864969306392456D+5,-1.15132259675553483497211D+5/
+!----------------------------------------------------------------------
+!  COEFFICIENTS FOR MINIMAX APPROXIMATION OVER (12, INF).
+!----------------------------------------------------------------------
+      DATA C/-1.910444077728E-03_r8,8.4171387781295E-04_r8, &
+          -5.952379913043012E-04_r8,7.93650793500350248E-04_r8,&
+          -2.777777777777681622553E-03_r8,8.333333333333333331554247E-02_r8,&
+           5.7083835261E-03_r8/
+!D    DATA C/-1.910444077728D-03,8.4171387781295D-04,
+!D   1     -5.952379913043012D-04,7.93650793500350248D-04,
+!D   2     -2.777777777777681622553D-03,8.333333333333333331554247D-02,
+!D   3      5.7083835261D-03/
+!----------------------------------------------------------------------
+!  STATEMENT FUNCTIONS FOR CONVERSION BETWEEN INTEGER AND FLOAT
+!----------------------------------------------------------------------
+      CONV(I) = REAL(I,r8)
+!D    CONV(I) = DBLE(I)
+      PARITY=.FALSE.
+      FACT=ONE
+      N=0
+      Y=X
+      IF(Y.LE.ZERO)THEN
+!----------------------------------------------------------------------
+!  ARGUMENT IS NEGATIVE
+!----------------------------------------------------------------------
+        Y=-X
+        Y1=AINT(Y)
+        RES=Y-Y1
+        IF(RES.NE.ZERO)THEN
+          IF(Y1.NE.AINT(Y1*HALF)*TWO)PARITY=.TRUE.
+          FACT=-PI/SIN(PI*RES)
+          Y=Y+ONE
+        ELSE
+          RES=XINF
+          GOTO 900
+        ENDIF
+      ENDIF
+!----------------------------------------------------------------------
+!  ARGUMENT IS POSITIVE
+!----------------------------------------------------------------------
+      IF(Y.LT.EPS)THEN
+!----------------------------------------------------------------------
+!  ARGUMENT .LT. EPS
+!----------------------------------------------------------------------
+        IF(Y.GE.XMININ)THEN
+          RES=ONE/Y
+        ELSE
+          RES=XINF
+          GOTO 900
+        ENDIF
+      ELSEIF(Y.LT.TWELVE)THEN
+        Y1=Y
+        IF(Y.LT.ONE)THEN
+!----------------------------------------------------------------------
+!  0.0 .LT. ARGUMENT .LT. 1.0
+!----------------------------------------------------------------------
+          Z=Y
+          Y=Y+ONE
+        ELSE
+!----------------------------------------------------------------------
+!  1.0 .LT. ARGUMENT .LT. 12.0, REDUCE ARGUMENT IF NECESSARY
+!----------------------------------------------------------------------
+          N=INT(Y)-1
+          Y=Y-CONV(N)
+          Z=Y-ONE
+        ENDIF
+!----------------------------------------------------------------------
+!  EVALUATE APPROXIMATION FOR 1.0 .LT. ARGUMENT .LT. 2.0
+!----------------------------------------------------------------------
+        XNUM=ZERO
+        XDEN=ONE
+        DO 260 I=1,8
+          XNUM=(XNUM+P(I))*Z
+          XDEN=XDEN*Z+Q(I)
+  260   CONTINUE
+        RES=XNUM/XDEN+ONE
+        IF(Y1.LT.Y)THEN
+!----------------------------------------------------------------------
+!  ADJUST RESULT FOR CASE  0.0 .LT. ARGUMENT .LT. 1.0
+!----------------------------------------------------------------------
+          RES=RES/Y1
+        ELSEIF(Y1.GT.Y)THEN
+!----------------------------------------------------------------------
+!  ADJUST RESULT FOR CASE  2.0 .LT. ARGUMENT .LT. 12.0
+!----------------------------------------------------------------------
+          DO 290 I=1,N
+            RES=RES*Y
+            Y=Y+ONE
+  290     CONTINUE
+        ENDIF
+      ELSE
+!----------------------------------------------------------------------
+!  EVALUATE FOR ARGUMENT .GE. 12.0,
+!----------------------------------------------------------------------
+       IF(Y.LE.XBIG)THEN
+          YSQ=Y*Y
+          SUM=C(7)
+          DO 350 I=1,6
+            SUM=SUM/YSQ+C(I)
+  350     CONTINUE
+          SUM=SUM/Y-Y+SQRTPI
+          SUM=SUM+(Y-HALF)*LOG(Y)
+          RES=EXP(SUM)
+        ELSE
+          RES=XINF
+          GOTO 900
+        ENDIF
+      ENDIF
+!----------------------------------------------------------------------
+!  FINAL ADJUSTMENTS AND RETURN
+!----------------------------------------------------------------------
+      IF(PARITY)RES=-RES
+      IF(FACT.NE.ONE)RES=FACT/RES
+  900 kf_GAMMA=RES
+!D900 DGAMMA = RES
+      RETURN
+! ---------- LAST LINE OF kf_GAMMA ----------
+      END function kf_GAMMA
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! error function in single precision
+!
+!    Copyright(C) 1996 Takuya OOURA (email: ooura@mmm.t.u-tokyo.ac.jp).
+!    You may use, copy, modify this code for any purpose and
+!    without fee. You may distribute this ORIGINAL package.
+
+      function derf(x)
+      implicit real (a - h, o - z)
+      real(r8) a,b,x
+      dimension a(0 : 64), b(0 : 64)
+      integer i,k
+      data (a(i), i = 0, 12) / &
+         0.00000000005958930743d0, -0.00000000113739022964d0, &
+         0.00000001466005199839d0, -0.00000016350354461960d0, &
+         0.00000164610044809620d0, -0.00001492559551950604d0, &
+         0.00012055331122299265d0, -0.00085483269811296660d0, &
+         0.00522397762482322257d0, -0.02686617064507733420d0, &
+         0.11283791670954881569d0, -0.37612638903183748117d0, &
+         1.12837916709551257377d0 /
+      data (a(i), i = 13, 25) / &
+         0.00000000002372510631d0, -0.00000000045493253732d0, &
+         0.00000000590362766598d0, -0.00000006642090827576d0, &
+         0.00000067595634268133d0, -0.00000621188515924000d0, &
+         0.00005103883009709690d0, -0.00037015410692956173d0, &
+         0.00233307631218880978d0, -0.01254988477182192210d0, &
+         0.05657061146827041994d0, -0.21379664776456006580d0, &
+         0.84270079294971486929d0 /
+      data (a(i), i = 26, 38) / &
+         0.00000000000949905026d0, -0.00000000018310229805d0, &
+         0.00000000239463074000d0, -0.00000002721444369609d0, &
+         0.00000028045522331686d0, -0.00000261830022482897d0, &
+         0.00002195455056768781d0, -0.00016358986921372656d0, &
+         0.00107052153564110318d0, -0.00608284718113590151d0, &
+         0.02986978465246258244d0, -0.13055593046562267625d0, &
+         0.67493323603965504676d0 /
+      data (a(i), i = 39, 51) / &
+         0.00000000000382722073d0, -0.00000000007421598602d0, &
+         0.00000000097930574080d0, -0.00000001126008898854d0, &
+         0.00000011775134830784d0, -0.00000111992758382650d0, &
+         0.00000962023443095201d0, -0.00007404402135070773d0, &
+         0.00050689993654144881d0, -0.00307553051439272889d0, &
+         0.01668977892553165586d0, -0.08548534594781312114d0, &
+         0.56909076642393639985d0 /
+      data (a(i), i = 52, 64) / &
+         0.00000000000155296588d0, -0.00000000003032205868d0, &
+         0.00000000040424830707d0, -0.00000000471135111493d0, &
+         0.00000005011915876293d0, -0.00000048722516178974d0, &
+         0.00000430683284629395d0, -0.00003445026145385764d0, &
+         0.00024879276133931664d0, -0.00162940941748079288d0, &
+         0.00988786373932350462d0, -0.05962426839442303805d0, &
+         0.49766113250947636708d0 /
+     data (b(i), i = 0, 12) / &
+         -0.00000000029734388465d0, 0.00000000269776334046d0, &
+         -0.00000000640788827665d0, -0.00000001667820132100d0, &
+         -0.00000021854388148686d0, 0.00000266246030457984d0, &
+         0.00001612722157047886d0, -0.00025616361025506629d0, &
+         0.00015380842432375365d0, 0.00815533022524927908d0, &
+         -0.01402283663896319337d0, -0.19746892495383021487d0,&
+         0.71511720328842845913d0 /
+      data (b(i), i = 13, 25) / &
+         -0.00000000001951073787d0, -0.00000000032302692214d0, &
+         0.00000000522461866919d0, 0.00000000342940918551d0, &
+         -0.00000035772874310272d0, 0.00000019999935792654d0, &
+         0.00002687044575042908d0, -0.00011843240273775776d0, &
+         -0.00080991728956032271d0, 0.00661062970502241174d0, &
+         0.00909530922354827295d0, -0.20160072778491013140d0, &
+         0.51169696718727644908d0 /
+      data (b(i), i = 26, 38) / &
+         0.00000000003147682272d0, -0.00000000048465972408d0, &
+         0.00000000063675740242d0, 0.00000003377623323271d0, &
+         -0.00000015451139637086d0, -0.00000203340624738438d0,&
+         0.00001947204525295057d0, 0.00002854147231653228d0, &
+         -0.00101565063152200272d0, 0.00271187003520095655d0, &
+         0.02328095035422810727d0, -0.16725021123116877197d0, &
+         0.32490054966649436974d0 /
+      data (b(i), i = 39, 51) / &
+         0.00000000002319363370d0, -0.00000000006303206648d0, &
+         -0.00000000264888267434d0, 0.00000002050708040581d0, &
+         0.00000011371857327578d0, -0.00000211211337219663d0, &
+         0.00000368797328322935d0, 0.00009823686253424796d0, &
+         -0.00065860243990455368d0, -0.00075285814895230877d0,&
+         0.02585434424202960464d0, -0.11637092784486193258d0, &
+         0.18267336775296612024d0 /
+      data (b(i), i = 52, 64) / &
+         -0.00000000000367789363d0, 0.00000000020876046746d0, &
+         -0.00000000193319027226d0, -0.00000000435953392472d0, &
+         0.00000018006992266137d0, -0.00000078441223763969d0, &
+         -0.00000675407647949153d0, 0.00008428418334440096d0, &
+         -0.00017604388937031815d0, -0.00239729611435071610d0, &
+         0.02064129023876022970d0, -0.06905562880005864105d0, &
+         0.09084526782065478489d0 /
+      w = abs(x)
+      if (w .lt. 2.2d0) then
+          t = w * w
+          k = int(t)
+          t = t - k
+          k = k * 13
+          y = ((((((((((((a(k) * t + a(k + 1)) * t + &
+             a(k + 2)) * t + a(k + 3)) * t + a(k + 4)) * t + &
+             a(k + 5)) * t + a(k + 6)) * t + a(k + 7)) * t + &
+             a(k + 8)) * t + a(k + 9)) * t + a(k + 10)) * t + &
+             a(k + 11)) * t + a(k + 12)) * w
+      else if (w .lt. 6.9d0) then
+          k = int(w)
+          t = w - k
+          k = 13 * (k - 2)
+          y = (((((((((((b(k) * t + b(k + 1)) * t + &
+             b(k + 2)) * t + b(k + 3)) * t + b(k + 4)) * t + &
+             b(k + 5)) * t + b(k + 6)) * t + b(k + 7)) * t + &
+             b(k + 8)) * t + b(k + 9)) * t + b(k + 10)) * t + &
+             b(k + 11)) * t + b(k + 12)
+          y = y * y
+          y = y * y
+          y = y * y
+          y = 1 - y * y
+      else
+          y = 1
+      end if
+      if (x .lt. 0) y = -y
+      derf = y
+      end function derf
+
+!-----------------------------------------------------------------------
+        real function erfc_num_recipes( x )
+!
+!   from press et al, numerical recipes, 1990, page 164
+!
+        implicit none
+        real x
+        double precision erfc_dbl, dum, t, zz
+
+        zz = abs(x)
+        t = 1.0/(1.0 + 0.5*zz)
+
+!       erfc_num_recipes =
+!     &   t*exp( -zz*zz - 1.26551223 + t*(1.00002368 + t*(0.37409196 +
+!     &   t*(0.09678418 + t*(-0.18628806 + t*(0.27886807 +
+!     &                                    t*(-1.13520398 +
+!     &   t*(1.48851587 + t*(-0.82215223 + t*0.17087277 )))))))))
+
+        dum =  ( -zz*zz - 1.26551223 + t*(1.00002368 + t*(0.37409196 +   &
+          t*(0.09678418 + t*(-0.18628806 + t*(0.27886807 +   &
+                                           t*(-1.13520398 +   &
+          t*(1.48851587 + t*(-0.82215223 + t*0.17087277 )))))))))
+
+        erfc_dbl = t * exp(dum)
+        if (x .lt. 0.0) erfc_dbl = 2.0d0 - erfc_dbl
+
+        erfc_num_recipes = erfc_dbl
+
+        return
+        end function erfc_num_recipes
+
+!-----------------------------------------------------------------------
+    real function erf_alt( x )
+
+    implicit none
+
+    real,intent(in) :: x
+
+    erf_alt = 1. - erfc_num_recipes(x)
+
+    end function erf_alt
+      subroutine kf_activate(wbar, tair, rhoair,  &
+                 na, pmode, nmode, ma, sigman, hygro, rhodry, nact,qs)
+!      calculates number, surface, and mass fraction of aerosols activated as
+!      CCN
+!      calculates flux of cloud droplets, surface area, and aerosol mass into
+!      cloud
+!      assumes an internal mixture within each of up to pmode multiple aerosol
+!      modes
+!      a gaussiam spectrum of updrafts can be treated.
+
+!      mks units
+
+!      Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+!      2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+!      use physconst, only: rair, epsilo, cpair, rh2o, latvap, gravit,   &
+!                                 rhoh2o, mwh2o, r_universal
+!ckay      use wv_saturation, only: estblf, epsqs
+
+      implicit none
+
+       save  ! sep6
+
+!      input
+
+      integer pmode,ptype ! dimension of modes, types in modes
+      real(r8) wbar          ! grid cell mean vertical velocity (m/s)
+      real(r8) tair          ! air temperature (K)
+      real(r8) rhoair        ! air density (kg/m3)
+      real(r8) na(pmode)           ! aerosol number concentration (/m3)
+      integer nmode      ! number of aerosol modes
+      real(r8) ma(pmode)     ! aerosol mass concentration (kg/m3)
+      real(r8) rhodry(pmode) ! density of aerosol material
+      real(r8) sigman(pmode)  ! geometric standard deviation of aerosol size distribution
+      real(r8) hygro(pmode)  ! hygroscopicity of aerosol mode
+
+
+!      output
+
+      real(r8) nact      ! number fraction of aerosols activated
+
+!      local
+#if (defined AIX)
+#define ERF erf
+#define ERFC erfc
+#else
+#define ERF derf
+#define ERFC derfc
+#define ERF_ALT erf_alt
+      real(r8) derf,derfc, erf_alt
+#endif
+
+      integer, parameter:: nx=200
+      integer :: maxmodes
+
+      real(r8) surften       ! surface tension of water w/respect to air (N/m)
+      data surften/0.076/
+      save surften
+      real(r8) p0     ! reference pressure (Pa)
+      data p0/1013.25e2/
+      save p0
+
+      real(r8) :: volc(naer_cu) ! total aerosol volume  concentration (m3/m3)
+      real(r8) tmass ! total aerosol mass concentration (g/cm3)
+      real(r8) rm ! number mode radius of aerosol at max supersat (cm)
+      real(r8) pres ! pressure (Pa)
+      real(r8) path ! mean free path (m)
+      real(r8) diff ! diffusivity (m2/s)
+      real(r8) conduct ! thermal conductivity (Joule/m/sec/deg)
+      real(r8) diff0,conduct0
+      real(r8) qs ! water vapor saturation mixing ratio
+      real(r8) dqsdt ! change in qs with temperature
+      real(r8) dqsdp ! change in qs with pressure
+      real(r8) gloc ! thermodynamic function (m2/s)
+      real(r8) zeta
+      real(r8) :: eta(naer_cu)
+      real(r8) :: smc(naer_cu)
+      real(r8) lnsmax ! ln(smax)
+      real(r8) alpha
+      real(r8) gammaloc
+      real(r8) beta
+      real(r8) sqrtg
+      real(r8) alogam
+      real(r8) rlo,rhi,xint1,xint2,xint3,xint4
+      real(r8) w,wnuc,wb
+      real(r8) alw,sqrtalw
+      real(r8) smax
+      real(r8) x,arg
+      real(r8) xmincoeff,xcut,volcut,surfcut
+      real(r8) z,z1,z2,wf1,wf2,zf1,zf2,gf1,gf2,gf
+      real(r8) :: etafactor1,etafactor2max
+      real(r8) :: etafactor2(naer_cu)
+      real(r8) es
+      integer m,n
+
+      real(r8) :: amcubeloc(naer_cu)
+      real(r8) :: lnsmloc(naer_cu)
+      maxmodes = naer_cu
+
+      if(maxmodes<pmode)then
+!         write(*,*)'maxmodes,pmode in activate =',maxmodes,pmode
+!         call endrun('kf_activate')
+      endif
+
+      nact=0._r8
+
+      if(nmode.eq.1.and.na(1).lt.1.e-20)return
+
+      if(wbar.le.0.)return
+
+      pres=rair*rhoair*tair
+      diff0=0.211e-4*(p0/pres)*(tair/t0)**1.94
+      conduct0=(5.69+0.017*(tair-t0))*4.186e2*1.e-5 ! convert to J/m/s/deg
+!ckay      es = estblf(tair)
+!ckay      qs = epsilo*es/(pres-(1.0_r8 - epsqs)*es)
+!        print *,'rh2o=',rh2o
+      dqsdt=latvap/(rh2o*tair*tair)*qs
+      alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1./(rair*tair))
+      gammaloc=(1+latvap/cpair*dqsdt)/(rhoair*qs)
+!     growth coefficent Abdul-Razzak & Ghan 1998 eqn 16
+!     should depend on mean radius of mode to account for gas kinetic effects
+      gloc=1./(rhoh2o/(diff0*rhoair*qs)                                    &
+          +latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair)-1.))
+      sqrtg=sqrt(gloc)
+      beta=4.*pi*rhoh2o*gloc*gammaloc
+      etafactor2max=1.e10/(alpha*wbar)**1.5 ! this should make eta big if na is very small.
+
+      do m=1,nmode
+!         internal mixture of aerosols
+          volc(m)=ma(m)/(rhodry(m)) ! only if variable size dist
+         if(volc(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then
+            etafactor2(m)=1./(na(m)*beta*sqrtg)  !fixed or variable size dist
+!            number mode radius (m)
+            amcubeloc(m)=(3.*volc(m)/(4.*pi*exp45logsig(m)*na(m)))  ! only if variable size dist
+            smc(m)=smcrit(m) ! only for prescribed size dist
+
+!danger ??
+!May30,2014
+                 if(hygro(m).gt.1.e-10)then   ! loop only if variable size dist
+                    smc(m)=2.*aten*sqrt(aten/(27.*hygro(m)*amcubeloc(m)))
+                 else
+                   smc(m)=100.
+                 endif
+         else
+            smc(m)=1.
+            etafactor2(m)=etafactor2max ! this should make eta big if na is very small.
+         endif
+         lnsmloc(m)=log(smc(m)) ! only if variable size dist
+      enddo
+
+!         single  updraft
+         wnuc=wbar
+!        write(iulog,*)'uniform updraft =',wnuc
+
+            w=wbar
+            alw=alpha*wnuc
+            sqrtalw=sqrt(alw)
+            zeta=2.*sqrtalw*aten/(3.*sqrtg)
+            etafactor1=2.*alw*sqrtalw
+
+            do m=1,nmode
+               eta(m)=etafactor1*etafactor2(m)
+            enddo
+
+!             print *,' kf_maxsat '
+            call kf_maxsat(zeta,eta,nmode,smc,smax)
+
+            lnsmax=log(smax)
+!           print *,'smc,smax=',smc,smax
+            xmincoeff=alogaten-2.*third*(lnsmax-alog2)-alog3
+
+            nact=0._r8
+            do m=1,nmode
+               x=2*(lnsmloc(m)-lnsmax)/(3*sq2*alogsig(m))
+!original ghan code
+!               nact=nact+0.5*(1.-ERF(x))*na(m)
+!++ag replace sg erf with hm derf pre 1.68
+!               nact=nact+0.5*(1.-derf(x))*na(m)
+!++ag 1.68 new error function
+                nact=nact+0.5*(1.-derf(x))*na(m)  ! danger erf
+!       write(*,*)'nact',nact,derf(x),na(m),m
+!       write(*,*) 'lnsmloc(m)',lnsmloc(m),lnsmax,alogsig(m)
+!                write(*,*) 'wbar=',wbar
+            enddo
+            nact=nact/rhoair ! convert from #/m3 to #/kg
+
+!      write(*,*)'na(m),qs',na(m),m,qs
+!      write(*,*)'nact',nact
+!      deallocate( &
+!         volc,       &
+!         eta,        &
+!         smc,        &
+!         etafactor2, &
+!         amcubeloc,  &
+!         lnsmloc     )
+
+      return
+      end subroutine kf_activate
+
+      subroutine kf_maxsat(zeta,eta,nmode,smc,smax)
+
+!      calculates maximum supersaturation for multiple
+!      competing aerosol modes.
+
+!      Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+!      2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+      implicit none
+       save ! sep6
+      integer nmode ! number of modes
+      real(r8) :: smc(:) ! critical supersaturation for number mode radius
+      real(r8) zeta
+      real(r8) :: eta(:)
+      real(r8) smax ! maximum supersaturation
+      integer m  ! mode index
+      real(r8) sum, g1, g2
+
+      do m=1,nmode
+         if(zeta.gt.1.e5*eta(m).or.smc(m)*smc(m).gt.1.e5*eta(m))then
+!            weak forcing. essentially none activated
+            smax=1.e-20
+         else
+!            significant activation of this mode. calc activation all modes.
+            go to 1
+         endif
+      enddo
+
+      return
+
+  1   continue
+
+      sum=0
+      do m=1,nmode
+         if(eta(m).gt.1.e-20)then
+            g1=sqrt(zeta/eta(m))
+            g1=g1*g1*g1
+            g2=smc(m)/sqrt(eta(m)+3*zeta)
+            g2=sqrt(g2)
+            g2=g2*g2*g2
+            sum=sum+(f1(m)*g1+f2(m)*g2)/(smc(m)*smc(m))
+!    write(*,*)'f1(m)',f1(m),m
+         else
+            sum=1.e20
+         endif
+      enddo
+
+      smax=1./sqrt(sum)
+
+      return
+
+      end subroutine kf_maxsat
+
+subroutine kf_nucleati(wbar, tair, relhum,  qc,  rhoair, &
+       na,  naer_all, nuci  &
+       , onihf, oniimm, onidep, onimey)
+
+!---------------------------------------------------------------
+! Purpose:
+!  The parameterization of ice nucleation.
+!
+! Method: The current method is based on Liu & Penner (2005)
+!  It related the ice nucleation with the aerosol number, temperature and the
+!  updraft velocity. It includes homogeneous freezing of sulfate, immersion
+!  freezing of soot, and Meyers et al. (1992) deposition nucleation
+!
+! Authors: Xiaohong Liu, 01/2005, modifications by A. Gettelman 2009-2010
+!----------------------------------------------------------------
+! Input Arguments
+!
+     save   ! sep6
+  integer  naer_all
+  real(r8) :: wbar                ! grid cell mean vertical velocity (m/s)
+  real(r8) :: tair                ! temperature (K)
+  real(r8) :: relhum              ! relative humidity with respective to liquid
+
+  real(r8) :: qc                  ! liquid water mixing ratio (kg/kg)
+  real(r8) :: rhoair              ! air density (kg/m3)
+  real(r8) :: na(naer_all)        ! aerosol number concentration (/m3)
+
+!
+! Output Arguments
+!
+  real(r8) :: nuci               ! ice number nucleated (#/kg)
+  real(r8) :: onihf              ! nucleated number from homogeneous freezing of so4
+  real(r8) :: oniimm             ! nucleated number from immersion freezing
+  real(r8) :: onidep             ! nucleated number from deposition nucleation
+  real(r8) :: onimey             ! nucleated number from deposition nucleation (meyers: mixed phase)
+!
+! Local workspace
+!
+  real(r8)  so4_num                                      ! so4 aerosol number (#/cm^3)
+  real(r8)  soot_num                                     ! soot (hydrophilic) aerosol number (#/cm^3)
+  real(r8)  dst1_num,dst2_num,dst3_num,dst4_num          ! dust aerosol number (#/cm^3)
+  real(r8)  dst_num                                      ! total dust aerosol number (#/cm^3)
+  real(r8)  nihf                                         ! nucleated number from homogeneous freezing of so4
+  real(r8)  niimm                                        ! nucleated number from immersion freezing
+  real(r8)  nidep                                        ! nucleated number from deposition nucleation
+  real(r8)  nimey                                        ! nucleated number from deposition nucleation (meyers)
+  real(r8)  n1,ni                                        ! nucleated number
+  real(r8)  tc,A,B,C,regm                                ! work variable
+  real(r8)  esl,esi,deles                                ! work variable
+  real(r8)  dst_scale
+  real(r8)  subgrid
+  real(r8)  dmc,ssmc         ! variables for modal scheme.
+
+    so4_num=0.0_r8
+    soot_num=0.0_r8
+    dst_num=0.0_r8
+    dst1_num = 0.0_r8
+    dst2_num = 0.0_r8
+    dst3_num = 0.0_r8
+    dst4_num = 0.0_r8
+
+!For modal aerosols, assume for the upper troposphere:
+! soot = accumulation mode
+! sulfate = aiken mode
+! dust = coarse mode
+! since modal has internal mixtures.
+
+    if(idxsul .gt. 0) then
+      so4_num=na(idxsul)*1.0e-6_r8 ! #/cm^3
+    end if
+
+    if(idxbcphi .gt. 0) then
+      soot_num=na(idxbcphi)*1.0e-6_r8 !#/cm^3
+    end if
+
+    if(idxdst1 .gt. 0) then
+       dst1_num=na(idxdst1)*1.0e-6_r8 !#/cm^3
+    end if
+
+    if(idxdst2 .gt. 0) then
+       dst2_num=na(idxdst2)*1.0e-6_r8 !#/cm^3
+    end if
+
+    if(idxdst3 .gt. 0) then
+       dst3_num=na(idxdst3)*1.0e-6_r8 !#/cm^3
+    end if
+
+    if(idxdst4 .gt. 0) then
+       dst4_num=na(idxdst4)*1.0e-6_r8 !#/cm^3
+    end if
+
+    dst_num =dst1_num+dst2_num+dst3_num+dst4_num
+! no soot nucleation for now.
+   ! soot_num=0.0_r8
+
+    ni=0._r8
+    tc=tair-273.15_r8
+
+    ! initialize
+    niimm=0._r8
+    nidep=0._r8
+    nihf=0._r8
+
+    if(so4_num.ge.1.0e-10_r8 .and. (soot_num+dst_num).ge.1.0e-10_r8 ) then
+
+      subgrid = 1.0_r8
+
+!          print *,'nucleiate wbar=', wbar
+     if((wbar.lt.4.0_r8) .and. (tc.le.-35.0_r8) .and.((relhum*kf_polysvp(tair,0)/kf_polysvp(tair,1)*subgrid).ge.1.2_r8)) then 
+!< regm => T in Eq.10 of Liu et al., J. Climate, 2007>
+       print*,'Aerosol Ice Nucleation is Doing Something'
+       A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8
+       B = -10.41_r8  * log(soot_num+dst_num) - 67.69_r8
+       regm = A * log(wbar) + B
+
+!         print *,'before bunch of hetero'
+       if(tc.gt.regm) then    ! heterogeneous nucleation only
+         if(tc.lt.-40._r8 .and. wbar.gt.1._r8) then ! exclude T<-40 & W>1m/s from hetero. nucleation
+           call kf_hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+           niimm=0._r8
+           nidep=0._r8
+           n1=nihf
+         else
+           call kf_hetero(tc,wbar,soot_num+dst_num,niimm,nidep)
+           nihf=0._r8
+           n1=niimm+nidep
+         endif
+       elseif (tc.lt.regm-5._r8) then ! homogeneous nucleation only
+         call kf_hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+         niimm=0._r8
+         nidep=0._r8
+         n1=nihf
+       else        ! transition between homogeneous and heterogeneous: interpolate in-between
+         if(tc.lt.-40._r8 .and. wbar.gt.1._r8) then ! exclude T<-40 & W>1m/s from hetero. nucleation
+           call kf_hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+           niimm=0._r8
+           nidep=0._r8
+           n1=nihf
+         else
+           call kf_hf(regm-5._r8,wbar,relhum,subgrid,so4_num,nihf)
+           call kf_hetero(regm,wbar,soot_num+dst_num,niimm,nidep)
+           if(nihf.le.(niimm+nidep)) then
+             n1=nihf
+           else
+              n1=(niimm+nidep)*((niimm+nidep)/nihf)**((tc-regm)/5._r8)
+           endif
+         endif
+       endif
+
+       ni=n1
+
+    endif
+    endif
+1100  continue
+
+! deposition/condensation nucleation in mixed clouds (-37<T<0C) (Meyers, 1992)
+!<Eq.12 of Liu et al., J. Climate, 2007
+! Nid(L-1)*1.e-3 => Nid(m-3)
+! Question:  RHi=RHw*esl/esi
+
+    if(tc.lt.0._r8 .and. tc.gt.-37._r8 .and. qc.gt.1.e-12_r8) then
+      esl = kf_polysvp(tair,0)     ! over water in mixed clouds
+      esi = kf_polysvp(tair,1)     ! over ice
+!songxl      deles = (esl - esi)
+      deles = (relhum*esl - esi)
+      nimey=1.e-3_r8*exp(12.96_r8*deles/esi - 0.639_r8)
+    else
+      nimey=0._r8
+    endif
+
+    nuci=ni+nimey
+    if(nuci.gt.9999._r8.or.nuci.lt.0._r8) then
+       write(*, *) 'incorrect ice nucleation number'
+       write(*, *) ni, tair, relhum, wbar, nihf, niimm,nidep,deles,esi,dst2_num,dst3_num,dst4_num
+       nuci=0._r8
+         CALL wrf_error_fatal ( 'Incorrect Ice Nucleation Number, diags' )
+    endif
+
+    nuci=nuci*1.e+6_r8/rhoair    ! change unit from #/cm3 to #/kg
+    onimey=nimey*1.e+6_r8/rhoair
+    onidep=nidep*1.e+6_r8/rhoair
+    oniimm=niimm*1.e+6_r8/rhoair
+    onihf=nihf*1.e+6_r8/rhoair
+
+!     print *,'inputs=',wbar, tair, relhum,  qc,  rhoair, &
+!      na,  naer_all, nuci,onimey,onidep,oniimm,onihf 
+!     print *,'na,tari,nuci.. =', na,tair,nuci,onimey,onidep,oniimm,onihf
+  return
+  end subroutine kf_nucleati
+
+  subroutine kf_hetero(T,ww,Ns,Nis,Nid)
+
+    real(r8) :: T, ww, Ns
+    real(r8) :: Nis, Nid
+
+    real(r8) A11,A12,A21,A22,B11,B12,B21,B22
+    real(r8) A,B,C
+
+     save    ! spe6
+!---------------------------------------------------------------------
+! parameters
+
+      A11 = 0.0263_r8
+      A12 = -0.0185_r8
+      A21 = 2.758_r8
+      A22 = 1.3221_r8
+      B11 = -0.008_r8
+      B12 = -0.0468_r8
+      B21 = -0.2667_r8
+      B22 = -1.4588_r8
+!<Eq.11 of Liu et al., J. Climate, 2007>
+!     ice from immersion nucleation (cm-3)
+
+      B = (A11+B11*log(Ns)) * log(ww) + (A12+B12*log(Ns))
+      C =  A21+B21*log(Ns)
+
+      Nis = exp(A22) * Ns**B22 * exp(B*T) * ww**C
+      Nis = min(Nis,Ns)
+
+      Nid = 0.0_r8    ! don't include deposition nucleation for cirrus clouds when T<-37C
+
+      return
+  end subroutine kf_hetero
+
+ subroutine kf_hf(T,ww,RH,subgrid,Na,Ni)
+
+      real(r8) :: T, ww, RH, subgrid, Na
+      real(r8), intent(out) :: Ni
+
+      real(r8)    A1_fast,A21_fast,A22_fast,B1_fast,B21_fast,B22_fast
+      real(r8)    A2_fast,B2_fast
+      real(r8)    C1_fast,C2_fast,k1_fast,k2_fast
+      real(r8)    A1_slow,A2_slow,B1_slow,B2_slow,B3_slow
+      real(r8)    C1_slow,C2_slow,k1_slow,k2_slow
+      real(r8)    regm
+      real(r8)    A,B,C
+      real(r8)    RHw
+
+      save   ! sep6
+!---------------------------------------------------------------------
+!<Table 1 of  Liu et al., J. Climate, 2007>
+! parameters
+
+      A1_fast  =0.0231_r8
+      A21_fast =-1.6387_r8  !(T>-64 deg)
+      A22_fast =-6.045_r8   !(T<=-64 deg)
+      B1_fast  =-0.008_r8
+      B21_fast =-0.042_r8   !(T>-64 deg)
+      B22_fast =-0.112_r8   !(T<=-64 deg)
+      C1_fast  =0.0739_r8
+      C2_fast  =1.2372_r8
+
+      A1_slow  =-0.3949_r8
+      A2_slow  =1.282_r8
+      B1_slow  =-0.0156_r8
+      B2_slow  =0.0111_r8
+      B3_slow  =0.0217_r8
+      C1_slow  =0.120_r8
+      C2_slow  =2.312_r8
+
+      Ni = 0.0_r8
+
+!----------------------------
+!<Eq.6 of Liu et al., J. Climate, 2007 
+! w~m/s, T~degree C, RHw~% => RHw*0.01~fraction  >
+!RHw xiaohong's parameter
+      A = 6.0e-4_r8*log(ww)+6.6e-3_r8
+      B = 6.0e-2_r8*log(ww)+1.052_r8
+      C = 1.68_r8  *log(ww)+129.35_r8
+      RHw=(A*T*T+B*T+C)*0.01_r8
+
+      if((T.le.-37.0_r8) .and. ((RH*subgrid).ge.RHw)) then
+
+!<Eq.9 of Liu et al., J. Climate, 2007>
+        regm = 6.07_r8*log(ww)-55.0_r8
+
+        if(T.ge.regm) then    ! fast-growth regime
+
+          if(T.gt.-64.0_r8) then
+            A2_fast=A21_fast
+            B2_fast=B21_fast
+          else
+            A2_fast=A22_fast
+            B2_fast=B22_fast
+          endif
+!<Eq.7 of Liu et al., J. Climate, 2007> 
+          k1_fast = exp(A2_fast + B2_fast*T + C2_fast*log(ww))
+          k2_fast = A1_fast+B1_fast*T+C1_fast*log(ww)
+
+          Ni = k1_fast*Na**(k2_fast)
+          Ni = min(Ni,Na)
+        else       ! slow-growth regime
+!<Eq.7 of Liu et al., J. Climate, 2007>
+          k1_slow = exp(A2_slow + (B2_slow+B3_slow*log(ww))*T + C2_slow*log(ww))
+          k2_slow = A1_slow+B1_slow*T+C1_slow*log(ww)
+
+          Ni = k1_slow*Na**(k2_slow)
+          Ni = min(Ni,Na)
+        endif
+      end if
+
+      return
+  end subroutine kf_hf
+
+      function kf_polysvp (T,type)
+!  Compute saturation vapor pressure by using
+! function from Goff and Gatch (1946)
+
+!  Polysvp returned in units of pa.
+!  T is input in units of K.
+!  type refers to saturation with respect to liquid (0) or ice (1)
+
+      real(r8) dum
+
+      real(r8) T,kf_polysvp
+
+      integer type
+
+! ice
+
+      if (type.eq.1) then
+
+! Goff Gatch equation (good down to -100 C)
+
+         kf_polysvp = 10._r8**(-9.09718_r8*(273.16_r8/t-1._r8)-3.56654_r8* &
+          log10(273.16_r8/t)+0.876793_r8*(1._r8-t/273.16_r8)+ &
+          log10(6.1071_r8))*100._r8
+
+      end if
+
+
+! Goff Gatch equation, uncertain below -70 C
+
+      if (type.eq.0) then
+         kf_polysvp = 10._r8**(-7.90298_r8*(373.16_r8/t-1._r8)+ &
+             5.02808_r8*log10(373.16_r8/t)- &
+             1.3816e-7_r8*(10._r8**(11.344_r8*(1._r8-t/373.16_r8))-1._r8)+ &
+             8.1328e-3_r8*(10._r8**(-3.49149_r8*(373.16_r8/t-1._r8))-1._r8)+ &
+             log10(1013.246_r8))*100._r8
+         end if
+
+
+      end function kf_polysvp
+
+ end module module_cu_mp
+!end module zm_microphysics
+!----------------------------------------------------------------------------------------------
+!dkay begin MSKF
+!.........................................
+
 MODULE module_cu_mskf
 
    USE module_wrf_error
-
+ 
+   !dkay
+   USE module_cu_mp
+!  use netcdf !PSH
 !
 !ckay=Kiran Alapaty, EPA
 !CGM = Chris Marciano, NCSU
@@ -62,12 +3381,16 @@ CONTAINS
              ,RQICUTEN,RQSCUTEN, RQVFTEN                     &
 !ckay
              ,cldfra_dp_KF,cldfra_sh_KF,w_up                 &
-             ,qc_KF,qi_KF                                    &
+             ,qc_KF,qi_KF,qr_KF,qs_KF                        & ! TWG
+             ,nc_KF,ni_KF,nr_KF,ns_KF                        & ! TWG
+             ,ccn_KF,ainc_frac                               & ! TWG
 !kf_edrates
              ,UDR_KF,DDR_KF                                  &
              ,UER_KF,DER_KF                                  &
              ,TIMEC_KF,KF_EDRATES                            & 
              ,ZOL,WSTAR,UST,PBLH                             &   !ckay
+             ,aerocu,no_src_types_cu,aercu_fct,aercu_opt     & !PSH/TWG
+             ,EFCS,EFIS,EFSS                                 & !TWG
                                                              )
 !
 !-------------------------------------------------------------
@@ -100,6 +3423,13 @@ CONTAINS
                                                        Pcps, &
                                                         rho, &
                                                          pi
+  INTEGER,      INTENT(IN   ) :: no_src_types_cu !PSH/TWG
+  INTEGER,      INTENT(IN   ) :: aercu_opt !PSH/TWG
+  REAL,         INTENT(IN   ) :: aercu_fct       !PSH/TWG
+  REAL,  DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), OPTIONAL, &
+          INTENT(INOUT) ::                                   aerocu !PSH/TWG
+
+
 !
    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         , &
           INTENT(INOUT) ::                                   &
@@ -160,8 +3490,21 @@ CONTAINS
                                                cldfra_sh_KF, &
                                                       qc_KF, &
                                                       qi_KF, &
+                                                      qr_KF, & ! TWG
+                                                      qs_KF, & ! TWG
+                                                      nc_KF, & ! TWG
+                                                      ni_KF, & ! TWG
+                                                      nr_KF, & ! TWG
+                                                      ns_KF, & ! TWG
+                                                     ccn_KF, & ! TWG
+                                                       EFCS, & ! TWG
+                                                       EFIS, & ! TWG
+                                                       EFSS, & ! TWG
                                                           W
 
+   REAL, DIMENSION( ims:ime , jms:jme ),                     & !TWG
+          INTENT(INOUT) ::                           ainc_frac
+
 !kf_edrates
    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         , &
           INTENT(INOUT) ::                         &
@@ -455,8 +3798,19 @@ CONTAINS
                cldfra_sh_KF(I,k,J)=0.
                qc_KF(I,k,J)=0.
                qi_KF(I,k,J)=0.
+! TWG 06/14/16
+               qr_KF(I,k,J)=0.
+               qs_KF(I,k,J)=0.
+               nc_KF(I,k,J)=0.
+               ni_KF(I,k,J)=0.
+               nr_KF(I,k,J)=0.
+               ns_KF(I,k,J)=0.
+               ccn_KF(I,k,J)=0.
+               
+! END TWG
                w_up(I,k,J)=0.
             ENDDO
+               ainc_frac(I,J) = 0. ! TWG
             IF (KF_EDRATES == 1) THEN
                DO k=kts,kte
                   UDR_KF(I,k,J)=0.
@@ -491,6 +3845,12 @@ CONTAINS
                   tpart_v1D(K) = 0.
                ENDIF
             ENDDO
+
+!dkay
+   IF (aercu_opt.gt.0) THEN
+            call zm_mphyi ()
+   END IF
+
             CALL KF_eta_PARA(I, J,                  &
                  U1D,V1D,T1D,QV1D,P1D,DZ1D,W0AVG1D, &
                  tpart_h1D,tpart_v1D,               &
@@ -507,12 +3867,16 @@ CONTAINS
                  its,ite, jts,jte, kts,kte,         &
 !ckay
                  cldfra_dp_KF,cldfra_sh_KF,w_up,    &
-                 qc_KF,qi_KF,                       &
+                 qc_KF,qi_KF,qr_KF,qs_KF,           &
+                 nc_KF,ni_KF,nr_KF,ns_KF,ccn_KF,    & !TWG
+                 ainc_frac,                         & !TWG
 !kf_edrates
                  UDR_KF,DDR_KF,                     &
                  UER_KF,DER_KF,                     &
                  TIMEC_KF,KF_EDRATES,               &                 
-                 ZOL,WSTAR,UST,PBLH                 )
+                 ZOL,WSTAR,UST,PBLH,                &
+                 aerocu,no_src_types_cu,aercu_fct,  &
+                 aercu_opt,EFCS,EFIS,EFSS) !PSH/TWG
 
             IF(PRESENT(rthcuten).AND.PRESENT(rqvcuten)) THEN
               DO K=kts,kte
@@ -578,12 +3942,16 @@ CONTAINS
                       its,ite, jts,jte, kts,kte,           &
 !ckay
                       cldfra_dp_KF,cldfra_sh_KF,w_up,      &
-                      qc_KF,qi_KF,                         &
+                      qc_KF,qi_KF,qr_KF,qs_KF,             & !TWG
+                      nc_KF,ni_KF,nr_KF,ns_KF,ccn_KF,      & !TWG
+                      ainc_frac,                           & !TWG
 !kf_edrates
                       UDR_KF,DDR_KF,                       &
                       UER_KF,DER_KF,                       &
                       TIMEC_KF,KF_EDRATES,                 &
-                      ZOL,WSTAR,UST,PBLH                   )
+                      ZOL,WSTAR,UST,PBLH,                  &
+                      aerocu,no_src_types_cu,aercu_fct,    &
+                      aercu_opt,EFCS,EFIS,EFSS             ) !PSH/TWG
 !-----------------------------------------------------------
 !***** The KF scheme that is currently used in experimental runs of EMCs 
 !***** Eta model....jsk 8/00
@@ -619,6 +3987,13 @@ CONTAINS
       REAL,  INTENT(IN   ) :: XLV0,XLV1,XLS0,XLS1,CP,R,G
       REAL,  INTENT(IN   ) :: EP2,SVP1,SVP2,SVP3,SVPT0
 
+      INTEGER, INTENT(IN   ) :: no_src_types_cu  !PSH/TWG
+      REAL,    INTENT(IN   ) :: aercu_fct        !PSH/TWG
+      INTEGER, INTENT(IN   ) :: aercu_opt        !PSH/TWG
+      REAL,  DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), OPTIONAL, &
+      INTENT(INOUT) ::                                   aerocu !PSH/TWG
+
+
 !ckay
       REAL, DIMENSION( ims:ime, jms:jme ),                 &
             INTENT(   IN) ::                          ZOL, &
@@ -637,12 +4012,25 @@ CONTAINS
       REAL,    DIMENSION( ims:ime , jms:jme ),             &
             INTENT(INOUT) ::                          NCA
 
+      REAL,    DIMENSION( ims:ime , jms:jme ),             & !TWG
+            INTENT(INOUT) ::                      ainc_frac
+
 !ckay
       REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),      &
             INTENT(INOUT) ::                 cldfra_dp_KF, &
                                              cldfra_sh_KF, &
                                                     qc_KF, &
-                                                    qi_KF
+                                                    qi_KF, &
+                                                    qr_KF, & !TWG
+                                                    qs_KF, & !TWG
+                                                    nc_KF, & !TWG
+                                                    ni_KF, & !TWG
+                                                    nr_KF, & !TWG
+                                                    ns_KF, & !TWG
+                                                   ccn_KF, & !TWG
+                                                     EFCS, & !TWG
+                                                     EFIS, & !TWG
+                                                     EFSS
 !kf_edrates
       REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),      &
             INTENT(INOUT) ::       UDR_KF,       &
@@ -678,6 +4066,10 @@ CONTAINS
             UMF,UER,UDR,DMF,DER,DDR,UMF2,UER2,             &
             UDR2,DMF2,DER2,DDR2,DZA,THTA0,THETEE,          &
             THTAU,THETEU,THTAD,THETED,QLIQ,QICE,           &
+!TWG 06/14/16
+            QRAIN,QSNOW,NLIQ,NICE,NRAIN,NSNOW,CCN,         &
+            EFFCH,EFFIH,EFFSH,                             &
+!EBD TWG
             QLQOUT,QICOUT,PPTLIQ,PPTICE,DETLQ,DETIC,       &
             DETLQ2,DETIC2,RATIO,RATIO2
 
@@ -740,6 +4132,65 @@ CONTAINS
    REAL    :: envEsat, envQsat, envRH, envRHavg, denSplume
    REAL    :: updil, Drag
 
+!dkay for dccmp
+   real :: zmVMFLCL, ajunk1,ajunk2, a4kay
+   LOGICAL :: DCCMP
+   REAL :: eps1u, alatent, Qsu
+   LOGICAL :: onetime
+   Data onetime/.true./
+   integer, parameter :: r8 = 8
+   integer, parameter :: naer_cu = 10
+   integer, parameter :: pcols = 1
+   REAL(r8) muu(pcols, KTS:KTE)
+   REAL(r8) su(pcols, KTS:KTE)
+   REAL(r8) quu(pcols, KTS:KTE)
+   REAL(r8) duu(pcols, KTS:KTE)
+   REAL(r8) euu(pcols, KTS:KTE)
+   REAL(r8) cmel(pcols, KTS:KTE)
+   REAL(r8) cmei(pcols, KTS:KTE)
+   REAL(r8) zfu(pcols, KTS:KTE+1)
+   REAL(r8) zf_wrf(0:KTE)
+   REAL(r8) pru(pcols, KTS:KTE)
+   REAL(r8) tee(pcols, KTS:KTE)
+   REAL(r8) qee(pcols, KTS:KTE)
+   REAL(r8) qsatzm(pcols, KTS:KTE)
+   REAL(r8) gamhat(pcols, KTS:KTE)
+   REAL(r8) aer_mmr(pcols, KTS:KTE,naer_cu)
+   REAL(r8) Aqnewic(KTS:KTE)
+   REAL(r8) Aqnewlq(KTS:KTE)
+   REAL(r8) wu_kf_act(KTS:KTE)
+   REAL(r8) qc_kf_act(KTS:KTE)
+   REAL(r8) qi_kf_act(KTS:KTE)
+   REAL(r8) effc(pcols, KTS:KTE)
+   REAL(r8) effi(pcols, KTS:KTE)
+   REAL(r8) effs(pcols, KTS:KTE)
+   real(r8) QSATu(KTS:KTE), oldQU(KTS:KTE),oldTU(KTS:KTE)      ! rate of freezing
+   REAL(r8) EPSI0(pcols)
+   REAL(r8) dLfmzmp(pcols,KTS:KTE),dIfmzmp(pcols,KTS:KTE)
+!junk
+   REAL(r8) oldpptliq(KTS:KTE)
+   REAL(r8) oldpptice(KTS:KTE)
+
+   REAL(r8) wump(pcols, KTS:KTE)
+   real(r8) zmqliq(pcols,KTS:KTE)       ! cloud water mixing ratio (kg/kg)
+   real(r8) zmqice(pcols,KTS:KTE)       ! cloud ice mixing ratio (kg/kg)
+   real(r8) zmqrain(pcols,KTS:KTE)      ! rain mixing ratio (kg/kg) !TWG
+   real(r8) zmqsnow(pcols,KTS:KTE)      ! snow mixing ratio (kg/kg) !TWG
+   real(r8) ncmp(pcols,KTS:KTE)       ! cloud water number conc (1/kg)
+   real(r8) nimp(pcols,KTS:KTE)       ! cloud ice number conc (1/kg)
+   real(r8) nrmp(pcols,KTS:KTE)       ! rain number conc (1/kg) !TWG
+   real(r8) nsmp(pcols,KTS:KTE)       ! snow number conc (1/kg) !TWG
+   real(r8) zmccn(pcols,KTS:KTE)       ! ccn conc (1/kg) !TWG
+   real(r8) rprd(pcols,KTS:KTE)     ! rate of production of precip at that layer
+   real(r8) sprd(pcols,KTS:KTE)     ! rate of production of snow at that layer
+   real(r8) frz(pcols,KTS:KTE)      ! rate of freezing
+
+   REAL(r8) grav, Rdry , DTZMP, CPIN, psh_fac
+
+   Integer KQ, JK, JBB(1), JTT(1), JLCL(1), msg1, il2g , JZM, KA
+   Integer NLEVZM, NLEVZMP1, KKAY, Miter, Itest, KC
+!dkay
+
       INTEGER :: KX,K,KL
 !
       INTEGER :: NCHECK
@@ -765,6 +4216,12 @@ CONTAINS
 !      DATA RATE/0.01/  ! value used in NRCM
 !      DATA RATE/0.001/  ! effectively turn off autoconversion
 !-----------------------------------------------------------
+   IF (aercu_opt.gt.0) THEN
+     DCCMP = .TRUE.
+   ELSE
+     DCCMP = .FALSE.
+   END IF
+
       IPRNT=.FALSE.
       GDRY=-G/CP
       ROCP=R/CP
@@ -1029,7 +4486,13 @@ usl:   DO
           ELSE
             WKLCL=0.02                ! units of m/s
           ENDIF
-          WKL=(W0AVG1D(K)+(W0AVG1D(KLCL)-W0AVG1D(K))*DLP)*DX/25.E3-WKLCL
+!TWG.ckay c
+         if(DX.GE.25.E3) then
+           WKL=(W0AVG1D(K)+(W0AVG1D(KLCL)-W0AVG1D(K))*DLP)*DX/25.E3-WKLCL
+         else
+           WKL=(W0AVG1D(K)+(W0AVG1D(KLCL)-W0AVG1D(K))*DLP)-WKLCL
+         end if 
+!TWG ckay, Modified WKL
           IF(WKL.LT.0.0001)THEN
             DTLCL=0.
           ELSE
@@ -1118,6 +4581,18 @@ usl:   DO
             EQFRC(K)=1.
             QLIQ(K)=0.
             QICE(K)=0.
+!TWG 06/14/16
+            QRAIN(K)=0.
+            QSNOW(K)=0.
+            NLIQ(K)=0.
+            NICE(K)=0.
+            NRAIN(K)=0.
+            NSNOW(K)=0.
+            CCN(K)=0.
+            EFFCH(K) = 2.5
+            EFFIH(K) = 4.99
+            EFFSH(K) = 9.99
+!END TWG
             QLQOUT(K)=0.
             QICOUT(K)=0.
             DETLQ(K)=0.
@@ -1145,6 +4620,35 @@ usl:   DO
             UD1=0.
             REI = 0.
             DILBE = 0.
+
+!dkay
+IF (aercu_opt.gt.0) THEN
+                zf_wrf(0) = 0.0  ! ground
+                DO KQ=KTS,KTE
+                 zf_wrf(KQ) = zf_wrf(KQ-1)+DZQ(KQ)
+                 Aqnewlq(kq) = 0.0
+                 Aqnewic(kq) = 0.0
+                 rprd(1,kq) = 0.0
+                 wump(1,kq) =0.0
+                 ncmp(1,kq) =0.0
+                 nimp(1,kq) =0.0
+                 sprd(1,kq) =0.0
+                 frz(1,kq) =0.0
+                   jk = kq
+                   muu(1,JK) = 0.0
+                   duu(1,JK) =0.0
+                   EUU(1,JK) =0.0
+                   cmel(1,JK) =0.0
+                   cmei(1,JK) =0.0
+               oldTU(kq) = t0(kq)
+               oldQU(kq) = Q0(kq)
+
+                End do
+
+              Miter = 0
+END IF
+
+
 updraft:    DO NK=K,KL-1
               NK1=NK+1
               RATIO2(NK1)=RATIO2(NK)
@@ -1152,10 +4656,38 @@ updraft:    DO NK=K,KL-1
               TU(NK1)=T0(NK1)
               THETEU(NK1)=THETEU(NK)
               QU(NK1)=QU(NK)
+!dkay
+     IF (aercu_opt.gt.0) THEN
+              oldQU(NK) = QU(NK)
+              oldTU(NK) = TU(NK)
+     END IF
+!dkay
               QLIQ(NK1)=QLIQ(NK)
               QICE(NK1)=QICE(NK)
               call tpmix2(p0(nk1),theteu(nk1),tu(nk1),qu(nk1),qliq(nk1),        &
-                     qice(nk1),qnewlq,qnewic,XLV1,XLV0)
+                     qice(nk1),qnewlq,qnewic,XLV1,XLV0,QSu)
+
+!dkay QSu has been added to the tpmix2
+
+!dkay
+! saturation value of Q of updraft for use with gamma hat in DCCMP routine
+   IF (aercu_opt.gt.0) THEN
+        QSATu(NK) = QSu/(1.+QSu)   ! saturated specific hum
+         Aqnewlq(NK) = qnewlq
+         Aqnewic(NK) = qnewic
+
+         Aqnewlq(NK) = qnewlq + Qliq(nk )
+         Aqnewic(NK) = qnewic + Qice(nk )
+
+!dkaydec26
+         if(TU(NK).le.273.) then
+          Aqnewlq(NK) = 0.0
+          Aqnewic(NK) = qnewlq + qnewic
+         else
+          Aqnewlq(NK) = qnewlq + qnewic
+          Aqnewic(NK) = 0.0
+         end if
+   END IF
 !
 !
 !...CHECK TO SEE IF UPDRAFT TEMP IS ABOVE THE TEMPERATURE AT WHICH
@@ -1261,7 +4793,7 @@ updraft:    DO NK=K,KL-1
                 TMPLIQ=F2*QLIQ(NK1)
                 TMPICE=F2*QICE(NK1)
                 call tpmix2(p0(nk1),thttmp,ttmp,qtmp,tmpliq,tmpice,        &
-                           qnewlq,qnewic,XLV1,XLV0)
+                           qnewlq,qnewic,XLV1,XLV0,QSu)
                 TU95=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)
                 IF(TU95.GT.TV0(NK1))THEN
                   EE2=1.
@@ -1275,7 +4807,7 @@ updraft:    DO NK=K,KL-1
                   TMPLIQ=F2*QLIQ(NK1)
                   TMPICE=F2*QICE(NK1)
                   call tpmix2(p0(nk1),thttmp,ttmp,qtmp,tmpliq,tmpice,        &
-                               qnewlq,qnewic,XLV1,XLV0)
+                               qnewlq,qnewic,XLV1,XLV0,QSu)
                   TU10=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)
                   TVDIFF = ABS(TU10-TVQU(NK1))
                   IF(TVDIFF.LT.1.e-3)THEN
@@ -1357,8 +4889,220 @@ updraft:    DO NK=K,KL-1
                 TRPPT=TRPPT+PPTLIQ(NK1)+PPTICE(NK1)
                 IF(NK1.LE.KPBL)UER(NK1)=UER(NK1)+VMFLCL*DP(NK1)/DPTHMX
               ENDIF
+
+
+!dkay
+              IF (aercu_opt.gt.0) THEN
+                  eps1u = 0.622
+                  alatent = 2.54E6
+                  KQ = NK
+                  JK = KTE-KQ+1
+                   muu(1,JK) = UMF(KQ)/VMFLCL     ! normalized updraft mass flux
+                   duu(1,JK) = UDR(KQ)/DZQ(KQ)/VMFLCL  ! fractional detrainment rate in units of per meter
+                   EUU(1,JK) = UER(KQ)/DZQ(KQ)/VMFLCL  ! normalized entrainment rate in unts of per meter
+                   cmel(1,JK) = muu(1,JK)*AQNEWLQ(KQ)/DZQ(KQ)
+                   cmei(1,JK) = muu(1,JK)*AQNEWIC(KQ)/DZQ(KQ)
+                  gamhat(1,JK) = QSATu(KQ)*(1.+QSATu(KQ)/eps1u)   &
+                 *eps1u*alatent/(R*oldTU(KQ)**2)*alatent/CP
+                   wu_kf_act(JK) = WU(KQ)  ! kf updraft velocity incloud
+                   qc_kf_act(JK) = AQNEWLQ(KQ)
+                   qi_kf_act(JK)=AQNEWIC(KQ)
+              END IF
+!end dkay
+
+
 !
             END DO updraft
+
+!dkay
+          IF (aercu_opt.gt.0) THEN
+            Zfu(1,KTE+1) = 0.0
+
+                CPin   = CP
+
+            EPSI0(1) = 2.0E-4
+
+            DO KQ=KTS,KTE
+              JK = KTE-KQ+1
+                   zfu(1,JK) = zf_wrf(KQ)
+                   su(1,JK) = oldTU(KQ) + (G*zf_wrf(KQ))/CP
+                   quu(1,JK) = oldQU(KQ)/(1.+oldQU(KQ)) ! specific humidity of updraft
+                   pru(1,JK) = P0(KQ)/100.0    ! in millibars
+                   TEE(1,JK) = oldTU(KQ)  ! danger T0(KQ)
+                   TEE(1,JK) = T0(KQ)    ! ccc
+                   QEE(1,JK) = Q0(KQ)/(1.+Q0(KQ))           ! specific humidity of environment
+
+                   qee(1,JK) = oldQU(KQ)/(1.+oldQU(KQ)) ! specific humidity of updraft
+                   QSATZM(1,JK) = QSATu(KQ)
+!
+!psh: Now, using aerosol concs from CESM
+!
+                    denSplume = P0(KQ)/(R*oldTU(KQ))
+                    psh_fac = 1.0E-09/denSplume        ! convert ug/m3 to kg/kg
+
+                    aer_mmr(1,JK, 1) = aerocu(I,KQ,J, 6)*psh_fac
+                    aer_mmr(1,JK, 2) = aerocu(I,KQ,J, 5)*psh_fac
+                    aer_mmr(1,JK, 3) = 1.44*aerocu(I,KQ,J, 1)*psh_fac
+                    aer_mmr(1,JK, 4) = 1.44*aerocu(I,KQ,J, 2)*psh_fac
+                    aer_mmr(1,JK, 5) = 1.44*aerocu(I,KQ,J, 3)*psh_fac
+                    aer_mmr(1,JK, 6) = 1.44*aerocu(I,KQ,J, 4)*psh_fac
+                    aer_mmr(1,JK, 7) = 1.54*aerocu(I,KQ,J, 9)*psh_fac
+                    aer_mmr(1,JK, 8) = 1.37*aerocu(I,KQ,J, 7)*psh_fac
+                    aer_mmr(1,JK, 9) = 1.25*aerocu(I,KQ,J,10)*psh_fac
+                    aer_mmr(1,JK,10) = 1.37*aerocu(I,KQ,J, 8)*psh_fac
+
+!psh
+                  gamhat(1,JK) = QSATu(KQ)*(1.+QSATu(KQ)/eps1u)   &
+                 *eps1u*alatent/(R*oldTU(KQ)**2)*alatent/CP
+
+              END DO
+                  JTT(1) = KX-NK+1
+                  JBB(1) = KX-K+1  ! updraft base level   =====>>> flipped for CAM5 indexing
+                  if(jtt(1).gt.jbb(1))  then
+                   JTT(1) = JBB(1)
+                  end if
+                  JLCL(1) = JBB(1) - 1
+                  msg1 = 0
+                  il2g = 1
+                  grav  = G
+                  Rdry = R
+                  DTzmp = DT
+!                 print *,'jtt,jbb=', JTT(1), JBB(1)
+
+!dkay: call the new DCCMP scheme here
+              NLEVZM = KTE-KTS+1      !  this is equal to pver in zm_mp
+              NLEVZMP1 = NLEVZM + 1   !  pverp
+
+                if(jtt(1).eq.1) then
+                   print *,' cloud bottom is on ground!'
+                   print*,'I ',I,' J ',J
+                   CALL wrf_error_fatal ('MSKF Cloud Bottom IS ON THE GROUND, diags' )
+                 end if
+                if(jbb(1).eq.KTE) then
+                   print *,' cloud top went through the roof!'
+                   print *,'JTT, jbb, jlcl=',JTT(1),JBB(1),JLCL(1)
+                   CALL wrf_error_fatal ( 'MSKF CLOUD TOP WENT OVER MODEL TOP, diags' )
+                 end if
+            if(DCCMP) then
+
+!           do kq=KTE,1,-1
+!             print *,'wrf dz=',dzq(kq),(KTE-KQ+1)
+!           end do
+
+          call zm_mphy(su,quu,muu,duu,cmel,cmei,zfu, pru,tee,qee,epsi0, &
+               jbb,jtt,jlcl, msg1,il2g, grav, cpin, rdry,zmqliq,zmqice,zmqrain,zmqsnow,&
+               rprd,wump, euu, ncmp,nimp,nrmp,nsmp,zmccn,sprd, frz, aer_mmr, dtzmp, &
+               NLEVZM,NLEVZMP1,gamhat,qsatzm,wu_kf_act,qc_kf_act,qi_kf_act,effc,effi, &
+               effs)
+              end if
+
+                ajunk1=0.0
+                ajunk2=0.0
+               do kq=K,NK
+                JK = KTE-KQ+1
+!        ajunk1 = ajunk1 + aqnewlq(kq)+aqnewic(kq)
+!        ajunk2 = ajunk2 + zmqliq(1,jk)+ &
+!          zmqice(1,jk)+rprd(1,jk)*dzq(kq)+sprd(1,jk)*dzq(kq)
+!         ajunk2 = ajunk2 + dLfmzmp(1,jk)*dzq(kq)
+!         ajunk2 = ajunk2 + dzq(kq)*dIfmzmp(1,jk)
+                end do
+!               print *,'condensates in & out',ajunk1,ajunk2
+
+               Itest = 0
+                if(Itest.eq.1) then
+
+               write(121,*),'k,nk, kq,jk,su,quuE3,muu,duu,cmel,zfu,pru,tee, &
+               qeeE3,zmqliqE4,zmqiceE4,rprd,wump,euu,ncmp,nimp,sprd,frz'
+               do kq=K,NK
+               JK = KTE-KQ+1
+               write (121,2021) k,nk,kq,jk,su(1,jk),quu(1,jk)*1000,muu(1,jk),duu(1,jk),cmel(1,jk)
+               write (121,2022) zfu(1,jk),pru(1,jk),tee(1,jk),qee(1,jk)*1000,zmqliq(1,jk)*1.e3,zmqice(1,jk)*1.e3
+               write (121,2022) rprd(1,jk),wump(1,jk),euu(1,jk),ncmp(1,jk),nimp(1,jk),sprd(1,jk)
+               write (121,2023) frz(1,jk)
+
+2021          format(4I3,6(1x,E13.6))
+2022          format(6(1x,e13.6))
+2023          format(2(1x,e13.6))
+               end do
+                end if ! itest
+            
+
+               if(DCCMP) then
+              do kq=KTS,KTE
+               QLIQ(KQ) = 0.0
+               QICE(KQ) = 0.0
+!TWG 06/14/16
+               QRAIN(KQ) = 0.0
+               QSNOW(KQ) = 0.0
+               NLIQ(KQ) = 0.0
+               NICE(KQ) = 0.0
+               NRAIN(KQ) = 0.0
+               NSNOW(KQ) = 0.0
+               CCN(KQ) = 0.0
+               EFFCH(KQ) = 2.51
+               EFFIH(KQ) = 4.99
+               EFFSH(KQ) = 9.99
+!END TWG 
+               PPTLIQ(KQ)=0.0  ! nov23
+               PPTICE(KQ)=0.0  ! nov23
+               QLQOUT(KQ)=0.0  ! nov23
+               QICOUT(KQ)=0.0  ! nov23
+               DETLQ(KQ)=0.0  ! dec26
+               DETIC(KQ)=0.0  ! dec26
+              end do
+              TRPPT = 0.0
+              DO KQ=KTS, KTE
+
+               JK = KX-KQ+1
+!               print *,'kf qliq=', QLIQ(KQ)
+                 QLIQ(KQ) = amax1(0.0,zmqliq(1,JK))
+                 QICE(KQ) = amax1(0.0,zmqice(1,JK))
+!TWG 06/14/16
+                 QRAIN(KQ) = amax1(0.0,zmqrain(1,JK))
+                 QSNOW(KQ) = amax1(0.0,zmqsnow(1,JK))
+                 NLIQ(KQ) = amax1(0.0,ncmp(1,JK))
+                 NICE(KQ) = amax1(0.0,nimp(1,JK))
+                 NRAIN(KQ) = amax1(0.0,nrmp(1,JK))
+                 NSNOW(KQ) = amax1(0.0,nsmp(1,JK))
+                 CCN(KQ) = amax1(0.0,zmccn(1,JK))
+                 EFFCH(KQ) = MAX(2.49, MIN(effc(1,JK), 50.))
+                 EFFIH(KQ) = MAX(4.99, MIN(effi(1,JK), 125.))
+                 EFFSH(KQ) = MAX(9.99, MIN(effs(1,JK), 999.))
+! END TWG        
+                  DETLQ(KQ)= QLIQ(KQ)*UDR(KQ)
+                  DETIC(KQ)= QICE(KQ)*UDR(KQ)
+!               print *,'zm qliq=', QLIQ(KQ)
+                   densPlume = PPTLIQ(KQ)
+!nov23
+                  if(rprd(1,JK).lt.0.0) rprd(1,JK) = 0.0
+                  if(sprd(1,JK).lt.0.0) sprd(1,JK) = 0.0
+
+                   QLQOUT(KQ)=rprd(1,JK)*dzq(KQ)
+                  QICOUT(KQ)=sprd(1,JK)*dzq(KQ)
+                  PPTLIQ(KQ)=QLQOUT(KQ)*VMFLCL   ! check this out
+                  PPTICE(KQ)=QICOUT(KQ)*VMFLCL   !   ditto
+
+                 TRPPT=TRPPT+PPTLIQ(KQ)+PPTICE(KQ)
+!                  if(densPlume.gt.0.0) then
+!               print *,'zm pptliq=', &
+!        PPTLIQ(KQ),'kf pptliq=',oldPPTLIQ(kq),'KQ=',KQ
+!               end if
+!                 print *,'zmQliqout=',kq,densPlume,VMFLCL,pptliq(kq)
+!                if((i.ge.60.and.i.le.65).and.(j.ge.60.and.j.le.65)) then
+!                     print *, 'KF & MP qliq=', Aqnewlq(nk),QLIQ(NK)
+!                     print *, 'mu & du=', muu(1,JK), duu(1,JK)
+!                      print *,'i,j,k=',I,J,KQ
+!                   end if
+
+              END DO
+
+              end if  ! dccmp
+!dkay
+     
+2999         CONTINUE
+     END IF
+
+
 !
 !...CHECK CLOUD DEPTH...IF CLOUD IS TALL ENOUGH, ESTIMATE THE EQUILIBRIUM
 !   TEMPERATURE LEVEL (LET) AND ADJUST MASS FLUX PROFILE AT CLOUD TOP SO
@@ -1387,8 +5131,19 @@ updraft:    DO NK=K,KL-1
             DO NK=K,LTOP
               qc_KF(I,NK,J)=QLIQ(NK)
               qi_KF(I,NK,J)=QICE(NK)
+! TWG 06/14/16
+              qr_KF(I,NK,J)=QRAIN(NK)
+              qs_KF(I,NK,J)=QSNOW(NK)
+              nc_KF(I,NK,J)=NLIQ(NK)
+              ni_KF(I,NK,J)=NICE(NK)
+              nr_KF(I,NK,J)=NRAIN(NK)
+              ns_KF(I,NK,J)=QSNOW(NK)
+              ccn_KF(I,NK,J)=CCN(NK)
+              EFCS(I,NK,J)=MAX(2.49, MIN(EFFCH(NK), 50.))
+              EFIS(I,NK,J)=MAX(4.99, MIN(EFFIH(NK), 120.))
+              EFSS(I,NK,J)=MAX(9.99, MIN(EFFSH(NK), 999.))
+! END TWG
             END DO
-
 !ckay: if mean env RH with respect to water/ice is over 100% then dont allow KF
 !ckay: added saturation w.r.to ice june 10, 2015
 ! to avoid double counting
@@ -1449,6 +5204,15 @@ updraft:    DO NK=K,KL-1
                 cldfra_sh_KF(I,NK,J)=0.
                 qc_KF(I,NK,J)=0.
                 qi_KF(I,NK,J)=0.
+!TWG 06/14/16
+                qr_KF(I,NK,J)=0.
+                qs_KF(I,NK,J)=0.
+                nc_KF(I,NK,J)=0.
+                ni_KF(I,NK,J)=0.
+                nr_KF(I,NK,J)=0.
+                ns_KF(I,NK,J)=0.
+                ccn_KF(I,NK,J)=0.
+! END TWG
                 w_up(I,NK,J)=0.
               ENDDO
 !        
@@ -1485,6 +5249,15 @@ updraft:    DO NK=K,KL-1
                   cldfra_sh_KF(I,NK,J)=0.
                   qc_KF(I,NK,J)=0.
                   qi_KF(I,NK,J)=0.
+!TWG 06/14/16
+                qr_KF(I,NK,J)=0.
+                qs_KF(I,NK,J)=0.
+                nc_KF(I,NK,J)=0.
+                ni_KF(I,NK,J)=0.
+                nr_KF(I,NK,J)=0.
+                ns_KF(I,NK,J)=0.
+                ccn_KF(I,NK,J)=0.
+! END TWG
                   w_up(I,NK,J)=0.
                 ENDDO
               ENDIF
@@ -1578,6 +5351,15 @@ updraft:    DO NK=K,KL-1
         cldfra_sh_KF(I,NK,J)=0.
         qc_KF(I,NK,J)=0.
         qi_KF(I,NK,J)=0.
+!TWG 06/14/16
+        qr_KF(I,NK,J)=0.
+        qs_KF(I,NK,J)=0.
+        nc_KF(I,NK,J)=0.
+        ni_KF(I,NK,J)=0.
+        nr_KF(I,NK,J)=0.
+        ns_KF(I,NK,J)=0.
+        ccn_KF(I,NK,J)=0.
+! END TWG
         w_up (I,NK,J)=0.
       ENDIF
       UDR(NK)=0.
@@ -1622,6 +5404,15 @@ updraft:    DO NK=K,KL-1
           cldfra_sh_KF(I,NK,J)=0.
           qc_KF(I,NK,J)=0.
           qi_KF(I,NK,J)=0.
+!TWG 06/14/16
+          qr_KF(I,NK,J)=0.
+          qs_KF(I,NK,J)=0.
+          nc_KF(I,NK,J)=0.
+          ni_KF(I,NK,J)=0.
+          nr_KF(I,NK,J)=0.
+          ns_KF(I,NK,J)=0.
+          ccn_KF(I,NK,J)=0.
+! END TWG
           w_up(I,NK,J)=0.
         ENDIF
         THTA0(NK)=0.
@@ -1693,7 +5484,7 @@ updraft:    DO NK=K,KL-1
 
           FRC2 = SQRT(FRC2)  
           SCLvel =  FRC2  ! Wsb=new subcloud layer velocity scale for all conditions
-
+         IF(SCLvel.lt.0.1) SCLvel = 0.1
          if(ABE.le.0.0) ABE = 1.0 
          TIMEC = TIMEC/((0.03*SCLvel*ABE)**0.3333)
 
@@ -2376,6 +6167,7 @@ iter:     DO NCOUNT=1,10
 ! get the cloud fraction for layer NK+1=NK1
             updil = (100.-AINC)
             updil = updil/100.
+            ainc_frac(I,J) = 1.0-updil !TWG
             updil = updil*dxsq  
             Drag = 0.5   
 
@@ -2534,7 +6326,7 @@ iter:     DO NCOUNT=1,10
        IF(IPRNT)then 
 !    if(I.eq.16 .and. J.eq.41)then
 !      IF(ISTOP.EQ.1)THEN
-         write(98,*)
+!         write(98,*)
 !        write(98,*)'At t(h), I, J =',float(NTSD)*72./3600.,I,J
          write(message,*)'P(LC), DTP, WKL, WKLCL =',p0(LC)/100.,       &
                      TLCL+DTLCL+dtrh-TENV,WKL,WKLCL
@@ -2616,8 +6408,8 @@ iter:     DO NCOUNT=1,10
 ! 4422       format(i6) 
             DO 310 NK = 1,KL
               k = kl - nk + 1
-              write(98,4455) p0(k)/100.,t0(k)-273.16,q0(k)*1000.,       &
-                       u0(k),v0(k),W0AVG1D(K),dp(k),tke(k)
+ !             write(98,4455) p0(k)/100.,t0(k)-273.16,q0(k)*1000.,       &
+ !                      u0(k),v0(k),W0AVG1D(K),dp(k),tke(k)
 !             write(98) p0,t0,q0,u0,v0,w0,dp,tke
 !           WRITE(98,1115)Z0(K),P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,
 !    *               U0(K),V0(K),DP(K)/100.,W0AVG(I,J,K)
@@ -2634,7 +6426,7 @@ iter:     DO NCOUNT=1,10
 !        RAINCV(I,J)=.1*.5*DT*PPTFLX/DXSQ               !  PPT FB MODS
 !         RNC=0.1*TIMEC*PPTFLX/DXSQ
         RNC=RAINCV(I,J)*NIC
-       IF(ISHALL.EQ.0.AND.IPRNT)write (98,909)I,J,RNC
+!       IF(ISHALL.EQ.0.AND.IPRNT)write (98,909)I,J,RNC
 
 !     WRITE(98,1095)CPR*AINC,TDER+PPTFLX+CNDTNF
 !     
@@ -2653,13 +6445,13 @@ iter:     DO NCOUNT=1,10
         QFNL=QFNL+PPTFLX*TIMEC*(1.-FBFRC)       !  PPT FB MODS
 !        QFNL=QFNL+PPTFLX*TIMEC                 !  PPT FB MODS
         ERR2=(QFNL-QINIT)*100./QINIT
-       IF(IPRNT)WRITE(98,1110)QINIT,QFNL,ERR2
+!       IF(IPRNT)WRITE(98,1110)QINIT,QFNL,ERR2
       IF(ABS(ERR2).GT.0.05 .AND. ISTOP.EQ.0)THEN 
 !       write(99,*)'!!!!!!!! MOISTURE BUDGET ERROR IN KFPARA !!!'
 !       WRITE(99,1110)QINIT,QFNL,ERR2
-        IPRNT=.TRUE.
+        IPRNT=.FALSE.
         ISTOP=1
-            write(98,4422)kl
+!            write(98,4422)kl
  4422       format(i6)
             DO 311 NK = 1,KL
               k = kl - nk + 1
@@ -2668,8 +6460,8 @@ iter:     DO NCOUNT=1,10
 !             write(98) p0,t0,q0,u0,v0,w0,dp,tke
 !           WRITE(98,1115)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
 !                    U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
-            WRITE(98,4456)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
-                     U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
+!            WRITE(98,4456)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
+!                     U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
  311        CONTINUE
 !           flush(98)
 
@@ -2684,9 +6476,9 @@ iter:     DO NCOUNT=1,10
           RELERR=0.
         ENDIF
      IF(IPRNT)THEN
-        WRITE(98,1120)RELERR
-        WRITE(98,*)'TDER, CPR, TRPPT =',              &
-          TDER,CPR*AINC,TRPPT*AINC
+!        WRITE(98,1120)RELERR
+!        WRITE(98,*)'TDER, CPR, TRPPT =',              &
+!          TDER,CPR*AINC,TRPPT*AINC
      ENDIF
 !     
 !...FEEDBACK TO RESOLVABLE SCALE TENDENCIES.
@@ -2820,7 +6612,10 @@ iter:     DO NCOUNT=1,10
    END SUBROUTINE  KF_eta_PARA
 !********************************************************************
 ! ***********************************************************************
-   SUBROUTINE TPMIX2(p,thes,tu,qu,qliq,qice,qnewlq,qnewic,XLV1,XLV0)
+!dkay
+!dkay: added QSu as output to get saturated Q of updraft
+
+   SUBROUTINE TPMIX2(p,thes,tu,qu,qliq,qice,qnewlq,qnewic,XLV1,XLV0,Qsu)
 !
 ! Lookup table variables:
 !     INTEGER, PARAMETER :: (KFNT=250,KFNP=220)
@@ -2833,7 +6628,7 @@ iter:     DO NCOUNT=1,10
    IMPLICIT NONE
 !-----------------------------------------------------------------------
    REAL,         INTENT(IN   )   :: P,THES,XLV1,XLV0
-   REAL,         INTENT(OUT  )   :: QNEWLQ,QNEWIC
+   REAL,         INTENT(OUT  )   :: QNEWLQ,QNEWIC,QSu
    REAL,         INTENT(INOUT)   :: TU,QU,QLIQ,QICE
    REAL    ::    TP,QQ,BTH,TTH,PP,T00,T10,T01,T11,Q00,Q10,Q01,Q11,          &
                  TEMP,QS,QNEW,DQ,QTOT,RLL,CPP
@@ -2866,7 +6661,7 @@ iter:     DO NCOUNT=1,10
       pp   =tth-aint(tth)
       ithtb=int(tth)+1
        IF(IPTB.GE.220 .OR. IPTB.LE.1 .OR. ITHTB.GE.250 .OR. ITHTB.LE.1)THEN
-         write(98,*)'**** OUT OF BOUNDS *********'
+!         write(98,*)'**** OUT OF BOUNDS *********'
 !        flush(98)
        ENDIF
 !
@@ -2887,6 +6682,11 @@ iter:     DO NCOUNT=1,10
       temp=(t00+(t10-t00)*pp+(t01-t00)*qq+(t00-t10-t01+t11)*pp*qq)
 !
       qs=(q00+(q10-q00)*pp+(q01-q00)*qq+(q00-q10-q01+q11)*pp*qq)
+
+!dkay
+       QSu = qs
+!
+
 !
       DQ=QS-QU
       IF(DQ.LE.0.)THEN
@@ -3225,6 +7025,7 @@ iter:     DO NCOUNT=1,10
                                       its, ite, jts, jte, kts, kte
    INTEGER , INTENT(IN)           ::  P_QI,P_QS,P_FIRST_SCALAR
 
+
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
                                                           RTHCUTEN, &
                                                           RQVCUTEN, &
@@ -3295,6 +7096,7 @@ iter:     DO NCOUNT=1,10
  
    CALL KF_LUTAB(SVP1,SVP2,SVP3,SVPT0)
 
+
    END SUBROUTINE mskf_init
 
 !-------------------------------------------------------
diff --git a/phys/module_cumulus_driver.F b/phys/module_cumulus_driver.F
index ef13b27..a14f3d7 100644
--- a/phys/module_cumulus_driver.F
+++ b/phys/module_cumulus_driver.F
@@ -124,7 +124,13 @@ CONTAINS
 #if ( WRF_DFI_RADAR == 1 )
                  ! Optional CAP suppress option      --- 3.2 CLEANUP TODO -- THESE SHOULD BE OPTIONAL, NOT #IF/#ENDIF
                      ,do_capsuppress                                  &
-#endif                                 
+#endif 
+#if (EM_CORE == 1)                               
+          ,QR_CU,QS_CU,NC_CU,NI_CU,NR_CU,NS_CU,CCN_CU,CU_UAF          & !TWG
+          ,alevsiz_cu,num_months,no_src_types_cu,aercu_opt,aercu_fct  & !PSH/TWG 06/10/16
+          ,aeromcu,aerocu,aeropcu,id,JULDAY,JULIAN,aerovar            & !PSH/TWG 06/10/16
+          ,EFCS,EFIS,EFSS                                             & !TWG
+#endif
                                                                       )
 !----------------------------------------------------------------------
    USE module_model_constants
@@ -574,11 +580,22 @@ CONTAINS
                   INTENT(INOUT) ::                               &
                   QC_CU,QI_CU
                   
+#if (EM_CORE == 1)
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+                  INTENT(INOUT) ::                               &
+                  QR_CU,QS_CU,                                   & !TWG
+                  NC_CU,NI_CU,NR_CU,NS_CU,CCN_CU,                & !TWG
+                  EFCS,EFIS,EFSS                                   !TWG
+
+   REAL, DIMENSION( ims:ime, jms:jme ),                          &
+                  INTENT(INOUT) ::                               &
+                  CU_UAF                                           !TWG
+#endif
+                  
    REAL, DIMENSION( ims:ime , jms:jme , 1:ensdim ),              &
           OPTIONAL,                                              &
           INTENT(INOUT) ::                       XF_ENS, PR_ENS
 
-
 #if (EM_CORE == 1)
 !BSINGH - For WRFCuP Scheme
   REAL, DIMENSION( ims:ime , jms:jme ),                         &
@@ -677,6 +694,23 @@ CONTAINS
    logical :: l_flux
    LOGICAL :: decided , run_param , doing_adapt_dt
 
+#if (EM_CORE == 1)
+!PSH/TWG 06/10/16
+   INTEGER,  INTENT(IN)        :: alevsiz_cu, num_months, no_src_types_cu 
+   INTEGER,  INTENT(IN)        :: aercu_opt  
+   REAL,     INTENT(IN)        :: aercu_fct  
+   REAL, DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months, no_src_types_cu) :: aeromcu 
+   REAL, DIMENSION( ims:ime, alevsiz_cu, jms:jme, no_src_types_cu)   :: aerotcu
+   REAL, DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months)        :: aeropcu 
+   REAL, DIMENSION( ims:ime, alevsiz_cu, jms:jme )                   :: aeroptcu 
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu)      :: aerocu 
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme)                       :: aerovar 
+   REAL, INTENT(IN)    :: JULIAN        
+   INTEGER, INTENT(IN) :: id 
+   INTEGER, INTENT(IN) :: JULDAY
+!PSH/TWG END
+#endif
+
 
 !-----------------------------------------------------------------
     pattern_spp_conv=0.
@@ -817,7 +851,7 @@ CONTAINS
       endif
 
       IF ( cu_physics == G3SCHEME .OR.  cu_physics == GFSCHEME .OR.     &
-           cu_physics == KFETASCHEME .OR. cu_physics == MSKFSCHEME ) THEN
+           cu_physics == KFETASCHEME .OR. cu_physics == MSKFSCHEME) THEN 
 #ifdef DM_PARALLEL
 #include "HALO_CUP_G3_IN.inc"
 #endif
@@ -848,8 +882,42 @@ CONTAINS
         end do
         !wig, end.
         !BSINGH - ENDS
-#endif
 
+!PSH/TWG 06/10/16
+        !The following is for introducing aerosol data into the MSKF scheme !
+        !If the flag is set, the aerosol data will be interpolated in       !
+        !time and then pressure to the current state.  -PSH                 !
+        IF ( aercu_opt .GT. 0 ) THEN
+          IF ( aercu_opt .GT. 0 .AND. id .EQ. 1 ) THEN
+            call aer_time_int_cu(julday,julian,aeromcu,aerotcu,alevsiz_cu,num_months,no_src_types_cu,&
+                                  ids , ide , jds , jde , kds , kde ,     &
+                                  ims , ime , jms , jme , kms , kme ,     &
+                                  its , ite , jts , jte , kts , kte )
+
+            ! INTERPOLATE PRESSURE IN TIME
+            call aer_time_int_cu(julday,julian,aeropcu,aeroptcu,alevsiz_cu,num_months,1, &
+                                  ids , ide , jds , jde , kds , kde ,     &
+                                  ims , ime , jms , jme , kms , kme ,     &
+                                  its , ite , jts , jte , kts , kte )
+
+            call aer_p_int_cu(p ,aeroptcu, alevsiz_cu, aerotcu, aerocu, no_src_types_cu, p8w, &
+                                   ids , ide , jds , jde , kds , kde ,     &
+                                   ims , ime , jms , jme , kms , kme ,     &
+                                   its , ite , jts , jte , kts , kte )
+
+          do j=jts,jte
+             do k=kts,kte
+                do i=its,ite
+                   aerovar(i,k,j)=aerocu(i,k,j,2)
+                end do
+              end do
+          end do
+
+          ENDIF
+        ENDIF
+!PSH/TWG END
+
+#endif
 
    cps_select: SELECT CASE(cu_physics)
 
@@ -942,10 +1010,10 @@ CONTAINS
                ,UDR_KF=udr_kf,DDR_KF=ddr_kf                     & !kf_edrates
                ,UER_KF=uer_kf,DER_KF=der_kf                     & 
                ,TIMEC_KF=timec_kf,KF_EDRATES=kf_edrates         ) 
-
 #if (EM_CORE==1)
      CASE (MSKFSCHEME)
-          CALL wrf_debug(100,'in mskf_cps')
+          CALL wrf_debug(100,'in mskf_cps_mp')
+      
           CALL MSKF_CPS(                                        &
                 U=u ,V=v ,TH=th ,T=t ,W=w ,RHO=rho              &
                ,CUDT=cudt_pass                                  &
@@ -975,11 +1043,16 @@ CONTAINS
                ,CLDFRA_DP_KF=cldfra_dp                          & ! ckay for sub-grid cloud
                ,CLDFRA_SH_KF=cldfra_sh                          &
                ,W_UP=w_up                                       & ! ckay
-               ,QC_KF=QC_CU,QI_KF=QI_CU                         &
+               ,QC_KF=QC_CU,QI_KF=QI_CU,QR_KF=QR_CU,QS_KF=QS_CU & ! TWG
+               ,NC_KF=NC_CU,NI_KF=NI_CU,NR_KF=NR_CU,NS_KF=NS_CU & ! TWG
+               ,CCN_KF=CCN_CU,AINC_FRAC=CU_UAF                  & ! TWG
                ,UDR_KF=udr_kf,DDR_KF=ddr_kf                     & !kf_edrates
                ,UER_KF=uer_kf,DER_KF=der_kf                     & 
                ,TIMEC_KF=timec_kf,KF_EDRATES=kf_edrates         & 
-               ,ZOL=zol,WSTAR=wstar,UST=ust,PBLH=pblh           )  !ckay
+               ,ZOL=zol,WSTAR=wstar,UST=ust,PBLH=pblh           & !ckay
+               ,AEROCU=aerocu,NO_SRC_TYPES_CU=no_src_types_cu   & !PSH/TWG 06/10/16
+               ,AERCU_FCT=aercu_fct,AERCU_OPT=aercu_opt        &
+               ,EFCS=EFCS,EFIS=EFIS,EFSS=EFSS) !PSH 06/10/16
 #endif
 
      CASE (GDSCHEME)
@@ -1508,4 +1581,268 @@ CONTAINS
 
    END SUBROUTINE cumulus_driver
 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!                    PSH/TWG 06/10/16                       !!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! AER_TIME_INT and AER_P_INT were copied from the radiation driver code   !
+! for interpolating aerosol data in time and pressure. They have been     !
+! modified slightly here for aerosol data input to the MSKF scheme.       !
+
+SUBROUTINE aer_time_int_cu(julday,julian,aerodm,aerodt,levsiz,num_months,no_src,&
+                              ids , ide , jds , jde , kds , kde ,     &
+                              ims , ime , jms , jme , kms , kme ,     &
+                              its , ite , jts , jte , kts , kte )
+
+! adapted from oznint from CAM module
+!  input: aerodm - read from physics_init
+! output: aerodt - time interpolated
+
+!  USE module_ra_cam_support, ONLY : getfactors
+
+   IMPLICIT NONE
+
+   INTEGER,    INTENT(IN) ::           ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+
+   INTEGER,      INTENT(IN   )    ::   levsiz, num_months, no_src
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, num_months, no_src ),      &
+          INTENT(IN   ) ::                                  aerodm
+
+   INTEGER, INTENT(IN )      ::        JULDAY
+   REAL,    INTENT(IN )      ::        JULIAN
+
+   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, no_src ),      &
+          INTENT(OUT  ) ::                                  aerodt
+
+   !Local
+   REAL      :: intJULIAN
+   integer   :: np1,np,nm,m,k,i,j,s
+   integer   :: IJUL
+   integer, dimension(12) ::  date_oz
+   data date_oz/16, 45, 75, 105, 136, 166, 197, 228, 258, 289, 319, 350/
+   real, parameter :: daysperyear = 365.  ! number of days in a year
+   real      :: cdayozp, cdayozm
+   real      :: fact1, fact2, deltat
+   logical   :: finddate
+   logical   :: ozncyc
+   CHARACTER(LEN=256) :: msgstr
+
+   ozncyc = .true.
+   ! JULIAN starts from 0.0 at 0Z on 1 Jan.
+   intJULIAN = JULIAN + 1.0       ! offset by one day
+! jan 1st 00z is julian=1.0 here
+   IJUL=INT(intJULIAN)
+!  Note that following will drift.
+!    Need to use actual month/day info to compute julian.
+   intJULIAN=intJULIAN-FLOAT(IJUL)
+   IJUL=MOD(IJUL,365)
+   IF(IJUL.EQ.0)IJUL=365
+   intJULIAN=intJULIAN+IJUL
+   np1=1
+   finddate=.false.
+
+!  do m=1,num_months
+   do m=1,12
+      if(date_oz(m).gt.intjulian.and..not.finddate) then
+        np1=m
+        finddate=.true.
+      endif
+   enddo
+   cdayozp=date_oz(np1)
+
+   if(np1.gt.1) then
+      cdayozm=date_oz(np1-1)
+      np=np1
+      nm=np-1
+   else
+      cdayozm=date_oz(12)
+      np=np1
+      nm=12
+   endif
+
+!  call getfactors(ozncyc,np1, cdayozm, cdayozp,intjulian, &
+!                   fact1, fact2)
+!
+! Determine time interpolation factors.  Account for December-January
+! interpolation if dataset is being cycled yearly.
+!
+   if (ozncyc .and. np1 == 1) then                      ! Dec-Jan interpolation
+      deltat = cdayozp + daysperyear - cdayozm
+      if (intjulian > cdayozp) then                     ! We are in December
+         fact1 = (cdayozp + daysperyear - intjulian)/deltat
+         fact2 = (intjulian - cdayozm)/deltat
+      else                                              ! We are in January
+         fact1 = (cdayozp - intjulian)/deltat
+         fact2 = (intjulian + daysperyear - cdayozm)/deltat
+      end if
+   else
+      deltat = cdayozp - cdayozm
+      fact1 = (cdayozp - intjulian)/deltat
+      fact2 = (intjulian - cdayozm)/deltat
+   end if
+!
+! Time interpolation.
+!
+      do s=1, no_src
+        do j=jts,jte
+          do k=1,levsiz
+            do i=its,ite
+            aerodt(i,k,j,s) = aerodm(i,k,j,nm,s)*fact1 + aerodm(i,k,j,np,s)*fact2
+            end do
+          end do
+        end do
+      end do
+
+END SUBROUTINE aer_time_int_cu
+
+
+SUBROUTINE aer_p_int_cu(p ,pin_cu, levsiz_cu, aerotcu, aerocu, no_src_cu, pf, &
+                     ids , ide , jds , jde , kds , kde ,     &
+                     ims , ime , jms , jme , kms , kme ,     &
+                     its , ite , jts , jte , kts , kte )
+
+!-----------------------------------------------------------------------
+!
+! Purpose: Interpolate aerosol from current time-interpolated values to model
+! levels
+!
+! Method: Use pressure values to determine interpolation levels
+!
+! Author: Bruce Briegleb
+! WW: Adapted for general use
+! PSH: Modified to not calculate totaod 
+! 
+!   p:  model level pressure at half levels (Pa, bottom-up)
+!   pf: model level pressure at full levles (Pa, bottom-up)
+!
+!--------------------------------------------------------------------------
+   implicit none
+!--------------------------------------------------------------------------
+!
+! Arguments
+!
+
+   INTEGER,    INTENT(IN) ::           ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+
+   integer, intent(in) :: levsiz_cu              ! number of aerosol layers
+   integer, intent(in) :: no_src_cu              ! types of aerosol 
+
+   real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
+   real, intent(in) :: pf(ims:ime,kms:kme,jms:jme)
+   real, intent(in) :: pin_cu(ims:ime,levsiz_cu,jms:jme)        ! aerosol data level pressures (mks, top-down)
+   real, intent(in) :: aerotcu(ims:ime,levsiz_cu,jms:jme,no_src_cu) ! aerosol optical depth
+   real, intent(out) :: aerocu(ims:ime,kms:kme,jms:jme,no_src_cu+1) ! aerosol optical depth
+!
+! local storage
+!
+   real    pmid(its:ite,kts:kte)
+   integer i,j                 ! longitude index
+   integer k, kk, kkstart, kout! level indices
+   integer kupper(its:ite)     ! Level indices for interpolation
+   integer kount               ! Counter
+   integer ncol, pver, s
+
+   real    dpu                 ! upper level pressure difference
+   real    dpl                 ! lower level pressure difference
+
+   ncol = ite - its + 1
+   pver = kte - kts + 1
+
+   do s=1,no_src_cu
+   do j=jts,jte
+!
+! Initialize index array
+!
+   do i=its, ite
+      kupper(i) = 1
+   end do
+!
+! The pressure from incoming data is in hPa and top-down, 
+!     while model pressure is in Pa and bottom-up
+!
+      do k = kts,kte
+         kk = kte - k + kts
+      do i = its,ite
+         pmid(i,kk) = p(i,k,j)!*0.01
+      enddo
+      enddo
+
+   do k=1,pver
+
+      kout = pver - k + 1
+
+!
+! Top level we need to start looking is the top level for the previous k
+! for all longitude points
+!
+      kkstart = levsiz_cu
+      do i=its,ite
+         kkstart = min0(kkstart,kupper(i))
+      end do
+      kount = 0
+
+!
+! Store level indices for interpolation
+!
+      do kk=kkstart,levsiz_cu-1
+         do i=its,ite
+            if (pin_cu(i,kk,j).lt.pmid(i,k) .and. pmid(i,k).le.pin_cu(i,kk+1,j)) then
+               kupper(i) = kk
+               kount = kount + 1
+            end if
+         end do
+!
+! If all indices for this level have been found, do the interpolation and
+! go to the next level
+!
+         if (kount.eq.ncol) then
+            do i=its,ite
+               dpu = pmid(i,k) - pin_cu(i,kupper(i),j)
+               dpl = pin_cu(i,kupper(i)+1,j) - pmid(i,k)
+               aerocu(i,kout,j,s) = (aerotcu(i,kupper(i),j,s)*dpl + &
+                             aerotcu(i,kupper(i)+1,j,s)*dpu)/(dpl + dpu)
+            end do
+            goto 35
+         end if
+      end do
+
+!
+! If we've fallen through the kk=1,levsiz_cu-1 loop, we cannot interpolate and
+! must extrapolate from the bottom or top aerosol data level for at least some
+! of the longitude points.
+!
+      do i=its,ite
+         if (pmid(i,k) .lt. pin_cu(i,1,j)) then
+            aerocu(i,kout,j,s) = aerotcu(i,1,j,s)*pmid(i,k)/pin_cu(i,1,j)
+         else if (pmid(i,k) .gt. pin_cu(i,levsiz_cu,j)) then
+            aerocu(i,kout,j,s) = aerotcu(i,levsiz_cu,j,s)
+         else
+            dpu = pmid(i,k) - pin_cu(i,kupper(i),j)
+            dpl = pin_cu(i,kupper(i)+1,j) - pmid(i,k)
+            aerocu(i,kout,j,s) = (aerotcu(i,kupper(i),j,s)*dpl + &
+                          aerotcu(i,kupper(i)+1,j,s)*dpu)/(dpl + dpu)
+         end if
+      end do
+
+      if (kount.gt.ncol) then
+         call wrf_error_fatal ('AER_P_INT: Bad aerosol data: non-monotonicity suspected')
+      end if
+35    continue
+
+   end do
+   end do
+   end do
+
+   return
+END SUBROUTINE aer_p_int_cu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!             END    PSH/TWG 06/10/16   EDITS               !!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
 END MODULE module_cumulus_driver
diff --git a/phys/module_diag_afwa.F b/phys/module_diag_afwa.F
index 11fee1d..872acaa 100644
--- a/phys/module_diag_afwa.F
+++ b/phys/module_diag_afwa.F
@@ -2437,7 +2437,8 @@ CONTAINS
         ELSEIF ( config_flags % mp_physics == WSM5SCHEME .OR.   &
                  config_flags % mp_physics == WSM6SCHEME ) THEN
           icing_opt=4
-        ELSEIF ( config_flags % mp_physics == MORR_TWO_MOMENT ) THEN
+        ELSEIF ( config_flags % mp_physics == MORR_TWO_MOMENT .OR. &
+                 config_flags % mp_physics == MORR_TM_AERO ) THEN  !TWG add 2017
 
           ! Is this run with prognostic cloud droplets or no?
           ! -------------------------------------------------
diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F
index 3a86ac7..1bb854e 100644
--- a/phys/module_diag_misc.F
+++ b/phys/module_diag_misc.F
@@ -65,7 +65,8 @@ CONTAINS
       WSM6SCHEME, ETAMPNEW, THOMPSON, THOMPSONAERO,                     &
       MORR_TWO_MOMENT, GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME,           &
       NSSL_2MOM, NSSL_2MOMG, NSSL_2MOMCCN, NSSL_1MOM, NSSL_1MOMLFO,                 &
-      MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN, FULL_KHAIN_LYNN    !,MILBRANDT3MOM, NSSL_3MOM
+      MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN, FULL_KHAIN_LYNN,  &
+      MORR_TM_AERO  !TWG 2017  !,MILBRANDT3MOM, NSSL_3MOM
 
    IMPLICIT NONE
 !======================================================================
@@ -866,7 +867,7 @@ CONTAINS
 !      scheme_has_graupel = .true.
 !      either Hugh or Jason need to implement.
 
-     CASE (MORR_TWO_MOMENT)
+     CASE (MORR_TWO_MOMENT, MORR_TM_AERO)
        scheme_has_graupel = .true.
        xrho_g = 400.
        if (mpuse_hail .eq. 1) xrho_g = 900.
diff --git a/phys/module_diagnostics_driver.F b/phys/module_diagnostics_driver.F
index cea4ff6..7bc2c83 100644
--- a/phys/module_diagnostics_driver.F
+++ b/phys/module_diagnostics_driver.F
@@ -43,7 +43,8 @@ CONTAINS
                      WSM6SCHEME, ETAMPNEW, THOMPSON, THOMPSONAERO,                     &
                      MORR_TWO_MOMENT, GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME,           &
                      NSSL_2MOM, NSSL_2MOMCCN, NSSL_1MOM, NSSL_1MOMLFO,                 &
-                     MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN, FULL_KHAIN_LYNN    !,MILBRANDT3MOM, NSSL_3MOM, MORR_MILB_P3
+                     MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN, FULL_KHAIN_LYNN,  &
+                     MORR_TM_AERO !TWG add    !,MILBRANDT3MOM, NSSL_3MOM, MORR_MILB_P3
 
       USE module_driver_constants, ONLY: max_plevs, max_zlevs
 
@@ -414,7 +415,7 @@ CONTAINS
                 ,NUM_TILES=grid%num_tiles                            &
                                                                     )
 
-        CASE (MORR_TWO_MOMENT)
+        CASE (MORR_TWO_MOMENT, MORR_TM_AERO)  ! TWG add
 
       CALL diagnostic_output_calc(                                   &
                  DPSDT=grid%dpsdt   ,DMUDT=grid%dmudt                &
diff --git a/phys/module_microphysics_driver.F b/phys/module_microphysics_driver.F
index 7aa54e9..69434e3 100644
--- a/phys/module_microphysics_driver.F
+++ b/phys/module_microphysics_driver.F
@@ -97,7 +97,14 @@ SUBROUTINE microphysics_driver(                                          &
                       ,QV_OLD                                            &
                       ,xlat,xlong,ivgtyp                                 &
                       ,qrimef_curr,f_qrimef                              &
-                                                   )
+                      ,aercu_opt                                         & !TWG
+# if( EM_CORE==1 )
+                      ,aerocu,no_src_types_cu                            & !TWG
+                      ,PBL,EFCG,EFIG,EFSG,WACT,CCN1_GS,CCN2_GS           & !TWG
+                      ,CCN3_GS,CCN4_GS,CCN5_GS,CCN6_GS,CCN7_GS           & !TWG
+# endif
+                                                                         )
+
 ! Framework
 #if(NMM_CORE==1)
    USE module_state_description, ONLY :                                  &
@@ -112,7 +119,7 @@ SUBROUTINE microphysics_driver(                                          &
                     ,WSM6SCHEME, ETAMPNEW, FER_MP_HIRES, THOMPSON, THOMPSONAERO, FAST_KHAIN_LYNN, MORR_TWO_MOMENT     &
                     ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG  &
                     ,NSSL_1MOM,NSSL_1MOMLFO, FER_MP_HIRES_ADVECT & ! ,NSSL_3MOM       &
-                    ,MILBRANDT2MOM , CAMMGMPSCHEME,FULL_KHAIN_LYNN, P3_1CATEGORY, P3_1CATEGORY_NC !,MILBRANDT3MOM
+                    ,MILBRANDT2MOM , CAMMGMPSCHEME,FULL_KHAIN_LYNN, P3_1CATEGORY, P3_1CATEGORY_NC, MORR_TM_AERO !,MILBRANDT3MOM
 #endif
 
 #ifdef DM_PARALLEL
@@ -146,6 +153,9 @@ SUBROUTINE microphysics_driver(                                          &
    USE module_mp_gsfcgce
    USE module_mp_morr_two_moment
    USE module_mp_p3
+# if (EM_CORE == 1)
+   USE module_mp_morr_two_moment_aero ! add TWG
+# endif
    USE module_mp_wdm5
    USE module_mp_wdm6
    USE module_mp_milbrandt2mom
@@ -414,6 +424,9 @@ REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
                                                             lradius, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             iradius, &    !Old Cloud fraction for CAMMGMP microphysics only                                                            
                                                         cldfra_conv 
+
+
+
 #if ( WRF_CHEM == 1 )
 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
       INTENT(INOUT), OPTIONAL ::                                                 &
@@ -479,8 +492,6 @@ REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
                  ,qnwfa_curr,qnifa_curr                           & ! Added by G. Thompson
                  ,qvolg_curr,qvolh_curr, qrimef_curr
 
-
-
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
          OPTIONAL,                                                &
          INTENT(IN) :: qrcuten, qscuten, qicuten, qccuten
@@ -542,6 +553,30 @@ REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
    REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) ::  & ! G. Thompson
                  re_cloud, re_ice, re_snow
    INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs
+
+! TWG 06/17/16 Variables for prescribed CESM aerosol
+  INTEGER,           INTENT(IN   )    :: aercu_opt
+# if (EM_CORE == 1)
+
+  INTEGER, OPTIONAL, INTENT(IN   )    :: PBL
+  INTEGER,           INTENT(IN   )    :: no_src_types_cu
+  REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), INTENT(INOUT) & 
+                                      :: aerocu
+  REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) &
+                                      :: EFCG,           &
+                                         EFIG,           &
+                                         EFSG,           &
+                                         WACT,           &
+                                         CCN1_GS,        &
+                                         CCN2_GS,        &
+                                         CCN3_GS,        &
+                                         CCN4_GS,        &
+                                         CCN5_GS,        &
+                                         CCN6_GS,        &
+                                         CCN7_GS
+# endif
+! END TWG
+
 !  REAL , DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT) :: lwp
 
 ! LOCAL  VAR
@@ -1106,6 +1141,81 @@ REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
                                                                     )
 #endif
 
+
+# if (EM_CORE == 1)
+    CASE (MORR_TM_AERO)
+         CALL wrf_debug(100, 'microphysics_driver: calling morrison two moment')
+         IF ( PRESENT (MU) .AND. PRESENT (QSCUTEN).AND. &
+              PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
+              PRESENT ( W      )  ) THEN
+         CALL mp_morr_two_moment_aero(                            &
+                     ITIMESTEP=itimestep,                &  !*
+                     TH=th,                              &  !*
+                     QV=qv_curr,                         &  !*
+                     QC=qc_curr,                         &  !*
+                     QR=qr_curr,                         &  !*
+                     QI=qi_curr,                         &  !*
+                     QS=qs_curr,                         &  !*
+                     QG=qg_curr,                         &  !*
+                     NI=qni_curr,                        &  !*
+                     NS=qns_curr,                        &  !* ! VVT
+                     NR=qnr_curr,                        &  !* ! VVT
+                     NG=qng_curr,                        &  !* ! VVT
+                     NC=qnc_curr,                        &  ! TWG/amy added nc
+                     TKE=tke_pbl,                        &  ! TWG/amy add
+                     KZH=exch_h,                         &  ! TWG/amy add
+                     RHO=rho,                            &  !*
+                     PII=pi_phy,                         &  !*
+                     P=p,                                &  !*
+                     DT_IN=dt,                           &  !*
+                     DZ=dz8w,                            &  !* !hm
+                     HT=ht,                              &  !*
+                     W=w                                 &  !*
+                    ,RAINNC=RAINNC                       &  !*
+                    ,RAINNCV=RAINNCV                     &  !*
+                    ,SNOWNC=SNOWNC                       &  !*
+                    ,SNOWNCV=SNOWNCV                     &  !*
+                    ,GRAUPELNC=GRAUPELNC                 &  !*
+                    ,GRAUPELNCV=GRAUPELNCV               &  !*
+                    ,SR=SR                               &  !* !hm
+                    ,REFL_10CM=refl_10cm                 &  ! added for radar reflectivity
+                    ,diagflag=diagflag                   &  ! added for radar reflectivity
+                    ,do_radar_ref=do_radar_ref           &  ! added for radar reflectivity
+                    ,qrcuten=qrcuten                     &  ! hm
+                    ,qscuten=qscuten                     &  ! hm
+                    ,qicuten=qicuten                     &  ! hm
+                    ,mu=mu                               &  ! hm
+                    ,F_QNDROP=f_qndrop                   &  ! hm for wrf-chem
+                 ,QNDROP=qndrop_curr                     &  ! hm for wrf-chem
+                 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
+                 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
+                 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
+                 ,PBL=PBL                                & ! TWG/amy add
+                 ,aerocu=aerocu                          & ! TWG add
+                 ,aercu_opt=aercu_opt                    & ! TWG add
+                 ,no_src_types_cu=no_src_types_cu        & ! TWG add
+                 ,EFCG=EFCG                              & ! TWG add
+                 ,EFIG=EFIG                              & ! TWG add
+                 ,EFSG=EFSG                              & ! TWG add
+                 ,WACT=WACT                              & ! TWG add
+                 ,CCN1_GS=CCN1_GS                        & ! TWG add
+                 ,CCN2_GS=CCN2_GS                        & ! TWG add
+                 ,CCN3_GS=CCN3_GS                        & ! TWG add
+                 ,CCN4_GS=CCN4_GS                        & ! TWG add
+                 ,CCN5_GS=CCN5_GS                        & ! TWG add
+                 ,CCN6_GS=CCN6_GS                        & ! TWG add
+                 ,CCN7_GS=CCN7_GS                        & ! TWG add
+                 ,QLSINK=qlsink                                     & ! jdf for wrf-chem
+#if ( WRF_CHEM == 1 )
+                 ,EVAPPROD=evapprod,RAINPROD=rainprod               &
+#endif
+                 ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg   & ! jdf for wrf-chem
+                                                                    )
+        ELSE
+           Call wrf_error_fatal( 'arguments not present for calling morrison two moment aerosol')
+        ENDIF
+#endif
+
     CASE (MILBRANDT2MOM)
          CALL wrf_debug(100, 'microphysics_driver: calling milbrandt2mom')
          IF (PRESENT (QV_CURR) .AND.                           &
diff --git a/phys/module_mp_morr_two_moment_aero.F b/phys/module_mp_morr_two_moment_aero.F
new file mode 100644
index 0000000..e71ca57
--- /dev/null
+++ b/phys/module_mp_morr_two_moment_aero.F
@@ -0,0 +1,6090 @@
+!WRF:MODEL_LAYER:PHYSICS
+!
+
+! THIS MODULE CONTAINS THE TWO-MOMENT MICROPHYSICS CODE DESCRIBED BY
+!     MORRISON ET AL. (2009, MWR)
+
+! CHANGES FOR V3.2, RELATIVE TO MOST RECENT (BUG-FIX) CODE FOR V3.1
+
+! 1) ADDED ACCELERATED MELTING OF GRAUPEL/SNOW DUE TO COLLISION WITH RAIN, FOLLOWING LIN ET AL. (1983)
+! 2) INCREASED MINIMUM LAMBDA FOR RAIN, AND ADDED RAIN DROP BREAKUP FOLLOWING MODIFIED VERSION
+!     OF VERLINDE AND COTTON (1993)
+! 3) CHANGE MINIMUM ALLOWED MIXING RATIOS IN DRY CONDITIONS (RH < 90%), THIS IMPROVES RADAR REFLECTIIVITY
+!     IN LOW REFLECTIVITY REGIONS
+! 4) BUG FIX TO MAXIMUM ALLOWED PARTICLE FALLSPEEDS AS A FUNCTION OF AIR DENSITY
+! 5) BUG FIX TO CALCULATION OF LIQUID WATER SATURATION VAPOR PRESSURE (CHANGE IS VERY MINOR)
+! 6) INCLUDE WRF CONSTANTS PER SUGGESTION OF JIMY
+
+! bug fix, 5/12/10
+! 7) bug fix for saturation vapor pressure in low pressure, to avoid division by zero
+! 8) include 'EP2' WRF constant for saturation mixing ratio calculation, instead of hardwire constant
+
+! CHANGES FOR V3.3
+! 1) MODIFICATION FOR COUPLING WITH WRF-CHEM (PREDICTED DROPLET NUMBER CONCENTRATION) AS AN OPTION
+! 2) MODIFY FALLSPEED BELOW THE LOWEST LEVEL OF PRECIPITATION, WHICH PREVENTS
+!      POTENTIAL FOR SPURIOUS ACCUMULATION OF PRECIPITATION DURING SUB-STEPPING FOR SEDIMENTATION
+! 3) BUG FIX TO LATENT HEAT RELEASE DUE TO COLLISIONS OF CLOUD ICE WITH RAIN
+! 4) CLEAN UP OF COMMENTS IN THE CODE
+    
+! additional minor bug fixes and small changes, 5/30/2011
+! minor revisions by A. Ackerman April 2011:
+! 1) replaced kinematic with dynamic viscosity 
+! 2) replaced scaling by air density for cloud droplet sedimentation
+!    with viscosity-dependent Stokes expression
+! 3) use Ikawa and Saito (1991) air-density scaling for cloud ice
+! 4) corrected typo in 2nd digit of ventilation constant F2R
+
+! additional fixes:
+! 5) TEMPERATURE FOR ACCELERATED MELTING DUE TO COLLIIONS OF SNOW AND GRAUPEL
+!    WITH RAIN SHOULD USE CELSIUS, NOT KELVIN (BUG REPORTED BY K. VAN WEVERBERG)
+! 6) NPRACS IS NOT SUBTRACTED FROM SNOW NUMBER CONCENTRATION, SINCE
+!    DECREASE IN SNOW NUMBER IS ALREADY ACCOUNTED FOR BY NSMLTS 
+! 7) fix for switch for running w/o graupel/hail (cloud ice and snow only)
+
+! hm bug fix 3/16/12
+
+! 1) very minor change to limits on autoconversion source of rain number when cloud water is depleted
+
+! WRFV3.5
+! hm/A. Ackerman bug fix 11/08/12
+
+! 1) for accelerated melting from collisions, should use rain mass collected by snow, not snow mass 
+!    collected by rain
+! 2) minor changes to some comments
+! 3) reduction of maximum-allowed ice concentration from 10 cm-3 to 0.3
+!    cm-3. This was done to address the problem of excessive and persistent
+!    anvil cirrus produced by the scheme.
+
+! CHANGES FOR WRFV3.5.1
+! 1) added output for snow+cloud ice and graupel time step and accumulated
+!    surface precipitation
+! 2) bug fix to option w/o graupel/hail (IGRAUP = 1), include PRACI, PGSACW,
+!    and PGRACS as sources for snow instead of graupel/hail, bug reported by
+!    Hailong Wang (PNNL)
+! 3) very minor fix to immersion freezing rate formulation (negligible impact)
+! 4) clarifications to code comments
+! 5) minor change to shedding of rain, remove limit so that the number of 
+!    collected drops can smaller than number of shed drops
+! 6) change of specific heat of liquid water from 4218 to 4187 J/kg/K
+
+! CHANGES FOR WRFV3.6.1
+! 1) minor bug fix to melting of snow and graupel, an extra factor of air density (RHO) was removed
+!    from the calculation of PSMLT and PGMLT
+! 2) redundant initialization of PSMLT (non answer-changing)
+
+! CHANGES FOR WRFV3.8.1
+! 1) changes and cleanup of code comments
+! 2) correction to universal gas constant (very small change)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING
+! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES:
+! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL/HAIL.
+
+MODULE MODULE_MP_MORR_TWO_MOMENT_AERO
+   USE     module_wrf_error
+   USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm  ! GT
+   USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep  ! GT
+   USE module_mp_radar
+
+! USE WRF PHYSICS CONSTANTS
+  use module_model_constants, ONLY: CP, G, R => r_d, RV => r_v, EP_2, t0 ! TWG add
+
+!  USE module_state_description
+
+   IMPLICIT NONE
+
+   REAL, PARAMETER :: PI = 3.1415926535897932384626434
+   REAL, PARAMETER :: xxx = 0.9189385332046727417803297
+
+   PUBLIC  ::  MP_MORR_TWO_MOMENT_AERO
+   PUBLIC  ::  POLYSVP
+
+   PRIVATE :: GAMMA, DERF1
+   PRIVATE :: PI, xxx
+   PRIVATE :: MORR_TWO_MOMENT_MICRO
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! SWITCHES FOR MICROPHYSICS SCHEME
+! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K
+! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA
+! IACT = 3, ACTIVATION CALCULATED IN MODULE_MIXACTIVATE
+! IACT = 4, TWG 2016 Activation of Prescribed CESM Aerosool
+
+     INTEGER, PRIVATE ::  IACT
+
+! INUM = 0, PREDICT DROPLET CONCENTRATION
+! INUM = 1, ASSUME CONSTANT DROPLET CONCENTRATION   
+! !!!NOTE: PREDICTED DROPLET CONCENTRATION NOT AVAILABLE IN THIS VERSION
+! CONTACT HUGH MORRISON (morrison@ucar.edu) FOR FURTHER INFORMATION
+
+     INTEGER, PRIVATE ::  INUM
+
+! FOR INUM = 1, SET CONSTANT DROPLET CONCENTRATION (CM-3)
+     REAL, PRIVATE ::      NDCNST
+
+! SWITCH FOR LIQUID-ONLY RUN
+! ILIQ = 0, INCLUDE ICE
+! ILIQ = 1, LIQUID ONLY, NO ICE
+
+     INTEGER, PRIVATE ::  ILIQ
+
+! SWITCH FOR ICE NUCLEATION
+! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE)
+!      = 1, USE MPACE OBSERVATIONS
+!      = 2, USE Prescribed Aerosol Ice Nucleation ! TWG 2016 add
+
+     INTEGER, PRIVATE ::  INUC
+
+! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO 
+!             UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE
+!             AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING 
+!             NON-EQULIBRIUM SUPERSATURATION, 
+!             IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION
+! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO 
+!             UNRESOLVED ENTRAINMENT AND MIXING DOMINATES,
+!             ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM
+!             SUPERSATURATION, BASED ON THE 
+!             LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY 
+!             AT THE GRID POINT
+
+! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) IN NON-WRF-CHEM VERSION OF CODE
+
+     INTEGER, PRIVATE ::  IBASE
+
+! INCLUDE SUB-GRID VERTICAL VELOCITY IN DROPLET ACTIVATION
+! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION)
+! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W
+
+! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) IN NON-WRF-CHEM VERSION OF CODE
+
+     INTEGER, PRIVATE ::  ISUB      
+
+! SWITCH FOR GRAUPEL/NO GRAUPEL
+! IGRAUP = 0, INCLUDE GRAUPEL
+! IGRAUP = 1, NO GRAUPEL
+
+     INTEGER, PRIVATE ::  IGRAUP
+
+! HM ADDED NEW OPTION FOR HAIL
+! SWITCH FOR HAIL/GRAUPEL
+! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL
+! IHAIL = 1, DENSE PRECIPITATING GICE IS HAIL
+
+     INTEGER, PRIVATE ::  IHAIL
+
+! CLOUD MICROPHYSICS CONSTANTS
+
+     REAL, PRIVATE ::      AI,AC,AS,AR,AG ! 'A' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP
+     REAL, PRIVATE ::      BI,BC,BS,BR,BG ! 'B' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP
+!     REAL, PRIVATE ::      R           ! GAS CONSTANT FOR AIR
+!     REAL, PRIVATE ::      RV          ! GAS CONSTANT FOR WATER VAPOR
+!     REAL, PRIVATE ::      CP          ! SPECIFIC HEAT AT CONSTANT PRESSURE FOR DRY AIR
+     REAL, PRIVATE ::      RHOSU       ! STANDARD AIR DENSITY AT 850 MB
+     REAL, PRIVATE ::      RHOW        ! DENSITY OF LIQUID WATER
+     REAL, PRIVATE ::      RHOI        ! BULK DENSITY OF CLOUD ICE
+     REAL, PRIVATE ::      RHOSN       ! BULK DENSITY OF SNOW
+     REAL, PRIVATE ::      RHOG        ! BULK DENSITY OF GRAUPEL
+     REAL, PRIVATE ::      AIMM        ! PARAMETER IN BIGG IMMERSION FREEZING
+     REAL, PRIVATE ::      BIMM        ! PARAMETER IN BIGG IMMERSION FREEZING
+     REAL, PRIVATE ::      ECR         ! COLLECTION EFFICIENCY BETWEEN DROPLETS/RAIN AND SNOW/RAIN
+     REAL, PRIVATE ::      DCS         ! THRESHOLD SIZE FOR CLOUD ICE AUTOCONVERSION
+     REAL, PRIVATE ::      MI0         ! INITIAL SIZE OF NUCLEATED CRYSTAL
+     REAL, PRIVATE ::      MG0         ! MASS OF EMBRYO GRAUPEL
+     REAL, PRIVATE ::      F1S         ! VENTILATION PARAMETER FOR SNOW
+     REAL, PRIVATE ::      F2S         ! VENTILATION PARAMETER FOR SNOW
+     REAL, PRIVATE ::      F1R         ! VENTILATION PARAMETER FOR RAIN
+     REAL, PRIVATE ::      F2R         ! VENTILATION PARAMETER FOR RAIN
+!     REAL, PRIVATE ::      G           ! GRAVITATIONAL ACCELERATION
+     REAL, PRIVATE ::      QSMALL      ! SMALLEST ALLOWED HYDROMETEOR MIXING RATIO
+     REAL, PRIVATE ::      CI,DI,CS,DS,CG,DG ! SIZE DISTRIBUTION PARAMETERS FOR CLOUD ICE, SNOW, GRAUPEL
+     REAL, PRIVATE ::      EII         ! COLLECTION EFFICIENCY, ICE-ICE COLLISIONS
+     REAL, PRIVATE ::      ECI         ! COLLECTION EFFICIENCY, ICE-DROPLET COLLISIONS
+     REAL, PRIVATE ::      RIN     ! RADIUS OF CONTACT NUCLEI (M)
+! hm, add for V3.2
+     REAL, PRIVATE ::      CPW     ! SPECIFIC HEAT OF LIQUID WATER
+
+! CCN SPECTRA FOR IACT = 1
+
+     REAL, PRIVATE ::      C1     ! 'C' IN NCCN = CS^K (CM-3)
+     REAL, PRIVATE ::      K1     ! 'K' IN NCCN = CS^K
+
+! AEROSOL PARAMETERS FOR IACT = 2
+
+     REAL, PRIVATE ::      MW      ! MOLECULAR WEIGHT WATER (KG/MOL)
+     REAL, PRIVATE ::      OSM     ! OSMOTIC COEFFICIENT
+     REAL, PRIVATE ::      VI      ! NUMBER OF ION DISSOCIATED IN SOLUTION
+     REAL, PRIVATE ::      EPSM    ! AEROSOL SOLUBLE FRACTION
+     REAL, PRIVATE ::      RHOA    ! AEROSOL BULK DENSITY (KG/M3)
+     REAL, PRIVATE ::      MAP     ! MOLECULAR WEIGHT AEROSOL (KG/MOL)
+     REAL, PRIVATE ::      MA      ! MOLECULAR WEIGHT OF 'AIR' (KG/MOL)
+     REAL, PRIVATE ::      RR      ! UNIVERSAL GAS CONSTANT
+     REAL, PRIVATE ::      BACT    ! ACTIVATION PARAMETER
+     REAL, PRIVATE ::      RM1     ! GEOMETRIC MEAN RADIUS, MODE 1 (M)
+     REAL, PRIVATE ::      RM2     ! GEOMETRIC MEAN RADIUS, MODE 2 (M)
+     REAL, PRIVATE ::      NANEW1  ! TOTAL AEROSOL CONCENTRATION, MODE 1 (M^-3)
+     REAL, PRIVATE ::      NANEW2  ! TOTAL AEROSOL CONCENTRATION, MODE 2 (M^-3)
+     REAL, PRIVATE ::      SIG1    ! STANDARD DEVIATION OF AEROSOL S.D., MODE 1
+     REAL, PRIVATE ::      SIG2    ! STANDARD DEVIATION OF AEROSOL S.D., MODE 2
+     REAL, PRIVATE ::      F11     ! CORRECTION FACTOR FOR ACTIVATION, MODE 1
+     REAL, PRIVATE ::      F12     ! CORRECTION FACTOR FOR ACTIVATION, MODE 1
+     REAL, PRIVATE ::      F21     ! CORRECTION FACTOR FOR ACTIVATION, MODE 2
+     REAL, PRIVATE ::      F22     ! CORRECTION FACTOR FOR ACTIVATION, MODE 2     
+     REAL, PRIVATE ::      MMULT   ! MASS OF SPLINTERED ICE PARTICLE
+     REAL, PRIVATE ::      LAMMAXI,LAMMINI,LAMMAXR,LAMMINR,LAMMAXS,LAMMINS,LAMMAXG,LAMMING
+
+! CONSTANTS TO IMPROVE EFFICIENCY
+
+     REAL, PRIVATE :: CONS1,CONS2,CONS3,CONS4,CONS5,CONS6,CONS7,CONS8,CONS9,CONS10
+     REAL, PRIVATE :: CONS11,CONS12,CONS13,CONS14,CONS15,CONS16,CONS17,CONS18,CONS19,CONS20
+     REAL, PRIVATE :: CONS21,CONS22,CONS23,CONS24,CONS25,CONS26,CONS27,CONS28,CONS29,CONS30
+     REAL, PRIVATE :: CONS31,CONS32,CONS33,CONS34,CONS35,CONS36,CONS37,CONS38,CONS39,CONS40
+     REAL, PRIVATE :: CONS41
+
+!TWG 2016 Begin Add the following for prescribed aerosols
+      integer, parameter :: naer_cu = 10        !xsong 2013-08-22    !
+      real, private:: aten_pamdm
+      real, private:: alogsig_pamdm(naer_cu) ! natl log of geometric standard dev of aerosol
+      real, private:: exp45logsig_pamdm(naer_cu)
+      real, private:: argfactor_pamdm(naer_cu)
+      real, private:: amcube_pamdm(naer_cu) ! cube of dry mode radius (m)
+      real, private:: smcrit_pamdm(naer_cu) ! critical supersatuation for activation
+      real, private:: lnsm_pamdm(naer_cu) ! ln(smcrit_pamdm)
+      real, private:: amcubefactor_pamdm(naer_cu) ! factors for calculating mode radius
+      real, private:: smcritfactor_pamdm(naer_cu) ! factors for calculatingcritical supersaturation
+      real, private:: alog2_pamdm,alog3_pamdm,alogaten_pamdm,surften_pamdm
+
+      real, private:: f1_pamdm(naer_cu),f2_pamdm(naer_cu) ! abdul-razzak functions of width
+      real, private:: third_pamdm, sat_pamdm
+      real, private:: sq2_pamdm, arg_pamdm
+      integer, parameter:: psat_pamdm=7 ! number of supersaturations to calc ccn concentration
+      real, private:: super_pamdm(psat_pamdm)
+      real, private, parameter :: supersat_pamdm(psat_pamdm)= &! supersaturation (%) to determine ccn concentration
+               (/0.02,0.05,0.1,0.2,0.3,0.5,1.0/)
+      real, private:: ccnfact_pamdm(psat_pamdm,naer_cu)  !factor to calculate diagnostic CCN 
+
+
+
+!xsong 2013-08-22---------------
+      ! aerosol properties
+      character(len=20)  aername(naer_cu)
+      REAL dryrad_aer(naer_cu)
+      REAL density_aer(naer_cu)
+      REAL hygro_aer(naer_cu)
+      REAL dispersion_aer(naer_cu)
+      REAL num_to_mass_aer(naer_cu)
+
+!xsong 2013-08-22--------------------
+   data aername /"SULFATE","SEASALT2","DUST1","DUST2","DUST3","DUST4","OCPHO","BCPHO",   &
+                 "OCPHI","BCPHI"/
+   data dryrad_aer /0.695E-7,0.200E-5,0.151E-5,0.151E-5,0.151E-5,0.151E-5,     &
+                    0.212E-7,0.118E-7,0.212E-7, 0.118E-7/
+   data density_aer /1770.,2200.,2600.,2600.,2600.,2600.,1800.,  &
+                     1000.,2600.,1000./
+   data hygro_aer /0.507,1.160,0.140,0.140,0.140,0.140,0.100,0.100,  &
+                   0.140,0.100/
+   data dispersion_aer /2.030,1.3732,1.900,1.900,1.900,1.900,2.240,  &
+                        2.000,2.240,2.000/
+   data num_to_mass_aer /42097098109277080.,8626504211623.,3484000000000000.,213800000000000.,&
+                         22050000000000.,3165000000000.,0.745645E+18,0.167226E+20,&
+                         0.516216E+18,0.167226E+20/
+!xsong 2013-08-22-----------------------
+
+!TWG 2016 END
+
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+SUBROUTINE MORR_TWO_MOMENT_INIT_AERO(hail_opt) ! RAS
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! THIS SUBROUTINE INITIALIZES ALL PHYSICAL CONSTANTS AMND PARAMETERS 
+! NEEDED BY THE MICROPHYSICS SCHEME.
+! NEEDS TO BE CALLED AT FIRST TIME STEP, PRIOR TO CALL TO MAIN MICROPHYSICS INTERFACE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN):: hail_opt ! RAS
+
+      integer n,i,m !TWG add
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! THE FOLLOWING PARAMETERS ARE USER-DEFINED SWITCHES AND NEED TO BE
+! SET PRIOR TO CODE COMPILATION
+
+! INUM IS AUTOMATICALLY SET TO 0 FOR WRF-CHEM BELOW,
+! ALLOWING PREDICTION OF DROPLET CONCENTRATION
+! THUS, THIS PARAMETER SHOULD NOT BE CHANGED HERE
+! AND SHOULD BE LEFT TO 1
+
+      INUM = 1
+
+! SET CONSTANT DROPLET CONCENTRATION (UNITS OF CM-3)
+! IF NO COUPLING WITH WRF-CHEM
+
+      NDCNST = 250.
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! NOTE, THE FOLLOWING OPTIONS RELATED TO DROPLET ACTIVATION 
+! (IACT, IBASE, ISUB) ARE NOT AVAILABLE IN CURRENT VERSION
+! FOR WRF-CHEM, DROPLET ACTIVATION IS PERFORMED 
+! IN 'MIX_ACTIVATE', NOT IN MICROPHYSICS SCHEME
+
+
+! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K
+! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA
+
+      IACT = 2
+
+! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO 
+!             UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE
+!             AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING 
+!             NON-EQULIBRIUM SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, 
+!             IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION
+! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO 
+!             UNRESOLVED ENTRAINMENT AND MIXING DOMINATES,
+!             ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM
+!             SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, BASED ON THE 
+!             LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY 
+!             AT THE GRID POINT
+
+! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0)
+ 
+      IBASE = 2
+
+! INCLUDE SUB-GRID VERTICAL VELOCITY (standard deviation of w) IN DROPLET ACTIVATION
+! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION)
+! currently, sub-grid w is constant of 0.5 m/s (not coupled with PBL/turbulence scheme)
+! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W
+
+! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0)
+
+      ISUB = 0      
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+! SWITCH FOR LIQUID-ONLY RUN
+! ILIQ = 0, INCLUDE ICE
+! ILIQ = 1, LIQUID ONLY, NO ICE
+
+      ILIQ = 0
+
+! SWITCH FOR ICE NUCLEATION
+! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE)
+!      = 1, USE MPACE OBSERVATIONS (ARCTIC ONLY)
+
+      INUC = 0
+
+! SWITCH FOR GRAUPEL/HAIL NO GRAUPEL/HAIL
+! IGRAUP = 0, INCLUDE GRAUPEL/HAIL
+! IGRAUP = 1, NO GRAUPEL/HAIL
+
+      IGRAUP = 0
+
+! HM ADDED 11/7/07
+! SWITCH FOR HAIL/GRAUPEL
+! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL
+! IHAIL = 1, DENSE PRECIPITATING ICE IS HAIL
+! NOTE ---> RECOMMEND IHAIL = 1 FOR CONTINENTAL DEEP CONVECTION
+
+      !IHAIL = 0 !changed to namelist option (hail_opt) by RAS
+      ! Check if namelist option is feasible, otherwise default to graupel - RAS
+      IF (hail_opt .eq. 1) THEN
+         IHAIL = 1
+      ELSE
+         IHAIL = 0
+      ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! SET PHYSICAL CONSTANTS
+
+! FALLSPEED PARAMETERS (V=AD^B)
+         AI = 700.
+         AC = 3.E7
+         AS = 11.72
+         AR = 841.99667
+         BI = 1.
+         BC = 2.
+         BS = 0.41
+         BR = 0.8
+         IF (IHAIL.EQ.0) THEN
+	 AG = 19.3
+	 BG = 0.37
+         ELSE ! (MATSUN AND HUGGINS 1980)
+         AG = 114.5 
+         BG = 0.5
+         END IF
+
+! CONSTANTS AND PARAMETERS
+!         R = 287.15
+!         RV = 461.5
+!         CP = 1005.
+         RHOSU = 85000./(287.15*273.15)
+         RHOW = 997.
+         RHOI = 500.
+         RHOSN = 100.
+         IF (IHAIL.EQ.0) THEN
+	 RHOG = 400.
+         ELSE
+         RHOG = 900.
+         END IF
+         AIMM = 0.66
+         BIMM = 100.
+         ECR = 1.
+         DCS = 350.E-6
+         MI0 = 4./3.*PI*RHOI*(10.E-6)**3
+	 MG0 = 1.6E-10
+         F1S = 0.86
+         F2S = 0.28
+         F1R = 0.78
+!         F2R = 0.32
+! fix 053011
+         F2R = 0.308
+!         G = 9.806
+         QSMALL = 1.E-14
+         EII = 0.1
+         ECI = 0.7
+! HM, ADD FOR V3.2
+! hm, 7/23/13
+!         CPW = 4218.
+         CPW = 4187.
+
+! SIZE DISTRIBUTION PARAMETERS
+
+         CI = RHOI*PI/6.
+         DI = 3.
+         CS = RHOSN*PI/6.
+         DS = 3.
+         CG = RHOG*PI/6.
+         DG = 3.
+
+! RADIUS OF CONTACT NUCLEI
+         RIN = 0.1E-6
+
+         MMULT = 4./3.*PI*RHOI*(5.E-6)**3
+
+! SIZE LIMITS FOR LAMBDA
+
+         LAMMAXI = 1./1.E-6
+         LAMMINI = 1./(2.*DCS+100.E-6)
+         LAMMAXR = 1./20.E-6
+!         LAMMINR = 1./500.E-6
+         LAMMINR = 1./2800.E-6
+
+         LAMMAXS = 1./10.E-6
+         LAMMINS = 1./2000.E-6
+         LAMMAXG = 1./20.E-6
+         LAMMING = 1./2000.E-6
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! note: these parameters only used by the non-wrf-chem version of the 
+!       scheme with predicted droplet number
+
+! CCN SPECTRA FOR IACT = 1
+
+! MARITIME
+! MODIFIED FROM RASMUSSEN ET AL. 2002
+! NCCN = C*S^K, NCCN IS IN CM-3, S IS SUPERSATURATION RATIO IN %
+
+              K1 = 0.4
+              C1 = 120. 
+
+! CONTINENTAL
+
+!              K1 = 0.5
+!              C1 = 1000. 
+
+! AEROSOL ACTIVATION PARAMETERS FOR IACT = 2
+! PARAMETERS CURRENTLY SET FOR AMMONIUM SULFATE
+
+         MW = 0.018
+         OSM = 1.
+         VI = 3.
+         EPSM = 0.7
+         RHOA = 1777.
+         MAP = 0.132
+         MA = 0.0284
+! hm fix 6/23/16
+!         RR = 8.3187
+         RR = 8.3145
+         BACT = VI*OSM*EPSM*MW*RHOA/(MAP*RHOW)
+
+! AEROSOL SIZE DISTRIBUTION PARAMETERS CURRENTLY SET FOR MPACE 
+! (see morrison et al. 2007, JGR)
+! MODE 1
+
+         RM1 = 0.052E-6
+         SIG1 = 2.04
+         NANEW1 = 72.2E6
+         F11 = 0.5*EXP(2.5*(LOG(SIG1))**2)
+         F21 = 1.+0.25*LOG(SIG1)
+
+! MODE 2
+
+         RM2 = 1.3E-6
+         SIG2 = 2.5
+         NANEW2 = 1.8E6
+         F12 = 0.5*EXP(2.5*(LOG(SIG2))**2)
+         F22 = 1.+0.25*LOG(SIG2)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! CONSTANTS FOR EFFICIENCY
+
+         CONS1=GAMMA(1.+DS)*CS
+         CONS2=GAMMA(1.+DG)*CG
+         CONS3=GAMMA(4.+BS)/6.
+         CONS4=GAMMA(4.+BR)/6.
+         CONS5=GAMMA(1.+BS)
+         CONS6=GAMMA(1.+BR)
+         CONS7=GAMMA(4.+BG)/6.
+         CONS8=GAMMA(1.+BG)
+         CONS9=GAMMA(5./2.+BR/2.)
+         CONS10=GAMMA(5./2.+BS/2.)
+         CONS11=GAMMA(5./2.+BG/2.)
+         CONS12=GAMMA(1.+DI)*CI
+         CONS13=GAMMA(BS+3.)*PI/4.*ECI
+         CONS14=GAMMA(BG+3.)*PI/4.*ECI
+         CONS15=-1108.*EII*PI**((1.-BS)/3.)*RHOSN**((-2.-BS)/3.)/(4.*720.)
+         CONS16=GAMMA(BI+3.)*PI/4.*ECI
+         CONS17=4.*2.*3.*RHOSU*PI*ECI*ECI*GAMMA(2.*BS+2.)/(8.*(RHOG-RHOSN))
+         CONS18=RHOSN*RHOSN
+         CONS19=RHOW*RHOW
+         CONS20=20.*PI*PI*RHOW*BIMM
+         CONS21=4./(DCS*RHOI)
+         CONS22=PI*RHOI*DCS**3/6.
+         CONS23=PI/4.*EII*GAMMA(BS+3.)
+         CONS24=PI/4.*ECR*GAMMA(BR+3.)
+         CONS25=PI*PI/24.*RHOW*ECR*GAMMA(BR+6.)
+         CONS26=PI/6.*RHOW
+         CONS27=GAMMA(1.+BI)
+         CONS28=GAMMA(4.+BI)/6.
+         CONS29=4./3.*PI*RHOW*(25.E-6)**3
+         CONS30=4./3.*PI*RHOW
+         CONS31=PI*PI*ECR*RHOSN
+         CONS32=PI/2.*ECR
+         CONS33=PI*PI*ECR*RHOG
+         CONS34=5./2.+BR/2.
+         CONS35=5./2.+BS/2.
+         CONS36=5./2.+BG/2.
+         CONS37=4.*PI*1.38E-23/(6.*PI*RIN)
+         CONS38=PI*PI/3.*RHOW
+         CONS39=PI*PI/36.*RHOW*BIMM
+         CONS40=PI/6.*BIMM
+         CONS41=PI*PI*ECR*RHOW
+
+!+---+-----------------------------------------------------------------+
+!..Set these variables needed for computing radar reflectivity.  These
+!.. get used within radar_init to create other variables used in the
+!.. radar module.
+
+         xam_r = PI*RHOW/6.
+         xbm_r = 3.
+         xmu_r = 0.
+         xam_s = CS
+         xbm_s = DS
+         xmu_s = 0.
+         xam_g = CG
+         xbm_g = DG
+         xmu_g = 0.
+
+         call radar_init
+!+---+-----------------------------------------------------------------+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! TWG 2016 Begin add
+! set parameters for prescribed CESM  droplet activation, following abdul-razzak
+! and ghan 2000,
+! JGR
+
+!      mathematical constants
+
+      third_pamdm=1./3
+      sq2_pamdm=1.41421356237
+
+      surften_pamdm=0.076
+      aten_pamdm=2.*MW*surften_pamdm/(RR*t0*RHOW)
+      alogaten_pamdm=log(aten_pamdm)
+      alog2_pamdm=log(2.)
+      alog3_pamdm=log(3.)
+
+     do m=1,naer_cu
+!         use only if width of size distribution is prescribed
+          alogsig_pamdm(m)=log(dispersion_aer(m))
+          exp45logsig_pamdm(m)=exp(4.5*alogsig_pamdm(m)*alogsig_pamdm(m))
+          argfactor_pamdm(m)=2./(3.*SQRT(2.)*alogsig_pamdm(m))
+          f1_pamdm(m)=0.5*exp(2.5*alogsig_pamdm(m)*alogsig_pamdm(m))
+          f2_pamdm(m)=1.+0.25*alogsig_pamdm(m)
+          amcubefactor_pamdm(m)=3./(4.*pi*exp45logsig_pamdm(m)*density_aer(m))
+          smcritfactor_pamdm(m)=2.*aten_pamdm*SQRT(aten_pamdm/(27.*max(1.e-10,hygro_aer(m))))
+!         use only if mode radius of size distribution is prescribed
+          amcube_pamdm(m)=amcubefactor_pamdm(m)/(num_to_mass_aer(m))
+!         use only if only one component per mode
+          if(hygro_aer(m).gt.1.e-10) then
+             smcrit_pamdm(m)=smcritfactor_pamdm(m)/SQRT(amcube_pamdm(m))
+          else
+             smcrit_pamdm(m)=100.
+          endif
+          lnsm_pamdm(m)=log(smcrit_pamdm(m))
+
+         
+
+          do sat_pamdm=1,psat_pamdm
+             super_pamdm(sat_pamdm) = 0.01*supersat_pamdm(sat_pamdm)
+             arg_pamdm=argfactor_pamdm(m)*log(smcrit_pamdm(m)/super_pamdm(sat_pamdm))
+             if(arg_pamdm.lt.2) then
+               if(arg_pamdm.lt.-2) then
+                  ccnfact_pamdm(sat_pamdm,m)=1.e-6
+               else
+                  ccnfact_pamdm(sat_pamdm,m)=1.e-6*0.5*(1-DERF1(arg_pamdm))
+               endif
+             else
+                  ccnfact_pamdm(sat_pamdm,m)=0.0
+             endif
+             print*,'m',m,' sat ',sat_pamdm,' ccnfact',ccnfact_pamdm(sat_pamdm,m)
+           end do
+
+       end do
+! TWG 2016 end
+
+
+END SUBROUTINE MORR_TWO_MOMENT_INIT_AERO
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! THIS SUBROUTINE IS MAIN INTERFACE WITH THE TWO-MOMENT MICROPHYSICS SCHEME
+! THIS INTERFACE TAKES IN 3D VARIABLES FROM DRIVER MODEL, CONVERTS TO 1D FOR
+! CALL TO THE MAIN MICROPHYSICS SUBROUTINE (SUBROUTINE MORR_TWO_MOMENT_MICRO) 
+! WHICH OPERATES ON 1D VERTICAL COLUMNS.
+! 1D VARIABLES FROM THE MAIN MICROPHYSICS SUBROUTINE ARE THEN REASSIGNED BACK TO 3D FOR OUTPUT
+! BACK TO DRIVER MODEL USING THIS INTERFACE.
+! MICROPHYSICS TENDENCIES ARE ADDED TO VARIABLES HERE BEFORE BEING PASSED BACK TO DRIVER MODEL.
+
+! THIS CODE WAS WRITTEN BY HUGH MORRISON (NCAR) AND SLAVA TATARSKII (GEORGIA TECH).
+
+! FOR QUESTIONS, CONTACT: HUGH MORRISON, E-MAIL: MORRISON@UCAR.EDU, PHONE:303-497-8916
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE MP_MORR_TWO_MOMENT_AERO(ITIMESTEP,                       &
+                TH, QV, QC, QR, QI, QS, QG, NI, NS, NR, NG, NC,  & !TWG/amy add
+                TKE, KZH,                               & ! TWG/amy add
+                RHO, PII, P, DT_IN, DZ, HT, W,          &
+                RAINNC, RAINNCV, SR,                    &
+		SNOWNC,SNOWNCV,GRAUPELNC,GRAUPELNCV,    & ! hm added 7/13/13
+                refl_10cm, diagflag, do_radar_ref,      & ! GT added for reflectivity calcs
+                qrcuten, qscuten, qicuten, mu           & ! hm added
+               ,F_QNDROP, qndrop                        & ! hm added, wrf-chem 
+               ,IDS,IDE, JDS,JDE, KDS,KDE               & ! domain dims
+               ,IMS,IME, JMS,JME, KMS,KME               & ! memory dims
+               ,ITS,ITE, JTS,JTE, KTS,KTE               & ! tile   dimsi            )
+               ,PBL                               & ! TWG/amy add
+               ,aerocu                             & ! TWG add
+               ,aercu_opt                          & ! TWG add
+               ,no_src_types_cu                    & ! TWG add
+               ,EFCG, EFIG, EFSG, WACT             & !TWG add
+               ,CCN1_GS, CCN2_GS, CCN3_GS, CCN4_GS & !TWG add
+               ,CCN5_GS, CCN6_GS, CCN7_GS          & ! TWG add
+
+!jdf		   ,C2PREC3D,CSED3D,ISED3D,SSED3D,GSED3D,RSED3D & ! HM ADD, WRF-CHEM
+               ,rainprod, evapprod                      &
+		   ,QLSINK,PRECR,PRECI,PRECS,PRECG &        ! HM ADD, WRF-CHEM
+                                            )
+ 
+! QV - water vapor mixing ratio (kg/kg)
+! QC - cloud water mixing ratio (kg/kg)
+! QR - rain water mixing ratio (kg/kg)
+! QI - cloud ice mixing ratio (kg/kg)
+! QS - snow mixing ratio (kg/kg)
+! QG - graupel mixing ratio (KG/KG)
+! NI - cloud ice number concentration (1/kg)
+! NS - Snow Number concentration (1/kg)
+! NR - Rain Number concentration (1/kg)
+! NG - Graupel number concentration (1/kg)
+! NOTE: RHO AND HT NOT USED BY THIS SCHEME AND DO NOT NEED TO BE PASSED INTO SCHEME!!!!
+! P - AIR PRESSURE (PA)
+! W - VERTICAL AIR VELOCITY (M/S)
+! TH - POTENTIAL TEMPERATURE (K)
+! PII - exner function - used to convert potential temp to temp
+! DZ - difference in height over interface (m)
+! DT_IN - model time step (sec)
+! ITIMESTEP - time step counter
+! RAINNC - accumulated grid-scale precipitation (mm)
+! RAINNCV - one time step grid scale precipitation (mm/time step)
+! SNOWNC - accumulated grid-scale snow plus cloud ice (mm)
+! SNOWNCV - one time step grid scale snow plus cloud ice (mm/time step)
+! GRAUPELNC - accumulated grid-scale graupel (mm)
+! GRAUPELNCV - one time step grid scale graupel (mm/time step)
+! SR - one time step mass ratio of snow to total precip
+! qrcuten, rain tendency from parameterized cumulus convection
+! qscuten, snow tendency from parameterized cumulus convection
+! qicuten, cloud ice tendency from parameterized cumulus convection
+
+! variables below currently not in use, not coupled to PBL or radiation codes
+! TKE - turbulence kinetic energy (m^2 s-2), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW)
+! NCTEND - droplet concentration tendency from pbl (kg-1 s-1)
+! NCTEND - CLOUD ICE concentration tendency from pbl (kg-1 s-1)
+! KZH - heat eddy diffusion coefficient from YSU scheme (M^2 S-1), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW)
+! EFFCS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron)
+! EFFIS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron)
+! HM, ADDED FOR WRF-CHEM COUPLING
+! QLSINK - TENDENCY OF CLOUD WATER TO RAIN, SNOW, GRAUPEL (KG/KG/S)
+! CSED,ISED,SSED,GSED,RSED - SEDIMENTATION FLUXES (KG/M^2/S) FOR CLOUD WATER, ICE, SNOW, GRAUPEL, RAIN
+! PRECI,PRECS,PRECG,PRECR - SEDIMENTATION FLUXES (KG/M^2/S) FOR ICE, SNOW, GRAUPEL, RAIN
+
+! rainprod - total tendency of conversion of cloud water/ice and graupel to rain (kg kg-1 s-1)
+! evapprod - tendency of evaporation of rain (kg kg-1 s-1)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! reflectivity currently not included!!!!
+! REFL_10CM - CALCULATED RADAR REFLECTIVITY AT 10 CM (DBZ)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! EFFC - DROPLET EFFECTIVE RADIUS (MICRON)
+! EFFR - RAIN EFFECTIVE RADIUS (MICRON)
+! EFFS - SNOW EFFECTIVE RADIUS (MICRON)
+! EFFI - CLOUD ICE EFFECTIVE RADIUS (MICRON)
+
+! ADDITIONAL OUTPUT FROM MICRO - SEDIMENTATION TENDENCIES, NEEDED FOR LIQUID-ICE STATIC ENERGY
+
+! QGSTEN - GRAUPEL SEDIMENTATION TEND (KG/KG/S)
+! QRSTEN - RAIN SEDIMENTATION TEND (KG/KG/S)
+! QISTEN - CLOUD ICE SEDIMENTATION TEND (KG/KG/S)
+! QNISTEN - SNOW SEDIMENTATION TEND (KG/KG/S)
+! QCSTEN - CLOUD WATER SEDIMENTATION TEND (KG/KG/S)
+
+! WVAR - STANDARD DEVIATION OF SUB-GRID VERTICAL VELOCITY (M/S)
+
+   IMPLICIT NONE
+
+   INTEGER,      INTENT(IN   )    ::   ids, ide, jds, jde, kds, kde , &
+                                       ims, ime, jms, jme, kms, kme , &
+                                       its, ite, jts, jte, kts, kte, PBL ! TWG/amy add
+! Temporary changed from INOUT to IN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
+                          qv, qc, qr, qi, qs, qg, ni, ns, nr, TH, NG, NC !TWG add   
+!jdf                      qndrop ! hm added, wrf-chem
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional,INTENT(INOUT):: qndrop
+!jdf  REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT):: CSED3D, &
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional,INTENT(INOUT):: QLSINK, &
+                          rainprod, evapprod, &
+                          PRECI,PRECS,PRECG,PRECR ! HM, WRF-CHEM
+!, effcs, effis
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: &
+                          pii, p, dz, rho, w, tke, kzh !, TWG/amy add
+   REAL, INTENT(IN):: dt_in
+   INTEGER, INTENT(IN):: ITIMESTEP
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: &
+                          RAINNC, RAINNCV, SR, &
+! hm added 7/13/13
+                          SNOWNC,SNOWNCV,GRAUPELNC,GRAUPELNCV
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::       &  ! GT
+                          refl_10cm
+
+   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::       ht
+
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
+                          EFCG, EFIG, EFSG, WACT, CCN1_GS,  &
+        CCN2_GS, CCN3_GS, CCN4_GS, CCN5_GS, CCN6_GS, CCN7_GS
+
+   ! LOCAL VARIABLES
+
+   REAL, DIMENSION(its:ite, kts:kte, jts:jte)::                     &
+                      effi, effs, effr, EFFG
+
+   REAL, DIMENSION(its:ite, kts:kte, jts:jte)::                     &
+                      T, WVAR, EFFC
+
+   REAL, DIMENSION(kts:kte) ::                                                                & 
+                            QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D,                      &
+                            NI_TEND1D, NS_TEND1D, NR_TEND1D,                                  &
+                            QC1D, QI1D, QR1D,NI1D, NS1D, NR1D, QS1D,                          &
+                            T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, W1D, WVAR1D,         &
+                            EFFC1D, EFFI1D, EFFS1D, EFFR1D,DZ1D,   &
+   ! HM ADD GRAUPEL
+                            QG_TEND1D, NG_TEND1D, QG1D, NG1D, EFFG1D, &
+
+! ADD SEDIMENTATION TENDENCIES (UNITS OF KG/KG/S)
+                            QGSTEN,QRSTEN, QISTEN, QNISTEN, QCSTEN, &
+! ADD CUMULUS TENDENCIES
+                            QRCU1D, QSCU1D, QICU1D
+
+! add cumulus tendencies
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: &
+      qrcuten, qscuten, qicuten
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN):: &
+      mu
+
+  LOGICAL, INTENT(IN), OPTIONAL ::                F_QNDROP  ! wrf-chem
+  LOGICAL :: flag_qndrop  ! wrf-chem
+  integer :: iinum ! wrf-chem
+
+! wrf-chem
+   REAL, DIMENSION(kts:kte) :: nc1d, nc_tend1d,C2PREC,CSED,ISED,SSED,GSED,RSED    
+   REAL, DIMENSION(kts:kte) :: rainprod1d, evapprod1d
+! HM add reflectivity      
+   REAL, DIMENSION(kts:kte) :: dBZ
+                          
+   REAL PRECPRT1D, SNOWRT1D, SNOWPRT1D, GRPLPRT1D ! hm added 7/13/13
+
+   INTEGER I,K,J,L !TWG Add
+
+   REAL DT
+
+   LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
+   INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref
+
+! TWG begin declare prescribed aerosol parameters
+  INTEGER,      INTENT(IN   ) :: no_src_types_cu !PSH/TWG
+  INTEGER,      INTENT(IN   ) :: aercu_opt
+  REAL,  DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), OPTIONAL, &
+          INTENT(INOUT) ::                                   aerocu !PSH/TWG
+
+  REAL, DIMENSION(kts:kte, no_src_types_cu) :: maerosol, naer
+! TWG END
+
+
+! below for wrf-chem
+   flag_qndrop = .false.
+   IF ( PRESENT ( f_qndrop ) ) flag_qndrop = f_qndrop
+!!!!!!!!!!!!!!!!!!!!!!
+
+   ! Initialize tendencies (all set to 0) and transfer
+   ! array to local variables
+   DT = DT_IN   
+
+   DO I=ITS,ITE
+   DO J=JTS,JTE
+   DO K=KTS,KTE
+       T(I,K,J)        = TH(i,k,j)*PII(i,k,j)
+
+! NOTE: WVAR NOT CURRENTLY USED IN CODE !!!!!!!!!!
+! currently assign wvar to 0.5 m/s (not coupled with PBL scheme)
+! Begin TWG/amy add
+! wvar is the ST. DEV. OF sub-grid vertical velocity, used for calculating
+! droplet 
+! activation rates.
+! WVAR CAN BE DERIVED EITHER FROM PREDICTED TKE (AS IN MYJ PBL SCHEME),
+! OR FROM EDDY DIFFUSION COEFFICIENT KZH (AS IN YSU PBL SCHEME),
+! DEPENDING ON THE PARTICULAR pbl SCHEME DRIVER MODEL IS COUPLED WITH
+! NOTE: IF MODEL HAS HIGH ENOUGH RESOLUTION TO RESOLVE UPDRAFTS, WVAR MAY 
+! NOT BE NEEDED 
+
+
+!       WVAR(I,K,J)     = 10.0
+! for YSU pbl scheme:
+! coupling as in WRF2
+      if (PBL.ne.1) then
+! for MYJ pbl scheme or 3D TKE:
+         WVAR(I,K,J)     = (0.667*tke(i,k,j))**0.5
+      else
+! for YSU pbl scheme:
+         WVAR(I,K,J) = KZH(I,K+1,J)/20.
+      endif
+
+       WVAR(I,K,J) = MAX(0.5,WVAR(I,K,J))
+       WVAR(I,K,J) = MIN(50.,WVAR(I,K,J))
+
+! currently mixing of number concentrations also is neglected (not coupled with PBL schemes)
+
+   END DO
+   END DO
+   END DO
+
+   do i=its,ite      ! i loop (east-west)
+   do j=jts,jte      ! j loop (north-south)
+   !
+   ! Transfer 3D arrays into 1D for microphysical calculations
+   !
+
+! hm , initialize 1d tendency arrays to zero
+
+      do k=kts,kte   ! k loop (vertical)
+
+          QC_TEND1D(k)  = 0.
+          QI_TEND1D(k)  = 0.
+          QNI_TEND1D(k) = 0.
+          QR_TEND1D(k)  = 0.
+          NI_TEND1D(k)  = 0.
+          NS_TEND1D(k)  = 0.
+          NR_TEND1D(k)  = 0.
+          T_TEND1D(k)   = 0.
+          QV_TEND1D(k)  = 0.
+          nc_tend1d(k) = 0. ! wrf-chem
+
+!TWG add Initalize CCN
+          CCN1_GS(i,k,j) = 0.0
+          CCN2_GS(i,k,j) = 0.0
+          CCN3_GS(i,k,j) = 0.0
+          CCN4_GS(i,k,j) = 0.0
+          CCN5_GS(i,k,j) = 0.0
+          CCN6_GS(i,k,j) = 0.0
+          CCN7_GS(i,k,j) = 0.0
+
+          QC1D(k)       = QC(i,k,j)
+          QI1D(k)       = QI(i,k,j)
+          QS1D(k)       = QS(i,k,j)
+          QR1D(k)       = QR(i,k,j)
+
+          NI1D(k)       = NI(i,k,j)
+
+          NS1D(k)       = NS(i,k,j)
+          NR1D(k)       = NR(i,k,j)
+! HM ADD GRAUPEL
+          QG1D(K)       = QG(I,K,j)
+          NG1D(K)       = NG(I,K,j)
+          QG_TEND1D(K)  = 0.
+          NG_TEND1D(K)  = 0.
+
+          T1D(k)        = T(i,k,j)
+          QV1D(k)       = QV(i,k,j)
+          P1D(k)        = P(i,k,j)
+          DZ1D(k)       = DZ(i,k,j)
+          W1D(k)        = W(i,k,j)
+          WVAR1D(k)     = WVAR(i,k,j)
+! add cumulus tendencies, decouple from mu
+          qrcu1d(k)     = qrcuten(i,k,j)/mu(i,j)
+          qscu1d(k)     = qscuten(i,k,j)/mu(i,j)
+          qicu1d(k)     = qicuten(i,k,j)/mu(i,j)
+      end do  !jdf added this
+! below for wrf-chem
+   IF (flag_qndrop .AND. PRESENT( qndrop )) THEN
+      iact = 3
+      DO k = kts, kte
+         nc1d(k)=qndrop(i,k,j)
+         iinum=0
+      ENDDO
+   ELSE
+      DO k = kts, kte
+! TWG 2016 comment this out temporarily
+        ! nc1d(k)=0. ! temporary placeholder, set to constant in microphysics subroutine
+        ! iinum=1
+      IF (aercu_opt.eq.2) THEN
+         iinum = 0
+         INUM = 0
+!TWG/amy add
+         nc1d(k) = NC(i,k,j)
+!TWG 2016 Begin
+         DO L=1,no_src_types_cu
+            maerosol(k,L) = 0.0
+            naer(k,L)     = 0.0
+         END DO
+         iact = 4
+        ! print*,'Doing TWG added activation'
+         INUC = 2
+         maerosol(k,1) = aerocu(i,k,j,6)*1E-9
+         naer(k,1) = 2.0*maerosol(k,1)*num_to_mass_aer(1)
+
+         maerosol(k,2) = aerocu(i,k,j,5)*1E-9
+         naer(k,2) = maerosol(k,2)*num_to_mass_aer(2)
+
+         maerosol(k,3) = 1.44*aerocu(i,k,j,1)*1E-9
+         naer(k,3) = maerosol(k,3)*num_to_mass_aer(3)
+
+         maerosol(k,4) = 1.44*aerocu(i,k,j,2)*1E-9
+         naer(k,4) = maerosol(k,4)*num_to_mass_aer(4)
+
+         maerosol(k,5) = 1.44*aerocu(i,k,j,3)*1E-9
+         naer(k,5) = maerosol(k,5)*num_to_mass_aer(5)
+
+         maerosol(k,6) = 1.44*aerocu(i,k,j,4)*1E-9
+         naer(k,6) = maerosol(k,6)*num_to_mass_aer(6)
+
+         maerosol(k,7) = 1.54*aerocu(i,k,j,9)*1E-9
+         naer(k,7) = maerosol(k,7)*num_to_mass_aer(7)
+
+         maerosol(k,8) = 1.37*aerocu(i,k,j,7)*1E-9
+         naer(k,8) = maerosol(k,8)*num_to_mass_aer(8)
+
+         maerosol(k,9) = 1.25*aerocu(i,k,j,10)*1E-9
+         naer(k,9) = maerosol(k,9)*num_to_mass_aer(9)
+
+         maerosol(k,10) = 1.37*aerocu(i,k,j,8)*1E-9
+         naer(k,10) = maerosol(k,10)*num_to_mass_aer(10)
+ 
+         DO L=1,no_src_types_cu
+           CCN1_GS(i,k,j) = CCN1_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(1,L))
+           CCN2_GS(i,k,j) = CCN2_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(2,L))
+           CCN3_GS(i,k,j) = CCN3_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(3,L))
+           CCN4_GS(i,k,j) = CCN4_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(4,L))
+           CCN5_GS(i,k,j) = CCN5_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(5,L))
+           CCN6_GS(i,k,j) = CCN6_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(6,L))
+           CCN7_GS(i,k,j) = CCN7_GS(i,k,j)+(naer(k,L)*ccnfact_pamdm(7,L))
+         ENDDO
+
+       ELSE
+         nc1d(k)=0. ! temporary placeholder, set to constant in microphysics
+         iinum=1
+         INUM=1
+       END IF
+! TWG 2016 END
+      ENDDO
+   ENDIF
+
+!jdf  end do
+
+      call MORR_TWO_MOMENT_MICRO(QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D,            &
+       NI_TEND1D, NS_TEND1D, NR_TEND1D,                                                  &
+       QC1D, QI1D, QS1D, QR1D,NI1D, NS1D, NR1D,                                          &
+       T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, DZ1D, W1D, WVAR1D,                   &
+       PRECPRT1D,SNOWRT1D,                                                               &
+       SNOWPRT1D,GRPLPRT1D,                 & ! hm added 7/13/13
+       EFFC1D,EFFI1D,EFFS1D,EFFR1D,DT,                                                   &
+                                            IMS,IME, JMS,JME, KMS,KME,                   &
+                                            ITS,ITE, JTS,JTE, KTS,KTE,                   & ! HM ADD GRAUPEL
+                                    QG_TEND1D,NG_TEND1D,QG1D,NG1D,EFFG1D, &
+                                    qrcu1d, qscu1d, qicu1d, &
+! ADD SEDIMENTATION TENDENCIES
+                                  QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN, &
+                                  nc1d, nc_tend1d, iinum, C2PREC,CSED,ISED,SSED,GSED,RSED & !wrf-chem
+                                  ,no_src_types_cu,maerosol,naer               & !TWG add prescribed aerosol
+#if (WRF_CHEM == 1)
+                                  ,rainprod1d, evapprod1d & !wrf-chem
+#endif
+                       )
+
+   !
+   ! Transfer 1D arrays back into 3D arrays
+   !
+      do k=kts,kte
+
+! hm, add tendencies to update global variables 
+! HM, TENDENCIES FOR Q AND N NOW ADDED IN M2005MICRO, SO WE
+! ONLY NEED TO TRANSFER 1D VARIABLES BACK TO 3D
+
+          QC(i,k,j)        = QC1D(k)
+          QI(i,k,j)        = QI1D(k)
+          QS(i,k,j)        = QS1D(k)
+          QR(i,k,j)        = QR1D(k)
+          NI(i,k,j)        = NI1D(k)
+          NS(i,k,j)        = NS1D(k)          
+          NR(i,k,j)        = NR1D(k)
+	  QG(I,K,j)        = QG1D(K)
+          NG(I,K,j)        = NG1D(K)
+
+          T(i,k,j)         = T1D(k)
+          TH(I,K,J)        = T(i,k,j)/PII(i,k,j) ! CONVERT TEMP BACK TO POTENTIAL TEMP
+          QV(i,k,j)        = QV1D(k)
+
+          EFFC(i,k,j)      = EFFC1D(k)
+          EFFI(i,k,j)      = EFFI1D(k)
+          EFFS(i,k,j)      = EFFS1D(k)
+          EFFR(i,k,j)      = EFFR1D(k)
+	  EFFG(I,K,j)      = EFFG1D(K)
+
+!TWG add to send effective radius to RRTMG
+        IF (aercu_opt.gt.0) THEN 
+          EFCG(i,k,j) = MAX(2.49, MIN(EFFC1D(k), 50.))
+          EFIG(i,k,j)   = MAX(4.99, MIN(EFFI1D(k), 120.))
+          EFSG(i,k,j)  = MAX(9.99, MIN(EFFS1D(k), 999.))
+          WACT(i,k,j)  = MAX(WVAR(i,k,j)+W(i,k,j),0.5)
+        END IF
+
+
+! wrf-chem
+          IF (flag_qndrop .AND. PRESENT( qndrop )) THEN
+             qndrop(i,k,j) = nc1d(k)
+!jdf         CSED3D(I,K,J) = CSED(K)
+!TWG 2016 modify for prescribed aerosol
+          ELSE
+             NC(i,k,j) = nc1d(k)
+!TWG end modification
+          END IF
+          IF ( PRESENT( QLSINK ) ) THEN
+             if(qc(i,k,j)>1.e-10) then
+                QLSINK(I,K,J)  = C2PREC(K)/QC(I,K,J)
+             else
+                QLSINK(I,K,J)  = 0.0
+             endif
+          END IF
+          IF ( PRESENT( PRECR ) ) PRECR(I,K,J) = RSED(K)
+          IF ( PRESENT( PRECI ) ) PRECI(I,K,J) = ISED(K)
+          IF ( PRESENT( PRECS ) ) PRECS(I,K,J) = SSED(K)
+          IF ( PRESENT( PRECG ) ) PRECG(I,K,J) = GSED(K)
+! EFFECTIVE RADIUS FOR RADIATION CODE (currently not coupled)
+! HM, ADD LIMIT TO PREVENT BLOWING UP OPTICAL PROPERTIES, 8/18/07
+!          EFFCS(I,K,J)     = MIN(EFFC(I,K,J),50.)
+!          EFFCS(I,K,J)     = MAX(EFFCS(I,K,J),1.)
+!          EFFIS(I,K,J)     = MIN(EFFI(I,K,J),130.)
+!          EFFIS(I,K,J)     = MAX(EFFIS(I,K,J),13.)
+
+#if ( WRF_CHEM == 1)
+           IF ( PRESENT( rainprod ) ) rainprod(i,k,j) = rainprod1d(k)
+           IF ( PRESENT( evapprod ) ) evapprod(i,k,j) = evapprod1d(k)
+#endif
+
+      end do
+
+! hm modified so that m2005 precip variables correctly match wrf precip variables
+      RAINNC(i,j) = RAINNC(I,J)+PRECPRT1D
+      RAINNCV(i,j) = PRECPRT1D
+! hm, added 7/13/13
+      SNOWNC(i,j) = SNOWNC(I,J)+SNOWPRT1D
+      SNOWNCV(i,j) = SNOWPRT1D
+      GRAUPELNC(i,j) = GRAUPELNC(I,J)+GRPLPRT1D
+      GRAUPELNCV(i,j) = GRPLPRT1D
+      SR(i,j) = SNOWRT1D/(PRECPRT1D+1.E-12)
+
+!+---+-----------------------------------------------------------------+
+         IF ( PRESENT (diagflag) ) THEN
+         if (diagflag .and. do_radar_ref == 1) then
+          call refl10cm_hm (qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d,   &
+                      t1d, p1d, dBZ, kts, kte, i, j)
+          do k = kts, kte
+             refl_10cm(i,k,j) = MAX(-35., dBZ(k))
+          enddo
+         endif
+         ENDIF
+!+---+-----------------------------------------------------------------+
+
+   end do
+   end do   
+
+END SUBROUTINE MP_MORR_TWO_MOMENT_AERO
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+      SUBROUTINE MORR_TWO_MOMENT_MICRO(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN,         &
+       NI3DTEN,NS3DTEN,NR3DTEN,QC3D,QI3D,QNI3D,QR3D,NI3D,NS3D,NR3D,              &
+       T3DTEN,QV3DTEN,T3D,QV3D,PRES,DZQ,W3D,WVAR,PRECRT,SNOWRT,            &
+       SNOWPRT,GRPLPRT,                & ! hm added 7/13/13
+       EFFC,EFFI,EFFS,EFFR,DT,                                                   &
+                                            IMS,IME, JMS,JME, KMS,KME,           &
+                                            ITS,ITE, JTS,JTE, KTS,KTE,           & ! ADD GRAUPEL
+                        QG3DTEN,NG3DTEN,QG3D,NG3D,EFFG,qrcu1d,qscu1d, qicu1d,    &
+                        QGSTEN,QRSTEN,QISTEN,QNISTEN,QCSTEN, &
+                        nc3d,nc3dten,iinum, & ! wrf-chem
+				c2prec,CSED,ISED,SSED,GSED,RSED  &  ! hm added, wrf-chem
+                        ,no_src_types_cu,maerosol,naer & ! TWG add
+#if (WRF_CHEM == 1)
+        ,rainprod, evapprod &
+#endif
+                        )
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! THIS PROGRAM IS THE MAIN TWO-MOMENT MICROPHYSICS SUBROUTINE DESCRIBED BY
+! MORRISON ET AL. 2005 JAS AND MORRISON ET AL. 2009 MWR
+
+! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING
+! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES:
+! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL/HAIL.
+
+! CODE STRUCTURE: MAIN SUBROUTINE IS 'MORR_TWO_MOMENT'. ALSO INCLUDED IN THIS FILE IS
+! 'FUNCTION POLYSVP', 'FUNCTION DERF1', AND
+! 'FUNCTION GAMMA'.
+
+! NOTE: THIS SUBROUTINE USES 1D ARRAY IN VERTICAL (COLUMN), EVEN THOUGH VARIABLES ARE CALLED '3D'......
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+! DECLARATIONS
+
+      IMPLICIT NONE
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! THESE VARIABLES BELOW MUST BE LINKED WITH THE MAIN MODEL.
+! DEFINE ARRAY SIZES
+
+! INPUT NUMBER OF GRID CELLS
+
+! INPUT/OUTPUT PARAMETERS                                 ! DESCRIPTION (UNITS)
+      INTEGER, INTENT( IN)  :: IMS,IME, JMS,JME, KMS,KME,          &
+                               ITS,ITE, JTS,JTE, KTS,KTE
+
+      REAL, DIMENSION(KTS:KTE) ::  QC3DTEN            ! CLOUD WATER MIXING RATIO TENDENCY (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QI3DTEN            ! CLOUD ICE MIXING RATIO TENDENCY (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QNI3DTEN           ! SNOW MIXING RATIO TENDENCY (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QR3DTEN            ! RAIN MIXING RATIO TENDENCY (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  NI3DTEN            ! CLOUD ICE NUMBER CONCENTRATION (1/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  NS3DTEN            ! SNOW NUMBER CONCENTRATION (1/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  NR3DTEN            ! RAIN NUMBER CONCENTRATION (1/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QC3D               ! CLOUD WATER MIXING RATIO (KG/KG)
+      REAL, DIMENSION(KTS:KTE) ::  QI3D               ! CLOUD ICE MIXING RATIO (KG/KG)
+      REAL, DIMENSION(KTS:KTE) ::  QNI3D              ! SNOW MIXING RATIO (KG/KG)
+      REAL, DIMENSION(KTS:KTE) ::  QR3D               ! RAIN MIXING RATIO (KG/KG)
+      REAL, DIMENSION(KTS:KTE) ::  NI3D               ! CLOUD ICE NUMBER CONCENTRATION (1/KG)
+      REAL, DIMENSION(KTS:KTE) ::  NS3D               ! SNOW NUMBER CONCENTRATION (1/KG)
+      REAL, DIMENSION(KTS:KTE) ::  NR3D               ! RAIN NUMBER CONCENTRATION (1/KG)
+      REAL, DIMENSION(KTS:KTE) ::  T3DTEN             ! TEMPERATURE TENDENCY (K/S)
+      REAL, DIMENSION(KTS:KTE) ::  QV3DTEN            ! WATER VAPOR MIXING RATIO TENDENCY (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  T3D                ! TEMPERATURE (K)
+      REAL, DIMENSION(KTS:KTE) ::  QV3D               ! WATER VAPOR MIXING RATIO (KG/KG)
+      REAL, DIMENSION(KTS:KTE) ::  PRES               ! ATMOSPHERIC PRESSURE (PA)
+      REAL, DIMENSION(KTS:KTE) ::  DZQ                ! DIFFERENCE IN HEIGHT ACROSS LEVEL (m)
+      REAL, DIMENSION(KTS:KTE) ::  W3D                ! GRID-SCALE VERTICAL VELOCITY (M/S)
+      REAL, DIMENSION(KTS:KTE) ::  WVAR               ! SUB-GRID VERTICAL VELOCITY (M/S)
+! below for wrf-chem
+      REAL, DIMENSION(KTS:KTE) ::  nc3d
+      REAL, DIMENSION(KTS:KTE) ::  nc3dten
+      integer, intent(in) :: iinum
+
+! HM ADDED GRAUPEL VARIABLES
+      REAL, DIMENSION(KTS:KTE) ::  QG3DTEN            ! GRAUPEL MIX RATIO TENDENCY (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  NG3DTEN            ! GRAUPEL NUMB CONC TENDENCY (1/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QG3D            ! GRAUPEL MIX RATIO (KG/KG)
+      REAL, DIMENSION(KTS:KTE) ::  NG3D            ! GRAUPEL NUMBER CONC (1/KG)
+
+! HM, ADD 1/16/07, SEDIMENTATION TENDENCIES FOR MIXING RATIO
+
+      REAL, DIMENSION(KTS:KTE) ::  QGSTEN            ! GRAUPEL SED TEND (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QRSTEN            ! RAIN SED TEND (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QISTEN            ! CLOUD ICE SED TEND (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QNISTEN           ! SNOW SED TEND (KG/KG/S)
+      REAL, DIMENSION(KTS:KTE) ::  QCSTEN            ! CLOUD WAT SED TEND (KG/KG/S)      
+
+! hm add cumulus tendencies for precip
+        REAL, DIMENSION(KTS:KTE) ::   qrcu1d
+        REAL, DIMENSION(KTS:KTE) ::   qscu1d
+        REAL, DIMENSION(KTS:KTE) ::   qicu1d
+
+! OUTPUT VARIABLES
+
+        REAL PRECRT                ! TOTAL PRECIP PER TIME STEP (mm)
+        REAL SNOWRT                ! SNOW PER TIME STEP (mm)
+! hm added 7/13/13
+        REAL SNOWPRT      ! TOTAL CLOUD ICE PLUS SNOW PER TIME STEP (mm)
+	REAL GRPLPRT	  ! TOTAL GRAUPEL PER TIME STEP (mm)
+
+        REAL, DIMENSION(KTS:KTE) ::   EFFC            ! DROPLET EFFECTIVE RADIUS (MICRON)
+        REAL, DIMENSION(KTS:KTE) ::   EFFI            ! CLOUD ICE EFFECTIVE RADIUS (MICRON)
+        REAL, DIMENSION(KTS:KTE) ::   EFFS            ! SNOW EFFECTIVE RADIUS (MICRON)
+        REAL, DIMENSION(KTS:KTE) ::   EFFR            ! RAIN EFFECTIVE RADIUS (MICRON)
+        REAL, DIMENSION(KTS:KTE) ::   EFFG            ! GRAUPEL EFFECTIVE RADIUS (MICRON)
+
+! MODEL INPUT PARAMETERS (FORMERLY IN COMMON BLOCKS)
+
+        REAL DT         ! MODEL TIME STEP (SEC)
+
+!.....................................................................................................
+! LOCAL VARIABLES: ALL PARAMETERS BELOW ARE LOCAL TO SCHEME AND DON'T NEED TO COMMUNICATE WITH THE
+! REST OF THE MODEL.
+
+! SIZE PARAMETER VARIABLES
+
+     REAL, DIMENSION(KTS:KTE) :: LAMC          ! SLOPE PARAMETER FOR DROPLETS (M-1)
+     REAL, DIMENSION(KTS:KTE) :: LAMI          ! SLOPE PARAMETER FOR CLOUD ICE (M-1)
+     REAL, DIMENSION(KTS:KTE) :: LAMS          ! SLOPE PARAMETER FOR SNOW (M-1)
+     REAL, DIMENSION(KTS:KTE) :: LAMR          ! SLOPE PARAMETER FOR RAIN (M-1)
+     REAL, DIMENSION(KTS:KTE) :: LAMG          ! SLOPE PARAMETER FOR GRAUPEL (M-1)
+     REAL, DIMENSION(KTS:KTE) :: CDIST1        ! PSD PARAMETER FOR DROPLETS
+     REAL, DIMENSION(KTS:KTE) :: N0I           ! INTERCEPT PARAMETER FOR CLOUD ICE (KG-1 M-1)
+     REAL, DIMENSION(KTS:KTE) :: N0S           ! INTERCEPT PARAMETER FOR SNOW (KG-1 M-1)
+     REAL, DIMENSION(KTS:KTE) :: N0RR          ! INTERCEPT PARAMETER FOR RAIN (KG-1 M-1)
+     REAL, DIMENSION(KTS:KTE) :: N0G           ! INTERCEPT PARAMETER FOR GRAUPEL (KG-1 M-1)
+     REAL, DIMENSION(KTS:KTE) :: PGAM          ! SPECTRAL SHAPE PARAMETER FOR DROPLETS
+
+! MICROPHYSICAL PROCESSES
+
+     REAL, DIMENSION(KTS:KTE) ::  NSUBC     ! LOSS OF NC DURING EVAP
+     REAL, DIMENSION(KTS:KTE) ::  NSUBI     ! LOSS OF NI DURING SUB.
+     REAL, DIMENSION(KTS:KTE) ::  NSUBS     ! LOSS OF NS DURING SUB.
+     REAL, DIMENSION(KTS:KTE) ::  NSUBR     ! LOSS OF NR DURING EVAP
+     REAL, DIMENSION(KTS:KTE) ::  PRD       ! DEP CLOUD ICE
+     REAL, DIMENSION(KTS:KTE) ::  PRE       ! EVAP OF RAIN
+     REAL, DIMENSION(KTS:KTE) ::  PRDS      ! DEP SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NNUCCC    ! CHANGE N DUE TO CONTACT FREEZ DROPLETS
+     REAL, DIMENSION(KTS:KTE) ::  MNUCCC    ! CHANGE Q DUE TO CONTACT FREEZ DROPLETS
+     REAL, DIMENSION(KTS:KTE) ::  PRA       ! ACCRETION DROPLETS BY RAIN
+     REAL, DIMENSION(KTS:KTE) ::  PRC       ! AUTOCONVERSION DROPLETS
+     REAL, DIMENSION(KTS:KTE) ::  PCC       ! COND/EVAP DROPLETS
+     REAL, DIMENSION(KTS:KTE) ::  NNUCCD    ! CHANGE N FREEZING AEROSOL (PRIM ICE NUCLEATION)
+     REAL, DIMENSION(KTS:KTE) ::  MNUCCD    ! CHANGE Q FREEZING AEROSOL (PRIM ICE NUCLEATION)
+     REAL, DIMENSION(KTS:KTE) ::  MNUCCR    ! CHANGE Q DUE TO CONTACT FREEZ RAIN
+     REAL, DIMENSION(KTS:KTE) ::  NNUCCR    ! CHANGE N DUE TO CONTACT FREEZ RAIN
+     REAL, DIMENSION(KTS:KTE) ::  NPRA      ! CHANGE IN N DUE TO DROPLET ACC BY RAIN
+     REAL, DIMENSION(KTS:KTE) ::  NRAGG     ! SELF-COLLECTION/BREAKUP OF RAIN
+     REAL, DIMENSION(KTS:KTE) ::  NSAGG     ! SELF-COLLECTION OF SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NPRC      ! CHANGE NC AUTOCONVERSION DROPLETS
+     REAL, DIMENSION(KTS:KTE) ::  NPRC1      ! CHANGE NR AUTOCONVERSION DROPLETS
+     REAL, DIMENSION(KTS:KTE) ::  PRAI      ! CHANGE Q ACCRETION CLOUD ICE BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PRCI      ! CHANGE Q AUTOCONVERSIN CLOUD ICE TO SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PSACWS    ! CHANGE Q DROPLET ACCRETION BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NPSACWS   ! CHANGE N DROPLET ACCRETION BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PSACWI    ! CHANGE Q DROPLET ACCRETION BY CLOUD ICE
+     REAL, DIMENSION(KTS:KTE) ::  NPSACWI   ! CHANGE N DROPLET ACCRETION BY CLOUD ICE
+     REAL, DIMENSION(KTS:KTE) ::  NPRCI     ! CHANGE N AUTOCONVERSION CLOUD ICE BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NPRAI     ! CHANGE N ACCRETION CLOUD ICE
+     REAL, DIMENSION(KTS:KTE) ::  NMULTS    ! ICE MULT DUE TO RIMING DROPLETS BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NMULTR    ! ICE MULT DUE TO RIMING RAIN BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  QMULTS    ! CHANGE Q DUE TO ICE MULT DROPLETS/SNOW
+     REAL, DIMENSION(KTS:KTE) ::  QMULTR    ! CHANGE Q DUE TO ICE RAIN/SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PRACS     ! CHANGE Q RAIN-SNOW COLLECTION
+     REAL, DIMENSION(KTS:KTE) ::  NPRACS    ! CHANGE N RAIN-SNOW COLLECTION
+     REAL, DIMENSION(KTS:KTE) ::  PCCN      ! CHANGE Q DROPLET ACTIVATION
+     REAL, DIMENSION(KTS:KTE) ::  PSMLT     ! CHANGE Q MELTING SNOW TO RAIN
+     REAL, DIMENSION(KTS:KTE) ::  EVPMS     ! CHNAGE Q MELTING SNOW EVAPORATING
+     REAL, DIMENSION(KTS:KTE) ::  NSMLTS    ! CHANGE N MELTING SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NSMLTR    ! CHANGE N MELTING SNOW TO RAIN
+! HM ADDED 12/13/06
+     REAL, DIMENSION(KTS:KTE) ::  PIACR     ! CHANGE QR, ICE-RAIN COLLECTION
+     REAL, DIMENSION(KTS:KTE) ::  NIACR     ! CHANGE N, ICE-RAIN COLLECTION
+     REAL, DIMENSION(KTS:KTE) ::  PRACI     ! CHANGE QI, ICE-RAIN COLLECTION
+     REAL, DIMENSION(KTS:KTE) ::  PIACRS     ! CHANGE QR, ICE RAIN COLLISION, ADDED TO SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NIACRS     ! CHANGE N, ICE RAIN COLLISION, ADDED TO SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PRACIS     ! CHANGE QI, ICE RAIN COLLISION, ADDED TO SNOW
+     REAL, DIMENSION(KTS:KTE) ::  EPRD      ! SUBLIMATION CLOUD ICE
+     REAL, DIMENSION(KTS:KTE) ::  EPRDS     ! SUBLIMATION SNOW
+! HM ADDED GRAUPEL PROCESSES
+     REAL, DIMENSION(KTS:KTE) ::  PRACG    ! CHANGE IN Q COLLECTION RAIN BY GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  PSACWG    ! CHANGE IN Q COLLECTION DROPLETS BY GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  PGSACW    ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PGRACS    ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  PRDG    ! DEP OF GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  EPRDG    ! SUB OF GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  EVPMG    ! CHANGE Q MELTING OF GRAUPEL AND EVAPORATION
+     REAL, DIMENSION(KTS:KTE) ::  PGMLT    ! CHANGE Q MELTING OF GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  NPRACG    ! CHANGE N COLLECTION RAIN BY GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  NPSACWG    ! CHANGE N COLLECTION DROPLETS BY GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  NSCNG    ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NGRACS    ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW
+     REAL, DIMENSION(KTS:KTE) ::  NGMLTG    ! CHANGE N MELTING GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  NGMLTR    ! CHANGE N MELTING GRAUPEL TO RAIN
+     REAL, DIMENSION(KTS:KTE) ::  NSUBG    ! CHANGE N SUB/DEP OF GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  PSACR    ! CONVERSION DUE TO COLL OF SNOW BY RAIN
+     REAL, DIMENSION(KTS:KTE) ::  NMULTG    ! ICE MULT DUE TO ACC DROPLETS BY GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  NMULTRG    ! ICE MULT DUE TO ACC RAIN BY GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  QMULTG    ! CHANGE Q DUE TO ICE MULT DROPLETS/GRAUPEL
+     REAL, DIMENSION(KTS:KTE) ::  QMULTRG    ! CHANGE Q DUE TO ICE MULT RAIN/GRAUPEL
+
+! TIME-VARYING ATMOSPHERIC PARAMETERS
+
+     REAL, DIMENSION(KTS:KTE) ::   KAP   ! THERMAL CONDUCTIVITY OF AIR
+     REAL, DIMENSION(KTS:KTE) ::   EVS   ! SATURATION VAPOR PRESSURE
+     REAL, DIMENSION(KTS:KTE) ::   EIS   ! ICE SATURATION VAPOR PRESSURE
+     REAL, DIMENSION(KTS:KTE) ::   QVS   ! SATURATION MIXING RATIO
+     REAL, DIMENSION(KTS:KTE) ::   QVI   ! ICE SATURATION MIXING RATIO
+     REAL, DIMENSION(KTS:KTE) ::   QVQVS ! SAUTRATION RATIO
+     REAL, DIMENSION(KTS:KTE) ::   QVQVSI! ICE SATURAION RATIO
+     REAL, DIMENSION(KTS:KTE) ::   DV    ! DIFFUSIVITY OF WATER VAPOR IN AIR
+     REAL, DIMENSION(KTS:KTE) ::   XXLS  ! LATENT HEAT OF SUBLIMATION
+     REAL, DIMENSION(KTS:KTE) ::   XXLV  ! LATENT HEAT OF VAPORIZATION
+     REAL, DIMENSION(KTS:KTE) ::   CPM   ! SPECIFIC HEAT AT CONST PRESSURE FOR MOIST AIR
+     REAL, DIMENSION(KTS:KTE) ::   MU    ! VISCOCITY OF AIR
+     REAL, DIMENSION(KTS:KTE) ::   SC    ! SCHMIDT NUMBER
+     REAL, DIMENSION(KTS:KTE) ::   XLF   ! LATENT HEAT OF FREEZING
+     REAL, DIMENSION(KTS:KTE) ::   RHO   ! AIR DENSITY
+     REAL, DIMENSION(KTS:KTE) ::   AB    ! CORRECTION TO CONDENSATION RATE DUE TO LATENT HEATING
+     REAL, DIMENSION(KTS:KTE) ::   ABI    ! CORRECTION TO DEPOSITION RATE DUE TO LATENT HEATING
+
+! TIME-VARYING MICROPHYSICS PARAMETERS
+
+     REAL, DIMENSION(KTS:KTE) ::   DAP    ! DIFFUSIVITY OF AEROSOL
+     REAL    NACNT                    ! NUMBER OF CONTACT IN
+     REAL    FMULT                    ! TEMP.-DEP. PARAMETER FOR RIME-SPLINTERING
+     REAL    COFFI                    ! ICE AUTOCONVERSION PARAMETER
+
+! FALL SPEED WORKING VARIABLES (DEFINED IN CODE)
+
+      REAL, DIMENSION(KTS:KTE) ::    DUMI,DUMR,DUMFNI,DUMG,DUMFNG
+      REAL UNI, UMI,UMR
+      REAL, DIMENSION(KTS:KTE) ::    FR, FI, FNI,FG,FNG
+      REAL RGVM
+      REAL, DIMENSION(KTS:KTE) ::   FALOUTR,FALOUTI,FALOUTNI
+      REAL FALTNDR,FALTNDI,FALTNDNI,RHO2
+      REAL, DIMENSION(KTS:KTE) ::   DUMQS,DUMFNS
+      REAL UMS,UNS
+      REAL, DIMENSION(KTS:KTE) ::   FS,FNS, FALOUTS,FALOUTNS,FALOUTG,FALOUTNG
+      REAL FALTNDS,FALTNDNS,UNR,FALTNDG,FALTNDNG
+      REAL, DIMENSION(KTS:KTE) ::    DUMC,DUMFNC
+      REAL UNC,UMC,UNG,UMG
+      REAL, DIMENSION(KTS:KTE) ::   FC,FALOUTC,FALOUTNC
+      REAL FALTNDC,FALTNDNC
+      REAL, DIMENSION(KTS:KTE) ::   FNC,DUMFNR,FALOUTNR
+      REAL FALTNDNR
+      REAL, DIMENSION(KTS:KTE) ::   FNR
+
+! FALL-SPEED PARAMETER 'A' WITH AIR DENSITY CORRECTION
+
+      REAL, DIMENSION(KTS:KTE) ::    AIN,ARN,ASN,ACN,AGN
+
+! EXTERNAL FUNCTION CALL RETURN VARIABLES
+
+!      REAL GAMMA,      ! EULER GAMMA FUNCTION
+!      REAL POLYSVP,    ! SAT. PRESSURE FUNCTION
+!      REAL DERF1        ! ERROR FUNCTION
+
+! DUMMY VARIABLES
+
+     REAL DUM,DUM1,DUM2,DUMT,DUMQV,DUMQSS,DUMQSI,DUMS
+
+! PROGNOSTIC SUPERSATURATION
+
+     REAL DQSDT    ! CHANGE OF SAT. MIX. RAT. WITH TEMPERATURE
+     REAL DQSIDT   ! CHANGE IN ICE SAT. MIXING RAT. WITH T
+     REAL EPSI     ! 1/PHASE REL. TIME (SEE M2005), ICE
+     REAL EPSS     ! 1/PHASE REL. TIME (SEE M2005), SNOW
+     REAL EPSR     ! 1/PHASE REL. TIME (SEE M2005), RAIN
+     REAL EPSG     ! 1/PHASE REL. TIME (SEE M2005), GRAUPEL
+
+! NEW DROPLET ACTIVATION VARIABLES
+     REAL TAUC     ! PHASE REL. TIME (SEE M2005), DROPLETS
+     REAL TAUR     ! PHASE REL. TIME (SEE M2005), RAIN
+     REAL TAUI     ! PHASE REL. TIME (SEE M2005), CLOUD ICE
+     REAL TAUS     ! PHASE REL. TIME (SEE M2005), SNOW
+     REAL TAUG     ! PHASE REL. TIME (SEE M2005), GRAUPEL
+     REAL DUMACT,DUM3
+
+! COUNTING/INDEX VARIABLES
+
+     INTEGER K,NSTEP,N,L !TWG add ! ,I
+
+! LTRUE IS ONLY USED TO SPEED UP THE CODE !!
+! LTRUE, SWITCH = 0, NO HYDROMETEORS IN COLUMN, 
+!               = 1, HYDROMETEORS IN COLUMN
+
+      INTEGER LTRUE
+
+! DROPLET ACTIVATION/FREEZING AEROSOL
+
+
+     REAL    CT      ! DROPLET ACTIVATION PARAMETER
+     REAL    TEMP1   ! DUMMY TEMPERATURE
+     REAL    SAT1    ! DUMMY SATURATION
+     REAL    SIGVL   ! SURFACE TENSION LIQ/VAPOR
+     REAL    KEL     ! KELVIN PARAMETER
+     REAL    KC2     ! TOTAL ICE NUCLEATION RATE
+! TWG 2016 Begin
+     REAL    KC2H    ! ICE NUCLEATED FROM HOMOGENOUS FREEZING OF SULFATE
+     REAL    KC2IM   ! ICE NUCLEATED FROM IMMERSION FREEZING
+     REAL    KC2D    ! ICE NUCLEATED FROM DEPOSITION NUCLEATION
+     REAL    KC2DM   ! ICE NUCLEATED FROM MIXED PHASE DEPOSITION NUCLEATION
+
+       REAL CRY,KRY   ! AEROSOL ACTIVATION PARAMETERS
+
+! MORE WORKING/DUMMY VARIABLES
+
+     REAL DUMQI,DUMNI,DC0,DS0,DG0
+     REAL DUMQC,DUMQR,RATIO,SUM_DEP,FUDGEF
+
+! EFFECTIVE VERTICAL VELOCITY  (M/S)
+     REAL WEF
+
+! WORKING PARAMETERS FOR ICE NUCLEATION
+
+      REAL ANUC,BNUC
+
+! WORKING PARAMETERS FOR AEROSOL ACTIVATION
+
+        REAL AACT,GAMM,GG,PSI,ETA1,ETA2,SM1,SM2,SMAX,UU1,UU2,ALPHA
+
+! DUMMY SIZE DISTRIBUTION PARAMETERS
+
+        REAL DLAMS,DLAMR,DLAMI,DLAMC,DLAMG,LAMMAX,LAMMIN
+
+        INTEGER IDROP
+
+! TWG 2016 Begin  FOR Prescribed Aerosol
+   INTEGER no_src_types_cu
+   REAL, DIMENSION(KTS:KTE,no_src_types_cu) :: maerosol,naer
+   REAL, DIMENSION(no_src_types_cu) :: maero,naero
+! TWG 2016 END
+
+
+! FOR WRF-CHEM
+	REAL, DIMENSION(KTS:KTE)::C2PREC,CSED,ISED,SSED,GSED,RSED
+#if (WRF_CHEM == 1)
+    REAL, DIMENSION(KTS:KTE), INTENT(INOUT) :: rainprod, evapprod
+#endif
+    REAL, DIMENSION(KTS:KTE)                :: tqimelt ! melting of cloud ice (tendency)
+
+! comment lines for wrf-chem since these are intent(in) in that case
+!       REAL, DIMENSION(KTS:KTE) ::  NC3DTEN            ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG/S)
+!       REAL, DIMENSION(KTS:KTE) ::  NC3D               ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG)
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+! SET LTRUE INITIALLY TO 0
+
+         LTRUE = 0
+
+! ATMOSPHERIC PARAMETERS THAT VARY IN TIME AND HEIGHT
+         DO K = KTS,KTE
+
+! NC3DTEN LOCAL ARRAY INITIALIZED
+!               NC3DTEN(K) = 0.
+! TWG/amy comment out this initialization
+! INITIALIZE VARIABLES FOR WRF-CHEM OUTPUT TO ZERO
+
+		C2PREC(K)=0.
+		CSED(K)=0.
+		ISED(K)=0.
+		SSED(K)=0.
+		GSED(K)=0.
+		RSED(K)=0.
+
+#if (WRF_CHEM == 1)
+         rainprod(K) = 0.
+         evapprod(K) = 0.
+         tqimelt(K)  = 0.
+         PRC(K)      = 0.
+         PRA(K)      = 0.
+#endif
+
+!TWG 2016
+!Make single point aerosol number and mass
+        DO L=1,no_src_types_cu
+           maero(L)=maerosol(K,L)
+           naero(L)=naer(K,L)
+        END DO
+!TWG 2016 END
+
+
+! LATENT HEAT OF VAPORATION
+
+            XXLV(K) = 3.1484E6-2370.*T3D(K)
+
+! LATENT HEAT OF SUBLIMATION
+
+            XXLS(K) = 3.15E6-2370.*T3D(K)+0.3337E6
+
+            CPM(K) = CP*(1.+0.887*QV3D(K))
+
+! SATURATION VAPOR PRESSURE AND MIXING RATIO
+
+! hm, add fix for low pressure, 5/12/10
+            EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0))   ! PA
+            EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1))   ! PA
+
+! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING
+
+            IF (EIS(K).GT.EVS(K)) EIS(K) = EVS(K)
+
+            QVS(K) = EP_2*EVS(K)/(PRES(K)-EVS(K))
+            QVI(K) = EP_2*EIS(K)/(PRES(K)-EIS(K))
+
+            QVQVS(K) = QV3D(K)/QVS(K)
+            QVQVSI(K) = QV3D(K)/QVI(K)
+
+! AIR DENSITY
+
+            RHO(K) = PRES(K)/(R*T3D(K))
+
+! ADD NUMBER CONCENTRATION DUE TO CUMULUS TENDENCY
+! ASSUME N0 ASSOCIATED WITH CUMULUS PARAM RAIN IS 10^7 M^-4
+! ASSUME N0 ASSOCIATED WITH CUMULUS PARAM SNOW IS 2 X 10^7 M^-4
+! FOR DETRAINED CLOUD ICE, ASSUME MEAN VOLUME DIAM OF 80 MICRON
+
+            IF (QRCU1D(K).GE.1.E-10) THEN
+            DUM=1.8e5*(QRCU1D(K)*DT/(PI*RHOW*RHO(K)**3))**0.25
+            NR3D(K)=NR3D(K)+DUM
+            END IF
+            IF (QSCU1D(K).GE.1.E-10) THEN
+            DUM=3.e5*(QSCU1D(K)*DT/(CONS1*RHO(K)**3))**(1./(DS+1.))
+            NS3D(K)=NS3D(K)+DUM
+            END IF
+            IF (QICU1D(K).GE.1.E-10) THEN
+            DUM=QICU1D(K)*DT/(CI*(80.E-6)**DI)
+            NI3D(K)=NI3D(K)+DUM
+            END IF
+
+! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER
+! hm modify 7/0/09 change limit to 1.e-8
+
+             IF (QVQVS(K).LT.0.9) THEN
+               IF (QR3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QR3D(K)
+                  T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K)
+                  QR3D(K)=0.
+               END IF
+               IF (QC3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QC3D(K)
+                  T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K)
+                  QC3D(K)=0.
+               END IF
+             END IF
+
+             IF (QVQVSI(K).LT.0.9) THEN
+               IF (QI3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QI3D(K)
+                  T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K)
+                  QI3D(K)=0.
+               END IF
+               IF (QNI3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QNI3D(K)
+                  T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K)
+                  QNI3D(K)=0.
+               END IF
+               IF (QG3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QG3D(K)
+                  T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K)
+                  QG3D(K)=0.
+               END IF
+             END IF
+
+! HEAT OF FUSION
+
+            XLF(K) = XXLS(K)-XXLV(K)
+
+!..................................................................
+! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO
+
+       IF (QC3D(K).LT.QSMALL) THEN
+         QC3D(K) = 0.
+         NC3D(K) = 0.
+         EFFC(K) = 0.
+       END IF
+       IF (QR3D(K).LT.QSMALL) THEN
+         QR3D(K) = 0.
+         NR3D(K) = 0.
+         EFFR(K) = 0.
+       END IF
+       IF (QI3D(K).LT.QSMALL) THEN
+         QI3D(K) = 0.
+         NI3D(K) = 0.
+         EFFI(K) = 0.
+       END IF
+       IF (QNI3D(K).LT.QSMALL) THEN
+         QNI3D(K) = 0.
+         NS3D(K) = 0.
+         EFFS(K) = 0.
+       END IF
+       IF (QG3D(K).LT.QSMALL) THEN
+         QG3D(K) = 0.
+         NG3D(K) = 0.
+         EFFG(K) = 0.
+       END IF
+
+! INITIALIZE SEDIMENTATION TENDENCIES FOR MIXING RATIO
+
+      QRSTEN(K) = 0.
+      QISTEN(K) = 0.
+      QNISTEN(K) = 0.
+      QCSTEN(K) = 0.
+      QGSTEN(K) = 0.
+
+!..................................................................
+! MICROPHYSICS PARAMETERS VARYING IN TIME/HEIGHT
+
+! fix 053011
+            MU(K) = 1.496E-6*T3D(K)**1.5/(T3D(K)+120.)
+
+! FALL SPEED WITH DENSITY CORRECTION (HEYMSFIELD AND BENSSEMER 2006)
+
+            DUM = (RHOSU/RHO(K))**0.54
+
+! fix 053011
+!            AIN(K) = DUM*AI
+! AA revision 4/1/11: Ikawa and Saito 1991 air-density correction 
+            AIN(K) = (RHOSU/RHO(K))**0.35*AI
+            ARN(K) = DUM*AR
+            ASN(K) = DUM*AS
+!            ACN(K) = DUM*AC
+! AA revision 4/1/11: temperature-dependent Stokes fall speed
+            ACN(K) = G*RHOW/(18.*MU(K))
+! HM ADD GRAUPEL 8/28/06
+            AGN(K) = DUM*AG
+
+!hm 4/7/09 bug fix, initialize lami to prevent later division by zero
+            LAMI(K)=0.
+
+!..................................
+! IF THERE IS NO CLOUD/PRECIP WATER, AND IF SUBSATURATED, THEN SKIP MICROPHYSICS
+! FOR THIS LEVEL
+
+            IF (QC3D(K).LT.QSMALL.AND.QI3D(K).LT.QSMALL.AND.QNI3D(K).LT.QSMALL &
+                 .AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.QSMALL) THEN
+                 IF (T3D(K).LT.273.15.AND.QVQVSI(K).LT.0.999) GOTO 200
+                 IF (T3D(K).GE.273.15.AND.QVQVS(K).LT.0.999) GOTO 200
+            END IF
+
+! THERMAL CONDUCTIVITY FOR AIR
+
+! fix 053011
+            KAP(K) = 1.414E3*MU(K)
+
+! DIFFUSIVITY OF WATER VAPOR
+
+            DV(K) = 8.794E-5*T3D(K)**1.81/PRES(K)
+
+! SCHMIT NUMBER
+
+! fix 053011
+            SC(K) = MU(K)/(RHO(K)*DV(K))
+
+! PSYCHOMETIC CORRECTIONS
+
+! RATE OF CHANGE SAT. MIX. RATIO WITH TEMPERATURE
+
+            DUM = (RV*T3D(K)**2)
+
+            DQSDT = XXLV(K)*QVS(K)/DUM
+            DQSIDT =  XXLS(K)*QVI(K)/DUM
+
+            ABI(K) = 1.+DQSIDT*XXLS(K)/CPM(K)
+            AB(K) = 1.+DQSDT*XXLV(K)/CPM(K)
+
+! 
+!.....................................................................
+!.....................................................................
+! CASE FOR TEMPERATURE ABOVE FREEZING
+
+            IF (T3D(K).GE.273.15) THEN
+
+!......................................................................
+!HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER
+! INUM = 0, PREDICT DROPLET NUMBER
+! INUM = 1, SET CONSTANT DROPLET NUMBER
+
+         IF (iinum.EQ.1) THEN
+! CONVERT NDCNST FROM CM-3 TO KG-1
+            NC3D(K)=NDCNST*1.E6/RHO(K)
+         END IF
+
+! GET SIZE DISTRIBUTION PARAMETERS
+
+! MELT VERY SMALL SNOW AND GRAUPEL MIXING RATIOS, ADD TO RAIN
+       IF (QNI3D(K).LT.1.E-6) THEN
+          QR3D(K)=QR3D(K)+QNI3D(K)
+          NR3D(K)=NR3D(K)+NS3D(K)
+          T3D(K)=T3D(K)-QNI3D(K)*XLF(K)/CPM(K)
+          QNI3D(K) = 0.
+          NS3D(K) = 0.
+       END IF
+       IF (QG3D(K).LT.1.E-6) THEN
+          QR3D(K)=QR3D(K)+QG3D(K)
+          NR3D(K)=NR3D(K)+NG3D(K)
+          T3D(K)=T3D(K)-QG3D(K)*XLF(K)/CPM(K)
+          QG3D(K) = 0.
+          NG3D(K) = 0.
+       END IF
+
+       IF (QC3D(K).LT.QSMALL.AND.QNI3D(K).LT.1.E-8.AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.1.E-8) GOTO 300
+
+! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE
+
+      NS3D(K) = MAX(0.,NS3D(K))
+      NC3D(K) = MAX(0.,NC3D(K))
+      NR3D(K) = MAX(0.,NR3D(K))
+      NG3D(K) = MAX(0.,NG3D(K))
+
+!......................................................................
+! RAIN
+
+      IF (QR3D(K).GE.QSMALL) THEN
+      LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.)
+      N0RR(K) = NR3D(K)*LAMR(K)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMR(K).LT.LAMMINR) THEN
+
+      LAMR(K) = LAMMINR
+
+      N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW)
+
+      NR3D(K) = N0RR(K)/LAMR(K)
+      ELSE IF (LAMR(K).GT.LAMMAXR) THEN
+      LAMR(K) = LAMMAXR
+      N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW)
+
+      NR3D(K) = N0RR(K)/LAMR(K)
+      END IF
+      END IF
+
+!......................................................................
+! CLOUD DROPLETS
+
+! MARTIN ET AL. (1994) FORMULA FOR PGAM
+
+      IF (QC3D(K).GE.QSMALL) THEN
+
+         DUM = PRES(K)/(287.15*T3D(K))
+         PGAM(K)=0.0005714*(NC3D(K)/1.E6*DUM)+0.2714
+         PGAM(K)=1./(PGAM(K)**2)-1.
+         PGAM(K)=MAX(PGAM(K),2.)
+         PGAM(K)=MIN(PGAM(K),10.)
+
+! CALCULATE LAMC
+
+      LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/   &
+                 (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.)
+
+! LAMMIN, 60 MICRON DIAMETER
+! LAMMAX, 1 MICRON
+
+      LAMMIN = (PGAM(K)+1.)/60.E-6
+      LAMMAX = (PGAM(K)+1.)/1.E-6
+
+      IF (LAMC(K).LT.LAMMIN) THEN
+      LAMC(K) = LAMMIN
+
+      NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+              &
+                LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26
+      ELSE IF (LAMC(K).GT.LAMMAX) THEN
+      LAMC(K) = LAMMAX
+
+      NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+              &
+                LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26
+
+      END IF
+
+      END IF
+
+!......................................................................
+! SNOW
+
+      IF (QNI3D(K).GE.QSMALL) THEN
+      LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS)
+      N0S(K) = NS3D(K)*LAMS(K)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMS(K).LT.LAMMINS) THEN
+      LAMS(K) = LAMMINS
+      N0S(K) = LAMS(K)**4*QNI3D(K)/CONS1
+
+      NS3D(K) = N0S(K)/LAMS(K)
+
+      ELSE IF (LAMS(K).GT.LAMMAXS) THEN
+
+      LAMS(K) = LAMMAXS
+      N0S(K) = LAMS(K)**4*QNI3D(K)/CONS1
+
+      NS3D(K) = N0S(K)/LAMS(K)
+      END IF
+      END IF
+
+!......................................................................
+! GRAUPEL
+
+      IF (QG3D(K).GE.QSMALL) THEN
+      LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG)
+      N0G(K) = NG3D(K)*LAMG(K)
+
+! ADJUST VARS
+
+      IF (LAMG(K).LT.LAMMING) THEN
+      LAMG(K) = LAMMING
+      N0G(K) = LAMG(K)**4*QG3D(K)/CONS2
+
+      NG3D(K) = N0G(K)/LAMG(K)
+
+      ELSE IF (LAMG(K).GT.LAMMAXG) THEN
+
+      LAMG(K) = LAMMAXG
+      N0G(K) = LAMG(K)**4*QG3D(K)/CONS2
+
+      NG3D(K) = N0G(K)/LAMG(K)
+      END IF
+      END IF
+
+!.....................................................................
+! ZERO OUT PROCESS RATES
+
+            PRC(K) = 0.
+            NPRC(K) = 0.
+            NPRC1(K) = 0.
+            PRA(K) = 0.
+            NPRA(K) = 0.
+            NRAGG(K) = 0.
+            NSMLTS(K) = 0.
+            NSMLTR(K) = 0.
+            EVPMS(K) = 0.
+            PCC(K) = 0.
+            PRE(K) = 0.
+            NSUBC(K) = 0.
+            NSUBR(K) = 0.
+            PRACG(K) = 0.
+            NPRACG(K) = 0.
+            PSMLT(K) = 0.
+            PGMLT(K) = 0.
+            EVPMG(K) = 0.
+            PRACS(K) = 0.
+            NPRACS(K) = 0.
+            NGMLTG(K) = 0.
+            NGMLTR(K) = 0.
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CALCULATION OF MICROPHYSICAL PROCESS RATES, T > 273.15 K
+
+!.................................................................
+!.......................................................................
+! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN
+! FORMULA FROM BEHENG (1994)
+! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION
+! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED
+! AS A GAMMA DISTRIBUTION
+
+! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR
+
+         IF (QC3D(K).GE.1.E-6) THEN
+
+! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA
+! FROM KHAIROUTDINOV AND KOGAN 2000, MWR
+
+                PRC(K)=1350.*QC3D(K)**2.47*  &
+           (NC3D(K)/1.e6*RHO(K))**(-1.79)
+
+! note: nprc1 is change in Nr,
+! nprc is change in Nc
+
+        NPRC1(K) = PRC(K)/CONS29
+        NPRC(K) = PRC(K)/(QC3D(k)/NC3D(K))
+
+! hm bug fix 3/20/12
+                NPRC(K) = MIN(NPRC(K),NC3D(K)/DT)
+                NPRC1(K) = MIN(NPRC1(K),NPRC(K))
+
+         END IF
+
+!.......................................................................
+! HM ADD 12/13/06, COLLECTION OF SNOW BY RAIN ABOVE FREEZING
+! FORMULA FROM IKAWA AND SAITO (1991)
+
+         IF (QR3D(K).GE.1.E-8.AND.QNI3D(K).GE.1.E-8) THEN
+
+            UMS = ASN(K)*CONS3/(LAMS(K)**BS)
+            UMR = ARN(K)*CONS4/(LAMR(K)**BR)
+            UNS = ASN(K)*CONS5/LAMS(K)**BS
+            UNR = ARN(K)*CONS6/LAMR(K)**BR
+
+! SET REASLISTIC LIMITS ON FALLSPEEDS
+
+! bug fix, 10/08/09
+            dum=(rhosu/rho(k))**0.54
+            UMS=MIN(UMS,1.2*dum)
+            UNS=MIN(UNS,1.2*dum)
+            UMR=MIN(UMR,9.1*dum)
+            UNR=MIN(UNR,9.1*dum)
+
+! hm fix, 2/12/13
+! for above freezing conditions to get accelerated melting of snow,
+! we need collection of rain by snow (following Lin et al. 1983)
+!            PRACS(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+              &
+!                  0.08*UMS*UMR)**0.5*RHO(K)*                     &
+!                 N0RR(K)*N0S(K)/LAMS(K)**3*                    &
+!                  (5./(LAMS(K)**3*LAMR(K))+                    &
+!                  2./(LAMS(K)**2*LAMR(K)**2)+                  &
+!                  0.5/(LAMS(K)*LAMR(K)**3)))
+
+            PRACS(K) = CONS41*(((1.2*UMR-0.95*UMS)**2+                   &
+                  0.08*UMS*UMR)**0.5*RHO(K)*                      &
+                  N0RR(K)*N0S(K)/LAMR(K)**3*                              &
+                  (5./(LAMR(K)**3*LAMS(K))+                    &
+                  2./(LAMR(K)**2*LAMS(K)**2)+                  &				 
+                  0.5/(LAMR(k)*LAMS(k)**3)))
+
+! fix 053011, npracs no longer subtracted from snow
+!            NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+            &
+!                0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)*              &
+!                (1./(LAMR(K)**3*LAMS(K))+                      &
+!                 1./(LAMR(K)**2*LAMS(K)**2)+                   &
+!                 1./(LAMR(K)*LAMS(K)**3))
+
+         END IF
+
+! ADD COLLECTION OF GRAUPEL BY RAIN ABOVE FREEZING
+! ASSUME ALL RAIN COLLECTION BY GRAUPEL ABOVE FREEZING IS SHED
+! ASSUME SHED DROPS ARE 1 MM IN SIZE
+
+         IF (QR3D(K).GE.1.E-8.AND.QG3D(K).GE.1.E-8) THEN
+
+            UMG = AGN(K)*CONS7/(LAMG(K)**BG)
+            UMR = ARN(K)*CONS4/(LAMR(K)**BR)
+            UNG = AGN(K)*CONS8/LAMG(K)**BG
+            UNR = ARN(K)*CONS6/LAMR(K)**BR
+
+! SET REASLISTIC LIMITS ON FALLSPEEDS
+! bug fix, 10/08/09
+            dum=(rhosu/rho(k))**0.54
+            UMG=MIN(UMG,20.*dum)
+            UNG=MIN(UNG,20.*dum)
+            UMR=MIN(UMR,9.1*dum)
+            UNR=MIN(UNR,9.1*dum)
+
+! PRACG IS MIXING RATIO OF RAIN PER SEC COLLECTED BY GRAUPEL/HAIL
+            PRACG(K) = CONS41*(((1.2*UMR-0.95*UMG)**2+                   &
+                  0.08*UMG*UMR)**0.5*RHO(K)*                      &
+                  N0RR(K)*N0G(K)/LAMR(K)**3*                              &
+                  (5./(LAMR(K)**3*LAMG(K))+                    &
+                  2./(LAMR(K)**2*LAMG(K)**2)+				   &
+				  0.5/(LAMR(k)*LAMG(k)**3)))
+
+! ASSUME 1 MM DROPS ARE SHED, GET NUMBER SHED PER SEC
+
+            DUM = PRACG(K)/5.2E-7
+
+            NPRACG(K) = CONS32*RHO(K)*(1.7*(UNR-UNG)**2+            &
+                0.3*UNR*UNG)**0.5*N0RR(K)*N0G(K)*              &
+                (1./(LAMR(K)**3*LAMG(K))+                      &
+                 1./(LAMR(K)**2*LAMG(K)**2)+                   &
+                 1./(LAMR(K)*LAMG(K)**3))
+
+! hm 7/15/13, remove limit so that the number of collected drops can smaller than 
+! number of shed drops
+!            NPRACG(K)=MAX(NPRACG(K)-DUM,0.)
+            NPRACG(K)=NPRACG(K)-DUM
+
+	    END IF
+
+!.......................................................................
+! ACCRETION OF CLOUD LIQUID WATER BY RAIN
+! CONTINUOUS COLLECTION EQUATION WITH
+! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED
+
+         IF (QR3D(K).GE.1.E-8 .AND. QC3D(K).GE.1.E-8) THEN
+
+! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM
+! KHAIROUTDINOV AND KOGAN 2000, MWR
+
+           DUM=(QC3D(K)*QR3D(K))
+           PRA(K) = 67.*(DUM)**1.15
+           NPRA(K) = PRA(K)/(QC3D(K)/NC3D(K))
+
+         END IF
+!.......................................................................
+! SELF-COLLECTION OF RAIN DROPS
+! FROM BEHENG(1994)
+! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION
+! AS DESCRINED ABOVE FOR AUTOCONVERSION
+
+         IF (QR3D(K).GE.1.E-8) THEN
+! include breakup add 10/09/09
+            dum1=300.e-6
+            if (1./lamr(k).lt.dum1) then
+            dum=1.
+            else if (1./lamr(k).ge.dum1) then
+            dum=2.-exp(2300.*(1./lamr(k)-dum1))
+            end if
+!            NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K)
+            NRAGG(K) = -5.78*dum*NR3D(K)*QR3D(K)*RHO(K)
+         END IF
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CALCULATE EVAP OF RAIN (RUTLEDGE AND HOBBS 1983)
+
+      IF (QR3D(K).GE.QSMALL) THEN
+        EPSR = 2.*PI*N0RR(K)*RHO(K)*DV(K)*                           &
+                   (F1R/(LAMR(K)*LAMR(K))+                       &
+                    F2R*(ARN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS9/                   &
+                (LAMR(K)**CONS34))
+      ELSE
+      EPSR = 0.
+      END IF
+
+! NO CONDENSATION ONTO RAIN, ONLY EVAP ALLOWED
+
+           IF (QV3D(K).LT.QVS(K)) THEN
+              PRE(K) = EPSR*(QV3D(K)-QVS(K))/AB(K)
+              PRE(K) = MIN(PRE(K),0.)
+           ELSE
+              PRE(K) = 0.
+           END IF
+
+!.......................................................................
+! MELTING OF SNOW
+
+! SNOW MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984
+! IF WATER SUPERSATURATION, SNOW MELTS TO FORM RAIN
+
+          IF (QNI3D(K).GE.1.E-8) THEN
+
+! fix 053011
+! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN
+!             DUM = -CPW/XLF(K)*T3D(K)*PRACS(K)
+             DUM = -CPW/XLF(K)*(T3D(K)-273.15)*PRACS(K)
+
+! hm fix 1/20/15
+!             PSMLT(K)=2.*PI*N0S(K)*KAP(K)*(273.15-T3D(K))/       &
+!                    XLF(K)*RHO(K)*(F1S/(LAMS(K)*LAMS(K))+        &
+!                    F2S*(ASN(K)*RHO(K)/MU(K))**0.5*                      &
+!                    SC(K)**(1./3.)*CONS10/                   &
+!                   (LAMS(K)**CONS35))+DUM
+             PSMLT(K)=2.*PI*N0S(K)*KAP(K)*(273.15-T3D(K))/       &
+                    XLF(K)*(F1S/(LAMS(K)*LAMS(K))+        &
+                    F2S*(ASN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS10/                   &
+                   (LAMS(K)**CONS35))+DUM
+
+! IN WATER SUBSATURATION, SNOW MELTS AND EVAPORATES
+
+      IF (QVQVS(K).LT.1.) THEN
+        EPSS = 2.*PI*N0S(K)*RHO(K)*DV(K)*                            &
+                   (F1S/(LAMS(K)*LAMS(K))+                       &
+                    F2S*(ASN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS10/                   &
+               (LAMS(K)**CONS35))
+! hm fix 8/4/08
+        EVPMS(K) = (QV3D(K)-QVS(K))*EPSS/AB(K)    
+        EVPMS(K) = MAX(EVPMS(K),PSMLT(K))
+        PSMLT(K) = PSMLT(K)-EVPMS(K)
+      END IF
+      END IF
+
+!.......................................................................
+! MELTING OF GRAUPEL
+
+! GRAUPEL MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984
+! IF WATER SUPERSATURATION, GRAUPEL MELTS TO FORM RAIN
+
+          IF (QG3D(K).GE.1.E-8) THEN
+
+! fix 053011
+! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN
+!             DUM = -CPW/XLF(K)*T3D(K)*PRACG(K)
+             DUM = -CPW/XLF(K)*(T3D(K)-273.15)*PRACG(K)
+
+! hm fix 1/20/15
+!             PGMLT(K)=2.*PI*N0G(K)*KAP(K)*(273.15-T3D(K))/ 		 &
+!                    XLF(K)*RHO(K)*(F1S/(LAMG(K)*LAMG(K))+                &
+!                    F2S*(AGN(K)*RHO(K)/MU(K))**0.5*                      &
+!                    SC(K)**(1./3.)*CONS11/                   &
+!                   (LAMG(K)**CONS36))+DUM
+             PGMLT(K)=2.*PI*N0G(K)*KAP(K)*(273.15-T3D(K))/ 		 &
+                    XLF(K)*(F1S/(LAMG(K)*LAMG(K))+                &
+                    F2S*(AGN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS11/                   &
+                   (LAMG(K)**CONS36))+DUM
+
+! IN WATER SUBSATURATION, GRAUPEL MELTS AND EVAPORATES
+
+      IF (QVQVS(K).LT.1.) THEN
+        EPSG = 2.*PI*N0G(K)*RHO(K)*DV(K)*                                &
+                   (F1S/(LAMG(K)*LAMG(K))+                               &
+                    F2S*(AGN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS11/                   &
+               (LAMG(K)**CONS36))
+! hm fix 8/4/08
+        EVPMG(K) = (QV3D(K)-QVS(K))*EPSG/AB(K)
+        EVPMG(K) = MAX(EVPMG(K),PGMLT(K))
+        PGMLT(K) = PGMLT(K)-EVPMG(K)
+      END IF
+      END IF
+
+! HM, V3.2
+! RESET PRACG AND PRACS TO ZERO, THIS IS DONE BECAUSE THERE IS NO
+! TRANSFER OF MASS FROM SNOW AND GRAUPEL TO RAIN DIRECTLY FROM COLLECTION
+! ABOVE FREEZING, IT IS ONLY USED FOR ENHANCEMENT OF MELTING AND SHEDDING
+
+      PRACG(K) = 0.
+      PRACS(K) = 0.
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+! FOR CLOUD ICE, ONLY PROCESSES OPERATING AT T > 273.15 IS
+! MELTING, WHICH IS ALREADY CONSERVED DURING PROCESS
+! CALCULATION
+
+! CONSERVATION OF QC
+
+      DUM = (PRC(K)+PRA(K))*DT
+
+      IF (DUM.GT.QC3D(K).AND.QC3D(K).GE.QSMALL) THEN
+
+        RATIO = QC3D(K)/DUM
+
+        PRC(K) = PRC(K)*RATIO
+        PRA(K) = PRA(K)*RATIO
+
+        END IF
+
+! CONSERVATION OF SNOW
+
+        DUM = (-PSMLT(K)-EVPMS(K)+PRACS(K))*DT
+
+        IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN
+
+! NO SOURCE TERMS FOR SNOW AT T > FREEZING
+        RATIO = QNI3D(K)/DUM
+
+        PSMLT(K) = PSMLT(K)*RATIO
+        EVPMS(K) = EVPMS(K)*RATIO
+        PRACS(K) = PRACS(K)*RATIO
+
+        END IF
+
+! CONSERVATION OF GRAUPEL
+
+        DUM = (-PGMLT(K)-EVPMG(K)+PRACG(K))*DT
+
+        IF (DUM.GT.QG3D(K).AND.QG3D(K).GE.QSMALL) THEN
+
+! NO SOURCE TERM FOR GRAUPEL ABOVE FREEZING
+        RATIO = QG3D(K)/DUM
+
+        PGMLT(K) = PGMLT(K)*RATIO
+        EVPMG(K) = EVPMG(K)*RATIO
+        PRACG(K) = PRACG(K)*RATIO
+
+        END IF
+
+! CONSERVATION OF QR
+! HM 12/13/06, ADDED CONSERVATION OF RAIN SINCE PRE IS NEGATIVE
+
+        DUM = (-PRACS(K)-PRACG(K)-PRE(K)-PRA(K)-PRC(K)+PSMLT(K)+PGMLT(K))*DT
+
+        IF (DUM.GT.QR3D(K).AND.QR3D(K).GE.QSMALL) THEN
+
+        RATIO = (QR3D(K)/DT+PRACS(K)+PRACG(K)+PRA(K)+PRC(K)-PSMLT(K)-PGMLT(K))/ &
+                        (-PRE(K))
+        PRE(K) = PRE(K)*RATIO
+        
+        END IF
+
+!....................................
+
+      QV3DTEN(K) = QV3DTEN(K)+(-PRE(K)-EVPMS(K)-EVPMG(K))
+
+      T3DTEN(K) = T3DTEN(K)+(PRE(K)*XXLV(K)+(EVPMS(K)+EVPMG(K))*XXLS(K)+&
+                    (PSMLT(K)+PGMLT(K)-PRACS(K)-PRACG(K))*XLF(K))/CPM(K)
+
+      QC3DTEN(K) = QC3DTEN(K)+(-PRA(K)-PRC(K))
+      QR3DTEN(K) = QR3DTEN(K)+(PRE(K)+PRA(K)+PRC(K)-PSMLT(K)-PGMLT(K)+PRACS(K)+PRACG(K))
+      QNI3DTEN(K) = QNI3DTEN(K)+(PSMLT(K)+EVPMS(K)-PRACS(K))
+      QG3DTEN(K) = QG3DTEN(K)+(PGMLT(K)+EVPMG(K)-PRACG(K))
+! fix 053011
+!      NS3DTEN(K) = NS3DTEN(K)-NPRACS(K)
+! HM, bug fix 5/12/08, npracg is subtracted from nr not ng
+!      NG3DTEN(K) = NG3DTEN(K)
+      NC3DTEN(K) = NC3DTEN(K)+ (-NPRA(K)-NPRC(K))
+      NR3DTEN(K) = NR3DTEN(K)+ (NPRC1(K)+NRAGG(K)-NPRACG(K))
+
+! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC
+
+	C2PREC(K) = PRA(K)+PRC(K)
+      IF (PRE(K).LT.0.) THEN
+         DUM = PRE(K)*DT/QR3D(K)
+           DUM = MAX(-1.,DUM)
+         NSUBR(K) = DUM*NR3D(K)/DT
+      END IF
+
+        IF (EVPMS(K)+PSMLT(K).LT.0.) THEN
+         DUM = (EVPMS(K)+PSMLT(K))*DT/QNI3D(K)
+           DUM = MAX(-1.,DUM)
+         NSMLTS(K) = DUM*NS3D(K)/DT
+        END IF
+        IF (PSMLT(K).LT.0.) THEN
+          DUM = PSMLT(K)*DT/QNI3D(K)
+          DUM = MAX(-1.0,DUM)
+          NSMLTR(K) = DUM*NS3D(K)/DT
+        END IF
+        IF (EVPMG(K)+PGMLT(K).LT.0.) THEN
+         DUM = (EVPMG(K)+PGMLT(K))*DT/QG3D(K)
+           DUM = MAX(-1.,DUM)
+         NGMLTG(K) = DUM*NG3D(K)/DT
+        END IF
+        IF (PGMLT(K).LT.0.) THEN
+          DUM = PGMLT(K)*DT/QG3D(K)
+          DUM = MAX(-1.0,DUM)
+          NGMLTR(K) = DUM*NG3D(K)/DT
+        END IF
+
+         NS3DTEN(K) = NS3DTEN(K)+(NSMLTS(K))
+         NG3DTEN(K) = NG3DTEN(K)+(NGMLTG(K))
+         NR3DTEN(K) = NR3DTEN(K)+(NSUBR(K)-NSMLTR(K)-NGMLTR(K))
+
+ 300  CONTINUE
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE
+! WATER SATURATION
+
+      DUMT = T3D(K)+DT*T3DTEN(K)
+      DUMQV = QV3D(K)+DT*QV3DTEN(K)
+! hm, add fix for low pressure, 5/12/10
+      dum=min(0.99*pres(k),POLYSVP(DUMT,0))
+      DUMQSS = EP_2*dum/(PRES(K)-dum)
+      DUMQC = QC3D(K)+DT*QC3DTEN(K)
+      DUMQC = MAX(DUMQC,0.)
+
+! SATURATION ADJUSTMENT FOR LIQUID
+
+      DUMS = DUMQV-DUMQSS
+      PCC(K) = DUMS/(1.+XXLV(K)**2*DUMQSS/(CPM(K)*RV*DUMT**2))/DT
+      IF (PCC(K)*DT+DUMQC.LT.0.) THEN
+           PCC(K) = -DUMQC/DT
+      END IF
+
+      QV3DTEN(K) = QV3DTEN(K)-PCC(K)
+      T3DTEN(K) = T3DTEN(K)+PCC(K)*XXLV(K)/CPM(K)
+      QC3DTEN(K) = QC3DTEN(K)+PCC(K)
+
+#if (WRF_CHEM == 1)
+         evapprod(k) = - PRE(K) - EVPMS(K) - EVPMG(K)
+         rainprod(k) = PRA(K) + PRC(K) + tqimelt(K)
+#endif
+
+!.......................................................................
+! ACTIVATION OF CLOUD DROPLETS
+! DROPLET CONCENTRATION IS SPECIFIED !!!!!
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!!TWG/amy begin Morrison Activation Code
+      IF (INUM.EQ.0) THEN
+
+      IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL) THEN
+
+! EFFECTIVE VERTICAL VELOCITY (M/S)
+
+      IF (ISUB.EQ.0) THEN
+! ADD SUB-GRID VERTICAL VELOCITY
+         DUM = W3D(K)+WVAR(K)
+
+! ASSUME MINIMUM EFF. SUB-GRID VELOCITY 0.10 M/S
+         DUM = MAX(DUM,0.10)
+
+      ELSE IF (ISUB.EQ.1) THEN
+         DUM=W3D(K)
+      END IF
+! ONLY ACTIVATE IN REGIONS OF UPWARD MOTION
+      IF (DUM.GE.0.001) THEN
+
+      IF (IBASE.EQ.1) THEN
+
+! ACTIVATE ONLY IF THERE IS LITTLE CLOUD WATER
+! OR IF AT CLOUD BASE, OR AT LOWEST MODEL LEVEL (K=1)
+
+         IDROP=0
+
+         IF (QC3D(K)+QC3DTEN(K)*DT.LE.0.05E-3/RHO(K)) THEN
+            IDROP=1
+         END IF
+         IF (K.EQ.1) THEN
+            IDROP=1
+         ELSE IF (K.GE.2) THEN
+            IF (QC3D(K)+QC3DTEN(K)*DT.GT.0.05E-3/RHO(K).AND. &
+             QC3D(K-1)+QC3DTEN(K-1)*DT.LE.0.05E-3/RHO(K-1)) THEN
+            IDROP=1
+            END IF
+         END IF
+
+         IF (IDROP.EQ.1) THEN
+! ACTIVATE AT CLOUD BASE OR REGIONS WITH VERY LITTLE LIQ WATER
+
+         IF (IACT.EQ.1) THEN
+! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W
+! BASED ON TWOMEY 1959
+
+            DUM=DUM*100.  ! CONVERT FROM M/S TO CM/S
+            DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.))
+            DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3
+            DUM2=DUM2/RHO(K)  ! CONVERT FROM M-3 TO KG-1
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+           ELSE IF (IACT.EQ.2) THEN
+! DROPLET ACTIVATION FROM ABDUL-RAZZAK AND GHAN (2000)
+
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+           ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K))
+           GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K))
+
+           GG =1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ &
+              (T3D(K)*RR)-1.))
+
+           PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT
+
+           ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1)
+           ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+           DUM1=1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75)
+           DUM2=1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75)
+
+           SMAX = 1./(DUM1+DUM2)**0.5
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+            DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+! TWG 2016 BEGIN
+           ELSE IF (IACT.EQ.4) THEN
+            DUM = MAX((W3D(K)+WVAR(K)),0.5)
+           call mdm_prescribed_activate(DUM,T3D(K),RHO(K), &
+           naero, naer_cu,naer_cu, maero,  &
+           dispersion_aer,hygro_aer, density_aer, DUM2, XXLV(K))
+
+           DUM2 = (DUM2-NC3D(K))/DT
+           DUM2 = MAX(0.,DUM2)
+           NC3DTEN(K) = NC3DTEN(K)+DUM2
+!TWG 2016 END
+           END IF  ! IACT
+
+!.............................................................................
+        ELSE IF (IDROP.EQ.0) THEN
+! ACTIVATE IN CLOUD INTERIOR
+! FIND EQUILIBRIUM SUPERSATURATION
+
+           TAUC=1./(2.*PI*RHO(k)*DV(K)*NC3D(K)*(PGAM(K)+1.)/LAMC(K))
+           IF (EPSR.GT.1.E-8) THEN
+             TAUR=1./EPSR
+           ELSE
+             TAUR=1.E8
+           END IF
+
+! hm fix 1/20/15
+!           DUM3=(QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM
+           DUM3=(-QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM
+           DUM3=DUM3*TAUC*TAUR/(TAUC+TAUR)
+
+           IF (DUM3/QVS(K).GE.1.E-6) THEN
+           IF (IACT.EQ.1) THEN
+
+! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQUILIBRIUM SS
+
+            DUM=DUM*100.  ! CONVERT FROM M/S TO CM/S
+            DUMACT = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.))
+
+! USE POWER LAW CCN SPECTRA
+
+! CONVERT FROM ABSOLUTE SUPERSATURATION TO SUPERSATURATION RATIO IN %
+            DUM3=DUM3/QVS(K)*100.
+
+            DUM2=C1*DUM3**K1
+! MAKE SURE VALUE DOESN'T EXCEED THAT FOR NON-EQUILIBRIUM SS
+            DUM2=MIN(DUM2,DUMACT)
+            DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3
+            DUM2=DUM2/RHO(K)  ! CONVERT FROM M-3 TO KG-1
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+           ELSE IF (IACT.EQ.2) THEN
+
+! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQUILIBRIUM SS
+
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+!           ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K))
+!           GAMM =
+!           RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K))
+
+           GG =1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ &
+              (T3D(K)*RR)-1.))
+
+           PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT
+
+           ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1)
+           ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+           DUM1=1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75)
+           DUM2=1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75)
+
+           SMAX = 1./(DUM1+DUM2)**0.5
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+           DUMACT = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+! USE LOGNORMAL AEROSOL
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION
+           SMAX = DUM3/QVS(K)
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+            DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+! MAKE SURE ISN'T GREATER THAN NON-EQUIL. SS
+            DUM2=MIN(DUM2,DUMACT)
+
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+! TWG 2016 BEGIN
+           ELSE IF (IACT.EQ.4) THEN
+           DUM = MAX((W3D(K)+WVAR(K)),0.5)
+           call mdm_prescribed_activate(DUM,T3D(K),RHO(K), &
+           naero, naer_cu,naer_cu, maero,  &
+           dispersion_aer,hygro_aer, density_aer, DUM2, XXLV(K))
+
+           DUM2 = (DUM2-NC3D(K))/DT
+           DUM2 = MAX(0.,DUM2)
+           NC3DTEN(K) = NC3DTEN(K)+DUM2
+! TWG 2016 END
+           END IF ! IACT
+           END IF ! DUM3/QVS > 1.E-6
+        END IF  ! IDROP = 1
+
+!.......................................................................
+      ELSE IF (IBASE.EQ.2) THEN
+
+           IF (IACT.EQ.1) THEN
+! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W
+! BASED ON TWOMEY 1959
+
+            DUM=DUM*100.  ! CONVERT FROM M/S TO CM/S
+            DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.))
+            DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3
+            DUM2=DUM2/RHO(K)  ! CONVERT FROM M-3 TO KG-1
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+           ELSE IF (IACT.EQ.2) THEN
+
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+           ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K))
+           GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K))
+
+           GG =1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ &
+              (T3D(K)*RR)-1.))
+
+           PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT
+
+           ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1)
+           ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+           DUM1=1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75)
+           DUM2=1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75)
+
+           SMAX = 1./(DUM1+DUM2)**0.5
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+            DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+!TWG 2016 BEGIN
+           ELSE IF (IACT.EQ.4) THEN
+           DUM = MAX((W3D(K)+WVAR(K)),0.5)
+           call mdm_prescribed_activate(DUM,T3D(K),RHO(K), &
+           naero, naer_cu,naer_cu, maero,  &
+           dispersion_aer,hygro_aer, density_aer, DUM2, XXLV(K))
+
+           DUM2 = (DUM2-NC3D(K))/DT
+           DUM2 = MAX(0.,DUM2)
+           NC3DTEN(K) = NC3DTEN(K)+DUM2
+!TWG 2016 END
+           END IF  ! IACT
+        END IF  ! IBASE
+        END IF  ! W > 0.001
+        END IF  ! QC3D > QSMALL
+        END IF  ! INUM = 0
+!!TWG/amy end
+
+
+
+! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION
+! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND
+! LOSS OF NUMBER CONCENTRATION
+
+!     IF (PCC(K).LT.0.) THEN
+!        DUM = PCC(K)*DT/QC3D(K)
+!           DUM = MAX(-1.,DUM)
+!        NSUBC(K) = DUM*NC3D(K)/DT
+!     END IF
+
+! UPDATE TENDENCIES
+
+!        NC3DTEN(K) = NC3DTEN(K)+NSUBC(K)
+
+!.....................................................................
+!.....................................................................
+         ELSE  ! TEMPERATURE < 273.15
+
+!......................................................................
+!HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER
+! INUM = 0, PREDICT DROPLET NUMBER
+! INUM = 1, SET CONSTANT DROPLET NUMBER
+
+         IF (iinum.EQ.1) THEN
+! CONVERT NDCNST FROM CM-3 TO KG-1
+            NC3D(K)=NDCNST*1.E6/RHO(K)
+         END IF
+
+! CALCULATE SIZE DISTRIBUTION PARAMETERS
+! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE
+
+      NI3D(K) = MAX(0.,NI3D(K))
+      NS3D(K) = MAX(0.,NS3D(K))
+      NC3D(K) = MAX(0.,NC3D(K))
+      NR3D(K) = MAX(0.,NR3D(K))
+      NG3D(K) = MAX(0.,NG3D(K))
+
+!......................................................................
+! CLOUD ICE
+
+      IF (QI3D(K).GE.QSMALL) THEN
+         LAMI(K) = (CONS12*                 &
+              NI3D(K)/QI3D(K))**(1./DI)
+         N0I(K) = NI3D(K)*LAMI(K)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMI(K).LT.LAMMINI) THEN
+
+      LAMI(K) = LAMMINI
+
+      N0I(K) = LAMI(K)**4*QI3D(K)/CONS12
+
+      NI3D(K) = N0I(K)/LAMI(K)
+      ELSE IF (LAMI(K).GT.LAMMAXI) THEN
+      LAMI(K) = LAMMAXI
+      N0I(K) = LAMI(K)**4*QI3D(K)/CONS12
+
+      NI3D(K) = N0I(K)/LAMI(K)
+      END IF
+      END IF
+
+!......................................................................
+! RAIN
+
+      IF (QR3D(K).GE.QSMALL) THEN
+      LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.)
+      N0RR(K) = NR3D(K)*LAMR(K)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMR(K).LT.LAMMINR) THEN
+
+      LAMR(K) = LAMMINR
+
+      N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW)
+
+      NR3D(K) = N0RR(K)/LAMR(K)
+      ELSE IF (LAMR(K).GT.LAMMAXR) THEN
+      LAMR(K) = LAMMAXR
+      N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW)
+
+      NR3D(K) = N0RR(K)/LAMR(K)
+      END IF
+      END IF
+
+!......................................................................
+! CLOUD DROPLETS
+
+! MARTIN ET AL. (1994) FORMULA FOR PGAM
+
+      IF (QC3D(K).GE.QSMALL) THEN
+
+         DUM = PRES(K)/(287.15*T3D(K))
+         PGAM(K)=0.0005714*(NC3D(K)/1.E6*DUM)+0.2714
+         PGAM(K)=1./(PGAM(K)**2)-1.
+         PGAM(K)=MAX(PGAM(K),2.)
+         PGAM(K)=MIN(PGAM(K),10.)
+
+! CALCULATE LAMC
+
+      LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/   &
+                 (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.)
+
+! LAMMIN, 60 MICRON DIAMETER
+! LAMMAX, 1 MICRON
+
+      LAMMIN = (PGAM(K)+1.)/60.E-6
+      LAMMAX = (PGAM(K)+1.)/1.E-6
+
+      IF (LAMC(K).LT.LAMMIN) THEN
+      LAMC(K) = LAMMIN
+
+      NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+              &
+                LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26
+      ELSE IF (LAMC(K).GT.LAMMAX) THEN
+      LAMC(K) = LAMMAX
+      NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+              &
+                LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26
+
+      END IF
+
+! TO CALCULATE DROPLET FREEZING
+
+        CDIST1(K) = NC3D(K)/GAMMA(PGAM(K)+1.)
+
+      END IF
+
+!......................................................................
+! SNOW
+
+      IF (QNI3D(K).GE.QSMALL) THEN
+      LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS)
+      N0S(K) = NS3D(K)*LAMS(K)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMS(K).LT.LAMMINS) THEN
+      LAMS(K) = LAMMINS
+      N0S(K) = LAMS(K)**4*QNI3D(K)/CONS1
+
+      NS3D(K) = N0S(K)/LAMS(K)
+
+      ELSE IF (LAMS(K).GT.LAMMAXS) THEN
+
+      LAMS(K) = LAMMAXS
+      N0S(K) = LAMS(K)**4*QNI3D(K)/CONS1
+
+      NS3D(K) = N0S(K)/LAMS(K)
+      END IF
+      END IF
+
+!......................................................................
+! GRAUPEL
+
+      IF (QG3D(K).GE.QSMALL) THEN
+      LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG)
+      N0G(K) = NG3D(K)*LAMG(K)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMG(K).LT.LAMMING) THEN
+      LAMG(K) = LAMMING
+      N0G(K) = LAMG(K)**4*QG3D(K)/CONS2
+
+      NG3D(K) = N0G(K)/LAMG(K)
+
+      ELSE IF (LAMG(K).GT.LAMMAXG) THEN
+
+      LAMG(K) = LAMMAXG
+      N0G(K) = LAMG(K)**4*QG3D(K)/CONS2
+
+      NG3D(K) = N0G(K)/LAMG(K)
+      END IF
+      END IF
+
+!.....................................................................
+! ZERO OUT PROCESS RATES
+
+            MNUCCC(K) = 0.
+            NNUCCC(K) = 0.
+            PRC(K) = 0.
+            NPRC(K) = 0.
+            NPRC1(K) = 0.
+            NSAGG(K) = 0.
+            PSACWS(K) = 0.
+            NPSACWS(K) = 0.
+            PSACWI(K) = 0.
+            NPSACWI(K) = 0.
+            PRACS(K) = 0.
+            NPRACS(K) = 0.
+            NMULTS(K) = 0.
+            QMULTS(K) = 0.
+            NMULTR(K) = 0.
+            QMULTR(K) = 0.
+            NMULTG(K) = 0.
+            QMULTG(K) = 0.
+            NMULTRG(K) = 0.
+            QMULTRG(K) = 0.
+            MNUCCR(K) = 0.
+            NNUCCR(K) = 0.
+            PRA(K) = 0.
+            NPRA(K) = 0.
+            NRAGG(K) = 0.
+            PRCI(K) = 0.
+            NPRCI(K) = 0.
+            PRAI(K) = 0.
+            NPRAI(K) = 0.
+            NNUCCD(K) = 0.
+            MNUCCD(K) = 0.
+            PCC(K) = 0.
+            PRE(K) = 0.
+            PRD(K) = 0.
+            PRDS(K) = 0.
+            EPRD(K) = 0.
+            EPRDS(K) = 0.
+            NSUBC(K) = 0.
+            NSUBI(K) = 0.
+            NSUBS(K) = 0.
+            NSUBR(K) = 0.
+            PIACR(K) = 0.
+            NIACR(K) = 0.
+            PRACI(K) = 0.
+            PIACRS(K) = 0.
+            NIACRS(K) = 0.
+            PRACIS(K) = 0.
+! HM: ADD GRAUPEL PROCESSES
+            PRACG(K) = 0.
+            PSACR(K) = 0.
+	    PSACWG(K) = 0.
+	    PGSACW(K) = 0.
+            PGRACS(K) = 0.
+	    PRDG(K) = 0.
+	    EPRDG(K) = 0.
+	    NPRACG(K) = 0.
+	    NPSACWG(K) = 0.
+	    NSCNG(K) = 0.
+ 	    NGRACS(K) = 0.
+	    NSUBG(K) = 0.
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CALCULATION OF MICROPHYSICAL PROCESS RATES
+! ACCRETION/AUTOCONVERSION/FREEZING/MELTING/COAG.
+!.......................................................................
+! FREEZING OF CLOUD DROPLETS
+! ONLY ALLOWED BELOW -4 C
+        IF (QC3D(K).GE.QSMALL .AND. T3D(K).LT.269.15) THEN
+
+! NUMBER OF CONTACT NUCLEI (M^-3) FROM MEYERS ET AL., 1992
+! FACTOR OF 1000 IS TO CONVERT FROM L^-1 TO M^-3
+
+! MEYERS CURVE
+
+           NACNT = EXP(-2.80+0.262*(273.15-T3D(K)))*1000.
+
+! COOPER CURVE
+!        NACNT =  5.*EXP(0.304*(273.15-T3D(K)))
+
+! FLECTHER
+!     NACNT = 0.01*EXP(0.6*(273.15-T3D(K)))
+
+! CONTACT FREEZING
+
+! MEAN FREE PATH
+
+            DUM = 7.37*T3D(K)/(288.*10.*PRES(K))/100.
+
+! EFFECTIVE DIFFUSIVITY OF CONTACT NUCLEI
+! BASED ON BROWNIAN DIFFUSION
+
+            DAP(K) = CONS37*T3D(K)*(1.+DUM/RIN)/MU(K)
+ 
+           MNUCCC(K) = CONS38*DAP(K)*NACNT*EXP(LOG(CDIST1(K))+   &
+                   LOG(GAMMA(PGAM(K)+5.))-4.*LOG(LAMC(K)))
+           NNUCCC(K) = 2.*PI*DAP(K)*NACNT*CDIST1(K)*           &
+                    GAMMA(PGAM(K)+2.)/                         &
+                    LAMC(K)
+
+! IMMERSION FREEZING (BIGG 1953)
+
+!           MNUCCC(K) = MNUCCC(K)+CONS39*                   &
+!                  EXP(LOG(CDIST1(K))+LOG(GAMMA(7.+PGAM(K)))-6.*LOG(LAMC(K)))*             &
+!                   EXP(AIMM*(273.15-T3D(K)))
+
+!           NNUCCC(K) = NNUCCC(K)+                                  &
+!            CONS40*EXP(LOG(CDIST1(K))+LOG(GAMMA(PGAM(K)+4.))-3.*LOG(LAMC(K)))              &
+!                *EXP(AIMM*(273.15-T3D(K)))
+
+! hm 7/15/13 fix for consistency w/ original formula
+           MNUCCC(K) = MNUCCC(K)+CONS39*                   &
+                  EXP(LOG(CDIST1(K))+LOG(GAMMA(7.+PGAM(K)))-6.*LOG(LAMC(K)))*             &
+                   (EXP(AIMM*(273.15-T3D(K)))-1.)
+
+           NNUCCC(K) = NNUCCC(K)+                                  &
+            CONS40*EXP(LOG(CDIST1(K))+LOG(GAMMA(PGAM(K)+4.))-3.*LOG(LAMC(K)))              &
+                *(EXP(AIMM*(273.15-T3D(K)))-1.)
+
+! PUT IN A CATCH HERE TO PREVENT DIVERGENCE BETWEEN NUMBER CONC. AND
+! MIXING RATIO, SINCE STRICT CONSERVATION NOT CHECKED FOR NUMBER CONC
+
+           NNUCCC(K) = MIN(NNUCCC(K),NC3D(K)/DT)
+
+        END IF
+
+!.................................................................
+!.......................................................................
+! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN
+! FORMULA FROM BEHENG (1994)
+! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION
+! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED
+! AS A GAMMA DISTRIBUTION
+
+! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR
+
+         IF (QC3D(K).GE.1.E-6) THEN
+
+! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA
+! FROM KHAIROUTDINOV AND KOGAN 2000, MWR
+
+                PRC(K)=1350.*QC3D(K)**2.47*  &
+           (NC3D(K)/1.e6*RHO(K))**(-1.79)
+
+! note: nprc1 is change in Nr,
+! nprc is change in Nc
+
+        NPRC1(K) = PRC(K)/CONS29
+        NPRC(K) = PRC(K)/(QC3D(K)/NC3D(K))
+
+! hm bug fix 3/20/12
+                NPRC(K) = MIN(NPRC(K),NC3D(K)/DT)
+                NPRC1(K) = MIN(NPRC1(K),NPRC(K))
+
+         END IF
+
+!.......................................................................
+! SELF-COLLECTION OF DROPLET NOT INCLUDED IN KK2000 SCHEME
+
+! SNOW AGGREGATION FROM PASSARELLI, 1978, USED BY REISNER, 1998
+! THIS IS HARD-WIRED FOR BS = 0.4 FOR NOW
+
+         IF (QNI3D(K).GE.1.E-8) THEN
+             NSAGG(K) = CONS15*ASN(K)*RHO(K)**            &
+            ((2.+BS)/3.)*QNI3D(K)**((2.+BS)/3.)*                  &
+            (NS3D(K)*RHO(K))**((4.-BS)/3.)/                       &
+            (RHO(K))
+         END IF
+
+!.......................................................................
+! ACCRETION OF CLOUD DROPLETS ONTO SNOW/GRAUPEL
+! HERE USE CONTINUOUS COLLECTION EQUATION WITH
+! SIMPLE GRAVITATIONAL COLLECTION KERNEL IGNORING
+
+! SNOW
+
+         IF (QNI3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN
+
+           PSACWS(K) = CONS13*ASN(K)*QC3D(K)*RHO(K)*               &
+                  N0S(K)/                        &
+                  LAMS(K)**(BS+3.)
+           NPSACWS(K) = CONS13*ASN(K)*NC3D(K)*RHO(K)*              &
+                  N0S(K)/                        &
+                  LAMS(K)**(BS+3.)
+
+         END IF
+
+!............................................................................
+! COLLECTION OF CLOUD WATER BY GRAUPEL
+
+         IF (QG3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN
+
+           PSACWG(K) = CONS14*AGN(K)*QC3D(K)*RHO(K)*               &
+                  N0G(K)/                        &
+                  LAMG(K)**(BG+3.)
+           NPSACWG(K) = CONS14*AGN(K)*NC3D(K)*RHO(K)*              &
+                  N0G(K)/                        &
+                  LAMG(K)**(BG+3.)
+	    END IF
+
+!.......................................................................
+! HM, ADD 12/13/06
+! CLOUD ICE COLLECTING DROPLETS, ASSUME THAT CLOUD ICE MEAN DIAM > 100 MICRON
+! BEFORE RIMING CAN OCCUR
+! ASSUME THAT RIME COLLECTED ON CLOUD ICE DOES NOT LEAD
+! TO HALLET-MOSSOP SPLINTERING
+
+         IF (QI3D(K).GE.1.E-8 .AND. QC3D(K).GE.QSMALL) THEN
+
+! PUT IN SIZE DEPENDENT COLLECTION EFFICIENCY BASED ON STOKES LAW
+! FROM THOMPSON ET AL. 2004, MWR
+
+            IF (1./LAMI(K).GE.100.E-6) THEN
+
+           PSACWI(K) = CONS16*AIN(K)*QC3D(K)*RHO(K)*               &
+                  N0I(K)/                        &
+                  LAMI(K)**(BI+3.)
+           NPSACWI(K) = CONS16*AIN(K)*NC3D(K)*RHO(K)*              &
+                  N0I(K)/                        &
+                  LAMI(K)**(BI+3.)
+           END IF
+         END IF
+
+!.......................................................................
+! ACCRETION OF RAIN WATER BY SNOW
+! FORMULA FROM IKAWA AND SAITO, 1991, USED BY REISNER ET AL, 1998
+
+         IF (QR3D(K).GE.1.E-8.AND.QNI3D(K).GE.1.E-8) THEN
+
+            UMS = ASN(K)*CONS3/(LAMS(K)**BS)
+            UMR = ARN(K)*CONS4/(LAMR(K)**BR)
+            UNS = ASN(K)*CONS5/LAMS(K)**BS
+            UNR = ARN(K)*CONS6/LAMR(K)**BR
+
+! SET REASLISTIC LIMITS ON FALLSPEEDS
+
+! bug fix, 10/08/09
+            dum=(rhosu/rho(k))**0.54
+            UMS=MIN(UMS,1.2*dum)
+            UNS=MIN(UNS,1.2*dum)
+            UMR=MIN(UMR,9.1*dum)
+            UNR=MIN(UNR,9.1*dum)
+
+            PRACS(K) = CONS41*(((1.2*UMR-0.95*UMS)**2+                   &
+                  0.08*UMS*UMR)**0.5*RHO(K)*                      &
+                  N0RR(K)*N0S(K)/LAMR(K)**3*                              &
+                  (5./(LAMR(K)**3*LAMS(K))+                    &
+                  2./(LAMR(K)**2*LAMS(K)**2)+                  &				 
+                  0.5/(LAMR(k)*LAMS(k)**3)))
+
+            NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+            &
+                0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)*              &
+                (1./(LAMR(K)**3*LAMS(K))+                      &
+                 1./(LAMR(K)**2*LAMS(K)**2)+                   &
+                 1./(LAMR(K)*LAMS(K)**3))
+
+! MAKE SURE PRACS DOESN'T EXCEED TOTAL RAIN MIXING RATIO
+! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING
+! RIME-SPLINTERING
+
+            PRACS(K) = MIN(PRACS(K),QR3D(K)/DT)
+
+! COLLECTION OF SNOW BY RAIN - NEEDED FOR GRAUPEL CONVERSION CALCULATIONS
+! ONLY CALCULATE IF SNOW AND RAIN MIXING RATIOS EXCEED 0.1 G/KG
+
+! HM MODIFY FOR WRFV3.1
+!            IF (IHAIL.EQ.0) THEN
+            IF (QNI3D(K).GE.0.1E-3.AND.QR3D(K).GE.0.1E-3) THEN
+            PSACR(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+              &
+                  0.08*UMS*UMR)**0.5*RHO(K)*                     &
+                 N0RR(K)*N0S(K)/LAMS(K)**3*                               &
+                  (5./(LAMS(K)**3*LAMR(K))+                    &
+                  2./(LAMS(K)**2*LAMR(K)**2)+                  &
+                  0.5/(LAMS(K)*LAMR(K)**3)))            
+            END IF
+!            END IF
+
+         END IF
+
+!.......................................................................
+
+! COLLECTION OF RAINWATER BY GRAUPEL, FROM IKAWA AND SAITO 1990, 
+! USED BY REISNER ET AL 1998
+         IF (QR3D(K).GE.1.E-8.AND.QG3D(K).GE.1.E-8) THEN
+
+            UMG = AGN(K)*CONS7/(LAMG(K)**BG)
+            UMR = ARN(K)*CONS4/(LAMR(K)**BR)
+            UNG = AGN(K)*CONS8/LAMG(K)**BG
+            UNR = ARN(K)*CONS6/LAMR(K)**BR
+
+! SET REASLISTIC LIMITS ON FALLSPEEDS
+! bug fix, 10/08/09
+            dum=(rhosu/rho(k))**0.54
+            UMG=MIN(UMG,20.*dum)
+            UNG=MIN(UNG,20.*dum)
+            UMR=MIN(UMR,9.1*dum)
+            UNR=MIN(UNR,9.1*dum)
+
+            PRACG(K) = CONS41*(((1.2*UMR-0.95*UMG)**2+                   &
+                  0.08*UMG*UMR)**0.5*RHO(K)*                      &
+                  N0RR(K)*N0G(K)/LAMR(K)**3*                              &
+                  (5./(LAMR(K)**3*LAMG(K))+                    &
+                  2./(LAMR(K)**2*LAMG(K)**2)+				   &
+				  0.5/(LAMR(k)*LAMG(k)**3)))
+
+            NPRACG(K) = CONS32*RHO(K)*(1.7*(UNR-UNG)**2+            &
+                0.3*UNR*UNG)**0.5*N0RR(K)*N0G(K)*              &
+                (1./(LAMR(K)**3*LAMG(K))+                      &
+                 1./(LAMR(K)**2*LAMG(K)**2)+                   &
+                 1./(LAMR(K)*LAMG(K)**3))
+
+! MAKE SURE PRACG DOESN'T EXCEED TOTAL RAIN MIXING RATIO
+! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING
+! RIME-SPLINTERING
+
+            PRACG(K) = MIN(PRACG(K),QR3D(K)/DT)
+
+	    END IF
+
+!.......................................................................
+! RIME-SPLINTERING - SNOW
+! HALLET-MOSSOP (1974)
+! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER
+
+! DUM1 = MASS OF INDIVIDUAL SPLINTERS
+
+! HM ADD THRESHOLD SNOW AND DROPLET MIXING RATIO FOR RIME-SPLINTERING
+! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS
+! THESE THRESHOLDS CORRESPOND WITH GRAUPEL THRESHOLDS IN RH 1984
+
+!v1.4
+         IF (QNI3D(K).GE.0.1E-3) THEN
+         IF (QC3D(K).GE.0.5E-3.OR.QR3D(K).GE.0.1E-3) THEN
+         IF (PSACWS(K).GT.0..OR.PRACS(K).GT.0.) THEN
+            IF (T3D(K).LT.270.16 .AND. T3D(K).GT.265.16) THEN
+
+               IF (T3D(K).GT.270.16) THEN
+                  FMULT = 0.
+               ELSE IF (T3D(K).LE.270.16.AND.T3D(K).GT.268.16)  THEN
+                  FMULT = (270.16-T3D(K))/2.
+               ELSE IF (T3D(K).GE.265.16.AND.T3D(K).LE.268.16)   THEN
+                  FMULT = (T3D(K)-265.16)/3.
+               ELSE IF (T3D(K).LT.265.16) THEN
+                  FMULT = 0.
+               END IF
+
+! 1000 IS TO CONVERT FROM KG TO G
+
+! SPLINTERING FROM DROPLETS ACCRETED ONTO SNOW
+
+               IF (PSACWS(K).GT.0.) THEN
+                  NMULTS(K) = 35.E4*PSACWS(K)*FMULT*1000.
+                  QMULTS(K) = NMULTS(K)*MMULT
+
+! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS
+! THAN WAS RIMED ONTO SNOW
+
+                  QMULTS(K) = MIN(QMULTS(K),PSACWS(K))
+                  PSACWS(K) = PSACWS(K)-QMULTS(K)
+
+               END IF
+
+! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS
+
+               IF (PRACS(K).GT.0.) THEN
+                   NMULTR(K) = 35.E4*PRACS(K)*FMULT*1000.
+                   QMULTR(K) = NMULTR(K)*MMULT
+
+! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS
+! THAN WAS RIMED ONTO SNOW
+
+                   QMULTR(K) = MIN(QMULTR(K),PRACS(K))
+
+                   PRACS(K) = PRACS(K)-QMULTR(K)
+
+               END IF
+
+            END IF
+         END IF
+         END IF
+         END IF
+
+!.......................................................................
+! RIME-SPLINTERING - GRAUPEL 
+! HALLET-MOSSOP (1974)
+! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER
+
+! DUM1 = MASS OF INDIVIDUAL SPLINTERS
+
+! HM ADD THRESHOLD SNOW MIXING RATIO FOR RIME-SPLINTERING
+! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS
+
+!         IF (IHAIL.EQ.0) THEN
+! v1.4
+         IF (QG3D(K).GE.0.1E-3) THEN
+         IF (QC3D(K).GE.0.5E-3.OR.QR3D(K).GE.0.1E-3) THEN
+         IF (PSACWG(K).GT.0..OR.PRACG(K).GT.0.) THEN
+            IF (T3D(K).LT.270.16 .AND. T3D(K).GT.265.16) THEN
+
+               IF (T3D(K).GT.270.16) THEN
+                  FMULT = 0.
+               ELSE IF (T3D(K).LE.270.16.AND.T3D(K).GT.268.16)  THEN
+                  FMULT = (270.16-T3D(K))/2.
+               ELSE IF (T3D(K).GE.265.16.AND.T3D(K).LE.268.16)   THEN
+                  FMULT = (T3D(K)-265.16)/3.
+               ELSE IF (T3D(K).LT.265.16) THEN
+                  FMULT = 0.
+               END IF
+
+! 1000 IS TO CONVERT FROM KG TO G
+
+! SPLINTERING FROM DROPLETS ACCRETED ONTO GRAUPEL
+
+               IF (PSACWG(K).GT.0.) THEN
+                  NMULTG(K) = 35.E4*PSACWG(K)*FMULT*1000.
+                  QMULTG(K) = NMULTG(K)*MMULT
+
+! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS
+! THAN WAS RIMED ONTO GRAUPEL
+
+                  QMULTG(K) = MIN(QMULTG(K),PSACWG(K))
+                  PSACWG(K) = PSACWG(K)-QMULTG(K)
+
+               END IF
+
+! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS
+
+               IF (PRACG(K).GT.0.) THEN
+                   NMULTRG(K) = 35.E4*PRACG(K)*FMULT*1000.
+                   QMULTRG(K) = NMULTRG(K)*MMULT
+
+! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS
+! THAN WAS RIMED ONTO GRAUPEL
+
+                   QMULTRG(K) = MIN(QMULTRG(K),PRACG(K))
+                   PRACG(K) = PRACG(K)-QMULTRG(K)
+
+               END IF
+               END IF
+               END IF
+            END IF
+            END IF
+!         END IF
+
+!........................................................................
+! CONVERSION OF RIMED CLOUD WATER ONTO SNOW TO GRAUPEL/HAIL
+
+!           IF (IHAIL.EQ.0) THEN
+	   IF (PSACWS(K).GT.0.) THEN
+! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QC > 0.5 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984)
+              IF (QNI3D(K).GE.0.1E-3.AND.QC3D(K).GE.0.5E-3) THEN
+
+! PORTION OF RIMING CONVERTED TO GRAUPEL (REISNER ET AL. 1998, ORIGINALLY IS1991)
+	     PGSACW(K) = MIN(PSACWS(K),CONS17*DT*N0S(K)*QC3D(K)*QC3D(K)* &
+                          ASN(K)*ASN(K)/ &
+                           (RHO(K)*LAMS(K)**(2.*BS+2.))) 
+
+! MIX RAT CONVERTED INTO GRAUPEL AS EMBRYO (REISNER ET AL. 1998, ORIG M1990)
+	     DUM = MAX(RHOSN/(RHOG-RHOSN)*PGSACW(K),0.) 
+
+! NUMBER CONCENTRAITON OF EMBRYO GRAUPEL FROM RIMING OF SNOW
+	     NSCNG(K) = DUM/MG0*RHO(K)
+! LIMIT MAX NUMBER CONVERTED TO SNOW NUMBER
+             NSCNG(K) = MIN(NSCNG(K),NS3D(K)/DT)
+
+! PORTION OF RIMING LEFT FOR SNOW
+             PSACWS(K) = PSACWS(K) - PGSACW(K)
+             END IF
+	   END IF
+
+! CONVERSION OF RIMED RAINWATER ONTO SNOW CONVERTED TO GRAUPEL
+
+	   IF (PRACS(K).GT.0.) THEN
+! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QR > 0.1 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984)
+              IF (QNI3D(K).GE.0.1E-3.AND.QR3D(K).GE.0.1E-3) THEN
+! PORTION OF COLLECTED RAINWATER CONVERTED TO GRAUPEL (REISNER ET AL. 1998)
+	      DUM = CONS18*(4./LAMS(K))**3*(4./LAMS(K))**3 &    
+                   /(CONS18*(4./LAMS(K))**3*(4./LAMS(K))**3+ &  
+                   CONS19*(4./LAMR(K))**3*(4./LAMR(K))**3)
+              DUM=MIN(DUM,1.)
+              DUM=MAX(DUM,0.)
+	      PGRACS(K) = (1.-DUM)*PRACS(K)
+            NGRACS(K) = (1.-DUM)*NPRACS(K)
+! LIMIT MAX NUMBER CONVERTED TO MIN OF EITHER RAIN OR SNOW NUMBER CONCENTRATION
+            NGRACS(K) = MIN(NGRACS(K),NR3D(K)/DT)
+            NGRACS(K) = MIN(NGRACS(K),NS3D(K)/DT)
+
+! AMOUNT LEFT FOR SNOW PRODUCTION
+            PRACS(K) = PRACS(K) - PGRACS(K)
+            NPRACS(K) = NPRACS(K) - NGRACS(K)
+! CONVERSION TO GRAUPEL DUE TO COLLECTION OF SNOW BY RAIN
+            PSACR(K)=PSACR(K)*(1.-DUM)
+            END IF
+	   END IF
+!           END IF
+
+!.......................................................................
+! FREEZING OF RAIN DROPS
+! FREEZING ALLOWED BELOW -4 C
+
+         IF (T3D(K).LT.269.15.AND.QR3D(K).GE.QSMALL) THEN
+
+! IMMERSION FREEZING (BIGG 1953)
+!            MNUCCR(K) = CONS20*NR3D(K)*EXP(AIMM*(273.15-T3D(K)))/LAMR(K)**3 &
+!                 /LAMR(K)**3
+
+!            NNUCCR(K) = PI*NR3D(K)*BIMM*EXP(AIMM*(273.15-T3D(K)))/LAMR(K)**3
+
+! hm fix 7/15/13 for consistency w/ original formula
+            MNUCCR(K) = CONS20*NR3D(K)*(EXP(AIMM*(273.15-T3D(K)))-1.)/LAMR(K)**3 &
+                 /LAMR(K)**3
+
+            NNUCCR(K) = PI*NR3D(K)*BIMM*(EXP(AIMM*(273.15-T3D(K)))-1.)/LAMR(K)**3
+
+! PREVENT DIVERGENCE BETWEEN MIXING RATIO AND NUMBER CONC
+            NNUCCR(K) = MIN(NNUCCR(K),NR3D(K)/DT)
+
+         END IF
+
+!.......................................................................
+! ACCRETION OF CLOUD LIQUID WATER BY RAIN
+! CONTINUOUS COLLECTION EQUATION WITH
+! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED
+
+         IF (QR3D(K).GE.1.E-8 .AND. QC3D(K).GE.1.E-8) THEN
+
+! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM
+! KHAIROUTDINOV AND KOGAN 2000, MWR
+
+           DUM=(QC3D(K)*QR3D(K))
+           PRA(K) = 67.*(DUM)**1.15
+           NPRA(K) = PRA(K)/(QC3D(K)/NC3D(K))
+
+         END IF
+!.......................................................................
+! SELF-COLLECTION OF RAIN DROPS
+! FROM BEHENG(1994)
+! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION
+! AS DESCRINED ABOVE FOR AUTOCONVERSION
+
+         IF (QR3D(K).GE.1.E-8) THEN
+! include breakup add 10/09/09
+            dum1=300.e-6
+            if (1./lamr(k).lt.dum1) then
+            dum=1.
+            else if (1./lamr(k).ge.dum1) then
+            dum=2.-exp(2300.*(1./lamr(k)-dum1))
+            end if
+!            NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K)
+            NRAGG(K) = -5.78*dum*NR3D(K)*QR3D(K)*RHO(K)
+         END IF
+
+!.......................................................................
+! AUTOCONVERSION OF CLOUD ICE TO SNOW
+! FOLLOWING HARRINGTON ET AL. (1995) WITH MODIFICATION
+! HERE IT IS ASSUMED THAT AUTOCONVERSION CAN ONLY OCCUR WHEN THE
+! ICE IS GROWING, I.E. IN CONDITIONS OF ICE SUPERSATURATION
+
+         IF (QI3D(K).GE.1.E-8 .AND.QVQVSI(K).GE.1.) THEN
+
+!           COFFI = 2./LAMI(K)
+!           IF (COFFI.GE.DCS) THEN
+              NPRCI(K) = CONS21*(QV3D(K)-QVI(K))*RHO(K)                         &
+                *N0I(K)*EXP(-LAMI(K)*DCS)*DV(K)/ABI(K)
+              PRCI(K) = CONS22*NPRCI(K)
+              NPRCI(K) = MIN(NPRCI(K),NI3D(K)/DT)
+
+!           END IF
+         END IF
+
+!.......................................................................
+! ACCRETION OF CLOUD ICE BY SNOW
+! FOR THIS CALCULATION, IT IS ASSUMED THAT THE VS >> VI
+! AND DS >> DI FOR CONTINUOUS COLLECTION
+
+         IF (QNI3D(K).GE.1.E-8 .AND. QI3D(K).GE.QSMALL) THEN
+            PRAI(K) = CONS23*ASN(K)*QI3D(K)*RHO(K)*N0S(K)/     &
+                     LAMS(K)**(BS+3.)
+            NPRAI(K) = CONS23*ASN(K)*NI3D(K)*                                       &
+                  RHO(K)*N0S(K)/                                 &
+                  LAMS(K)**(BS+3.)
+            NPRAI(K)=MIN(NPRAI(K),NI3D(K)/DT)
+         END IF
+
+!.......................................................................
+! HM, ADD 12/13/06, COLLISION OF RAIN AND ICE TO PRODUCE SNOW OR GRAUPEL
+! FOLLOWS REISNER ET AL. 1998
+! ASSUMED FALLSPEED AND SIZE OF ICE CRYSTAL << THAN FOR RAIN
+
+         IF (QR3D(K).GE.1.E-8.AND.QI3D(K).GE.1.E-8.AND.T3D(K).LE.273.15) THEN
+
+! ALLOW GRAUPEL FORMATION FROM RAIN-ICE COLLISIONS ONLY IF RAIN MIXING RATIO > 0.1 G/KG,
+! OTHERWISE ADD TO SNOW
+
+            IF (QR3D(K).GE.0.1E-3) THEN
+            NIACR(K)=CONS24*NI3D(K)*N0RR(K)*ARN(K) &
+                /LAMR(K)**(BR+3.)*RHO(K)
+            PIACR(K)=CONS25*NI3D(K)*N0RR(K)*ARN(K) &
+                /LAMR(K)**(BR+3.)/LAMR(K)**3*RHO(K)
+            PRACI(K)=CONS24*QI3D(K)*N0RR(K)*ARN(K)/ &
+                LAMR(K)**(BR+3.)*RHO(K)
+            NIACR(K)=MIN(NIACR(K),NR3D(K)/DT)
+            NIACR(K)=MIN(NIACR(K),NI3D(K)/DT)
+            ELSE 
+            NIACRS(K)=CONS24*NI3D(K)*N0RR(K)*ARN(K) &
+                /LAMR(K)**(BR+3.)*RHO(K)
+            PIACRS(K)=CONS25*NI3D(K)*N0RR(K)*ARN(K) &
+                /LAMR(K)**(BR+3.)/LAMR(K)**3*RHO(K)
+            PRACIS(K)=CONS24*QI3D(K)*N0RR(K)*ARN(K)/ &
+                LAMR(K)**(BR+3.)*RHO(K)
+            NIACRS(K)=MIN(NIACRS(K),NR3D(K)/DT)
+            NIACRS(K)=MIN(NIACRS(K),NI3D(K)/DT)
+            END IF
+         END IF
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! NUCLEATION OF CLOUD ICE FROM HOMOGENEOUS AND HETEROGENEOUS FREEZING ON AEROSOL
+! TWG 2016 BEGIN
+         KC2H = 0.0
+         KC2IM = 0.0
+         KC2D = 0.0
+         KC2DM = 0.0
+! TWG 2016 END
+
+         IF (INUC.EQ.0) THEN
+
+! add threshold according to Greg Thomspon
+
+         if ((QVQVS(K).GE.0.999.and.T3D(K).le.265.15).or. &
+              QVQVSI(K).ge.1.08) then
+
+! hm, modify dec. 5, 2006, replace with cooper curve
+      kc2 = 0.005*exp(0.304*(273.15-T3D(K)))*1000. ! convert from L-1 to m-3
+! limit to 500 L-1
+      kc2 = min(kc2,500.e3)
+      kc2=MAX(kc2/rho(k),0.)  ! convert to kg-1
+
+          IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN
+             NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT
+             MNUCCD(K) = NNUCCD(K)*MI0
+          END IF
+
+          END IF
+
+          ELSE IF (INUC.EQ.1) THEN
+
+          IF (T3D(K).LT.273.15.AND.QVQVSI(K).GT.1.) THEN
+
+             KC2 = 0.16*1000./RHO(K)  ! CONVERT FROM L-1 TO KG-1
+          IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN
+             NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT
+             MNUCCD(K) = NNUCCD(K)*MI0
+          END IF
+          END IF
+! TWG 2016 BEGIN
+         ELSE IF (INUC.EQ.2) THEN
+
+!         IF (T3D(K).LT.273.15.AND.QVQVSI(K).GT.1.) THEN
+         if ((QVQVS(K).GE.0.999.and.T3D(K).le.265.15).or. &
+              QVQVSI(K).ge.1.08) then
+
+            DUM = W3D(K)+WVAR(K)
+            call mdm_prescribed_nucleati(DUM,T3D(K),QVQVS(K),QC3D(K),RHO(K),  &
+                        naero,naer_cu,KC2 &
+                        , KC2H,     &
+                        KC2IM,KC2D,KC2DM)
+
+          IF (KC2.GT.NI3D(K)+NS3D(K)+NG3D(K)) THEN
+             NNUCCD(K) = (KC2-NI3D(K)-NS3D(K)-NG3D(K))/DT
+             NNUCCD(K) = max(NNUCCD(K),0.0)
+             MNUCCD(K) = NNUCCD(K)*MI0
+          END IF
+          END IF
+! TWG 2016 END
+          END IF
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+ 101      CONTINUE
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CALCULATE EVAP/SUB/DEP TERMS FOR QI,QNI,QR
+
+! NO VENTILATION FOR CLOUD ICE
+
+        IF (QI3D(K).GE.QSMALL) THEN
+
+         EPSI = 2.*PI*N0I(K)*RHO(K)*DV(K)/(LAMI(K)*LAMI(K))
+
+      ELSE
+         EPSI = 0.
+      END IF
+
+      IF (QNI3D(K).GE.QSMALL) THEN
+        EPSS = 2.*PI*N0S(K)*RHO(K)*DV(K)*                            &
+                   (F1S/(LAMS(K)*LAMS(K))+                       &
+                    F2S*(ASN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS10/                   &
+               (LAMS(K)**CONS35))
+      ELSE
+      EPSS = 0.
+      END IF
+
+      IF (QG3D(K).GE.QSMALL) THEN
+        EPSG = 2.*PI*N0G(K)*RHO(K)*DV(K)*                                &
+                   (F1S/(LAMG(K)*LAMG(K))+                               &
+                    F2S*(AGN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS11/                   &
+               (LAMG(K)**CONS36))
+
+
+      ELSE
+      EPSG = 0.
+      END IF
+
+      IF (QR3D(K).GE.QSMALL) THEN
+        EPSR = 2.*PI*N0RR(K)*RHO(K)*DV(K)*                           &
+                   (F1R/(LAMR(K)*LAMR(K))+                       &
+                    F2R*(ARN(K)*RHO(K)/MU(K))**0.5*                      &
+                    SC(K)**(1./3.)*CONS9/                   &
+                (LAMR(K)**CONS34))
+      ELSE
+      EPSR = 0.
+      END IF
+
+! ONLY INCLUDE REGION OF ICE SIZE DIST < DCS
+! DUM IS FRACTION OF D*N(D) < DCS
+
+! LOGIC BELOW FOLLOWS THAT OF HARRINGTON ET AL. 1995 (JAS)
+              IF (QI3D(K).GE.QSMALL) THEN              
+              DUM=(1.-EXP(-LAMI(K)*DCS)*(1.+LAMI(K)*DCS))
+              PRD(K) = EPSI*(QV3D(K)-QVI(K))/ABI(K)*DUM
+              ELSE
+              DUM=0.
+              END IF
+! ADD DEPOSITION IN TAIL OF ICE SIZE DIST TO SNOW IF SNOW IS PRESENT
+              IF (QNI3D(K).GE.QSMALL) THEN
+              PRDS(K) = EPSS*(QV3D(K)-QVI(K))/ABI(K)+ &
+                EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM)
+! OTHERWISE ADD TO CLOUD ICE
+              ELSE
+              PRD(K) = PRD(K)+EPSI*(QV3D(K)-QVI(K))/ABI(K)*(1.-DUM)
+              END IF
+! VAPOR DPEOSITION ON GRAUPEL
+              PRDG(K) = EPSG*(QV3D(K)-QVI(K))/ABI(K)
+
+! NO CONDENSATION ONTO RAIN, ONLY EVAP
+
+           IF (QV3D(K).LT.QVS(K)) THEN
+              PRE(K) = EPSR*(QV3D(K)-QVS(K))/AB(K)
+              PRE(K) = MIN(PRE(K),0.)
+           ELSE
+              PRE(K) = 0.
+           END IF
+
+! MAKE SURE NOT PUSHED INTO ICE SUPERSAT/SUBSAT
+! FORMULA FROM REISNER 2 SCHEME
+
+           DUM = (QV3D(K)-QVI(K))/DT
+
+           FUDGEF = 0.9999
+           SUM_DEP = PRD(K)+PRDS(K)+MNUCCD(K)+PRDG(K)
+
+           IF( (DUM.GT.0. .AND. SUM_DEP.GT.DUM*FUDGEF) .OR.                      &
+               (DUM.LT.0. .AND. SUM_DEP.LT.DUM*FUDGEF) ) THEN
+               MNUCCD(K) = FUDGEF*MNUCCD(K)*DUM/SUM_DEP
+               PRD(K) = FUDGEF*PRD(K)*DUM/SUM_DEP
+               PRDS(K) = FUDGEF*PRDS(K)*DUM/SUM_DEP
+	       PRDG(K) = FUDGEF*PRDG(K)*DUM/SUM_DEP
+           ENDIF
+
+! IF CLOUD ICE/SNOW/GRAUPEL VAP DEPOSITION IS NEG, THEN ASSIGN TO SUBLIMATION PROCESSES
+
+           IF (PRD(K).LT.0.) THEN
+              EPRD(K)=PRD(K)
+              PRD(K)=0.
+           END IF
+           IF (PRDS(K).LT.0.) THEN
+              EPRDS(K)=PRDS(K)
+              PRDS(K)=0.
+           END IF
+           IF (PRDG(K).LT.0.) THEN
+              EPRDG(K)=PRDG(K)
+              PRDG(K)=0.
+           END IF
+
+!.......................................................................
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+! CONSERVATION OF WATER
+! THIS IS ADOPTED LOOSELY FROM MM5 RESINER CODE. HOWEVER, HERE WE
+! ONLY ADJUST PROCESSES THAT ARE NEGATIVE, RATHER THAN ALL PROCESSES.
+
+! IF MIXING RATIOS LESS THAN QSMALL, THEN NO DEPLETION OF WATER
+! THROUGH MICROPHYSICAL PROCESSES, SKIP CONSERVATION
+
+! NOTE: CONSERVATION CHECK NOT APPLIED TO NUMBER CONCENTRATION SPECIES. ADDITIONAL CATCH
+! BELOW WILL PREVENT NEGATIVE NUMBER CONCENTRATION
+! FOR EACH MICROPHYSICAL PROCESS WHICH PROVIDES A SOURCE FOR NUMBER, THERE IS A CHECK
+! TO MAKE SURE THAT CAN'T EXCEED TOTAL NUMBER OF DEPLETED SPECIES WITH THE TIME
+! STEP
+
+!****SENSITIVITY - NO ICE
+
+      IF (ILIQ.EQ.1) THEN
+      MNUCCC(K)=0.
+      NNUCCC(K)=0.
+      MNUCCR(K)=0.
+      NNUCCR(K)=0.
+      MNUCCD(K)=0.
+      NNUCCD(K)=0.
+      END IF
+
+! ****SENSITIVITY - NO GRAUPEL
+      IF (IGRAUP.EQ.1) THEN
+            PRACG(K) = 0.
+            PSACR(K) = 0.
+	    PSACWG(K) = 0.
+	    PRDG(K) = 0.
+	    EPRDG(K) = 0.
+            EVPMG(K) = 0.
+            PGMLT(K) = 0.
+	    NPRACG(K) = 0.
+	    NPSACWG(K) = 0.
+	    NSCNG(K) = 0.
+ 	    NGRACS(K) = 0.
+	    NSUBG(K) = 0.
+	    NGMLTG(K) = 0.
+            NGMLTR(K) = 0.
+! fix 053011
+            PIACRS(K)=PIACRS(K)+PIACR(K)
+            PIACR(K) = 0.
+! fix 070713
+	    PRACIS(K)=PRACIS(K)+PRACI(K)
+	    PRACI(K) = 0.
+	    PSACWS(K)=PSACWS(K)+PGSACW(K)
+	    PGSACW(K) = 0.
+	    PRACS(K)=PRACS(K)+PGRACS(K)
+	    PGRACS(K) = 0.
+       END IF
+
+! CONSERVATION OF QC
+
+      DUM = (PRC(K)+PRA(K)+MNUCCC(K)+PSACWS(K)+PSACWI(K)+QMULTS(K)+PSACWG(K)+PGSACW(K)+QMULTG(K))*DT
+
+      IF (DUM.GT.QC3D(K).AND.QC3D(K).GE.QSMALL) THEN
+        RATIO = QC3D(K)/DUM
+
+        PRC(K) = PRC(K)*RATIO
+        PRA(K) = PRA(K)*RATIO
+        MNUCCC(K) = MNUCCC(K)*RATIO
+        PSACWS(K) = PSACWS(K)*RATIO
+        PSACWI(K) = PSACWI(K)*RATIO
+        QMULTS(K) = QMULTS(K)*RATIO
+        QMULTG(K) = QMULTG(K)*RATIO
+        PSACWG(K) = PSACWG(K)*RATIO
+	PGSACW(K) = PGSACW(K)*RATIO
+        END IF
+ 
+! CONSERVATION OF QI
+
+      DUM = (-PRD(K)-MNUCCC(K)+PRCI(K)+PRAI(K)-QMULTS(K)-QMULTG(K)-QMULTR(K)-QMULTRG(K) &
+                -MNUCCD(K)+PRACI(K)+PRACIS(K)-EPRD(K)-PSACWI(K))*DT
+
+      IF (DUM.GT.QI3D(K).AND.QI3D(K).GE.QSMALL) THEN
+
+        RATIO = (QI3D(K)/DT+PRD(K)+MNUCCC(K)+QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+ &
+                     MNUCCD(K)+PSACWI(K))/ &
+                      (PRCI(K)+PRAI(K)+PRACI(K)+PRACIS(K)-EPRD(K))
+
+        PRCI(K) = PRCI(K)*RATIO
+        PRAI(K) = PRAI(K)*RATIO
+        PRACI(K) = PRACI(K)*RATIO
+        PRACIS(K) = PRACIS(K)*RATIO
+        EPRD(K) = EPRD(K)*RATIO
+
+        END IF
+
+! CONSERVATION OF QR
+
+      DUM=((PRACS(K)-PRE(K))+(QMULTR(K)+QMULTRG(K)-PRC(K))+(MNUCCR(K)-PRA(K))+ &
+             PIACR(K)+PIACRS(K)+PGRACS(K)+PRACG(K))*DT
+
+      IF (DUM.GT.QR3D(K).AND.QR3D(K).GE.QSMALL) THEN
+
+        RATIO = (QR3D(K)/DT+PRC(K)+PRA(K))/ &
+             (-PRE(K)+QMULTR(K)+QMULTRG(K)+PRACS(K)+MNUCCR(K)+PIACR(K)+PIACRS(K)+PGRACS(K)+PRACG(K))
+
+        PRE(K) = PRE(K)*RATIO
+        PRACS(K) = PRACS(K)*RATIO
+        QMULTR(K) = QMULTR(K)*RATIO
+        QMULTRG(K) = QMULTRG(K)*RATIO
+        MNUCCR(K) = MNUCCR(K)*RATIO
+        PIACR(K) = PIACR(K)*RATIO
+        PIACRS(K) = PIACRS(K)*RATIO
+        PGRACS(K) = PGRACS(K)*RATIO
+        PRACG(K) = PRACG(K)*RATIO
+
+        END IF
+
+! CONSERVATION OF QNI
+! CONSERVATION FOR GRAUPEL SCHEME
+
+        IF (IGRAUP.EQ.0) THEN
+
+      DUM = (-PRDS(K)-PSACWS(K)-PRAI(K)-PRCI(K)-PRACS(K)-EPRDS(K)+PSACR(K)-PIACRS(K)-PRACIS(K))*DT
+
+      IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN
+
+        RATIO = (QNI3D(K)/DT+PRDS(K)+PSACWS(K)+PRAI(K)+PRCI(K)+PRACS(K)+PIACRS(K)+PRACIS(K))/(-EPRDS(K)+PSACR(K))
+
+       EPRDS(K) = EPRDS(K)*RATIO
+       PSACR(K) = PSACR(K)*RATIO
+
+       END IF
+
+! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW
+       ELSE IF (IGRAUP.EQ.1) THEN
+
+      DUM = (-PRDS(K)-PSACWS(K)-PRAI(K)-PRCI(K)-PRACS(K)-EPRDS(K)+PSACR(K)-PIACRS(K)-PRACIS(K)-MNUCCR(K))*DT
+
+      IF (DUM.GT.QNI3D(K).AND.QNI3D(K).GE.QSMALL) THEN
+
+       RATIO = (QNI3D(K)/DT+PRDS(K)+PSACWS(K)+PRAI(K)+PRCI(K)+PRACS(K)+PIACRS(K)+PRACIS(K)+MNUCCR(K))/(-EPRDS(K)+PSACR(K))
+
+       EPRDS(K) = EPRDS(K)*RATIO
+       PSACR(K) = PSACR(K)*RATIO
+
+       END IF
+
+       END IF
+
+! CONSERVATION OF QG
+
+      DUM = (-PSACWG(K)-PRACG(K)-PGSACW(K)-PGRACS(K)-PRDG(K)-MNUCCR(K)-EPRDG(K)-PIACR(K)-PRACI(K)-PSACR(K))*DT
+
+      IF (DUM.GT.QG3D(K).AND.QG3D(K).GE.QSMALL) THEN
+
+        RATIO = (QG3D(K)/DT+PSACWG(K)+PRACG(K)+PGSACW(K)+PGRACS(K)+PRDG(K)+MNUCCR(K)+PSACR(K)+&
+                  PIACR(K)+PRACI(K))/(-EPRDG(K))
+
+       EPRDG(K) = EPRDG(K)*RATIO
+
+      END IF
+
+! TENDENCIES
+
+      QV3DTEN(K) = QV3DTEN(K)+(-PRE(K)-PRD(K)-PRDS(K)-MNUCCD(K)-EPRD(K)-EPRDS(K)-PRDG(K)-EPRDG(K))
+
+! BUG FIX HM, 3/1/11, INCLUDE PIACR AND PIACRS
+      T3DTEN(K) = T3DTEN(K)+(PRE(K)                                 &
+               *XXLV(K)+(PRD(K)+PRDS(K)+                            &
+                MNUCCD(K)+EPRD(K)+EPRDS(K)+PRDG(K)+EPRDG(K))*XXLS(K)+         &
+               (PSACWS(K)+PSACWI(K)+MNUCCC(K)+MNUCCR(K)+                      &
+                QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+PRACS(K) &
+                +PSACWG(K)+PRACG(K)+PGSACW(K)+PGRACS(K)+PIACR(K)+PIACRS(K))*XLF(K))/CPM(K)
+
+      QC3DTEN(K) = QC3DTEN(K)+                                      &
+                 (-PRA(K)-PRC(K)-MNUCCC(K)+PCC(K)-                  &
+                  PSACWS(K)-PSACWI(K)-QMULTS(K)-QMULTG(K)-PSACWG(K)-PGSACW(K))
+      QI3DTEN(K) = QI3DTEN(K)+                                      &
+         (PRD(K)+EPRD(K)+PSACWI(K)+MNUCCC(K)-PRCI(K)-                                 &
+                  PRAI(K)+QMULTS(K)+QMULTG(K)+QMULTR(K)+QMULTRG(K)+MNUCCD(K)-PRACI(K)-PRACIS(K))
+      QR3DTEN(K) = QR3DTEN(K)+                                      &
+                 (PRE(K)+PRA(K)+PRC(K)-PRACS(K)-MNUCCR(K)-QMULTR(K)-QMULTRG(K) &
+             -PIACR(K)-PIACRS(K)-PRACG(K)-PGRACS(K))
+
+      IF (IGRAUP.EQ.0) THEN
+
+      QNI3DTEN(K) = QNI3DTEN(K)+                                    &
+           (PRAI(K)+PSACWS(K)+PRDS(K)+PRACS(K)+PRCI(K)+EPRDS(K)-PSACR(K)+PIACRS(K)+PRACIS(K))
+      NS3DTEN(K) = NS3DTEN(K)+(NSAGG(K)+NPRCI(K)-NSCNG(K)-NGRACS(K)+NIACRS(K))
+      QG3DTEN(K) = QG3DTEN(K)+(PRACG(K)+PSACWG(K)+PGSACW(K)+PGRACS(K)+ &
+                    PRDG(K)+EPRDG(K)+MNUCCR(K)+PIACR(K)+PRACI(K)+PSACR(K))
+      NG3DTEN(K) = NG3DTEN(K)+(NSCNG(K)+NGRACS(K)+NNUCCR(K)+NIACR(K))
+
+! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW
+      ELSE IF (IGRAUP.EQ.1) THEN
+
+      QNI3DTEN(K) = QNI3DTEN(K)+                                    &
+           (PRAI(K)+PSACWS(K)+PRDS(K)+PRACS(K)+PRCI(K)+EPRDS(K)-PSACR(K)+PIACRS(K)+PRACIS(K)+MNUCCR(K))
+      NS3DTEN(K) = NS3DTEN(K)+(NSAGG(K)+NPRCI(K)-NSCNG(K)-NGRACS(K)+NIACRS(K)+NNUCCR(K))
+
+      END IF
+
+      NC3DTEN(K) = NC3DTEN(K)+(-NNUCCC(K)-NPSACWS(K)                &
+            -NPRA(K)-NPRC(K)-NPSACWI(K)-NPSACWG(K))
+
+      NI3DTEN(K) = NI3DTEN(K)+                                      &
+       (NNUCCC(K)-NPRCI(K)-NPRAI(K)+NMULTS(K)+NMULTG(K)+NMULTR(K)+NMULTRG(K)+ &
+               NNUCCD(K)-NIACR(K)-NIACRS(K))
+
+      NR3DTEN(K) = NR3DTEN(K)+(NPRC1(K)-NPRACS(K)-NNUCCR(K)      &
+                   +NRAGG(K)-NIACR(K)-NIACRS(K)-NPRACG(K)-NGRACS(K))
+
+! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC
+
+	C2PREC(K) = PRA(K)+PRC(K)+PSACWS(K)+QMULTS(K)+QMULTG(K)+PSACWG(K)+ &
+       PGSACW(K)+MNUCCC(K)+PSACWI(K)
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE
+! WATER SATURATION
+
+      DUMT = T3D(K)+DT*T3DTEN(K)
+      DUMQV = QV3D(K)+DT*QV3DTEN(K)
+! hm, add fix for low pressure, 5/12/10
+      dum=min(0.99*pres(k),POLYSVP(DUMT,0))
+      DUMQSS = EP_2*dum/(PRES(K)-dum)
+      DUMQC = QC3D(K)+DT*QC3DTEN(K)
+      DUMQC = MAX(DUMQC,0.)
+
+! SATURATION ADJUSTMENT FOR LIQUID
+
+      DUMS = DUMQV-DUMQSS
+      PCC(K) = DUMS/(1.+XXLV(K)**2*DUMQSS/(CPM(K)*RV*DUMT**2))/DT
+      IF (PCC(K)*DT+DUMQC.LT.0.) THEN
+           PCC(K) = -DUMQC/DT
+      END IF
+
+      QV3DTEN(K) = QV3DTEN(K)-PCC(K)
+      T3DTEN(K) = T3DTEN(K)+PCC(K)*XXLV(K)/CPM(K)
+      QC3DTEN(K) = QC3DTEN(K)+PCC(K)
+
+!.......................................................................
+! ACTIVATION OF CLOUD DROPLETS
+! ACTIVATION OF DROPLET CURRENTLY NOT CALCULATED
+! DROPLET CONCENTRATION IS SPECIFIED !!!!!
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!!TWG/amy added code to predict droplet concentration back in 
+      IF (INUM.EQ.0) THEN
+
+      IF (QC3D(K)+QC3DTEN(K)*DT.GE.QSMALL) THEN
+
+! EFFECTIVE VERTICAL VELOCITY (M/S)
+
+      IF (ISUB.EQ.0) THEN
+! ADD SUB-GRID VERTICAL VELOCITY
+         DUM = W3D(K)+WVAR(K)
+
+! ASSUME MINIMUM EFF. SUB-GRID VELOCITY 0.10 M/S
+         DUM = MAX(DUM,0.10)
+
+      ELSE IF (ISUB.EQ.1) THEN
+         DUM=W3D(K)
+      END IF
+
+! ONLY ACTIVATE IN REGIONS OF UPWARD MOTION
+      IF (DUM.GE.0.001) THEN
+
+      IF (IBASE.EQ.1) THEN
+
+! ACTIVATE ONLY IF THERE IS LITTLE CLOUD WATER
+! OR IF AT CLOUD BASE, OR AT LOWEST MODEL LEVEL (K=1)
+
+         IDROP=0
+
+         IF (QC3D(K)+QC3DTEN(K)*DT.LE.0.05E-3/RHO(K)) THEN
+            IDROP=1
+         END IF
+         IF (K.EQ.1) THEN
+            IDROP=1
+         ELSE IF (K.GE.2) THEN
+            IF (QC3D(K)+QC3DTEN(K)*DT.GT.0.05E-3/RHO(K).AND. &
+             QC3D(K-1)+QC3DTEN(K-1)*DT.LE.0.05E-3/RHO(K-1)) THEN
+            IDROP=1
+            END IF
+         END IF
+
+         IF (IDROP.EQ.1) THEN
+! ACTIVATE AT CLOUD BASE OR REGIONS WITH VERY LITTLE LIQ WATER
+
+           IF (IACT.EQ.1) THEN
+! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W
+! BASED ON TWOMEY 1959
+
+            DUM=DUM*100.  ! CONVERT FROM M/S TO CM/S
+            DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.))
+            DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3
+            DUM2=DUM2/RHO(K)  ! CONVERT FROM M-3 TO KG-1
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+           ELSE IF (IACT.EQ.2) THEN
+! DROPLET ACTIVATION FROM ABDUL-RAZZAK AND GHAN (2000)
+
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+           ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K))
+           GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K))
+
+           GG =1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ &
+              (T3D(K)*RR)-1.))
+
+           PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT
+
+           ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1)
+           ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+           DUM1 =1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75)
+           DUM2 =1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75)
+
+           SMAX = 1./(DUM1+DUM2)**0.5
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+            DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+!TWG 2016 BEGIN
+         ELSE IF (IACT.EQ.4) THEN
+           DUM = MAX((W3D(K)+WVAR(K)),0.5)
+           call mdm_prescribed_activate(DUM,T3D(K),RHO(K), &
+           naero, naer_cu,naer_cu, maero,  &
+           dispersion_aer,hygro_aer, density_aer, DUM2, XXLV(K))
+
+           DUM2 = (DUM2-NC3D(K))/DT
+           DUM2 = MAX(0.,DUM2)
+           NC3DTEN(K) = NC3DTEN(K)+DUM2
+!TWG 2016 END
+           END IF  ! IACT
+
+!.............................................................................
+        ELSE IF (IDROP.EQ.0) THEN
+! ACTIVATE IN CLOUD INTERIOR
+! FIND EQUILIBRIUM SUPERSATURATION
+
+           TAUC=1./(2.*PI*RHO(k)*DV(K)*NC3D(K)*(PGAM(K)+1.)/LAMC(K))
+           IF (EPSR.GT.1.E-8) THEN
+             TAUR=1./EPSR
+           ELSE
+             TAUR=1.E8
+           END IF
+!!amy taui,taus,taug lines added in v3
+           IF (EPSI.GT.1.E-8) THEN
+             TAUI=1./EPSI
+           ELSE
+             TAUI=1.E8
+           END IF
+           IF (EPSS.GT.1.E-8) THEN
+             TAUS=1./EPSS
+           ELSE
+             TAUS=1.E8
+           END IF
+           IF (EPSG.GT.1.E-8) THEN
+             TAUG=1./EPSG
+           ELSE
+             TAUG=1.E8
+           END IF
+
+! EQUILIBRIUM SS INCLUDING BERGERON EFFECT
+!!amy added taui,taus,taug to these lines in v3
+! hm fix 1/20/15
+!           DUM3=(QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM
+           DUM3=(-QVS(K)*RHO(K)/(PRES(K)-EVS(K))+DQSDT/CP)*G*DUM
+
+           DUM3=(DUM3*TAUC*TAUR*TAUI*TAUS*TAUG- &
+           (QVS(K)-QVI(K))*(TAUC*TAUR*TAUI*TAUG+TAUC*TAUR*TAUS*TAUG+TAUC*TAUR*TAUI*TAUS))/&
+           (TAUC*TAUR*TAUI*TAUG+TAUC*TAUR*TAUS*TAUG+TAUC*TAUR*TAUI*TAUS+ &
+            TAUR*TAUI*TAUS*TAUG+TAUC*TAUI*TAUS*TAUG)
+
+           IF (DUM3/QVS(K).GE.1.E-6) THEN
+           IF (IACT.EQ.1) THEN
+
+! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQUILIBRIUM SS
+
+            DUM=DUM*100.  ! CONVERT FROM M/S TO CM/S
+            DUMACT = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.))
+
+! USE POWER LAW CCN SPECTRA
+
+! CONVERT FROM ABSOLUTE SUPERSATURATION TO SUPERSATURATION RATIO IN %
+            DUM3=DUM3/QVS(K)*100.
+
+            DUM2=C1*DUM3**K1
+! MAKE SURE VALUE DOESN'T EXCEED THAT FOR NON-EQUILIBRIUM SS
+            DUM2=MIN(DUM2,DUMACT)
+            DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3
+            DUM2=DUM2/RHO(K)  ! CONVERT FROM M-3 TO KG-1
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+           ELSE IF (IACT.EQ.2) THEN
+
+! FIND MAXIMUM ALLOWED ACTIVATION WITH NON-EQUILIBRIUM SS
+
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+           ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K))
+           GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K))
+
+           GG = 1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ &
+              (T3D(K)*RR)-1.))
+
+           PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT
+
+           ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1)
+           ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+           DUM1 =1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75)
+           DUM2 =1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75)
+
+           SMAX = 1./(DUM1+DUM2)**0.5
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+           DUMACT = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+! USE LOGNORMAL AEROSOL
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+! GET SUPERSATURATION RATIO FROM ABSOLUTE SUPERSATURATION
+           SMAX = DUM3/QVS(K)
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+            DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+! MAKE SURE ISN'T GREATER THAN NON-EQUIL. SS
+            DUM2=MIN(DUM2,DUMACT)
+
+           DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+!TWG 2016 BEGIN
+           ELSE IF (IACT.EQ.4) THEN
+           DUM = MAX((W3D(K)+WVAR(K)),0.5)
+           call mdm_prescribed_activate(DUM,T3D(K),RHO(K), &
+           naero, naer_cu,naer_cu, maero,  &
+           dispersion_aer,hygro_aer, density_aer, DUM2, XXLV(K))
+
+           DUM2 = (DUM2-NC3D(K))/DT
+           DUM2 = MAX(0.,DUM2)
+           NC3DTEN(K) = NC3DTEN(K)+DUM2
+!TWG 2016 END
+           END IF ! IACT
+           END IF ! DUM3/QVS > 1.E-6
+        END IF  ! IDROP = 1
+
+!.......................................................................
+      ELSE IF (IBASE.EQ.2) THEN
+
+           IF (IACT.EQ.1) THEN
+! USE ROGERS AND YAU (1989) TO RELATE NUMBER ACTIVATED TO W
+! BASED ON TWOMEY 1959
+
+            DUM=DUM*100.  ! CONVERT FROM M/S TO CM/S
+            DUM2 = 0.88*C1**(2./(K1+2.))*(7.E-2*DUM**1.5)**(K1/(K1+2.))
+            DUM2=DUM2*1.E6 ! CONVERT FROM CM-3 TO M-3
+            DUM2=DUM2/RHO(K)  ! CONVERT FROM M-3 TO KG-1
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+
+           ELSE IF (IACT.EQ.2) THEN
+
+           SIGVL = 0.0761-1.55E-4*(T3D(K)-273.15)
+           AACT = 2.*MW/(RHOW*RR)*SIGVL/T3D(K)
+           ALPHA = G*MW*XXLV(K)/(CPM(K)*RR*T3D(K)**2)-G*MA/(RR*T3D(K))
+           GAMM = RR*T3D(K)/(EVS(K)*MW)+MW*XXLV(K)**2/(CPM(K)*PRES(K)*MA*T3D(K))
+
+           GG =1./(RHOW*RR*T3D(K)/(EVS(K)*DV(K)*MW)+XXLV(K)*RHOW/(KAP(K)*T3D(K))*(XXLV(K)*MW/ &
+              (T3D(K)*RR)-1.))
+
+           PSI = 2./3.*(ALPHA*DUM/GG)**0.5*AACT
+
+           ETA1 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW1)
+           ETA2 = (ALPHA*DUM/GG)**1.5/(2.*PI*RHOW*GAMM*NANEW2)
+
+           SM1 = 2./BACT**0.5*(AACT/(3.*RM1))**1.5
+           SM2 = 2./BACT**0.5*(AACT/(3.*RM2))**1.5
+
+           DUM1 =1./SM1**2*(F11*(PSI/ETA1)**1.5+F21*(SM1**2/(ETA1+3.*PSI))**0.75)
+           DUM2 =1./SM2**2*(F12*(PSI/ETA2)**1.5+F22*(SM2**2/(ETA2+3.*PSI))**0.75)
+
+           SMAX = 1./(DUM1+DUM2)**0.5
+
+           UU1 = 2.*LOG(SM1/SMAX)/(4.242*LOG(SIG1))
+           UU2 = 2.*LOG(SM2/SMAX)/(4.242*LOG(SIG2))
+           DUM1 = NANEW1/2.*(1.-DERF1(UU1))
+           DUM2 = NANEW2/2.*(1.-DERF1(UU2))
+
+           DUM2 = (DUM1+DUM2)/RHO(K)  !CONVERT TO KG-1
+
+! MAKE SURE THIS VALUE ISN'T GREATER THAN TOTAL NUMBER OF AEROSOL
+
+            DUM2 = MIN((NANEW1+NANEW2)/RHO(K),DUM2)
+
+            DUM2 = (DUM2-NC3D(K))/DT
+            DUM2 = MAX(0.,DUM2)
+            NC3DTEN(K) = NC3DTEN(K)+DUM2
+! TWG 2016 BEGIN
+           ELSE IF (IACT.EQ.4) THEN
+          DUM = MAX((W3D(K)+WVAR(K)),0.5)
+          call mdm_prescribed_activate(DUM,T3D(K),RHO(K), &
+           naero, naer_cu,naer_cu, maero,  &
+           dispersion_aer,hygro_aer, density_aer, DUM2, XXLV(K))
+
+           DUM2 = (DUM2-NC3D(K))/DT
+           DUM2 = MAX(0.,DUM2)
+           NC3DTEN(K) = NC3DTEN(K)+DUM2
+! TWG 2016 END
+           END IF  ! IACT
+        END IF  ! IBASE
+        END IF  ! W > 0.001
+        END IF  ! QC3D > QSMALL
+        END IF  ! INUM = 0
+!!TWG/amy end
+
+
+! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION
+! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND
+! LOSS OF NUMBER CONCENTRATION
+
+!     IF (PCC(K).LT.0.) THEN
+!        DUM = PCC(K)*DT/QC3D(K)
+!           DUM = MAX(-1.,DUM)
+!        NSUBC(K) = DUM*NC3D(K)/DT
+!     END IF
+
+      IF (EPRD(K).LT.0.) THEN
+         DUM = EPRD(K)*DT/QI3D(K)
+            DUM = MAX(-1.,DUM)
+         NSUBI(K) = DUM*NI3D(K)/DT
+      END IF
+      IF (EPRDS(K).LT.0.) THEN
+         DUM = EPRDS(K)*DT/QNI3D(K)
+           DUM = MAX(-1.,DUM)
+         NSUBS(K) = DUM*NS3D(K)/DT
+      END IF
+      IF (PRE(K).LT.0.) THEN
+         DUM = PRE(K)*DT/QR3D(K)
+           DUM = MAX(-1.,DUM)
+         NSUBR(K) = DUM*NR3D(K)/DT
+      END IF
+      IF (EPRDG(K).LT.0.) THEN
+         DUM = EPRDG(K)*DT/QG3D(K)
+           DUM = MAX(-1.,DUM)
+         NSUBG(K) = DUM*NG3D(K)/DT
+      END IF
+
+!        nsubr(k)=0.
+!        nsubs(k)=0.
+!        nsubg(k)=0.
+
+! UPDATE TENDENCIES
+
+!        NC3DTEN(K) = NC3DTEN(K)+NSUBC(K)
+         NI3DTEN(K) = NI3DTEN(K)+NSUBI(K)
+         NS3DTEN(K) = NS3DTEN(K)+NSUBS(K)
+         NG3DTEN(K) = NG3DTEN(K)+NSUBG(K)
+         NR3DTEN(K) = NR3DTEN(K)+NSUBR(K)
+
+#if (WRF_CHEM == 1)
+         evapprod(k) = - PRE(K) - EPRDS(K) - EPRDG(K) 
+         rainprod(k) = PRA(K) + PRC(K) + PSACWS(K) + PSACWG(K) + PGSACW(K) & 
+                       + PRAI(K) + PRCI(K) + PRACI(K) + PRACIS(K) + &
+                       + PRDS(K) + PRDG(K)
+#endif
+
+         END IF !!!!!! TEMPERATURE
+
+! SWITCH LTRUE TO 1, SINCE HYDROMETEORS ARE PRESENT
+         LTRUE = 1
+
+ 200     CONTINUE
+
+        END DO
+
+! INITIALIZE PRECIP AND SNOW RATES
+      PRECRT = 0.
+      SNOWRT = 0.
+! hm added 7/13/13
+      SNOWPRT = 0.
+      GRPLPRT = 0.
+
+! IF THERE ARE NO HYDROMETEORS, THEN SKIP TO END OF SUBROUTINE
+
+        IF (LTRUE.EQ.0) GOTO 400
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!.......................................................................
+! CALCULATE SEDIMENATION
+! THE NUMERICS HERE FOLLOW FROM REISNER ET AL. (1998)
+! FALLOUT TERMS ARE CALCULATED ON SPLIT TIME STEPS TO ENSURE NUMERICAL
+! STABILITY, I.E. COURANT# < 1
+
+!.......................................................................
+
+      NSTEP = 1
+
+      DO K = KTE,KTS,-1
+
+        DUMI(K) = QI3D(K)+QI3DTEN(K)*DT
+        DUMQS(K) = QNI3D(K)+QNI3DTEN(K)*DT
+        DUMR(K) = QR3D(K)+QR3DTEN(K)*DT
+        DUMFNI(K) = NI3D(K)+NI3DTEN(K)*DT
+        DUMFNS(K) = NS3D(K)+NS3DTEN(K)*DT
+        DUMFNR(K) = NR3D(K)+NR3DTEN(K)*DT
+        DUMC(K) = QC3D(K)+QC3DTEN(K)*DT
+        DUMFNC(K) = NC3D(K)+NC3DTEN(K)*DT
+	DUMG(K) = QG3D(K)+QG3DTEN(K)*DT
+	DUMFNG(K) = NG3D(K)+NG3DTEN(K)*DT
+
+! SWITCH FOR CONSTANT DROPLET NUMBER
+        IF (iinum.EQ.1) THEN
+        DUMFNC(K) = NC3D(K)
+        END IF
+
+! GET DUMMY LAMDA FOR SEDIMENTATION CALCULATIONS
+
+! MAKE SURE NUMBER CONCENTRATIONS ARE POSITIVE
+      DUMFNI(K) = MAX(0.,DUMFNI(K))
+      DUMFNS(K) = MAX(0.,DUMFNS(K))
+      DUMFNC(K) = MAX(0.,DUMFNC(K))
+      DUMFNR(K) = MAX(0.,DUMFNR(K))
+      DUMFNG(K) = MAX(0.,DUMFNG(K))
+
+!......................................................................
+! CLOUD ICE
+
+      IF (DUMI(K).GE.QSMALL) THEN
+        DLAMI = (CONS12*DUMFNI(K)/DUMI(K))**(1./DI)
+        DLAMI=MAX(DLAMI,LAMMINI)
+        DLAMI=MIN(DLAMI,LAMMAXI)
+      END IF
+!......................................................................
+! RAIN
+
+      IF (DUMR(K).GE.QSMALL) THEN
+        DLAMR = (PI*RHOW*DUMFNR(K)/DUMR(K))**(1./3.)
+        DLAMR=MAX(DLAMR,LAMMINR)
+        DLAMR=MIN(DLAMR,LAMMAXR)
+      END IF
+!......................................................................
+! CLOUD DROPLETS
+
+      IF (DUMC(K).GE.QSMALL) THEN
+         DUM = PRES(K)/(287.15*T3D(K))
+         PGAM(K)=0.0005714*(NC3D(K)/1.E6*DUM)+0.2714
+         PGAM(K)=1./(PGAM(K)**2)-1.
+         PGAM(K)=MAX(PGAM(K),2.)
+         PGAM(K)=MIN(PGAM(K),10.)
+
+        DLAMC = (CONS26*DUMFNC(K)*GAMMA(PGAM(K)+4.)/(DUMC(K)*GAMMA(PGAM(K)+1.)))**(1./3.)
+        LAMMIN = (PGAM(K)+1.)/60.E-6
+        LAMMAX = (PGAM(K)+1.)/1.E-6
+        DLAMC=MAX(DLAMC,LAMMIN)
+        DLAMC=MIN(DLAMC,LAMMAX)
+      END IF
+!......................................................................
+! SNOW
+
+      IF (DUMQS(K).GE.QSMALL) THEN
+        DLAMS = (CONS1*DUMFNS(K)/ DUMQS(K))**(1./DS)
+        DLAMS=MAX(DLAMS,LAMMINS)
+        DLAMS=MIN(DLAMS,LAMMAXS)
+      END IF
+!......................................................................
+! GRAUPEL
+
+      IF (DUMG(K).GE.QSMALL) THEN
+        DLAMG = (CONS2*DUMFNG(K)/ DUMG(K))**(1./DG)
+        DLAMG=MAX(DLAMG,LAMMING)
+        DLAMG=MIN(DLAMG,LAMMAXG)
+      END IF
+
+!......................................................................
+! CALCULATE NUMBER-WEIGHTED AND MASS-WEIGHTED TERMINAL FALL SPEEDS
+
+! CLOUD WATER
+
+      IF (DUMC(K).GE.QSMALL) THEN
+      UNC =  ACN(K)*GAMMA(1.+BC+PGAM(K))/ (DLAMC**BC*GAMMA(PGAM(K)+1.))
+      UMC = ACN(K)*GAMMA(4.+BC+PGAM(K))/  (DLAMC**BC*GAMMA(PGAM(K)+4.))
+      ELSE
+      UMC = 0.
+      UNC = 0.
+      END IF
+
+      IF (DUMI(K).GE.QSMALL) THEN
+      UNI =  AIN(K)*CONS27/DLAMI**BI
+      UMI = AIN(K)*CONS28/(DLAMI**BI)
+      ELSE
+      UMI = 0.
+      UNI = 0.
+      END IF
+
+      IF (DUMR(K).GE.QSMALL) THEN
+      UNR = ARN(K)*CONS6/DLAMR**BR
+      UMR = ARN(K)*CONS4/(DLAMR**BR)
+      ELSE
+      UMR = 0.
+      UNR = 0.
+      END IF
+
+      IF (DUMQS(K).GE.QSMALL) THEN
+      UMS = ASN(K)*CONS3/(DLAMS**BS)
+      UNS = ASN(K)*CONS5/DLAMS**BS
+      ELSE
+      UMS = 0.
+      UNS = 0.
+      END IF
+
+      IF (DUMG(K).GE.QSMALL) THEN
+      UMG = AGN(K)*CONS7/(DLAMG**BG)
+      UNG = AGN(K)*CONS8/DLAMG**BG
+      ELSE
+      UMG = 0.
+      UNG = 0.
+      END IF
+
+! SET REALISTIC LIMITS ON FALLSPEED
+
+! bug fix, 10/08/09
+        dum=(rhosu/rho(k))**0.54
+        UMS=MIN(UMS,1.2*dum)
+        UNS=MIN(UNS,1.2*dum)
+! fix 053011
+! fix for correction by AA 4/6/11
+        UMI=MIN(UMI,1.2*(rhosu/rho(k))**0.35)
+        UNI=MIN(UNI,1.2*(rhosu/rho(k))**0.35)
+        UMR=MIN(UMR,9.1*dum)
+        UNR=MIN(UNR,9.1*dum)
+        UMG=MIN(UMG,20.*dum)
+        UNG=MIN(UNG,20.*dum)
+
+      FR(K) = UMR
+      FI(K) = UMI
+      FNI(K) = UNI
+      FS(K) = UMS
+      FNS(K) = UNS
+      FNR(K) = UNR
+      FC(K) = UMC
+      FNC(K) = UNC
+      FG(K) = UMG
+      FNG(K) = UNG
+
+! V3.3 MODIFY FALLSPEED BELOW LEVEL OF PRECIP
+
+	IF (K.LE.KTE-1) THEN
+        IF (FR(K).LT.1.E-10) THEN
+	FR(K)=FR(K+1)
+	END IF
+        IF (FI(K).LT.1.E-10) THEN
+	FI(K)=FI(K+1)
+	END IF
+        IF (FNI(K).LT.1.E-10) THEN
+	FNI(K)=FNI(K+1)
+	END IF
+        IF (FS(K).LT.1.E-10) THEN
+	FS(K)=FS(K+1)
+	END IF
+        IF (FNS(K).LT.1.E-10) THEN
+	FNS(K)=FNS(K+1)
+	END IF
+        IF (FNR(K).LT.1.E-10) THEN
+	FNR(K)=FNR(K+1)
+	END IF
+        IF (FC(K).LT.1.E-10) THEN
+	FC(K)=FC(K+1)
+	END IF
+        IF (FNC(K).LT.1.E-10) THEN
+	FNC(K)=FNC(K+1)
+	END IF
+        IF (FG(K).LT.1.E-10) THEN
+	FG(K)=FG(K+1)
+	END IF
+        IF (FNG(K).LT.1.E-10) THEN
+	FNG(K)=FNG(K+1)
+	END IF
+	END IF ! K LE KTE-1
+
+! CALCULATE NUMBER OF SPLIT TIME STEPS
+
+      RGVM = MAX(FR(K),FI(K),FS(K),FC(K),FNI(K),FNR(K),FNS(K),FNC(K),FG(K),FNG(K))
+! VVT CHANGED IFIX -> INT (GENERIC FUNCTION)
+      NSTEP = MAX(INT(RGVM*DT/DZQ(K)+1.),NSTEP)
+
+! MULTIPLY VARIABLES BY RHO
+      DUMR(k) = DUMR(k)*RHO(K)
+      DUMI(k) = DUMI(k)*RHO(K)
+      DUMFNI(k) = DUMFNI(K)*RHO(K)
+      DUMQS(k) = DUMQS(K)*RHO(K)
+      DUMFNS(k) = DUMFNS(K)*RHO(K)
+      DUMFNR(k) = DUMFNR(K)*RHO(K)
+      DUMC(k) = DUMC(K)*RHO(K)
+      DUMFNC(k) = DUMFNC(K)*RHO(K)
+      DUMG(k) = DUMG(K)*RHO(K)
+      DUMFNG(k) = DUMFNG(K)*RHO(K)
+
+      END DO
+
+      DO N = 1,NSTEP
+
+      DO K = KTS,KTE
+      FALOUTR(K) = FR(K)*DUMR(K)
+      FALOUTI(K) = FI(K)*DUMI(K)
+      FALOUTNI(K) = FNI(K)*DUMFNI(K)
+      FALOUTS(K) = FS(K)*DUMQS(K)
+      FALOUTNS(K) = FNS(K)*DUMFNS(K)
+      FALOUTNR(K) = FNR(K)*DUMFNR(K)
+      FALOUTC(K) = FC(K)*DUMC(K)
+      FALOUTNC(K) = FNC(K)*DUMFNC(K)
+      FALOUTG(K) = FG(K)*DUMG(K)
+      FALOUTNG(K) = FNG(K)*DUMFNG(K)
+      END DO
+
+! TOP OF MODEL
+
+      K = KTE
+      FALTNDR = FALOUTR(K)/DZQ(k)
+      FALTNDI = FALOUTI(K)/DZQ(k)
+      FALTNDNI = FALOUTNI(K)/DZQ(k)
+      FALTNDS = FALOUTS(K)/DZQ(k)
+      FALTNDNS = FALOUTNS(K)/DZQ(k)
+      FALTNDNR = FALOUTNR(K)/DZQ(k)
+      FALTNDC = FALOUTC(K)/DZQ(k)
+      FALTNDNC = FALOUTNC(K)/DZQ(k)
+      FALTNDG = FALOUTG(K)/DZQ(k)
+      FALTNDNG = FALOUTNG(K)/DZQ(k)
+! ADD FALLOUT TERMS TO EULERIAN TENDENCIES
+
+      QRSTEN(K) = QRSTEN(K)-FALTNDR/NSTEP/RHO(k)
+      QISTEN(K) = QISTEN(K)-FALTNDI/NSTEP/RHO(k)
+      NI3DTEN(K) = NI3DTEN(K)-FALTNDNI/NSTEP/RHO(k)
+      QNISTEN(K) = QNISTEN(K)-FALTNDS/NSTEP/RHO(k)
+      NS3DTEN(K) = NS3DTEN(K)-FALTNDNS/NSTEP/RHO(k)
+      NR3DTEN(K) = NR3DTEN(K)-FALTNDNR/NSTEP/RHO(k)
+      QCSTEN(K) = QCSTEN(K)-FALTNDC/NSTEP/RHO(k)
+      NC3DTEN(K) = NC3DTEN(K)-FALTNDNC/NSTEP/RHO(k)
+      QGSTEN(K) = QGSTEN(K)-FALTNDG/NSTEP/RHO(k)
+      NG3DTEN(K) = NG3DTEN(K)-FALTNDNG/NSTEP/RHO(k)
+
+      DUMR(K) = DUMR(K)-FALTNDR*DT/NSTEP
+      DUMI(K) = DUMI(K)-FALTNDI*DT/NSTEP
+      DUMFNI(K) = DUMFNI(K)-FALTNDNI*DT/NSTEP
+      DUMQS(K) = DUMQS(K)-FALTNDS*DT/NSTEP
+      DUMFNS(K) = DUMFNS(K)-FALTNDNS*DT/NSTEP
+      DUMFNR(K) = DUMFNR(K)-FALTNDNR*DT/NSTEP
+      DUMC(K) = DUMC(K)-FALTNDC*DT/NSTEP
+      DUMFNC(K) = DUMFNC(K)-FALTNDNC*DT/NSTEP
+      DUMG(K) = DUMG(K)-FALTNDG*DT/NSTEP
+      DUMFNG(K) = DUMFNG(K)-FALTNDNG*DT/NSTEP
+
+      DO K = KTE-1,KTS,-1
+      FALTNDR = (FALOUTR(K+1)-FALOUTR(K))/DZQ(K)
+      FALTNDI = (FALOUTI(K+1)-FALOUTI(K))/DZQ(K)
+      FALTNDNI = (FALOUTNI(K+1)-FALOUTNI(K))/DZQ(K)
+      FALTNDS = (FALOUTS(K+1)-FALOUTS(K))/DZQ(K)
+      FALTNDNS = (FALOUTNS(K+1)-FALOUTNS(K))/DZQ(K)
+      FALTNDNR = (FALOUTNR(K+1)-FALOUTNR(K))/DZQ(K)
+      FALTNDC = (FALOUTC(K+1)-FALOUTC(K))/DZQ(K)
+      FALTNDNC = (FALOUTNC(K+1)-FALOUTNC(K))/DZQ(K)
+      FALTNDG = (FALOUTG(K+1)-FALOUTG(K))/DZQ(K)
+      FALTNDNG = (FALOUTNG(K+1)-FALOUTNG(K))/DZQ(K)
+
+! ADD FALLOUT TERMS TO EULERIAN TENDENCIES
+
+      QRSTEN(K) = QRSTEN(K)+FALTNDR/NSTEP/RHO(k)
+      QISTEN(K) = QISTEN(K)+FALTNDI/NSTEP/RHO(k)
+      NI3DTEN(K) = NI3DTEN(K)+FALTNDNI/NSTEP/RHO(k)
+      QNISTEN(K) = QNISTEN(K)+FALTNDS/NSTEP/RHO(k)
+      NS3DTEN(K) = NS3DTEN(K)+FALTNDNS/NSTEP/RHO(k)
+      NR3DTEN(K) = NR3DTEN(K)+FALTNDNR/NSTEP/RHO(k)
+      QCSTEN(K) = QCSTEN(K)+FALTNDC/NSTEP/RHO(k)
+      NC3DTEN(K) = NC3DTEN(K)+FALTNDNC/NSTEP/RHO(k)
+      QGSTEN(K) = QGSTEN(K)+FALTNDG/NSTEP/RHO(k)
+      NG3DTEN(K) = NG3DTEN(K)+FALTNDNG/NSTEP/RHO(k)
+
+      DUMR(K) = DUMR(K)+FALTNDR*DT/NSTEP
+      DUMI(K) = DUMI(K)+FALTNDI*DT/NSTEP
+      DUMFNI(K) = DUMFNI(K)+FALTNDNI*DT/NSTEP
+      DUMQS(K) = DUMQS(K)+FALTNDS*DT/NSTEP
+      DUMFNS(K) = DUMFNS(K)+FALTNDNS*DT/NSTEP
+      DUMFNR(K) = DUMFNR(K)+FALTNDNR*DT/NSTEP
+      DUMC(K) = DUMC(K)+FALTNDC*DT/NSTEP
+      DUMFNC(K) = DUMFNC(K)+FALTNDNC*DT/NSTEP
+      DUMG(K) = DUMG(K)+FALTNDG*DT/NSTEP
+      DUMFNG(K) = DUMFNG(K)+FALTNDNG*DT/NSTEP
+
+! FOR WRF-CHEM, NEED PRECIP RATES (UNITS OF KG/M^2/S)
+	  CSED(K)=CSED(K)+FALOUTC(K)/NSTEP
+	  ISED(K)=ISED(K)+FALOUTI(K)/NSTEP
+	  SSED(K)=SSED(K)+FALOUTS(K)/NSTEP
+	  GSED(K)=GSED(K)+FALOUTG(K)/NSTEP
+	  RSED(K)=RSED(K)+FALOUTR(K)/NSTEP
+      END DO
+
+! GET PRECIPITATION AND SNOWFALL ACCUMULATION DURING THE TIME STEP
+! FACTOR OF 1000 CONVERTS FROM M TO MM, BUT DIVISION BY DENSITY
+! OF LIQUID WATER CANCELS THIS FACTOR OF 1000
+
+        PRECRT = PRECRT+(FALOUTR(KTS)+FALOUTC(KTS)+FALOUTS(KTS)+FALOUTI(KTS)+FALOUTG(KTS))  &
+                     *DT/NSTEP
+        SNOWRT = SNOWRT+(FALOUTS(KTS)+FALOUTI(KTS)+FALOUTG(KTS))*DT/NSTEP
+! hm added 7/13/13
+        SNOWPRT = SNOWPRT+(FALOUTI(KTS)+FALOUTS(KTS))*DT/NSTEP
+        GRPLPRT = GRPLPRT+(FALOUTG(KTS))*DT/NSTEP
+
+      END DO
+
+        DO K=KTS,KTE
+
+! ADD ON SEDIMENTATION TENDENCIES FOR MIXING RATIO TO REST OF TENDENCIES
+
+        QR3DTEN(K)=QR3DTEN(K)+QRSTEN(K)
+        QI3DTEN(K)=QI3DTEN(K)+QISTEN(K)
+        QC3DTEN(K)=QC3DTEN(K)+QCSTEN(K)
+        QG3DTEN(K)=QG3DTEN(K)+QGSTEN(K)
+        QNI3DTEN(K)=QNI3DTEN(K)+QNISTEN(K)
+
+! PUT ALL CLOUD ICE IN SNOW CATEGORY IF MEAN DIAMETER EXCEEDS 2 * dcs
+
+!hm 4/7/09 bug fix
+!        IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.273.15) THEN
+        IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.273.15.AND.LAMI(K).GE.1.E-10) THEN
+        IF (1./LAMI(K).GE.2.*DCS) THEN
+           QNI3DTEN(K) = QNI3DTEN(K)+QI3D(K)/DT+ QI3DTEN(K)
+           NS3DTEN(K) = NS3DTEN(K)+NI3D(K)/DT+   NI3DTEN(K)
+           QI3DTEN(K) = -QI3D(K)/DT
+           NI3DTEN(K) = -NI3D(K)/DT
+        END IF
+        END IF
+
+! hm add tendencies here, then call sizeparameter
+! to ensure consisitency between mixing ratio and number concentration
+
+          QC3D(k)        = QC3D(k)+QC3DTEN(k)*DT
+          QI3D(k)        = QI3D(k)+QI3DTEN(k)*DT
+          QNI3D(k)        = QNI3D(k)+QNI3DTEN(k)*DT
+          QR3D(k)        = QR3D(k)+QR3DTEN(k)*DT
+          NC3D(k)        = NC3D(k)+NC3DTEN(k)*DT
+          NI3D(k)        = NI3D(k)+NI3DTEN(k)*DT
+          NS3D(k)        = NS3D(k)+NS3DTEN(k)*DT
+          NR3D(k)        = NR3D(k)+NR3DTEN(k)*DT
+
+          IF (IGRAUP.EQ.0) THEN
+          QG3D(k)        = QG3D(k)+QG3DTEN(k)*DT
+          NG3D(k)        = NG3D(k)+NG3DTEN(k)*DT
+          END IF
+
+! ADD TEMPERATURE AND WATER VAPOR TENDENCIES FROM MICROPHYSICS
+          T3D(K)         = T3D(K)+T3DTEN(k)*DT
+          QV3D(K)        = QV3D(K)+QV3DTEN(k)*DT
+
+! SATURATION VAPOR PRESSURE AND MIXING RATIO
+
+! hm, add fix for low pressure, 5/12/10
+            EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0))   ! PA
+            EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1))   ! PA
+
+! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING
+
+            IF (EIS(K).GT.EVS(K)) EIS(K) = EVS(K)
+
+            QVS(K) = EP_2*EVS(K)/(PRES(K)-EVS(K))
+            QVI(K) = EP_2*EIS(K)/(PRES(K)-EIS(K))
+
+            QVQVS(K) = QV3D(K)/QVS(K)
+            QVQVSI(K) = QV3D(K)/QVI(K)
+
+! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER
+! hm 7/9/09 change limit to 1.e-8
+
+             IF (QVQVS(K).LT.0.9) THEN
+               IF (QR3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QR3D(K)
+                  T3D(K)=T3D(K)-QR3D(K)*XXLV(K)/CPM(K)
+                  QR3D(K)=0.
+               END IF
+               IF (QC3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QC3D(K)
+                  T3D(K)=T3D(K)-QC3D(K)*XXLV(K)/CPM(K)
+                  QC3D(K)=0.
+               END IF
+             END IF
+
+             IF (QVQVSI(K).LT.0.9) THEN
+               IF (QI3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QI3D(K)
+                  T3D(K)=T3D(K)-QI3D(K)*XXLS(K)/CPM(K)
+                  QI3D(K)=0.
+               END IF
+               IF (QNI3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QNI3D(K)
+                  T3D(K)=T3D(K)-QNI3D(K)*XXLS(K)/CPM(K)
+                  QNI3D(K)=0.
+               END IF
+               IF (QG3D(K).LT.1.E-8) THEN
+                  QV3D(K)=QV3D(K)+QG3D(K)
+                  T3D(K)=T3D(K)-QG3D(K)*XXLS(K)/CPM(K)
+                  QG3D(K)=0.
+               END IF
+             END IF
+
+!..................................................................
+! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO
+
+       IF (QC3D(K).LT.QSMALL) THEN
+         QC3D(K) = 0.
+         NC3D(K) = 0.
+         EFFC(K) = 0.
+       END IF
+       IF (QR3D(K).LT.QSMALL) THEN
+         QR3D(K) = 0.
+         NR3D(K) = 0.
+         EFFR(K) = 0.
+       END IF
+       IF (QI3D(K).LT.QSMALL) THEN
+         QI3D(K) = 0.
+         NI3D(K) = 0.
+         EFFI(K) = 0.
+       END IF
+       IF (QNI3D(K).LT.QSMALL) THEN
+         QNI3D(K) = 0.
+         NS3D(K) = 0.
+         EFFS(K) = 0.
+       END IF
+       IF (QG3D(K).LT.QSMALL) THEN
+         QG3D(K) = 0.
+         NG3D(K) = 0.
+         EFFG(K) = 0.
+       END IF
+
+!..................................
+! IF THERE IS NO CLOUD/PRECIP WATER, THEN SKIP CALCULATIONS
+
+            IF (QC3D(K).LT.QSMALL.AND.QI3D(K).LT.QSMALL.AND.QNI3D(K).LT.QSMALL &
+                 .AND.QR3D(K).LT.QSMALL.AND.QG3D(K).LT.QSMALL) GOTO 500
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! CALCULATE INSTANTANEOUS PROCESSES
+
+! ADD MELTING OF CLOUD ICE TO FORM RAIN
+
+        IF (QI3D(K).GE.QSMALL.AND.T3D(K).GE.273.15) THEN
+           QR3D(K) = QR3D(K)+QI3D(K)
+           T3D(K) = T3D(K)-QI3D(K)*XLF(K)/CPM(K)
+#if (WRF_CHEM == 1)
+           tqimelt(K)=QI3D(K)/DT
+#endif
+           QI3D(K) = 0.
+           NR3D(K) = NR3D(K)+NI3D(K)
+           NI3D(K) = 0.
+        END IF
+
+! ****SENSITIVITY - NO ICE
+        IF (ILIQ.EQ.1) GOTO 778
+
+! HOMOGENEOUS FREEZING OF CLOUD WATER
+
+        IF (T3D(K).LE.233.15.AND.QC3D(K).GE.QSMALL) THEN
+           QI3D(K)=QI3D(K)+QC3D(K)
+           T3D(K)=T3D(K)+QC3D(K)*XLF(K)/CPM(K)
+           QC3D(K)=0.
+           NI3D(K)=NI3D(K)+NC3D(K)
+           NC3D(K)=0.
+        END IF
+
+! HOMOGENEOUS FREEZING OF RAIN
+
+        IF (IGRAUP.EQ.0) THEN
+
+        IF (T3D(K).LE.233.15.AND.QR3D(K).GE.QSMALL) THEN
+           QG3D(K) = QG3D(K)+QR3D(K)
+           T3D(K) = T3D(K)+QR3D(K)*XLF(K)/CPM(K)
+           QR3D(K) = 0.
+           NG3D(K) = NG3D(K)+ NR3D(K)
+           NR3D(K) = 0.
+        END IF
+
+        ELSE IF (IGRAUP.EQ.1) THEN
+
+        IF (T3D(K).LE.233.15.AND.QR3D(K).GE.QSMALL) THEN
+           QNI3D(K) = QNI3D(K)+QR3D(K)
+           T3D(K) = T3D(K)+QR3D(K)*XLF(K)/CPM(K)
+           QR3D(K) = 0.
+           NS3D(K) = NS3D(K)+NR3D(K)
+           NR3D(K) = 0.
+        END IF
+
+        END IF
+
+ 778    CONTINUE
+
+! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE
+
+      NI3D(K) = MAX(0.,NI3D(K))
+      NS3D(K) = MAX(0.,NS3D(K))
+      NC3D(K) = MAX(0.,NC3D(K))
+      NR3D(K) = MAX(0.,NR3D(K))
+      NG3D(K) = MAX(0.,NG3D(K))
+
+!......................................................................
+! CLOUD ICE
+
+      IF (QI3D(K).GE.QSMALL) THEN
+         LAMI(K) = (CONS12*                 &
+              NI3D(K)/QI3D(K))**(1./DI)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMI(K).LT.LAMMINI) THEN
+
+      LAMI(K) = LAMMINI
+
+      N0I(K) = LAMI(K)**4*QI3D(K)/CONS12
+
+      NI3D(K) = N0I(K)/LAMI(K)
+      ELSE IF (LAMI(K).GT.LAMMAXI) THEN
+      LAMI(K) = LAMMAXI
+      N0I(K) = LAMI(K)**4*QI3D(K)/CONS12
+
+      NI3D(K) = N0I(K)/LAMI(K)
+      END IF
+      END IF
+
+!......................................................................
+! RAIN
+
+      IF (QR3D(K).GE.QSMALL) THEN
+      LAMR(K) = (PI*RHOW*NR3D(K)/QR3D(K))**(1./3.)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMR(K).LT.LAMMINR) THEN
+
+      LAMR(K) = LAMMINR
+
+      N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW)
+
+      NR3D(K) = N0RR(K)/LAMR(K)
+      ELSE IF (LAMR(K).GT.LAMMAXR) THEN
+      LAMR(K) = LAMMAXR
+      N0RR(K) = LAMR(K)**4*QR3D(K)/(PI*RHOW)
+
+      NR3D(K) = N0RR(K)/LAMR(K)
+      END IF
+
+      END IF
+
+!......................................................................
+! CLOUD DROPLETS
+
+! MARTIN ET AL. (1994) FORMULA FOR PGAM
+
+      IF (QC3D(K).GE.QSMALL) THEN
+
+         DUM = PRES(K)/(287.15*T3D(K))
+         PGAM(K)=0.0005714*(NC3D(K)/1.E6*DUM)+0.2714
+         PGAM(K)=1./(PGAM(K)**2)-1.
+         PGAM(K)=MAX(PGAM(K),2.)
+         PGAM(K)=MIN(PGAM(K),10.)
+
+! CALCULATE LAMC
+
+      LAMC(K) = (CONS26*NC3D(K)*GAMMA(PGAM(K)+4.)/   &
+                 (QC3D(K)*GAMMA(PGAM(K)+1.)))**(1./3.)
+
+! LAMMIN, 60 MICRON DIAMETER
+! LAMMAX, 1 MICRON
+
+      LAMMIN = (PGAM(K)+1.)/60.E-6
+      LAMMAX = (PGAM(K)+1.)/1.E-6
+
+      IF (LAMC(K).LT.LAMMIN) THEN
+      LAMC(K) = LAMMIN
+      NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+              &
+                LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26
+
+      ELSE IF (LAMC(K).GT.LAMMAX) THEN
+      LAMC(K) = LAMMAX
+      NC3D(K) = EXP(3.*LOG(LAMC(K))+LOG(QC3D(K))+              &
+                LOG(GAMMA(PGAM(K)+1.))-LOG(GAMMA(PGAM(K)+4.)))/CONS26
+
+      END IF
+
+      END IF
+
+!......................................................................
+! SNOW
+
+      IF (QNI3D(K).GE.QSMALL) THEN
+      LAMS(K) = (CONS1*NS3D(K)/QNI3D(K))**(1./DS)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMS(K).LT.LAMMINS) THEN
+      LAMS(K) = LAMMINS
+      N0S(K) = LAMS(K)**4*QNI3D(K)/CONS1
+
+      NS3D(K) = N0S(K)/LAMS(K)
+
+      ELSE IF (LAMS(K).GT.LAMMAXS) THEN
+
+      LAMS(K) = LAMMAXS
+      N0S(K) = LAMS(K)**4*QNI3D(K)/CONS1
+      NS3D(K) = N0S(K)/LAMS(K)
+      END IF
+
+      END IF
+
+!......................................................................
+! GRAUPEL
+
+      IF (QG3D(K).GE.QSMALL) THEN
+      LAMG(K) = (CONS2*NG3D(K)/QG3D(K))**(1./DG)
+
+! CHECK FOR SLOPE
+
+! ADJUST VARS
+
+      IF (LAMG(K).LT.LAMMING) THEN
+      LAMG(K) = LAMMING
+      N0G(K) = LAMG(K)**4*QG3D(K)/CONS2
+
+      NG3D(K) = N0G(K)/LAMG(K)
+
+      ELSE IF (LAMG(K).GT.LAMMAXG) THEN
+
+      LAMG(K) = LAMMAXG
+      N0G(K) = LAMG(K)**4*QG3D(K)/CONS2
+
+      NG3D(K) = N0G(K)/LAMG(K)
+      END IF
+
+      END IF
+
+ 500  CONTINUE
+
+! CALCULATE EFFECTIVE RADIUS
+
+      IF (QI3D(K).GE.QSMALL) THEN
+         EFFI(K) = 3./LAMI(K)/2.*1.E6
+      ELSE
+         !EFFI(K) = 25.  !TWG change for consistency with RRTMG
+          EFFI(K) = 4.99
+      END IF
+
+      IF (QNI3D(K).GE.QSMALL) THEN
+         EFFS(K) = 3./LAMS(K)/2.*1.E6
+      ELSE
+         EFFS(K) = 25.
+      END IF
+
+      IF (QR3D(K).GE.QSMALL) THEN
+         EFFR(K) = 3./LAMR(K)/2.*1.E6
+      ELSE
+         EFFR(K) = 25.
+      END IF
+
+      IF (QC3D(K).GE.QSMALL) THEN
+      EFFC(K) = GAMMA(PGAM(K)+4.)/                        &
+             GAMMA(PGAM(K)+3.)/LAMC(K)/2.*1.E6
+      ELSE
+       !EFFC(K) = 25.
+        EFFC(K) = 2.49
+      END IF
+
+      IF (QG3D(K).GE.QSMALL) THEN
+         EFFG(K) = 3./LAMG(K)/2.*1.E6
+      ELSE
+         EFFG(K) = 25.
+      END IF
+
+! HM ADD 1/10/06, ADD UPPER BOUND ON ICE NUMBER, THIS IS NEEDED
+! TO PREVENT VERY LARGE ICE NUMBER DUE TO HOMOGENEOUS FREEZING
+! OF DROPLETS, ESPECIALLY WHEN INUM = 1, SET MAX AT 10 CM-3
+!          NI3D(K) = MIN(NI3D(K),10.E6/RHO(K))
+! HM, 12/28/12, LOWER MAXIMUM ICE CONCENTRATION TO ADDRESS PROBLEM
+! OF EXCESSIVE AND PERSISTENT ANVIL
+! NOTE: THIS MAY CHANGE/REDUCE SENSITIVITY TO AEROSOL/CCN CONCENTRATION
+          NI3D(K) = MIN(NI3D(K),0.3E6/RHO(K))
+
+! ADD BOUND ON DROPLET NUMBER - CANNOT EXCEED AEROSOL CONCENTRATION
+          IF (iinum.EQ.0.AND.IACT.EQ.2) THEN
+          NC3D(K) = MIN(NC3D(K),(NANEW1+NANEW2)/RHO(K))
+          END IF
+! SWITCH FOR CONSTANT DROPLET NUMBER
+          IF (iinum.EQ.1) THEN 
+! CHANGE NDCNST FROM CM-3 TO KG-1
+             NC3D(K) = NDCNST*1.E6/RHO(K)
+          END IF
+
+      END DO !!! K LOOP
+
+ 400         CONTINUE
+
+! ALL DONE !!!!!!!!!!!
+      RETURN
+      END SUBROUTINE MORR_TWO_MOMENT_MICRO
+
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      REAL FUNCTION POLYSVP (T,TYPE)
+
+!-------------------------------------------
+
+!  COMPUTE SATURATION VAPOR PRESSURE
+
+!  POLYSVP RETURNED IN UNITS OF PA.
+!  T IS INPUT IN UNITS OF K.
+!  TYPE REFERS TO SATURATION WITH RESPECT TO LIQUID (0) OR ICE (1)
+
+! REPLACE GOFF-GRATCH WITH FASTER FORMULATION FROM FLATAU ET AL. 1992, TABLE 4 (RIGHT-HAND COLUMN)
+
+      IMPLICIT NONE
+
+      REAL DUM
+      REAL T
+      INTEGER TYPE
+! ice
+      real a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i 
+      data a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i /&
+	6.11147274, 0.503160820, 0.188439774e-1, &
+        0.420895665e-3, 0.615021634e-5,0.602588177e-7, &
+        0.385852041e-9, 0.146898966e-11, 0.252751365e-14/	
+
+! liquid
+      real a0,a1,a2,a3,a4,a5,a6,a7,a8 
+
+! V1.7
+      data a0,a1,a2,a3,a4,a5,a6,a7,a8 /&
+	6.11239921, 0.443987641, 0.142986287e-1, &
+        0.264847430e-3, 0.302950461e-5, 0.206739458e-7, &
+        0.640689451e-10,-0.952447341e-13,-0.976195544e-15/
+      real dt
+
+! ICE
+
+      IF (TYPE.EQ.1) THEN
+
+!         POLYSVP = 10.**(-9.09718*(273.16/T-1.)-3.56654*                &
+!          LOG10(273.16/T)+0.876793*(1.-T/273.16)+						&
+!          LOG10(6.1071))*100.
+
+
+      dt = max(-80.,t-273.16)
+      polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) 
+      polysvp = polysvp*100.
+
+      END IF
+
+! LIQUID
+
+      IF (TYPE.EQ.0) THEN
+
+       dt = max(-80.,t-273.16)
+       polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt)))))))
+       polysvp = polysvp*100.
+
+!         POLYSVP = 10.**(-7.90298*(373.16/T-1.)+                        &
+!             5.02808*LOG10(373.16/T)-									&
+!             1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+				&
+!             8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+				&
+!             LOG10(1013.246))*100.
+
+         END IF
+
+
+      END FUNCTION POLYSVP
+
+!------------------------------------------------------------------------------
+
+      REAL FUNCTION GAMMA(X)
+!----------------------------------------------------------------------
+!
+! THIS ROUTINE CALCULATES THE GAMMA FUNCTION FOR A REAL ARGUMENT X.
+!   COMPUTATION IS BASED ON AN ALGORITHM OUTLINED IN REFERENCE 1.
+!   THE PROGRAM USES RATIONAL FUNCTIONS THAT APPROXIMATE THE GAMMA
+!   FUNCTION TO AT LEAST 20 SIGNIFICANT DECIMAL DIGITS.  COEFFICIENTS
+!   FOR THE APPROXIMATION OVER THE INTERVAL (1,2) ARE UNPUBLISHED.
+!   THOSE FOR THE APPROXIMATION FOR X .GE. 12 ARE FROM REFERENCE 2.
+!   THE ACCURACY ACHIEVED DEPENDS ON THE ARITHMETIC SYSTEM, THE
+!   COMPILER, THE INTRINSIC FUNCTIONS, AND PROPER SELECTION OF THE
+!   MACHINE-DEPENDENT CONSTANTS.
+!
+!
+!*******************************************************************
+!*******************************************************************
+!
+! EXPLANATION OF MACHINE-DEPENDENT CONSTANTS
+!
+! BETA   - RADIX FOR THE FLOATING-POINT REPRESENTATION
+! MAXEXP - THE SMALLEST POSITIVE POWER OF BETA THAT OVERFLOWS
+! XBIG   - THE LARGEST ARGUMENT FOR WHICH GAMMA(X) IS REPRESENTABLE
+!          IN THE MACHINE, I.E., THE SOLUTION TO THE EQUATION
+!                  GAMMA(XBIG) = BETA**MAXEXP
+! XINF   - THE LARGEST MACHINE REPRESENTABLE FLOATING-POINT NUMBER;
+!          APPROXIMATELY BETA**MAXEXP
+! EPS    - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT
+!          1.0+EPS .GT. 1.0
+! XMININ - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT
+!          1/XMININ IS MACHINE REPRESENTABLE
+!
+!     APPROXIMATE VALUES FOR SOME IMPORTANT MACHINES ARE:
+!
+!                            BETA       MAXEXP        XBIG
+!
+! CRAY-1         (S.P.)        2         8191        966.961
+! CYBER 180/855
+!   UNDER NOS    (S.P.)        2         1070        177.803
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (S.P.)        2          128        35.040
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (D.P.)        2         1024        171.624
+! IBM 3033       (D.P.)       16           63        57.574
+! VAX D-FORMAT   (D.P.)        2          127        34.844
+! VAX G-FORMAT   (D.P.)        2         1023        171.489
+!
+!                            XINF         EPS        XMININ
+!
+! CRAY-1         (S.P.)   5.45E+2465   7.11E-15    1.84E-2466
+! CYBER 180/855
+!   UNDER NOS    (S.P.)   1.26E+322    3.55E-15    3.14E-294
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (S.P.)   3.40E+38     1.19E-7     1.18E-38
+! IEEE (IBM/XT,
+!   SUN, ETC.)   (D.P.)   1.79D+308    2.22D-16    2.23D-308
+! IBM 3033       (D.P.)   7.23D+75     2.22D-16    1.39D-76
+! VAX D-FORMAT   (D.P.)   1.70D+38     1.39D-17    5.88D-39
+! VAX G-FORMAT   (D.P.)   8.98D+307    1.11D-16    1.12D-308
+!
+!*******************************************************************
+!*******************************************************************
+!
+! ERROR RETURNS
+!
+!  THE PROGRAM RETURNS THE VALUE XINF FOR SINGULARITIES OR
+!     WHEN OVERFLOW WOULD OCCUR.  THE COMPUTATION IS BELIEVED
+!     TO BE FREE OF UNDERFLOW AND OVERFLOW.
+!
+!
+!  INTRINSIC FUNCTIONS REQUIRED ARE:
+!
+!     INT, DBLE, EXP, LOG, REAL, SIN
+!
+!
+! REFERENCES:  AN OVERVIEW OF SOFTWARE DEVELOPMENT FOR SPECIAL
+!              FUNCTIONS   W. J. CODY, LECTURE NOTES IN MATHEMATICS,
+!              506, NUMERICAL ANALYSIS DUNDEE, 1975, G. A. WATSON
+!              (ED.), SPRINGER VERLAG, BERLIN, 1976.
+!
+!              COMPUTER APPROXIMATIONS, HART, ET. AL., WILEY AND
+!              SONS, NEW YORK, 1968.
+!
+!  LATEST MODIFICATION: OCTOBER 12, 1989
+!
+!  AUTHORS: W. J. CODY AND L. STOLTZ
+!           APPLIED MATHEMATICS DIVISION
+!           ARGONNE NATIONAL LABORATORY
+!           ARGONNE, IL 60439
+!
+!----------------------------------------------------------------------
+      implicit none
+      INTEGER I,N
+      LOGICAL PARITY
+      REAL                                                          &
+          CONV,EPS,FACT,HALF,ONE,RES,SUM,TWELVE,                    &
+          TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO
+      REAL, DIMENSION(7) :: C
+      REAL, DIMENSION(8) :: P
+      REAL, DIMENSION(8) :: Q
+!----------------------------------------------------------------------
+!  MATHEMATICAL CONSTANTS
+!----------------------------------------------------------------------
+      DATA ONE,HALF,TWELVE,TWO,ZERO/1.0E0,0.5E0,12.0E0,2.0E0,0.0E0/
+
+
+!----------------------------------------------------------------------
+!  MACHINE DEPENDENT PARAMETERS
+!----------------------------------------------------------------------
+      DATA XBIG,XMININ,EPS/35.040E0,1.18E-38,1.19E-7/,XINF/3.4E38/
+!----------------------------------------------------------------------
+!  NUMERATOR AND DENOMINATOR COEFFICIENTS FOR RATIONAL MINIMAX
+!     APPROXIMATION OVER (1,2).
+!----------------------------------------------------------------------
+      DATA P/-1.71618513886549492533811E+0,2.47656508055759199108314E+1,  &
+             -3.79804256470945635097577E+2,6.29331155312818442661052E+2,  &
+             8.66966202790413211295064E+2,-3.14512729688483675254357E+4,  &
+             -3.61444134186911729807069E+4,6.64561438202405440627855E+4/
+      DATA Q/-3.08402300119738975254353E+1,3.15350626979604161529144E+2,  &
+             -1.01515636749021914166146E+3,-3.10777167157231109440444E+3, &
+              2.25381184209801510330112E+4,4.75584627752788110767815E+3,  &
+            -1.34659959864969306392456E+5,-1.15132259675553483497211E+5/
+!----------------------------------------------------------------------
+!  COEFFICIENTS FOR MINIMAX APPROXIMATION OVER (12, INF).
+!----------------------------------------------------------------------
+      DATA C/-1.910444077728E-03,8.4171387781295E-04,                      &
+           -5.952379913043012E-04,7.93650793500350248E-04,				   &
+           -2.777777777777681622553E-03,8.333333333333333331554247E-02,	   &
+            5.7083835261E-03/
+!----------------------------------------------------------------------
+!  STATEMENT FUNCTIONS FOR CONVERSION BETWEEN INTEGER AND FLOAT
+!----------------------------------------------------------------------
+      CONV(I) = REAL(I)
+      PARITY=.FALSE.
+      FACT=ONE
+      N=0
+      Y=X
+      IF(Y.LE.ZERO)THEN
+!----------------------------------------------------------------------
+!  ARGUMENT IS NEGATIVE
+!----------------------------------------------------------------------
+        Y=-X
+        Y1=AINT(Y)
+        RES=Y-Y1
+        IF(RES.NE.ZERO)THEN
+          IF(Y1.NE.AINT(Y1*HALF)*TWO)PARITY=.TRUE.
+          FACT=-PI/SIN(PI*RES)
+          Y=Y+ONE
+        ELSE
+          RES=XINF
+          GOTO 900
+        ENDIF
+      ENDIF
+!----------------------------------------------------------------------
+!  ARGUMENT IS POSITIVE
+!----------------------------------------------------------------------
+      IF(Y.LT.EPS)THEN
+!----------------------------------------------------------------------
+!  ARGUMENT .LT. EPS
+!----------------------------------------------------------------------
+        IF(Y.GE.XMININ)THEN
+          RES=ONE/Y
+        ELSE
+          RES=XINF
+          GOTO 900
+        ENDIF
+      ELSEIF(Y.LT.TWELVE)THEN
+        Y1=Y
+        IF(Y.LT.ONE)THEN
+!----------------------------------------------------------------------
+!  0.0 .LT. ARGUMENT .LT. 1.0
+!----------------------------------------------------------------------
+          Z=Y
+          Y=Y+ONE
+        ELSE
+!----------------------------------------------------------------------
+!  1.0 .LT. ARGUMENT .LT. 12.0, REDUCE ARGUMENT IF NECESSARY
+!----------------------------------------------------------------------
+          N=INT(Y)-1
+          Y=Y-CONV(N)
+          Z=Y-ONE
+        ENDIF
+!----------------------------------------------------------------------
+!  EVALUATE APPROXIMATION FOR 1.0 .LT. ARGUMENT .LT. 2.0
+!----------------------------------------------------------------------
+        XNUM=ZERO
+        XDEN=ONE
+        DO I=1,8
+          XNUM=(XNUM+P(I))*Z
+          XDEN=XDEN*Z+Q(I)
+        END DO
+        RES=XNUM/XDEN+ONE
+        IF(Y1.LT.Y)THEN
+!----------------------------------------------------------------------
+!  ADJUST RESULT FOR CASE  0.0 .LT. ARGUMENT .LT. 1.0
+!----------------------------------------------------------------------
+          RES=RES/Y1
+        ELSEIF(Y1.GT.Y)THEN
+!----------------------------------------------------------------------
+!  ADJUST RESULT FOR CASE  2.0 .LT. ARGUMENT .LT. 12.0
+!----------------------------------------------------------------------
+          DO I=1,N
+            RES=RES*Y
+            Y=Y+ONE
+          END DO
+        ENDIF
+      ELSE
+!----------------------------------------------------------------------
+!  EVALUATE FOR ARGUMENT .GE. 12.0,
+!----------------------------------------------------------------------
+        IF(Y.LE.XBIG)THEN
+          YSQ=Y*Y
+          SUM=C(7)
+          DO I=1,6
+            SUM=SUM/YSQ+C(I)
+          END DO
+          SUM=SUM/Y-Y+xxx
+          SUM=SUM+(Y-HALF)*LOG(Y)
+          RES=EXP(SUM)
+        ELSE
+          RES=XINF
+          GOTO 900
+        ENDIF
+      ENDIF
+!----------------------------------------------------------------------
+!  FINAL ADJUSTMENTS AND RETURN
+!----------------------------------------------------------------------
+      IF(PARITY)RES=-RES
+      IF(FACT.NE.ONE)RES=FACT/RES
+  900 GAMMA=RES
+      RETURN
+! ---------- LAST LINE OF GAMMA ----------
+      END FUNCTION GAMMA
+
+
+      REAL FUNCTION DERF1(X)
+      IMPLICIT NONE
+      REAL X
+      REAL, DIMENSION(0 : 64) :: A, B
+      REAL W,T,Y
+      INTEGER K,I
+      DATA A/                                                 &
+         0.00000000005958930743E0, -0.00000000113739022964E0, &
+         0.00000001466005199839E0, -0.00000016350354461960E0, &
+         0.00000164610044809620E0, -0.00001492559551950604E0, &
+         0.00012055331122299265E0, -0.00085483269811296660E0, &
+         0.00522397762482322257E0, -0.02686617064507733420E0, &
+         0.11283791670954881569E0, -0.37612638903183748117E0, &
+         1.12837916709551257377E0,	                          &
+         0.00000000002372510631E0, -0.00000000045493253732E0, &
+         0.00000000590362766598E0, -0.00000006642090827576E0, &
+         0.00000067595634268133E0, -0.00000621188515924000E0, &
+         0.00005103883009709690E0, -0.00037015410692956173E0, &
+         0.00233307631218880978E0, -0.01254988477182192210E0, &
+         0.05657061146827041994E0, -0.21379664776456006580E0, &
+         0.84270079294971486929E0,							  &
+         0.00000000000949905026E0, -0.00000000018310229805E0, &
+         0.00000000239463074000E0, -0.00000002721444369609E0, &
+         0.00000028045522331686E0, -0.00000261830022482897E0, &
+         0.00002195455056768781E0, -0.00016358986921372656E0, &
+         0.00107052153564110318E0, -0.00608284718113590151E0, &
+         0.02986978465246258244E0, -0.13055593046562267625E0, &
+         0.67493323603965504676E0, 							  &
+         0.00000000000382722073E0, -0.00000000007421598602E0, &
+         0.00000000097930574080E0, -0.00000001126008898854E0, &
+         0.00000011775134830784E0, -0.00000111992758382650E0, &
+         0.00000962023443095201E0, -0.00007404402135070773E0, &
+         0.00050689993654144881E0, -0.00307553051439272889E0, &
+         0.01668977892553165586E0, -0.08548534594781312114E0, &
+         0.56909076642393639985E0,							  &
+         0.00000000000155296588E0, -0.00000000003032205868E0, &
+         0.00000000040424830707E0, -0.00000000471135111493E0, &
+         0.00000005011915876293E0, -0.00000048722516178974E0, &
+         0.00000430683284629395E0, -0.00003445026145385764E0, &
+         0.00024879276133931664E0, -0.00162940941748079288E0, &
+         0.00988786373932350462E0, -0.05962426839442303805E0, &
+         0.49766113250947636708E0 /
+      DATA (B(I), I = 0, 12) /                                  &
+         -0.00000000029734388465E0,  0.00000000269776334046E0, 	&
+         -0.00000000640788827665E0, -0.00000001667820132100E0,  &
+         -0.00000021854388148686E0,  0.00000266246030457984E0, 	&
+          0.00001612722157047886E0, -0.00025616361025506629E0, 	&
+          0.00015380842432375365E0,  0.00815533022524927908E0, 	&
+         -0.01402283663896319337E0, -0.19746892495383021487E0,  &
+          0.71511720328842845913E0 /
+      DATA (B(I), I = 13, 25) /                                 &
+         -0.00000000001951073787E0, -0.00000000032302692214E0,  &
+          0.00000000522461866919E0,  0.00000000342940918551E0, 	&
+         -0.00000035772874310272E0,  0.00000019999935792654E0, 	&
+          0.00002687044575042908E0, -0.00011843240273775776E0, 	&
+         -0.00080991728956032271E0,  0.00661062970502241174E0, 	&
+          0.00909530922354827295E0, -0.20160072778491013140E0, 	&
+          0.51169696718727644908E0 /
+      DATA (B(I), I = 26, 38) /                                 &
+         0.00000000003147682272E0, -0.00000000048465972408E0,   &
+         0.00000000063675740242E0,  0.00000003377623323271E0, 	&
+        -0.00000015451139637086E0, -0.00000203340624738438E0, 	&
+         0.00001947204525295057E0,  0.00002854147231653228E0, 	&
+        -0.00101565063152200272E0,  0.00271187003520095655E0, 	&
+         0.02328095035422810727E0, -0.16725021123116877197E0, 	&
+         0.32490054966649436974E0 /
+      DATA (B(I), I = 39, 51) /                                 &
+         0.00000000002319363370E0, -0.00000000006303206648E0,   &
+        -0.00000000264888267434E0,  0.00000002050708040581E0, 	&
+         0.00000011371857327578E0, -0.00000211211337219663E0, 	&
+         0.00000368797328322935E0,  0.00009823686253424796E0, 	&
+        -0.00065860243990455368E0, -0.00075285814895230877E0, 	&
+         0.02585434424202960464E0, -0.11637092784486193258E0, 	&
+         0.18267336775296612024E0 /
+      DATA (B(I), I = 52, 64) /                                 &
+        -0.00000000000367789363E0,  0.00000000020876046746E0, 	&
+        -0.00000000193319027226E0, -0.00000000435953392472E0, 	&
+         0.00000018006992266137E0, -0.00000078441223763969E0, 	&
+        -0.00000675407647949153E0,  0.00008428418334440096E0, 	&
+        -0.00017604388937031815E0, -0.00239729611435071610E0, 	&
+         0.02064129023876022970E0, -0.06905562880005864105E0,   &
+         0.09084526782065478489E0 /
+      W = ABS(X)
+      IF (W .LT. 2.2D0) THEN
+          T = W * W
+          K = INT(T)
+          T = T - K
+          K = K * 13
+          Y = ((((((((((((A(K) * T + A(K + 1)) * T +              &
+              A(K + 2)) * T + A(K + 3)) * T + A(K + 4)) * T +     &
+              A(K + 5)) * T + A(K + 6)) * T + A(K + 7)) * T +     &
+              A(K + 8)) * T + A(K + 9)) * T + A(K + 10)) * T + 	  &
+              A(K + 11)) * T + A(K + 12)) * W
+      ELSE IF (W .LT. 6.9D0) THEN
+          K = INT(W)
+          T = W - K
+          K = 13 * (K - 2)
+          Y = (((((((((((B(K) * T + B(K + 1)) * T +               &
+              B(K + 2)) * T + B(K + 3)) * T + B(K + 4)) * T + 	  &
+              B(K + 5)) * T + B(K + 6)) * T + B(K + 7)) * T + 	  &
+              B(K + 8)) * T + B(K + 9)) * T + B(K + 10)) * T + 	  &
+              B(K + 11)) * T + B(K + 12)
+          Y = Y * Y
+          Y = Y * Y
+          Y = Y * Y
+          Y = 1 - Y * Y
+      ELSE
+          Y = 1
+      END IF
+      IF (X .LT. 0) Y = -Y
+      DERF1 = Y
+      END FUNCTION DERF1
+
+!+---+-----------------------------------------------------------------+
+
+      subroutine refl10cm_hm (qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d, &
+                      t1d, p1d, dBZ, kts, kte, ii, jj)
+
+      IMPLICIT NONE
+
+!..Sub arguments
+      INTEGER, INTENT(IN):: kts, kte, ii, jj
+      REAL, DIMENSION(kts:kte), INTENT(IN)::                            &
+                      qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d, t1d, p1d
+      REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ
+
+!..Local variables
+      REAL, DIMENSION(kts:kte):: temp, pres, qv, rho
+      REAL, DIMENSION(kts:kte):: rr, nr, rs, ns, rg, ng
+
+      DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilamg, ilams
+      DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_g, N0_s
+      DOUBLE PRECISION:: lamr, lamg, lams
+      LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg
+
+      REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel
+      DOUBLE PRECISION:: fmelt_s, fmelt_g
+      DOUBLE PRECISION:: cback, x, eta, f_d
+
+      INTEGER:: i, k, k_0, kbot, n
+      LOGICAL:: melti
+
+!+---+
+
+      do k = kts, kte
+         dBZ(k) = -35.0
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Put column of data into local arrays.
+!+---+-----------------------------------------------------------------+
+      do k = kts, kte
+         temp(k) = t1d(k)
+         qv(k) = MAX(1.E-10, qv1d(k))
+         pres(k) = p1d(k)
+         rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622))
+
+         if (qr1d(k) .gt. 1.E-9) then
+            rr(k) = qr1d(k)*rho(k)
+            nr(k) = nr1d(k)*rho(k)
+            lamr = (xam_r*xcrg(3)*xorg2*nr(k)/rr(k))**xobmr
+            ilamr(k) = 1./lamr
+            N0_r(k) = nr(k)*xorg2*lamr**xcre(2)
+            L_qr(k) = .true.
+         else
+            rr(k) = 1.E-12
+            nr(k) = 1.E-12
+            L_qr(k) = .false.
+         endif
+
+         if (qs1d(k) .gt. 1.E-9) then
+            rs(k) = qs1d(k)*rho(k)
+            ns(k) = ns1d(k)*rho(k)
+            lams = (xam_s*xcsg(3)*xosg2*ns(k)/rs(k))**xobms
+            ilams(k) = 1./lams
+            N0_s(k) = ns(k)*xosg2*lams**xcse(2)
+            L_qs(k) = .true.
+         else
+            rs(k) = 1.E-12
+            ns(k) = 1.E-12
+            L_qs(k) = .false.
+         endif
+
+         if (qg1d(k) .gt. 1.E-9) then
+            rg(k) = qg1d(k)*rho(k)
+            ng(k) = ng1d(k)*rho(k)
+            lamg = (xam_g*xcgg(3)*xogg2*ng(k)/rg(k))**xobmg
+            ilamg(k) = 1./lamg
+            N0_g(k) = ng(k)*xogg2*lamg**xcge(2)
+            L_qg(k) = .true.
+         else
+            rg(k) = 1.E-12
+            ng(k) = 1.E-12
+            L_qg(k) = .false.
+         endif
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Locate K-level of start of melting (k_0 is level above).
+!+---+-----------------------------------------------------------------+
+      melti = .false.
+      k_0 = kts
+      do k = kte-1, kts, -1
+         if ( (temp(k).gt.273.15) .and. L_qr(k)                         &
+                                  .and. (L_qs(k+1).or.L_qg(k+1)) ) then
+            k_0 = MAX(k+1, k_0)
+            melti=.true.
+            goto 195
+         endif
+      enddo
+ 195  continue
+
+!+---+-----------------------------------------------------------------+
+!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps)
+!.. and non-water-coated snow and graupel when below freezing are
+!.. simple. Integrations of m(D)*m(D)*N(D)*dD.
+!+---+-----------------------------------------------------------------+
+
+      do k = kts, kte
+         ze_rain(k) = 1.e-22
+         ze_snow(k) = 1.e-22
+         ze_graupel(k) = 1.e-22
+         if (L_qr(k)) ze_rain(k) = N0_r(k)*xcrg(4)*ilamr(k)**xcre(4)
+         if (L_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI)     &
+                                 * (xam_s/900.0)*(xam_s/900.0)          &
+                                 * N0_s(k)*xcsg(4)*ilams(k)**xcse(4)
+         if (L_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/PI)*(6.0/PI)  &
+                                    * (xam_g/900.0)*(xam_g/900.0)       &
+                                    * N0_g(k)*xcgg(4)*ilamg(k)**xcge(4)
+      enddo
+
+!+---+-----------------------------------------------------------------+
+!..Special case of melting ice (snow/graupel) particles.  Assume the
+!.. ice is surrounded by the liquid water.  Fraction of meltwater is
+!.. extremely simple based on amount found above the melting level.
+!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting
+!.. routines).
+!+---+-----------------------------------------------------------------+
+
+      if (melti .and. k_0.ge.kts+1) then
+       do k = k_0-1, kts, -1
+
+!..Reflectivity contributed by melting snow
+          if (L_qs(k) .and. L_qs(k_0) ) then
+           fmelt_s = MAX(0.005d0, MIN(1.0d0-rs(k)/rs(k_0), 0.99d0))
+           eta = 0.d0
+           lams = 1./ilams(k)
+           do n = 1, nrbins
+              x = xam_s * xxDs(n)**xbm_s
+              call rayleigh_soak_wetgraupel (x,DBLE(xocms),DBLE(xobms), &
+                    fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, &
+                    CBACK, mixingrulestring_s, matrixstring_s,          &
+                    inclusionstring_s, hoststring_s,                    &
+                    hostmatrixstring_s, hostinclusionstring_s)
+              f_d = N0_s(k)*xxDs(n)**xmu_s * DEXP(-lams*xxDs(n))
+              eta = eta + f_d * CBACK * simpson(n) * xdts(n)
+           enddo
+           ze_snow(k) = SNGL(lamda4 / (pi5 * K_w) * eta)
+          endif
+
+
+!..Reflectivity contributed by melting graupel
+
+          if (L_qg(k) .and. L_qg(k_0) ) then
+           fmelt_g = MAX(0.005d0, MIN(1.0d0-rg(k)/rg(k_0), 0.99d0))
+           eta = 0.d0
+           lamg = 1./ilamg(k)
+           do n = 1, nrbins
+              x = xam_g * xxDg(n)**xbm_g
+              call rayleigh_soak_wetgraupel (x,DBLE(xocmg),DBLE(xobmg), &
+                    fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, &
+                    CBACK, mixingrulestring_g, matrixstring_g,          &
+                    inclusionstring_g, hoststring_g,                    &
+                    hostmatrixstring_g, hostinclusionstring_g)
+              f_d = N0_g(k)*xxDg(n)**xmu_g * DEXP(-lamg*xxDg(n))
+              eta = eta + f_d * CBACK * simpson(n) * xdtg(n)
+           enddo
+           ze_graupel(k) = SNGL(lamda4 / (pi5 * K_w) * eta)
+          endif
+
+       enddo
+      endif
+
+      do k = kte, kts, -1
+         dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18)
+      enddo
+
+
+      end subroutine refl10cm_hm
+
+!+---+-----------------------------------------------------------------+
+! TWG 2016 Begin Add activation subroutine for prescribed aerosols
+
+  subroutine mdm_prescribed_activate(wbar, tair, rhoair,  &
+                 naero, pmode, nmode, maero, sigman, hygro, rhodry, nact,latvap)
+!      calculates number, surface, and mass fraction of aerosols activated as
+!      CCN
+!      calculates flux of cloud droplets, surface area, and aerosol mass into
+!      cloud
+!      assumes an internal mixture within each of up to pmode multiple aerosol
+!      modes
+!      a gaussiam spectrum of updrafts can be treated.
+
+!      mks units
+
+!      Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+!      2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+      USE module_model_constants, only: svp1,svp2,svp3,ep_2
+
+
+      implicit none
+
+!       save  ! sep6
+
+!      input
+
+      integer pmode,ptype ! dimension of modes, types in modes
+      real wbar          ! grid cell mean vertical velocity (m/s)
+      real tair          ! air temperature (K)
+      real rhoair        ! air density (kg/m3)
+      real naero(pmode)           ! aerosol number concentration (/m3)
+      integer nmode      ! number of aerosol modes
+      real maero(pmode)     ! aerosol mass concentration (kg/m3)
+      real rhodry(pmode) ! density of aerosol material
+      real sigman(pmode)  ! geometric standard deviation of aerosol size distribution
+      real hygro(pmode)  ! hygroscopicity of aerosol mode
+
+
+!      output
+
+      real nact      ! number fraction of aerosols activated
+
+!      local
+!      real derf,derfc, erf_alt
+      integer, parameter:: nx=200
+      integer :: maxmodes
+
+      real p0     ! reference pressure (Pa)
+      data p0/1013.25e2/
+      save p0
+
+      real :: volc(naer_cu) ! total aerosol volume  concentration (m3/m3)
+      real tmass ! total aerosol mass concentration (g/cm3)
+      real rm ! number mode radius of aerosol at max supersat (cm)
+      real pres ! pressure (Pa)
+      real path ! mean free path (m)
+      real diff ! diffusivity (m2/s)
+      real conduct ! thermal conductivity (Joule/m/sec/deg)
+      real diff0,conduct0
+      real qs ! water vapor saturation mixing ratio
+      real dqsdt ! change in qs with temperature
+      real dqsdp ! change in qs with pressure
+      real gloc ! thermodynamic function (m2/s)
+      real zeta
+      real  :: eta(naer_cu)
+      real :: smc(naer_cu)
+      real lnsmax ! ln(smax)
+      real alpha_cesm
+      real gammaloc
+      real beta
+      real sqrtg
+      real alogam
+      real rlo,rhi,xint1,xint2,xint3,xint4
+      real w,wnuc,wb
+      real alw,sqrtalw
+      real smax
+      real x,arg
+      real xmincoeff,xcut,volcut,surfcut
+      real z,z1,z2,wf1,wf2,zf1,zf2,gf1,gf2,gf
+      real :: etafactor1,etafactor2max
+      real :: etafactor2(naer_cu)
+      real es
+      real latvap
+      integer m,n
+
+      real :: amcubeloc(naer_cu)
+      real :: lnsmloc(naer_cu)
+      maxmodes = naer_cu
+
+
+      nact=0.
+
+      !print*,'Doing MSKF-AERO Activation MDM'
+
+      if(nmode.eq.1.and.naero(1).lt.1.e-20)return
+
+      if(wbar.le.0.)return
+
+      pres=R*rhoair*tair
+      diff0=0.211e-4*(p0/pres)*(tair/t0)**1.94
+      conduct0=(5.69+0.017*(tair-t0))*4.186e2*1.e-5 ! convert to J/m/s/deg
+      es=1000.*svp1*exp( svp2*(tair-t0)/(tair-svp3) )
+      qs=ep_2*es/(pres-es)
+      dqsdt=latvap/(RV*tair*tair)*qs
+      alpha_cesm=G*(latvap/(CP*RV*tair*tair)-1./(R*tair))
+      gammaloc=(1+latvap/CP*dqsdt)/(rhoair*qs)
+!    growth coefficent Abdul-Razzak & Ghan 1998 eqn 16
+!     should depend on mean radius of mode to account for gas kinetic effects
+      gloc=1./(RHOW/(diff0*rhoair*qs)                                    &
+          +latvap*RHOW/(conduct0*tair)*(latvap/(RV*tair)-1.))
+      sqrtg=sqrt(gloc)
+      beta=4.*pi*RHOW*gloc*gammaloc
+      etafactor2max=1.e10/(alpha_cesm*wbar)**1.5 ! this should make eta big if na is very small.
+
+      do m=1,nmode
+!         internal mixture of aerosols
+          volc(m)=maero(m)/(rhodry(m)) ! only if variable size dist
+         if(volc(m).gt.1.e-39.and.naero(m).gt.1.e-39)then
+            etafactor2(m)=1./(naero(m)*beta*sqrtg)  !fixed or variable size dist
+!            number mode radius (m)
+            amcubeloc(m)=(3.*volc(m)/(4.*pi*exp45logsig_pamdm(m)*naero(m)))  !only if variable size dist
+            smc(m)=smcrit_pamdm(m) ! only for prescribed size dist
+
+!danger ??
+!May30,2014
+
+                 if(hygro(m).gt.1.e-10)then   ! loop only if variable size dist
+                    smc(m)=2.*aten_pamdm*sqrt(aten_pamdm/(27.*hygro(m)*amcubeloc(m)))
+                 else
+                   smc(m)=100.
+                 endif
+
+         else
+            smc(m)=1.
+            etafactor2(m)=etafactor2max ! this should make eta big if na is very small.
+         endif
+         lnsmloc(m)=log(smc(m)) ! only if variable size dist
+      enddo
+
+!         single  updraft
+         wnuc=wbar
+
+            w=wbar
+            alw=alpha_cesm*wnuc
+            sqrtalw=sqrt(alw)
+            zeta=2.*sqrtalw*aten_pamdm/(3.*sqrtg)
+            etafactor1=2.*alw*sqrtalw
+
+            do m=1,nmode
+               eta(m)=etafactor1*etafactor2(m)
+            enddo
+
+            call mdm_prescribed_maxsat(zeta,eta,nmode,smc,smax)
+
+            lnsmax=log(smax)
+            xmincoeff=alogaten_pamdm-2.*third_pamdm*(lnsmax-alog2_pamdm)-alog3_pamdm
+
+            nact=0.
+            do m=1,nmode
+               x=2*(lnsmloc(m)-lnsmax)/(3*sq2_pamdm*alogsig_pamdm(m))
+                nact=nact+0.5*(1.-DERF1(x))*naero(m)  ! danger erf
+            enddo
+            nact=nact/rhoair ! convert from #/m3 to #/kg
+
+      return
+end subroutine mdm_prescribed_activate
+
+subroutine mdm_prescribed_maxsat(zeta,eta,nmode,smc,smax)
+
+!      calculates maximum supersaturation for multiple
+!      competing aerosol modes.
+
+!      Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+!      2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+      implicit none
+!       save ! sep6
+      integer nmode ! number of modes
+      real :: smc(:) ! critical supersaturation for number mode radius
+      real zeta
+      real :: eta(:)
+      real smax ! maximum supersaturation
+      integer m  ! mode index
+      real sum, g1, g2
+
+      do m=1,nmode
+         if(zeta.gt.1.e5*eta(m).or.smc(m)*smc(m).gt.1.e5*eta(m))then
+!            weak forcing. essentially none activated
+            smax=1.e-20
+         else
+!            significant activation of this mode. calc activation all modes.
+            go to 1
+         endif
+      enddo
+
+      return
+
+  1   continue
+
+      sum=0
+      do m=1,nmode
+         if(eta(m).gt.1.e-20)then
+            g1=sqrt(zeta/eta(m))
+            g1=g1*g1*g1
+            g2=smc(m)/sqrt(eta(m)+3*zeta)
+            g2=sqrt(g2)
+            g2=g2*g2*g2
+            sum=sum+(f1_pamdm(m)*g1+f2_pamdm(m)*g2)/(smc(m)*smc(m))
+
+         else
+            sum=1.e20
+         endif
+      enddo
+
+      smax=1./sqrt(sum)
+
+      return
+
+      end subroutine mdm_prescribed_maxsat
+
+subroutine mdm_prescribed_nucleati(wbar, tair, relhum,  qc,  rhoair, &
+       naero,  naer_all, nuci  &
+       , onihf, oniimm, onidep, onimey)
+
+!---------------------------------------------------------------
+! Purpose:
+!  The parameterization of ice nucleation.
+!
+! Method: The current method is based on Liu & Penner (2005)
+!  It related the ice nucleation with the aerosol number, temperature and the
+!  updraft velocity. It includes homogeneous freezing of sulfate, immersion
+!  freezing of soot, and Meyers et al. (1992) deposition nucleation
+!
+! Authors: Xiaohong Liu, 01/2005, modifications by A. Gettelman 2009-2010
+!----------------------------------------------------------------
+! Input Arguments
+!
+!     save   ! sep6
+  integer  naer_all
+  real :: wbar                ! grid cell mean vertical velocity (m/s)
+  real :: tair                ! temperature (K)
+  real :: relhum              ! relative humidity with respective to liquid
+
+  real :: qc                  ! liquid water mixing ratio (kg/kg)
+  real :: rhoair              ! air density (kg/m3)
+  real :: naero(naer_all)        ! aerosol number concentration (/m3)
+
+!
+! Output Arguments
+!
+  real :: nuci               ! ice number nucleated (#/kg)
+  real :: onihf              ! nucleated number from homogeneous freezing of so4
+  real :: oniimm             ! nucleated number from immersion freezing
+  real :: onidep             ! nucleated number from deposition nucleation
+  real :: onimey             ! nucleated number from deposition nucleation (meyers: mixed phase)
+
+!
+! Local workspace
+!
+  real  so4_num                                      ! so4 aerosol number(#/cm^3)
+  real  soot_num                                     ! soot (hydrophilic) aerosol number (#/cm^3)
+  real  dst1_num,dst2_num,dst3_num,dst4_num          ! dust aerosol number (#/cm^3)
+  real  dst_num                                      ! total dust aerosol number (#/cm^3)
+  real  nihf                                         ! nucleated number from homogeneous freezing of so4
+  real  niimm                                        ! nucleated number from immersion freezing
+  real  nidep                                        ! nucleated number from deposition nucleation
+  real  nimey                                        ! nucleated number from deposition nucleation (meyers)
+  real  n1,ni                                        ! nucleated number
+  real tc,A,B,C,regm                                ! work variable
+  real  esl,esi,deles                                ! work variable
+  real  dst_scale
+  real  subgrid
+  real  dmc,ssmc         ! variables for modal scheme.
+
+
+    !print*,'Doing MSKF Aerosol Ice Nucleation MDM'
+
+    so4_num=0.0
+    soot_num=0.0
+    dst_num=0.0
+    dst1_num = 0.0
+    dst2_num = 0.0
+    dst3_num = 0.0
+    dst4_num = 0.0
+
+!For modal aerosols, assume for the upper troposphere:
+! soot = accumulation mode
+! sulfate = aiken mode
+! dust = coarse mode
+! since modal has internal mixtures.
+
+      so4_num=naero(1)*1.0e-6 ! #/cm^3
+      soot_num=naero(10)*1.0e-6 !#/cm^3
+      dst1_num=naero(3)*1.0e-6 !#/cm^3
+      dst2_num=naero(4)*1.0e-6 !#/cm^3
+      dst3_num=naero(5)*1.0e-6 !#/cm^3
+      dst4_num=naero(6)*1.0e-6 !#/cm^3
+
+    dst_num =dst1_num+dst2_num+dst3_num+dst4_num
+! no soot nucleation for now.
+!    soot_num=0.0
+
+    ni=0.
+    tc=tair-273.15
+
+    ! initialize
+    niimm=0.
+    nidep=0.
+    nihf=0.
+
+    if(so4_num.ge.1.0e-10 .and. (soot_num+dst_num).ge.1.0e-10 ) then
+
+      subgrid = 1.2
+
+  if((tc.le.-35.0).and.((relhum*mdm_prescribed_polysvp(tair,0)/mdm_prescribed_polysvp(tair,1) &
+   *subgrid).ge.1.2))then
+!< regm => T in Eq.10 of Liu et al., J. Climate, 2007>
+       A = -1.4938 * log(soot_num+dst_num) + 12.884
+       B = -10.41  * log(soot_num+dst_num) - 67.69
+       regm = A * log(wbar) + B
+
+       if(tc.gt.regm) then    ! heterogeneous nucleation only
+         if(tc.lt.-40. .and. wbar.gt.1.) then ! exclude T<-40 & W>1m/s from hetero. nucleation
+           call mdm_prescribed_hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+           niimm=0.
+           nidep=0.
+           n1=nihf
+         else
+           call mdm_prescribed_hetero(tc,wbar,soot_num+dst_num,niimm,nidep)
+           nihf=0.
+           n1=niimm+nidep
+         endif
+       elseif (tc.lt.regm-5.) then ! homogeneous nucleation only
+         call mdm_prescribed_hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+         niimm=0.
+         nidep=0.
+         n1=nihf
+       else        ! transition between homogeneous and heterogeneous: interpolate in-between
+         if(tc.lt.-40. .and. wbar.gt.1.) then ! exclude T<-40 & W>1m/s from hetero. nucleation
+           call mdm_prescribed_hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+           niimm=0.
+           nidep=0.
+           n1=nihf
+         else
+           call mdm_prescribed_hf(regm-5.,wbar,relhum,subgrid,so4_num,nihf)
+           call mdm_prescribed_hetero(regm,wbar,soot_num+dst_num,niimm,nidep)
+           if(nihf.le.(niimm+nidep)) then
+             n1=nihf
+           else
+             n1=(niimm+nidep)*((niimm+nidep)/nihf)**((tc-regm)/5.)
+           endif
+         endif
+       endif
+
+     ni=n1
+
+    endif
+    endif
+1100  continue
+
+! deposition/condensation nucleation in mixed clouds (-37<T<0C) (Meyers, 1992)
+!<Eq.12 of Liu et al., J. Climate, 2007
+! Nid(L-1)*1.e-3 => Nid(m-3)
+! Question:  RHi=RHw*esl/esi
+
+    if(tc.lt.0. .and. tc.gt.-37. .and. qc.gt.1.e-12) then
+      esl = mdm_prescribed_polysvp(tair,0)     ! over water in mixed clouds
+      esi = mdm_prescribed_polysvp(tair,1)     ! over ice
+      deles = (esl - esi)
+!      deles = (relhum*esl - esi) TWG use original formulation
+      nimey=1.e-3*exp(12.96*deles/esi - 0.639)
+    else
+      nimey=0.
+    endif
+
+    nuci=ni+nimey
+    if(nuci.gt.9999..or.nuci.lt.0.) then
+       write(*, *) 'incorrect ice nucleation number'
+       write(*, *) ni, tair, relhum, wbar, nihf,niimm,nidep,deles,esi,dst2_num,dst3_num,dst4_num
+       nuci=0.
+         stop 'nuclei prbolem?'
+    endif
+
+    nuci=nuci*1.e+6/rhoair    ! change unit from #/cm3 to #/kg
+    onimey=nimey*1.e+6/rhoair
+    onidep=nidep*1.e+6/rhoair
+    oniimm=niimm*1.e+6/rhoair
+    onihf=nihf*1.e+6/rhoair
+
+  return
+  end subroutine mdm_prescribed_nucleati
+
+subroutine mdm_prescribed_hetero(T,ww,Ns,Nis,Nid)
+
+    real :: T, ww, Ns
+    real :: Nis, Nid
+
+    real A11,A12,A21,A22,B11,B12,B21,B22
+    real A,B,C
+
+!     save    ! spe6
+!---------------------------------------------------------------------
+! parameters
+
+      A11 = 0.0263
+      A12 = -0.0185
+      A21 = 2.758
+      A22 = 1.3221
+      B11 = -0.008
+      B12 = -0.0468
+      B21 = -0.2667
+      B22 = -1.4588
+!<Eq.11 of Liu et al., J. Climate, 2007>
+!     ice from immersion nucleation (cm-3)
+
+      B = (A11+B11*log(Ns)) * log(ww) + (A12+B12*log(Ns))
+      C =  A21+B21*log(Ns)
+
+      Nis = exp(A22) * Ns**B22 * exp(B*T) * ww**C
+      Nis = min(Nis,Ns)
+      Nid = 0.0    ! don't include deposition nucleation for cirrus clouds when T<-37C
+      return
+  end subroutine mdm_prescribed_hetero
+
+ subroutine mdm_prescribed_hf(T,ww,RH,subgrid,Na,Ni)
+
+      real :: T, ww, RH, subgrid, Na
+      real, intent(out) :: Ni
+
+      real    A1_fast,A21_fast,A22_fast,B1_fast,B21_fast,B22_fast
+      real    A2_fast,B2_fast
+      real    C1_fast,C2_fast,k1_fast,k2_fast
+      real    A1_slow,A2_slow,B1_slow,B2_slow,B3_slow
+      real    C1_slow,C2_slow,k1_slow,k2_slow
+      real    regm
+      real    A,B,C
+      real    RHw
+
+!---------------------------------------------------------------------
+!<Table 1 of  Liu et al., J. Climate, 2007>
+! parameters
+
+      A1_fast  =0.0231
+      A21_fast =-1.6387  !(T>-64 deg)
+      A22_fast =-6.045   !(T<=-64 deg)
+      B1_fast  =-0.008
+      B21_fast =-0.042   !(T>-64 deg)
+      B22_fast =-0.112   !(T<=-64 deg)
+      C1_fast  =0.0739
+      C2_fast  =1.2372
+
+      A1_slow  =-0.3949
+      A2_slow  =1.282
+      B1_slow  =-0.0156
+      B2_slow  =0.0111
+      B3_slow  =0.0217
+      C1_slow  =0.120
+      C2_slow  =2.312
+
+      Ni = 0.0
+
+!----------------------------
+!<Eq.6 of Liu et al., J. Climate, 2007 
+! w~m/s, T~degree C, RHw~% => RHw*0.01~fraction  >
+!RHw xiaohong's parameter
+      A = 6.0e-4*log(ww)+6.6e-3
+      B = 6.0e-2*log(ww)+1.052
+      C = 1.68  *log(ww)+129.35
+      RHw=(A*T*T+B*T+C)*0.01
+
+      if((T.le.-37.0) .and. ((RH*subgrid).ge.RHw)) then
+
+!<Eq.9 of Liu et al., J. Climate, 2007>
+        regm = 6.07*log(ww)-55.0
+
+        if(T.ge.regm) then    ! fast-growth regime
+
+          if(T.gt.-64.0) then
+            A2_fast=A21_fast
+            B2_fast=B21_fast
+          else
+            A2_fast=A22_fast
+            B2_fast=B22_fast
+          endif
+
+!<Eq.7 of Liu et al., J. Climate, 2007> 
+          k1_fast = exp(A2_fast + B2_fast*T + C2_fast*log(ww))
+          k2_fast = A1_fast+B1_fast*T+C1_fast*log(ww)
+
+          Ni = k1_fast*Na**(k2_fast)
+          Ni = min(Ni,Na)
+        else       ! slow-growth regime
+!<Eq.7 of Liu et al., J. Climate, 2007>
+          k1_slow = exp(A2_slow + (B2_slow+B3_slow*log(ww))*T + C2_slow*log(ww))
+          k2_slow = A1_slow+B1_slow*T+C1_slow*log(ww)
+
+          Ni = k1_slow*Na**(k2_slow)
+          Ni = min(Ni,Na)
+        endif
+      end if
+
+      return
+  end subroutine mdm_prescribed_hf
+
+     function mdm_prescribed_polysvp (T,type)
+!  Compute saturation vapor pressure by using
+! function from Goff and Gatch (1946)
+
+!  Polysvp returned in units of pa.
+!  T is input in units of K.
+!  type refers to saturation with respect to liquid (0) or ice (1)
+
+      real dum
+
+      real T,mdm_prescribed_polysvp
+
+      integer type
+
+! ice
+
+      if (type.eq.1) then
+
+! Goff Gatch equation (good down to -100 C)
+
+         mdm_prescribed_polysvp = 10.**(-9.09718*(273.16/t-1.)-3.56654* &
+          log10(273.16/t)+0.876793*(1.-t/273.16)+ &
+          log10(6.1071))*100.
+
+      end if
+
+
+! Goff Gatch equation, uncertain below -70 C
+
+      if (type.eq.0) then
+         mdm_prescribed_polysvp = 10.**(-7.90298*(373.16/t-1.)+ &
+             5.02808*log10(373.16/t)- &
+             1.3816e-7*(10.**(11.344*(1.-t/373.16))-1.)+ &
+             8.1328e-3*(10.**(-3.49149*(373.16/t-1.))-1.)+ &
+             log10(1013.246))*100.
+         end if
+
+
+      end function mdm_prescribed_polysvp
+
+!TWG 2016 END
+END MODULE module_mp_morr_two_moment_aero
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F
index e84d73e..65c8f0c 100644
--- a/phys/module_physics_init.F
+++ b/phys/module_physics_init.F
@@ -81,9 +81,9 @@ CONTAINS
                          NUM_URBAN_LAYERS,                       &
                          NUM_URBAN_HI,                           &
                          raincv_a,raincv_b,                      &
-                         gd_cloud,gd_cloud2,                     &    ! Optional
-                         gd_cloud_a,gd_cloud2_a,                 &    ! Optional
-                         QC_CU,QI_CU,                            &    ! Optional
+                         gd_cloud,gd_cloud2,                     & 
+                         gd_cloud_a,gd_cloud2_a,                 &
+                         QC_CU,QI_CU,                            &
                          ozmixm,pin,                             &    ! Optional
                          aerodm,pina,                            &    ! Optional
                          m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ! Optional
@@ -225,7 +225,12 @@ CONTAINS
                          ,G_URB2D_mosaic,RN_URB2D_mosaic                                                      & ! danli mosaic 
                          ,TS_URB2D_mosaic                                                                     & ! danli mosaic 
                          ,TS_RUL2D_mosaic                                                                     & ! danli mosaic
-                         )
+#if ( EM_CORE == 1 )
+                         ,QR_CU,QS_CU,NC_CU,NI_CU,NR_CU,NS_CU,CCN_CU              & ! TWG
+                         ,alevsiz_cu,num_months,no_src_types_cu,aeromcu,aeropcu   & ! PSH/TWG 06/10/16                         
+                         ,EFCG,EFCS,EFIG,EFIS,EFSG                                & ! TWG
+#endif
+                          )
 
 !-----------------------------------------------------------------
    USE module_domain
@@ -273,6 +278,22 @@ CONTAINS
    REAL,  DIMENSION( ims:ime, alevsiz, jms:jme, n_ozmixm-1, no_src_types ), OPTIONAL, &
           INTENT(INOUT) ::                                  aerodm
 
+#if ( EM_CORE == 1 )
+  !PSH/TWG 06/10/16
+   INTEGER,      INTENT(IN   )    ::   alevsiz_cu, num_months, no_src_types_cu !PSH/TWG 06/10/16
+   REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months, no_src_types_cu), OPTIONAL, &
+          INTENT(INOUT) ::                                  aeromcu 
+   REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months), OPTIONAL,INTENT(INOUT)  :: aeropcu 
+
+   REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,         &
+          OPTIONAL, INTENT(INOUT   ) ::                              &
+                               QR_CU, QS_CU,                         & !TWG
+                               NC_CU, NI_CU, NR_CU, NS_CU,           & !TWG
+                               CCN_CU, EFCG, EFCS, EFIG,             & !TWG
+                               EFIS, EFSG
+  !PSH/TWG END
+#endif
+
    REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(INOUT)  ::        PIN
    REAL,  DIMENSION(alevsiz), OPTIONAL, INTENT(INOUT)  ::       PINA
 
@@ -419,10 +440,8 @@ CONTAINS
    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT),OPTIONAL :: TDLY
    REAL,     DIMENSION( ims:ime , 1:lagday , jms:jme ) , INTENT(INOUT),OPTIONAL :: TLAG
 
-
    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,         &
-          OPTIONAL,                                                  &
-          INTENT(INOUT   ) ::                                        &
+          OPTIONAL, INTENT(INOUT   ) ::                              &
                                gd_cloud, gd_cloud2,                  &
                                gd_cloud_a, gd_cloud2_a,              &
                                QC_CU, QI_CU
@@ -433,7 +452,6 @@ CONTAINS
 
 !Noah-MP
 
-
    INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: ISNOWXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,-2:num_soil_layers, jms:jme) :: ZSNSOXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,-2:0, jms:jme) :: TSNOXY
@@ -720,6 +738,9 @@ CONTAINS
    INTEGER :: mfshconv
    INTEGER :: icloud_cu
    INTEGER :: iopt_run
+   INTEGER :: aercu_opt !PSH/TWG 
+   REAL    :: aercu_fct !PSH/TWG 
+
 
    INTEGER :: i, j, k, itf, jtf, ktf, n
 integer myproc
@@ -755,6 +776,8 @@ integer myproc
    
 !-----------------------------------------------------------------
 
+   aercu_opt=config_flags%aercu_opt !PSH/TWG 06/10/16
+   aercu_fct=config_flags%aercu_fct !PSH/TWG 06/10/16
    sf_urban_physics=config_flags%sf_urban_physics
    usemonalb=config_flags%usemonalb
    rdmaxalb=config_flags%rdmaxalb
@@ -865,9 +888,44 @@ integer myproc
       END IF
    END IF
 #if (EM_CORE == 1)
-   IF ( config_flags%cu_physics == mskfscheme ) THEN
+   IF ( config_flags%cu_physics == mskfscheme) THEN
         icloud_cu = 2
    END IF
+
+!--------------------INPUT FOR AEROSOL DATA-----------------------
+!-----------------------------PSH/TWG-----------------------------
+   IF ( aercu_opt .GT. 0 .AND. id .EQ. 1 ) THEN
+      CALL aerosol_in_cu(aeromcu,alevsiz_cu,num_months,no_src_types_cu,XLAT,XLONG,aeropcu,&
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte)
+   ENDIF
+!-----------------------------PSH/TWG-----------------------------
+
+! Initialize Cumulus Hydrometeors
+    if (config_flags%aercu_opt == 1 )then
+     do j=jts,jtf
+       do k=kts,ktf
+          do i=its,itf
+            QC_CU(i,k,j) = 0.
+            QI_CU(i,k,j) = 0.
+            QR_CU(i,k,j) = 0.
+            QS_CU(i,k,j) = 0.
+            NC_CU(i,k,j) = 0.
+            NI_CU(i,k,j) = 0.
+            NR_CU(i,k,j) = 0.
+            NS_CU(i,k,j) = 0.
+            CCN_CU(i,k,j) = 0.
+            EFCG(i,k,j) = 2.51
+            EFCS(i,k,j) = 2.51
+            EFIS(i,k,j) = 5.01
+            EFIG(i,k,j) = 5.01
+            EFSG(i,k,j) = 10.01
+          end do
+       end do
+     end do
+    endif
+
 #endif
    CALL nl_set_icloud_cu ( id , icloud_cu )
 
@@ -1264,7 +1322,12 @@ integer myproc
                 ids, ide, jds, jde, kds, kde,                   &
                 ims, ime, jms, jme, kms, kme,                   &
                 its, ite, jts, jte, kts, kte,                   &
-                RQCNCUTEN,RQINCUTEN                            ) 
+                RQCNCUTEN,RQINCUTEN                             &
+#if ( EM_CORE == 1 )
+                ,aeromcu,alevsiz_cu,no_src_types_cu,num_months  &!PSH/TWG 06/10/16
+                ,aercu_opt,aercu_fct,id,XLAT,XLONG,aeropcu      &!PSH/TWG 06/10/16   
+#endif
+                                                                )
 
    CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to shcu_init' )
 
@@ -3279,7 +3342,12 @@ CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_fla
                       ids, ide, jds, jde, kds, kde,                &
                       ims, ime, jms, jme, kms, kme,                &
                       its, ite, jts, jte, kts, kte,                &
-                      RQCNCUTEN,RQINCUTEN                          )                        
+                      RQCNCUTEN,RQINCUTEN                          &
+#if ( EM_CORE == 1 )
+                      ,aeromcu,alevsiz_cu,no_src_types_cu,num_months &!PSH/TWG 06/10/16
+                      ,aercu_opt,aercu_fct,id,XLAT,XLONG,aeropcu     &!PSH/TWG 06/10/16
+#endif
+                                                                   )
 !------------------------------------------------------------------
    USE module_cu_kf
    USE module_cu_kfeta
@@ -3303,7 +3371,6 @@ CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_fla
    TYPE (grid_config_rec_type) ::     config_flags
    LOGICAL , INTENT(IN)        :: restart
 
-
    INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
                                   ims, ime, jms, jme, kms, kme,   &
                                   its, ite, jts, jte, kts, kte
@@ -3322,7 +3389,19 @@ CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_fla
         cldfra_cup,cldfratend_cup                               !CuP, wig 18-Sep-2006
    !BSINGH -ENDS
 #endif
-   
+
+#if ( EM_CORE == 1 )
+!PSH/TWG 06/10/16
+   INTEGER,  INTENT(IN)        ::   id
+   INTEGER,  INTENT(IN)        ::   alevsiz_cu, no_src_types_cu, num_months
+   INTEGER,  INTENT(IN)        ::   aercu_opt
+   REAL,     INTENT(IN)        ::   aercu_fct
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::  XLAT, XLONG
+   REAL,     DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months,no_src_types_cu), OPTIONAL,      &
+                        INTENT(INOUT) :: aeromcu                       
+   REAL,     DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months), OPTIONAL,INTENT(INOUT)  ::   aeropcu
+!PSU/TWG END
+#endif
 
    REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &    
                         cugd_tten,cugd_ttens,cugd_qvten,            &    
@@ -3673,6 +3752,7 @@ CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_fla
    USE module_mp_nssl_2mom
 #if (EM_CORE==1)
    USE module_mp_cammgmp_driver, ONLY:CAMMGMP_INIT !CAM5's microphysics
+   USE module_mp_morr_two_moment_aero              !TWG2017
 #endif
 !------------------------------------------------------------------
    IMPLICIT NONE
@@ -3817,6 +3897,12 @@ CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_fla
          CALL p3_init('./p3_lookup_table_1.dat','./p3_lookup_table_2.dat',1)
      CASE (P3_1CATEGORY_NC)
          CALL p3_init('./p3_lookup_table_1.dat','./p3_lookup_table_2.dat',1)
+#if (EM_CORE==1)
+!TWG Add Morrison Aerosol Option
+     CASE (MORR_TM_AERO)
+         CALL morr_two_moment_init_aero( config_flags%hail_opt )
+!END TWG
+#endif
      CASE (MILBRANDT2MOM)
          CALL milbrandt2mom_init
 !      CASE (MILBRANDT3MOM)
@@ -4628,4 +4714,233 @@ END SUBROUTINE aerosol_in
   return
   end subroutine interp_vec
 
+!!--------------------START   PSH/TWG   CHANGES-----------------------
+!--------------------INPUT FOR AEROSOL DATA---------------------------
+subroutine aerosol_in_cu(aeromcu,alevsiz,no_months,no_src_types,XLAT,XLONG,aeropcu, &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte)
+!
+! This module was taken from the radiation driver and modified for the
+! cumulus aerosol input. - PSH
+!
+  use netcdf !PSH
+   IMPLICIT NONE
+
+   INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde, &
+                                       ims,ime, jms,jme, kms,kme, &
+                                       its,ite, jts,jte, kts,kte
+
+   INTEGER,      INTENT(IN   )    ::   alevsiz, no_months, no_src_types
+
+   REAL,  DIMENSION( ims:ime, jms:jme ), INTENT(IN   )  ::     XLAT, XLONG
+
+   INTEGER :: i, j, k, itf, jtf, ktf, m, pin_unit, lat_unit,lon_unit,od_unit,ks,il, jl
+   INTEGER :: ilon1cu, ilon2cu, jlat1cu, jlat2cu
+   REAL    :: interp_ptcu, interp_pt_latcu, interp_pt_loncu,wlat1cu,wlat2cu,wlon1cu,wlon2cu
+   CHARACTER*256 :: message
+
+   integer                               :: ncId, lonID, latID, levID, &
+                                            lonDimID, latDimId, timeDimId, &
+                                            numLons, numLats, numLevs,    &
+                                            ncfcode, &
+                                            varID
+
+   REAL,  DIMENSION( ims:ime, alevsiz, jms:jme, no_months, no_src_types ),&
+          INTENT(OUT   ) ::                                  aeromcu !PSH
+   REAL,  DIMENSION( ims:ime, alevsiz, jms:jme, no_months), OPTIONAL, &
+   INTENT(OUT)  :: aeropcu !PSH
+   integer, dimension(nf90_max_var_dims) :: dimIDs
+   real, dimension(:, :, :, :, :), allocatable  :: aeroin !PSH
+   real, dimension(:, :, :, :), allocatable  :: aeropin !PSH
+   CHARACTER (len=10), dimension(no_src_types) :: species !PSH
+   CHARACTER (len=100) :: fname !PSH
+   CHARACTER (len=8) :: frmt !PSH
+   CHARACTER (len=2) :: mons !PSH
+   integer :: v, mi !PSH
+   REAL, dimension(:), ALLOCATABLE :: lon_aer, lat_aer !, lev_aer !PSH
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+! - - - - SPECIES OF INTEREST - - - - -
+   species = (/"DUST1   ","DUST2   ","DUST3   ","DUST4   ","SEASALT2", &
+               "SULFATE ","BCPHO   ","BCPHI   ","OCPHO   ","OCPHI   "/)
+   frmt = '(I0.2)'
+
+!------ OPEN AEROSOL NETCDF FILE ------
+    ncfcode = nf90_open("./CESM_RCP4.5_Current_Aerosol_Data_01.nc",nf90_nowrite,ncid )
+    if(ncfcode /= nf90_NoErr) call handle_err(ncfcode)
+
+!------- GET DIMENSIONS OF VARS -------
+!    AEROSOL DATA IS (LON, LAT, LEVEL)
+   ncfcode = nf90_inq_varid(ncid, TRIM(species(1)), varID)
+   if(ncfcode /= nf90_NoErr) call handle_err(ncfcode)
+   ncfcode = nf90_inquire_variable(ncid, varID, dimids = dimIDs)
+   if(ncfcode /= nf90_NoErr) call handle_err(ncfcode)
+   ncfcode = nf90_inquire_dimension(ncid, dimIDs(1), len = numLons)
+   if(ncfcode /= nf90_NoErr) call handle_err(ncfcode)
+   ncfcode = nf90_inquire_dimension(ncid, dimIDs(2), len = numLats)
+   if(ncfcode /= nf90_NoErr) call handle_err(ncfcode)
+   ncfcode = nf90_inquire_dimension(ncid, dimIDs(3), len = numLevs)
+   if(ncfcode /= nf90_NoErr) call handle_err(ncfcode)
+
+!---------- ALLOCATE VARIABLES --------
+   allocate(aeroin(numLons, numLats, numLevs, no_months, no_src_types))
+   allocate(aeropin(numLons, numLats, numLevs, no_months))
+   allocate(lon_aer(numLons))
+   allocate(lat_aer(numLats))
+
+!--------- GET LAT, LON, LEV ----------
+   ncfcode = nf90_inq_varid(ncid, "lon", varID)
+   if(ncfcode /= nf90_NoErr) call handle_err(12)
+   ncfcode = nf90_get_var (ncid, varID, lon_aer )
+   if(ncfcode /= nf90_NoErr) call handle_err(13)
+!Need lon to be from -180 to 180:
+   if(maxval(lon_aer) > 180.0) then
+     do i = 1,numLons
+       if(lon_aer(i) > 180) then
+         lon_aer(i) = lon_aer(i) - 360.0
+       end if
+     end do
+   end if
+   ncfcode = nf90_inq_varid(ncid, "lat", varID)
+   if(ncfcode /= nf90_NoErr) call handle_err(14)
+   ncfcode = nf90_get_var (ncid, varID, lat_aer )
+   if(ncfcode /= nf90_NoErr) call handle_err(15)
+
+!------- LOOP TO GET ALL MONTHS -------
+   do mi = 1, no_months
+!------ OPEN AEROSOL NETCDF FILE ------
+     WRITE (mons,frmt) mi
+     fname = './CESM_RCP4.5_Current_Aerosol_Data_'//TRIM(mons)//'.nc'
+     ncfcode = nf90_open (TRIM(fname), nf90_nowrite, ncid )
+     if(ncfcode /= nf90_NoErr) call handle_err(1)
+!--- LOOP TO GET ALL PRES FOR MONTH ---
+     ncfcode = nf90_inq_varid(ncid, "Pressure", varID)
+     if(ncfcode /= nf90_NoErr) call handle_err(14)
+     ncfcode = nf90_get_var (ncid, varID, aeropin(:,:,:,mi))
+     if(ncfcode /= nf90_NoErr) call handle_err(15)
+!--- LOOP TO GET ALL VARS FOR MONTH ---
+     do v = 1,no_src_types
+        ncfcode = nf90_inq_varid(ncid, TRIM(species(v)), varID)
+        if(ncfcode /= nf90_NoErr) call handle_err(2)
+        ncfcode = nf90_get_var (ncid, varID, aeroin(:,:,:,mi,v))
+        if(ncfcode /= nf90_NoErr) call handle_err(3)
+     end do ! End var loop
+   end do ! End month loop
+
+!---------------------------------------------------------------------------
+!-- latitudinally interpolate ozone data (and extend longitudinally)
+!-- using function lin_interpol2(x, f, y) result(g)
+! Purpose:
+!   interpolates f(x) to point y
+!   assuming f(x) = f(x0) + a * (x - x0)
+!   where a = ( f(x1) - f(x0) ) / (x1 - x0)
+!   x0 <= x <= x1
+!   assumes x is monotonically increasing
+!    real, intent(in), dimension(:) :: x  ! grid points
+!    real, intent(in), dimension(:) :: f  ! grid function values
+!    real, intent(in) :: y                ! interpolation point
+!    real :: g                            ! interpolated function value
+!---------------------------------------------------------------------------
+
+      do j=jts,jtf
+      do i=its,itf
+        interp_pt_latcu=XLAT(i,j)
+        interp_pt_loncu=XLONG(i,j)
+        call interp_vec_cu(lat_aer,interp_pt_latcu,.true.,jlat1cu,jlat2cu,wlat1cu,wlat2cu)
+        call interp_vec_cu(lon_aer,interp_pt_loncu,.true.,ilon1cu,ilon2cu,wlon1cu,wlon2cu)
+
+        do m  = 1,no_months
+        do k  = 1,alevsiz
+          aeropcu(i,k,j,m) = wlon1cu * (wlat1cu * aeropin(ilon1cu,jlat1cu,k,m)+&
+                                           wlat2cu*aeropin(ilon1cu,jlat2cu,k,m))+&
+                                wlon2cu * (wlat1cu*aeropin(ilon2cu,jlat1cu,k,m)+&
+                                           wlat2cu*aeropin(ilon2cu,jlat2cu,k,m))
+        do ks = 1,no_src_types
+          aeromcu(i,k,j,m,ks) = wlon1cu * (wlat1cu*aeroin(ilon1cu,jlat1cu,k,m,ks)  + &
+                                           wlat2cu*aeroin(ilon1cu,jlat2cu,k,m,ks))+ &
+                                wlon2cu * (wlat1cu*aeroin(ilon2cu,jlat1cu,k,m,ks)  + &
+                                           wlat2cu*aeroin(ilon2cu,jlat2cu,k,m,ks))
+
+        end do
+        end do
+        end do
+      end do
+      end do
+
+END SUBROUTINE aerosol_in_cu
+
+subroutine handle_err(errid)
+   INTEGER errid
+   print*,'Error in Aerosol read at ',errid
+   RETURN
+
+END SUBROUTINE handle_err
+
+subroutine interp_vec_cu(locvec,locwant,periodic,loc1,loc2,wght1,wght2)
+! This subroutine was taken and modified from the radiation driver. -PSH
+  implicit none
+
+  real, intent(in), dimension(:) :: locvec
+  real, intent(in)               :: locwant
+  logical, intent(in)            :: periodic
+  integer, intent(out)           :: loc1, loc2
+  real, intent(out)              :: wght1, wght2
+
+  integer :: vsize, n
+  real    :: locv1, locv2
+
+  vsize = size(locvec)
+
+  loc1 = -1
+  loc2 = -1
+
+  do n = 1, vsize-1
+    if ( locvec(n) <= locwant .and. locvec(n+1) > locwant ) then
+      loc1  = n
+      loc2  = n+1
+      locv1 = locvec(n)
+      locv2 = locvec(n+1)
+      exit
+    end if
+  end do
+
+  if ( loc1 < 0 .and. loc2 < 0 ) then
+    if ( periodic ) then
+      if ( locwant < locvec(1) ) then
+        loc1  = vsize
+        loc2  = 1
+        locv1 = locvec(vsize)-360.0
+        locv2 = locvec(1)
+      else
+        loc1  = vsize
+        loc2  = 1
+        locv1 = locvec(vsize)
+        locv2 = locvec(1)+360.0
+      end if
+    else
+      if ( locwant < locvec(1) ) then
+        loc1  = 1
+        loc2  = 1
+        locv1 = locvec(1)
+        locv2 = locvec(1)
+      else
+        loc1  = vsize
+        loc2  = vsize
+        locv1 = locvec(vsize)
+        locv2 = locvec(vsize)
+      end if
+    end if
+  end if
+
+  wght2 = (locwant-locv1) / (locv2-locv1)
+  wght1 = 1.0 - wght2
+
+  return
+  end subroutine interp_vec_cu
+!---------------------END   PSH/TWG  CHANGES----------------
+
 END MODULE module_physics_init
diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F
index 6fec318..6969423 100644
--- a/phys/module_radiation_driver.F
+++ b/phys/module_radiation_driver.F
@@ -144,6 +144,8 @@ CONTAINS
               ,aod5503d                                                   &
               ,taod5502d, taod5503d                                       & !  Trude
               ,mp_physics                                                 &
+              ,EFCG,EFCS,EFIG,EFIS,EFSG,aercu_opt                         &
+              ,EFSS,QS_CU                                                 &
                                                                           )
 
 
@@ -438,6 +440,16 @@ CONTAINS
                                                                t, &
                                                              t8w, &
                                                              rho
+!TWG Begin
+  REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL,        &
+        INTENT(IN)     ::                            EFCG,       & 
+                                                     EFCS,       &
+                                                     EFIG,       &
+                                                     EFIS,       &
+                                                     EFSG,       &
+                                                     EFSS
+!TWG END
+
 
    !BSINGH - For WRFCuP scheme
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL,        &
@@ -452,8 +464,11 @@ CONTAINS
                                  gaer300,gaer400,gaer600,gaer999, & ! jcb
                                  waer300,waer400,waer600,waer999
 
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
+         INTENT(IN ) ::          qc_cu, qi_cu
+
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
-         INTENT(IN ) ::          qc_cu, qi_cu, qc_bl
+         INTENT(IN ) ::          qc_bl, qs_cu
 
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
          INTENT(IN ) ::  tauaerlw1,tauaerlw2,tauaerlw3,tauaerlw4, & ! czhao 
@@ -553,7 +568,8 @@ CONTAINS
                                                           aer_aod550_opt, & ! input option for AOD at 550 nm
                                                           aer_angexp_opt, & ! input option for aerosol Angstrom exponent
                                                           aer_ssa_opt,    & ! input option for aerosol ssa
-                                                          aer_asy_opt       ! input option for aerosol asy
+                                                          aer_asy_opt,    & ! input option for aerosol asy
+                                                          aercu_opt         ! TWG add for MSKF option
     REAL,                                INTENT(IN)    :: aer_aod550_val, & ! AOD at 550 nm if aer_aod550_opt=1
                                                           aer_angexp_val, & ! aerosol Angstrom exponent if aer_angexp_opt=1
                                                           aer_ssa_val,    & ! aerosol ssa if aer_ssa_opt=1
@@ -630,8 +646,8 @@ CONTAINS
                                                        cldfra_bl
 
 !..G. Thompson
-   REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN):: re_cloud, re_ice, re_snow
-   INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs
+   REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT):: re_cloud, re_ice, re_snow
+   INTEGER, INTENT(INOUT):: has_reqc, has_reqi, has_reqs
 
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                     &
          OPTIONAL,                                                   &
@@ -705,6 +721,11 @@ CONTAINS
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qc_temp
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qi_save,qc_save
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qs_save
+!TWG Start
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qc_cu_weight
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qi_cu_weight
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qs_cu_weight
+!TWG End
 
    REAL    ::    gridkm, Wice,Wh2o
 
@@ -1057,6 +1078,19 @@ CONTAINS
           ENDDO
      ENDIF
 
+   IF(aercu_opt.gt.0.0) THEN
+     IF ( F_QI ) THEN
+          DO j=jts,jte
+          DO k=kts,kte
+          DO i=its,ite
+             qs_save(i,k,j) = qs(i,k,j)
+          ENDDO
+          ENDDO
+          ENDDO
+     ENDIF
+   END IF
+
+
 ! Fill temporary water variable depending on micro package (tgs 25 Apr 2006)
      if( F_QC ) then
         DO j=jts,jte
@@ -1132,8 +1166,8 @@ CONTAINS
                    its,ite, jts,jte, kts,kte               )
 
         IF ( PRESENT ( CLDFRA_DP ) ) THEN
-! this is for Kain-Fritsch scheme
-          IF ( icloud_cu .EQ. 2 ) THEN
+! this is for Kain-Fritsch schemes
+          IF ( icloud_cu .EQ. 2 .OR. aercu_opt .GT. 0 ) THEN
              CALL wrf_debug (1, 'use kf cldfra')
              DO j = jts,jte
              DO k = kts,kte
@@ -1142,8 +1176,51 @@ CONTAINS
                 CLDFRA(i,k,j)=(1.-cldfra_cu(i,k,j))*CLDFRA(i,k,j)  ! Update resolved cloud fraction for Cu punch-through
                 CLDFRA(i,k,j)=CLDFRA(i,k,j)+cldfra_cu(i,k,j)       ! New total cloud fraction
                 CLDFRA(i,k,j)=AMIN1(1.0,CLDFRA(i,k,j))
+ !TWG Begin
+                IF (aercu_opt.gt.0.0) THEN
+                IF (qc(i,k,j).eq.0.0.and.qc_cu(i,k,j).gt.0.0) THEN
+                    qc_cu_weight(i,k,j) = 1.0
+                ELSE IF (qc(i,k,j).gt.0.0.and.qc_cu(i,k,j).eq.0.0) THEN
+                    qc_cu_weight(i,k,j) = 0.0
+                ELSE IF (qc(i,k,j).eq.0.0.and.qc_cu(i,k,j).eq.0.0) THEN
+                    qc_cu_weight(i,k,j) = 0.0
+                ELSE
+                    qc_cu_weight(i,k,j) = (qc_cu(i,k,j)*cldfra_cu(i,k,j))/(qc(i,k,j) + qc_cu(i,k,j)*cldfra_cu(i,k,j))
+                END IF
+                IF (qi(i,k,j).eq.0.0.and.qi_cu(i,k,j).gt.0.0) THEN
+                    qi_cu_weight(i,k,j) = 1.0
+                ELSE IF (qi(i,k,j).gt.0.0.and.qi_cu(i,k,j).eq.0.0) THEN
+                    qi_cu_weight(i,k,j) = 0.0
+                ELSE IF (qi(i,k,j).eq.0.0.and.qi_cu(i,k,j).eq.0.0) THEN
+                    qi_cu_weight(i,k,j) = 0.0
+                ELSE
+                    qi_cu_weight(i,k,j) =(qi_cu(i,k,j)*cldfra_cu(i,k,j))/(qi(i,k,j) + qi_cu(i,k,j)*cldfra_cu(i,k,j))
+                END IF
+                IF (qs(i,k,j).eq.0.0.and.qs_cu(i,k,j).gt.0.0) THEN
+                    qs_cu_weight(i,k,j) = 1.0
+                ELSE IF (qs(i,k,j).gt.0.0.and.qs_cu(i,k,j).eq.0.0) THEN
+                    qs_cu_weight(i,k,j) = 0.0
+                ELSE IF (qs(i,k,j).eq.0.0.and.qs_cu(i,k,j).eq.0.0) THEN
+                    qs_cu_weight(i,k,j) = 0.0
+                ELSE
+                    qs_cu_weight(i,k,j)=(qs_cu(i,k,j)*cldfra_cu(i,k,j))/(qs(i,k,j) + qs_cu(i,k,j)*cldfra_cu(i,k,j))
+                END IF
+
+! use re_cloud, re_ice and re_snow to store combined effective radii from MSKF and Morrison microphysics
+                re_cloud(i,k,j) = EFCS(I,K,J)*qc_cu_weight(I,K,J) &
+                                + EFCG(I,K,J)*(1-qc_cu_weight(I,K,J))
+                re_ice(i,k,j)   = EFIS(I,K,J)*qi_cu_weight(I,K,J) &
+                                + EFIG(I,K,J)*(1-qi_cu_weight(I,K,J))
+                re_snow(i,k,j)  = EFSS(I,K,J)*qs_cu_weight(I,K,J) &
+                                + EFSG(I,K,J)*(1-qs_cu_weight(I,K,J))
+                has_reqc = 1
+                has_reqi = 1
+                has_reqs = 1
+                END IF
+!TWG END
                 qc(i,k,j) = qc(i,k,j)+qc_cu(i,k,j)*cldfra_cu(i,k,j)
                 qi(i,k,j) = qi(i,k,j)+qi_cu(i,k,j)*cldfra_cu(i,k,j)
+                qs(i,k,j) = qs(i,k,j)+qs_cu(i,k,j)*cldfra_cu(i,k,j)
              ENDDO
              ENDDO
              ENDDO
@@ -2248,6 +2325,18 @@ CONTAINS
          ENDDO
       ENDIF
 
+      IF (aercu_opt.gt.0.0) THEN
+      IF ( F_QS ) THEN
+         DO j=jts,jte
+         DO k=kts,kte
+         DO i=its,ite
+           qs(i,k,j) = qs_save(i,k,j)
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+      END IF
+
       IF (ICLOUD == 3 .AND. F_QS ) THEN
           DO j = jts,jte
           DO k = kts,kte
diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F
index da931e7..cbf167d 100644
--- a/share/module_check_a_mundo.F
+++ b/share/module_check_a_mundo.F
@@ -632,6 +632,28 @@
          END IF
       ENDDO
 
+!-----------------------------------------------------------------------
+! aercu_opt = 1 (CESM-aerosal) only works with MSKF, special Morrison and YSU PBL.
+!-----------------------------------------------------------------------
+
+      oops = 0
+      DO i = 1, model_config_rec % max_dom
+         IF ( model_config_rec%aercu_opt .GT. 0 .AND.       &
+              model_config_rec%cu_physics(i) .NE. MSKFSCHEME .OR. &
+              model_config_rec%mp_physics(i) .NE. MORR_TM_AERO .OR. &
+              model_config_rec%bl_pbl_physics(i) .NE. YSUSCHEME ) THEN
+              oops = oops + 1
+         END IF
+      ENDDO
+
+      IF ( oops .GT. 0 ) THEN
+         wrf_err_message = '--- ERROR: aercu_opt requires cu_physics = 11, bl_pbl_physics = 1 and mp_physics = 40 '
+         CALL wrf_message ( wrf_err_message )
+         wrf_err_message = '--- Fix these options in namelist.input if you would like to use aercu_opt'
+         CALL wrf_debug ( 0, TRIM( wrf_err_message ) )
+         fatal_error = .true.
+         count_fatal_error = count_fatal_error + 1
+      END IF
 #endif
 
 !-----------------------------------------------------------------------
