diff --git a/bld/build-namelist b/bld/build-namelist
index df276b2bfc..d0a1c8c8d0 100755
--- a/bld/build-namelist
+++ b/bld/build-namelist
@@ -608,8 +608,9 @@ if ( ($chem ne 'none') or ( $prog_species ) ){
($aer_wetdep_list =~ /ncl/i || $aer_wetdep_list =~ /sslt/i)) {
$prescribe_aerosols = $FALSE;
}
-
- add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list );
+ if ($chem !~ /_mam/) {
+ add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list );
+ }
if (!($chem =~ /_mam/)) {
if (!defined $nl->get_value('aer_sol_facti')) {
diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml
index af5f067f86..fad758cad1 100644
--- a/bld/namelist_files/namelist_definition.xml
+++ b/bld/namelist_files/namelist_definition.xml
@@ -6238,19 +6238,19 @@ Default: set by build-namelist.
+ group="aero_wetdep_nl" valid_values="" >
Tuning for below cloud scavenging of interstitial modal aerosols.
Default: set by build-namelist.
+ group="aero_wetdep_nl" valid_values="" >
Tuning for in-cloud scavenging of interstitial modal aerosols.
Default: set by build-namelist.
+ group="aero_wetdep_nl" valid_values="" >
Tuning for in-cloud scavenging of cloud-borne modal aerosols.
Default: set by build-namelist.
diff --git a/doc/ChangeLog b/doc/ChangeLog
index d953b89ee1..06acd1fa7f 100644
--- a/doc/ChangeLog
+++ b/doc/ChangeLog
@@ -1,5 +1,186 @@
===============================================================
+Tag name: cam6_4_035
+Originator(s): fvitt
+Date: 23 Sep 2024
+One-line Summary: Generalize aerosol wet removal
+Github PR URL: https://github.com/ESCOMP/CAM/pull/1099
+
+Purpose of changes (include the issue number and title text for each relevant GitHub issue):
+
+ #1098 Generalize aerosol wet removal processes using the abstract aerosol interfaces
+ framework which can be extended to other aerosol representations, such as CARMA.
+
+Describe any changes made to build system: N/A
+
+Describe any changes made to the namelist: N/A
+
+List any changes to the defaults for the boundary datasets: N/A
+
+Describe any substantial timing or memory changes: N/A
+
+Code reviewed by: nusbaume cacraigucar
+
+List all files eliminated:
+D src/chemistry/modal_aero/modal_aero_convproc.F90
+ - replaced by generalized aero_convproc module
+
+List all files added and what they do:
+A src/chemistry/aerosol/aero_convproc.F90
+ - generalized aerosol convective wet removal processes
+
+A src/chemistry/aerosol/aero_wetdep_cam.F90
+ - generalized cam layer for aerosol wet removal
+ (stratiform and convective)
+
+ src/chemistry/aerosol/modal_aero_data.F90
+ - moved from src/chemistry/modal_aero
+
+List all existing files that have been modified, and describe the changes:
+M bld/build-namelist
+ - do not set aer_wetdep_list for MAM
+
+M bld/namelist_files/namelist_definition.xml
+ - moved aerosol solubility factors to aero_setdep_nl group
+
+M src/chemistry/aerosol/aerosol_properties_mod.F90
+M src/chemistry/aerosol/modal_aerosol_properties_mod.F90
+ - add interfaces for scavenging diameter and resuspention resize
+
+M src/chemistry/aerosol/aerosol_state_mod.F90
+M src/chemistry/aerosol/modal_aerosol_state_mod.F90
+ - add interfaces for convective cloud aerosol activation, below cloud solubility, and wet diameter
+
+R100 src/chemistry/modal_aero/modal_aero_data.F90 src/chemistry/aerosol/modal_aero_data.F90
+ - moved to src/chemistry/aerosol/
+
+M src/physics/carma/cam/carma_intr.F90
+M src/chemistry/aerosol/wetdep.F90
+ - allow for 3-dimensional solubilities
+
+M src/chemistry/modal_aero/aero_model.F90
+ - moved aerosol wet removal code to generalized aero_wetdep_cam module
+
+M src/physics/cam/physpkg.F90
+M src/physics/cam7/physpkg.F90
+ - wetdep_lq moved to aero_wetdep_cam
+
+If there were any failures reported from running test_driver.sh on any test
+platform, and checkin with these failures has been OK'd by the gatekeeper,
+then copy the lines from the td.*.status files for the failed tests to the
+appropriate machine below. All failed tests must be justified.
+
+derecho/intel/aux_cam:
+ FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s
+ DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d
+ - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856
+
+ PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s
+ - pre-existing failures -- need fix in CLM external
+
+ NLFAIL ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp
+ NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase
+ NLFAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase
+ NLFAIL ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp
+ NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d
+ NLFAIL ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa
+ NLFAIL ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3
+ NLFAIL ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s
+ NLFAIL ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes
+ NLFAIL ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7
+ NLFAIL ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s
+ NLFAIL ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s
+ NLFAIL ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120
+ NLFAIL ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480
+ NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep
+ NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep
+ NLFAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase
+ NLFAIL SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday
+ NLFAIL SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4
+ NLFAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie
+ NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase
+ NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust
+ NLFAIL SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s
+ NLFAIL SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d
+ NLFAIL SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d
+ NLFAIL SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09
+ NLFAIL SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m
+ NLFAIL SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging
+ NLFAIL SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s
+ NLFAIL SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs
+ NLFAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp
+ - aerosol_nl settings moved to aero_wetdep_nl
+
+derecho/nvhpc/aux_cam:
+ NLFAIL ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default
+ - aerosol_nl settings moved to aero_wetdep_nl
+
+izumi/nag/aux_cam:
+ FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae
+ - pre-existing failure - issue #670
+
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s
+ NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac
+ NLFAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac
+ NLFAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8
+ NLFAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf
+ NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0
+ NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1
+ NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3
+ NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0
+ NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1
+ NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3
+ NLFAIL SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port
+ NLFAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm
+ NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam
+ NLFAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase
+ NLFAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s
+ NLFAIL TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac
+ NLFAIL TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8
+ - aerosol_nl settings moved to aero_wetdep_nl
+
+izumi/gnu/aux_cam:
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon
+ NLFAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s
+ NLFAIL ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s
+ NLFAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp
+ NLFAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s
+ NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0
+ NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1
+ NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3
+ NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6
+ NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6
+ NLFAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac
+ NLFAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp
+ - aerosol_nl settings moved to aero_wetdep_nl
+
+Summarize any changes to answers: bit-for-bit
+
+===============================================================
+===============================================================
+
Tag name: cam6_4_034
Originator(s): jimmielin
Date: Thu Sep 19 2024
diff --git a/src/chemistry/aerosol/aero_convproc.F90 b/src/chemistry/aerosol/aero_convproc.F90
new file mode 100644
index 0000000000..1915e295ad
--- /dev/null
+++ b/src/chemistry/aerosol/aero_convproc.F90
@@ -0,0 +1,2146 @@
+module aero_convproc
+!---------------------------------------------------------------------------------
+! Purpose:
+!
+! CAM interface to aerosol/trace-gas convective cloud processing scheme
+!
+! currently these routines assume stratiform and convective clouds only interact
+! through the detrainment of convective cloudborne material into stratiform clouds
+!
+! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed
+! by the convective up/downdrafts, but are affected by the detrainment
+!
+! Author: R. C. Easter
+!
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use shr_kind_mod, only: shr_kind_cs
+
+use spmd_utils, only: masterproc
+use physconst, only: gravit, rair
+use ppgrid, only: pver, pcols, pverp
+use constituents, only: pcnst, cnst_get_ind
+use constituents, only: cnst_species_class, cnst_spec_class_aerosol
+use phys_control, only: phys_getopts
+
+use physics_types, only: physics_state, physics_ptend
+use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field
+use time_manager, only: get_nstep
+use cam_history, only: outfld, addfld, add_default, horiz_only
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+
+use aerosol_properties_mod, only: aerosol_properties
+use aerosol_state_mod, only: aerosol_state, ptr2d_t
+
+implicit none
+private
+
+public :: aero_convproc_readnl
+public :: aero_convproc_init
+public :: aero_convproc_intr
+
+! namelist options
+! NOTE: These are the defaults for CAM6.
+logical, protected, public :: deepconv_wetdep_history = .true.
+logical, protected, public :: convproc_do_deep = .true.
+! NOTE: These are the defaults for the Eaton/Wang parameterization.
+logical, protected, public :: convproc_do_evaprain_atonce = .false.
+real(r8), protected, public :: convproc_pom_spechygro = -1._r8
+real(r8), protected, public :: convproc_wup_max = 4.0_r8
+
+logical, parameter :: use_cwaer_for_activate_maxsat = .false.
+logical, parameter :: apply_convproc_tend_to_ptend = .true.
+
+real(r8) :: hund_ovr_g ! = 100.0_r8/gravit
+! used with zm_conv mass fluxes and delta-p
+! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s]
+! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2]
+
+! method1_activate_nlayers = number of layers (including cloud base) where activation is applied
+integer, parameter :: method1_activate_nlayers = 2
+! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01)
+real(r8), parameter :: method2_activate_smaxmax = 0.003_r8
+
+! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac
+! (this works ok with convproc_method_activate = 1 but not for ... = 2)
+! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac
+! (this works ok with convproc_method_activate = 1 or 2)
+! = other -- do nothing involving reduce_actfrac
+integer, parameter :: method_reduce_actfrac = 0
+real(r8), parameter :: factor_reduce_actfrac = 0.5_r8
+
+! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers
+! 2=do secondary activation with prescribed supersat
+integer, parameter :: convproc_method_activate = 2
+
+logical :: convproc_do_aer
+
+! physics buffer indices
+integer :: fracis_idx = 0
+
+integer :: rprddp_idx = 0
+integer :: rprdsh_idx = 0
+integer :: nevapr_shcu_idx = 0
+integer :: nevapr_dpcu_idx = 0
+
+integer :: icwmrdp_idx = 0
+integer :: icwmrsh_idx = 0
+integer :: sh_frac_idx = 0
+integer :: dp_frac_idx = 0
+
+integer :: zm_eu_idx = 0
+integer :: zm_du_idx = 0
+integer :: zm_ed_idx = 0
+integer :: zm_dp_idx = 0
+integer :: zm_jt_idx = 0
+integer :: zm_maxg_idx = 0
+integer :: zm_ideep_idx = 0
+
+integer :: cmfmc_sh_idx = 0
+integer :: sh_e_ed_ratio_idx = 0
+
+integer :: istat
+
+integer :: nbins = 0
+integer :: ncnstaer = 0
+
+integer, allocatable :: aer_cnst_ndx(:)
+
+character(len=32), allocatable :: cnst_name_extd(:,:) ! (2,ncnstaer)
+
+contains
+
+!=========================================================================================
+subroutine aero_convproc_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'aero_convproc_readnl'
+
+ namelist /aerosol_convproc_opts/ deepconv_wetdep_history, convproc_do_deep, &
+ convproc_do_evaprain_atonce, convproc_pom_spechygro, convproc_wup_max
+
+ ! Read namelist
+ if (masterproc) then
+ open( newunit=unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'aerosol_convproc_opts', status=ierr)
+ if (ierr == 0) then
+ read(unitn, aerosol_convproc_opts, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast( deepconv_wetdep_history, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast( convproc_do_deep, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast( convproc_do_evaprain_atonce, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast( convproc_pom_spechygro, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast( convproc_wup_max, 1, mpi_real8, masterprocid, mpicom, ierr)
+
+ if (masterproc) then
+ write(iulog,*) subname//': deepconv_wetdep_history = ',deepconv_wetdep_history
+ write(iulog,*) subname//': convproc_do_deep = ',convproc_do_deep
+ write(iulog,*) subname//': convproc_do_evaprain_atonce = ',convproc_do_evaprain_atonce
+ write(iulog,*) subname//': convproc_pom_spechygro = ',convproc_pom_spechygro
+ write(iulog,*) subname//': convproc_wup_max = ', convproc_wup_max
+ end if
+
+end subroutine aero_convproc_readnl
+
+!=========================================================================================
+
+subroutine aero_convproc_init(aero_props)
+
+ class(aerosol_properties), intent(in) :: aero_props
+
+ integer :: m, mm, l, ndx, astat
+ integer :: npass_calc_updraft
+ logical :: history_aerosol
+ character(len=32) :: name_a, name_c
+
+ character(len=*), parameter :: prefix = 'aero_convproc_init: '
+
+ hund_ovr_g = 100.0_r8/gravit
+ ! used with zm_conv mass fluxes and delta-p
+ ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s]
+ ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2]
+
+ nbins = aero_props%nbins()
+ ncnstaer = aero_props%ncnst_tot()
+
+ allocate(aer_cnst_ndx(ncnstaer),stat=astat)
+ if (astat/=0) then
+ call endrun(prefix//'aer_cnst_ndx allocation error')
+ end if
+ allocate(cnst_name_extd(2,ncnstaer),stat=astat)
+ if (astat/=0) then
+ call endrun(prefix//'cnst_name_extd allocation error')
+ end if
+
+ aer_cnst_ndx(:) = -1
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ if (l==0) then
+ call aero_props%num_names(m, name_a, name_c)
+ else
+ call aero_props%mmr_names(m,l, name_a, name_c)
+ endif
+ cnst_name_extd(1,mm) = name_a
+ cnst_name_extd(2,mm) = name_c
+
+ call cnst_get_ind(trim(name_a), ndx, abort=.false.)
+ aer_cnst_ndx(mm) = ndx
+ end do
+ end do
+
+ call phys_getopts( history_aerosol_out=history_aerosol, &
+ convproc_do_aer_out = convproc_do_aer )
+
+ call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', &
+ 'Deep conv. column-max updraft mass flux' )
+ call addfld('DP_WCLDBASE', horiz_only, 'A', 'm/s', &
+ 'Deep conv. cloudbase vertical velocity' )
+ call addfld('DP_KCLDBASE', horiz_only, 'A', '1', &
+ 'Deep conv. cloudbase level index' )
+
+ ! output wet deposition fields to history
+ ! I = in-cloud removal; E = precip-evap resuspension
+ ! C = convective (total); D = deep convective
+ ! note that the precip-evap resuspension includes that resulting from
+ ! below-cloud removal, calculated in mz_aero_wet_intr
+ if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ ndx = aer_cnst_ndx(mm)
+
+ if ( deepconv_wetdep_history ) then
+ call addfld (trim(cnst_name_extd(1,mm))//'SFSID', &
+ horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface')
+ call addfld (trim(cnst_name_extd(1,mm))//'SFSED', &
+ horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface')
+ if (history_aerosol) then
+ call add_default(trim(cnst_name_extd(1,mm))//'SFSID', 1, ' ')
+ call add_default(trim(cnst_name_extd(1,mm))//'SFSED', 1, ' ')
+ end if
+ end if
+
+ end do
+ end do
+ end if
+
+ if ( history_aerosol .and. convproc_do_aer ) then
+ call add_default( 'DP_MFUP_MAX', 1, ' ' )
+ call add_default( 'DP_WCLDBASE', 1, ' ' )
+ call add_default( 'DP_KCLDBASE', 1, ' ' )
+ end if
+
+ fracis_idx = pbuf_get_index('FRACIS')
+
+ rprddp_idx = pbuf_get_index('RPRDDP')
+ rprdsh_idx = pbuf_get_index('RPRDSH')
+ nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU')
+ nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU')
+
+ icwmrdp_idx = pbuf_get_index('ICWMRDP')
+ icwmrsh_idx = pbuf_get_index('ICWMRSH')
+ dp_frac_idx = pbuf_get_index('DP_FRAC')
+ sh_frac_idx = pbuf_get_index('SH_FRAC')
+
+ zm_eu_idx = pbuf_get_index('ZM_EU')
+ zm_du_idx = pbuf_get_index('ZM_DU')
+ zm_ed_idx = pbuf_get_index('ZM_ED')
+ zm_dp_idx = pbuf_get_index('ZM_DP')
+ zm_jt_idx = pbuf_get_index('ZM_JT')
+ zm_maxg_idx = pbuf_get_index('ZM_MAXG')
+ zm_ideep_idx = pbuf_get_index('ZM_IDEEP')
+
+ cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
+ sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat)
+
+ if (masterproc ) then
+
+ write(iulog,'(a,l12)') 'aero_convproc_init - convproc_do_aer = ', &
+ convproc_do_aer
+ write(iulog,'(a,l12)') 'aero_convproc_init - use_cwaer_for_activate_maxsat = ', &
+ use_cwaer_for_activate_maxsat
+ write(iulog,'(a,l12)') 'aero_convproc_init - apply_convproc_tend_to_ptend = ', &
+ apply_convproc_tend_to_ptend
+ write(iulog,'(a,i12)') 'aero_convproc_init - convproc_method_activate = ', &
+ convproc_method_activate
+ write(iulog,'(a,i12)') 'aero_convproc_init - method1_activate_nlayers = ', &
+ method1_activate_nlayers
+ write(iulog,'(a,1pe12.4)') 'aero_convproc_init - method2_activate_smaxmax = ', &
+ method2_activate_smaxmax
+ write(iulog,'(a,i12)') 'aero_convproc_init - method_reduce_actfrac = ', &
+ method_reduce_actfrac
+ write(iulog,'(a,1pe12.4)') 'aero_convproc_init - factor_reduce_actfrac = ', &
+ factor_reduce_actfrac
+
+ npass_calc_updraft = 1
+ if ( (method_reduce_actfrac == 2) .and. &
+ (factor_reduce_actfrac >= 0.0_r8) .and. &
+ (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2
+ write(iulog,'(a,i12)') 'aero_convproc_init - npass_calc_updraft = ', &
+ npass_calc_updraft
+
+ end if
+
+end subroutine aero_convproc_init
+
+!=========================================================================================
+
+subroutine aero_convproc_intr( aero_props, aero_state, state, ptend, pbuf, ztodt, &
+ nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, &
+ aerdepwetis, dcondt_resusp3d )
+!-----------------------------------------------------------------------
+!
+! Convective cloud processing (transport, activation/resuspension,
+! wet removal) of aerosols and trace gases.
+! (Currently no aqueous chemistry and no trace-gas wet removal)
+! Does aerosols when convproc_do_aer is .true.
+!
+! Does deep convection
+! Uses mass fluxes, cloud water, precip production from the
+! convective cloud routines
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+
+ ! Arguments
+ class(aerosol_properties), intent(in) :: aero_props
+ class(aerosol_state), intent(in) :: aero_state
+
+ type(physics_state),target,intent(in ) :: state ! Physics state variables
+ type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
+
+ integer, intent(in) :: nsrflx_mzaer2cnvpr
+ real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,ncnstaer,nsrflx_mzaer2cnvpr)
+ real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial)
+ real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver)
+
+ ! Local variables
+ integer, parameter :: nsrflx = 5 ! last dimension of qsrflx
+ integer :: l, m, mm, ndx, lchnk
+ integer :: ncol
+
+ real(r8) :: dqdt(pcols,pver,ncnstaer)
+ real(r8) :: dt
+
+
+
+ real(r8) :: q(pcols,pver,ncnstaer)
+ real(r8) :: qsrflx(pcols,ncnstaer,nsrflx)
+ real(r8), pointer :: qptr(:,:)
+
+ real(r8) :: sflxic(pcols,ncnstaer)
+ real(r8) :: sflxid(pcols,ncnstaer)
+ real(r8) :: sflxec(pcols,ncnstaer)
+ real(r8) :: sflxed(pcols,ncnstaer)
+
+ type(ptr2d_t) :: raer(ncnstaer) ! aerosol mass, number mixing ratios
+ type(ptr2d_t) :: qqcw(ncnstaer)
+
+ logical :: dotend(pcnst)
+ logical :: applytend
+
+ !-------------------------------------------------------------------------------------------------
+
+ dotend = .false.
+
+ ! Initialize
+ lchnk = state%lchnk
+ ncol = state%ncol
+ dt = ztodt
+
+ sflxic(:,:) = 0.0_r8
+ sflxid(:,:) = 0.0_r8
+ sflxec(:,:) = 0.0_r8
+ sflxed(:,:) = 0.0_r8
+
+ call aero_state%get_states( aero_props, raer, qqcw )
+
+ ! prepare for deep conv processing
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+
+ mm = aero_props%indexer(m,l)
+ ndx = aer_cnst_ndx(mm)
+
+ sflxec(1:ncol,mm) = qsrflx_mzaer2cnvpr(1:ncol,mm,1)
+ sflxed(1:ncol,mm) = qsrflx_mzaer2cnvpr(1:ncol,mm,2)
+
+ applytend = .false.
+ if ( ndx > 0 ) then
+ applytend = ptend%lq(ndx)
+ dotend(ndx) = applytend
+ endif
+
+ qptr => raer(mm)%fld
+
+ if ( applytend ) then
+ ! calc new q (after calcaersize and mz_aero_wet_intr)
+ q(1:ncol,:,mm) = max( 0.0_r8, qptr(1:ncol,:) + dt*ptend%q(1:ncol,:,ndx) )
+ else
+ ! use old q
+ q(1:ncol,:,mm) = qptr(1:ncol,:)
+ end if
+
+ end do
+ end do
+
+ dqdt(:,:,:) = 0.0_r8
+ qsrflx(:,:,:) = 0.0_r8
+
+ if (convproc_do_aer) then
+
+ ! do deep conv processing
+ if (convproc_do_deep) then
+ call aero_convproc_dp_intr( aero_props, &
+ state, pbuf, dt, &
+ q, dqdt, nsrflx, qsrflx, dcondt_resusp3d )
+
+ ! apply deep conv processing tendency
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ ndx = aer_cnst_ndx(mm)
+
+ if ( apply_convproc_tend_to_ptend ) then
+ ! add dqdt onto ptend%q and set ptend%lq
+ if (ndx>0) then ! advected species
+ ptend%q(1:ncol,:,ndx) = ptend%q(1:ncol,:,ndx) + dqdt(1:ncol,:,mm)
+ else
+ raer(mm)%fld(1:ncol,:) = max( 0.0_r8, raer(mm)%fld(1:ncol,:) + dqdt(1:ncol,:,mm) * dt )
+ end if
+ end if
+
+ ! these used for history file wetdep diagnostics
+ sflxic(1:ncol,mm) = sflxic(1:ncol,mm) + qsrflx(1:ncol,mm,4)
+ sflxid(1:ncol,mm) = sflxid(1:ncol,mm) + qsrflx(1:ncol,mm,4)
+ sflxec(1:ncol,mm) = sflxec(1:ncol,mm) + qsrflx(1:ncol,mm,5)
+ sflxed(1:ncol,mm) = sflxed(1:ncol,mm) + qsrflx(1:ncol,mm,5)
+
+ ! this used for surface coupling
+ if (ndx>0) then
+ aerdepwetis(1:ncol,ndx) = aerdepwetis(1:ncol,ndx) &
+ + qsrflx(1:ncol,mm,4) + qsrflx(1:ncol,mm,5)
+ end if
+ end do
+ end do
+
+ end if
+
+ end if ! (convproc_do_aer) then
+
+ if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ ndx = aer_cnst_ndx(mm)
+
+ if (ndx>0) call outfld( trim(cnst_name_extd(1,mm))//'SFWET', aerdepwetis(:,ndx), pcols, lchnk )
+ call outfld( trim(cnst_name_extd(1,mm))//'SFSIC', sflxic(:,mm), pcols, lchnk )
+ call outfld( trim(cnst_name_extd(1,mm))//'SFSEC', sflxec(:,mm), pcols, lchnk )
+
+ if ( deepconv_wetdep_history ) then
+ call outfld( trim(cnst_name_extd(1,mm))//'SFSID', sflxid(:,mm), pcols, lchnk )
+ call outfld( trim(cnst_name_extd(1,mm))//'SFSED', sflxed(:,mm), pcols, lchnk )
+ end if
+ end do
+ end do
+
+ end if
+
+end subroutine aero_convproc_intr
+
+!=========================================================================================
+
+subroutine aero_convproc_dp_intr( aero_props, &
+ state, pbuf, dt, &
+ q, dqdt, nsrflx, qsrflx, dcondt_resusp3d)
+!-----------------------------------------------------------------------
+!
+! Convective cloud processing (transport, activation/resuspension,
+! wet removal) of aerosols and trace gases.
+! (Currently no aqueous chemistry and no trace-gas wet removal)
+! Does aerosols when convproc_do_aer is .true.
+!
+! This routine does deep convection
+! Uses mass fluxes, cloud water, precip production from the
+! convective cloud routines
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+ ! Arguments
+ class(aerosol_properties), intent(in) :: aero_props
+
+ type(physics_state), intent(in ) :: state ! Physics state variables
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ real(r8), intent(in) :: dt ! delta t (model time increment)
+
+ real(r8), intent(in) :: q(pcols,pver,ncnstaer)
+ real(r8), intent(inout) :: dqdt(pcols,pver,ncnstaer)
+ integer, intent(in) :: nsrflx
+ real(r8), intent(inout) :: qsrflx(pcols,ncnstaer,nsrflx)
+ real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver)
+
+ integer :: i
+ integer :: lchnk
+ integer :: nstep
+
+ real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb)
+ real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets
+ real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols)
+
+ ! physics buffer fields
+ real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble
+ real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg)
+ real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg)
+ real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud)
+ real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1)
+
+ ! deep conv variables
+ real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver)
+ real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver)
+ real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver)
+ ! eu, ed, du are "d(massflux)/dp" and are all positive
+ real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver)
+ integer, pointer :: jt(:) ! Index of cloud top for each column (pcols)
+ integer, pointer :: maxg(:) ! Index of cloud bottom for each column (pcols)
+ integer, pointer :: ideep(:) ! Gathering array (pcols)
+ integer :: lengath ! Gathered min lon indices over which to operate
+
+ ! Initialize
+
+ lchnk = state%lchnk
+ nstep = get_nstep()
+
+ ! Associate pointers with physics buffer fields
+ call pbuf_get_field(pbuf, rprddp_idx, rprddp)
+ call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp)
+ call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp)
+ call pbuf_get_field(pbuf, dp_frac_idx, dp_frac)
+ call pbuf_get_field(pbuf, fracis_idx, fracis)
+ call pbuf_get_field(pbuf, zm_eu_idx, eu)
+ call pbuf_get_field(pbuf, zm_du_idx, du)
+ call pbuf_get_field(pbuf, zm_ed_idx, ed)
+ call pbuf_get_field(pbuf, zm_dp_idx, dp)
+ call pbuf_get_field(pbuf, zm_jt_idx, jt)
+ call pbuf_get_field(pbuf, zm_maxg_idx, maxg)
+ call pbuf_get_field(pbuf, zm_ideep_idx, ideep)
+
+ lengath = count(ideep > 0)
+
+ fracice(:,:) = 0.0_r8
+
+ ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type
+ dpdry = 0._r8
+ do i = 1, lengath
+ dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8
+ end do
+
+ call aero_convproc_tend( aero_props, 'deep', lchnk, dt, &
+ state%t, state%pmid, q, du, eu, &
+ ed, dp, dpdry, jt, &
+ maxg, ideep, 1, lengath, &
+ dp_frac, icwmrdp, rprddp, evapcdp, &
+ fracice, dqdt, nsrflx, qsrflx, &
+ xx_mfup_max, xx_wcldbase, xx_kcldbase, &
+ dcondt_resusp3d )
+
+ call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk )
+ call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk )
+ call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk )
+
+end subroutine aero_convproc_dp_intr
+
+!=========================================================================================
+
+subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, &
+ t, pmid, q, du, eu, &
+ ed, dp, dpdry, jt, &
+ mx, ideep, il1g, il2g, &
+ cldfrac, icwmr, rprd, evapc, &
+ fracice, dqdt, nsrflx, qsrflx, &
+ xx_mfup_max, xx_wcldbase, xx_kcldbase, &
+ dcondt_resusp3d )
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Convective transport of trace species.
+! The trace species need not be conservative, and source/sink terms for
+! activation, resuspension, aqueous chemistry and gas uptake, and
+! wet removal are all applied.
+! Currently this works with the ZM deep convection, but we should be able
+! to adapt it for both Hack and McCaa shallow convection
+!
+! Compare to subr convproc which does conservative trace species.
+!
+! Method:
+! Computes tracer mixing ratios in updraft and downdraft "cells" in a
+! Lagrangian manner, with source/sinks applied in the updraft other.
+! Then computes grid-cell-mean tendencies by considering
+! updraft and downdraft fluxes across layer boundaries
+! environment subsidence/lifting fluxes across layer boundaries
+! sources and sinks in the updraft
+! resuspension of activated species in the grid-cell as a whole
+!
+! Note1: A better estimate or calculation of either the updraft velocity
+! or fractional area is needed.
+! Note2: If updraft area is a small fraction of over cloud area,
+! then aqueous chemistry is underestimated. These are both
+! research areas.
+!
+! Authors: O. Seland and R. Easter, based on convtran by P. Rasch
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+! Input arguments
+!
+ class(aerosol_properties), intent(in) :: aero_props
+
+ character(len=*), intent(in) :: convtype ! identifies the type of
+ ! convection ("deep", "shcu")
+ integer, intent(in) :: lchnk ! chunk identifier
+ real(r8), intent(in) :: dt ! Model timestep
+ real(r8), intent(in) :: t(pcols,pver) ! Temperature
+ real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels
+ real(r8), intent(in) :: q(pcols,pver,ncnstaer) ! Tracer array including moisture
+
+ real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft
+ real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft
+ real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft
+! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS ***
+! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code
+! - eventually these should be changed to (kg/m2/s)
+! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0
+
+ real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb)
+ real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb)
+ integer, intent(in) :: jt(pcols) ! Index of cloud top for each column
+ integer, intent(in) :: mx(pcols) ! Index of cloud bottom for each column
+ integer, intent(in) :: ideep(pcols) ! Gathering array indices
+ integer, intent(in) :: il1g ! Gathered min lon indices over which to operate
+ integer, intent(in) :: il2g ! Gathered max lon indices over which to operate
+! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index
+
+ real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area
+ real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang
+ real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate
+ real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate
+ real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets
+
+ real(r8), intent(out):: dqdt(pcols,pver,ncnstaer) ! Tracer tendency array
+ integer, intent(in) :: nsrflx ! last dimension of qsrflx
+ real(r8), intent(out):: qsrflx(pcols,ncnstaer,nsrflx)
+ ! process-specific column tracer tendencies
+ ! (1=activation, 2=resuspension, 3=aqueous rxn,
+ ! 4=wet removal, 5=renaming)
+ real(r8), intent(out) :: xx_mfup_max(pcols)
+ real(r8), intent(out) :: xx_wcldbase(pcols)
+ real(r8), intent(out) :: xx_kcldbase(pcols)
+ real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver)
+
+!--------------------------Local Variables------------------------------
+
+! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2
+
+ integer :: i, icol ! Work index
+ integer :: iconvtype ! 1=deep, 2=uw shallow
+ integer :: iflux_method ! 1=as in convtran (deep), 2=simpler
+ integer :: ipass_calc_updraft
+ integer :: jtsub ! Work index
+ integer :: k ! Work index
+ integer :: kactcnt ! Counter for no. of levels having activation
+ integer :: kactcntb ! Counter for activation diagnostic output
+ integer :: kactfirst ! Lowest layer with activation (= cloudbase)
+ integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i))
+ integer :: kbot_prevap ! Lowest layer for doing resuspension from evaporating precip
+ integer :: ktop ! Cloud-flux top layer for current i (=jt(i))
+ ! Layers between kbot,ktop have mass fluxes
+ ! but not all have cloud water, because the
+ ! updraft starts below the cloud base
+ integer :: km1, km1x ! Work index
+ integer :: kp1, kp1x ! Work index
+ integer :: l, mm ! Work index
+ integer :: m, n, ndx ! Work index
+ integer :: nerr ! number of errors for entire run
+ integer :: nerrmax ! maximum number of errors to report
+ integer :: npass_calc_updraft
+ integer :: ntsub !
+
+ logical do_act_this_lev ! flag for doing activation at current level
+
+ real(r8) aqfrac(2,ncnstaer) ! aqueous fraction of constituent in updraft
+ real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments)
+
+ real(r8) chat(2,ncnstaer,pverp) ! mix ratio in env at interfaces
+ real(r8) cond(2,ncnstaer,pverp) ! mix ratio in downdraft at interfaces
+ real(r8) const(2,ncnstaer,pver) ! gathered tracer array
+ real(r8) conu(2,ncnstaer,pverp) ! mix ratio in updraft at interfaces
+
+ real(r8) dcondt(2,ncnstaer,pver) ! grid-average TMR tendency for current column
+ real(r8) dcondt_prevap(2,ncnstaer,pver) ! portion of dcondt from precip evaporation
+ real(r8) dcondt_resusp(2,ncnstaer,pver) ! portion of dcondt from resuspension
+
+ real(r8) dcondt_wetdep(2,ncnstaer,pver) ! portion of dcondt from wet deposition
+ real(r8) dconudt_activa(2,ncnstaer,pverp) ! d(conu)/dt by activation
+ real(r8) dconudt_aqchem(2,ncnstaer,pverp) ! d(conu)/dt by aqueous chem
+ real(r8) dconudt_wetdep(2,ncnstaer,pverp) ! d(conu)/dt by wet removal
+
+ real(r8) maxflux(2,ncnstaer) ! maximum (over layers) of fluxin and fluxout
+ real(r8) maxflux2(2,ncnstaer) ! ditto but computed using method-2 fluxes
+ real(r8) maxprevap(2,ncnstaer) ! maximum (over layers) of dcondt_prevap*dp
+ real(r8) maxresusp(2,ncnstaer) ! maximum (over layers) of dcondt_resusp*dp
+ real(r8) maxsrce(2,ncnstaer) ! maximum (over layers) of netsrce
+
+ real(r8) sumflux(2,ncnstaer) ! sum (over layers) of netflux
+ real(r8) sumflux2(2,ncnstaer) ! ditto but computed using method-2 fluxes
+ real(r8) sumsrce(2,ncnstaer) ! sum (over layers) of dp*netsrce
+ real(r8) sumchng(2,ncnstaer) ! sum (over layers) of dp*dcondt
+ real(r8) sumchng3(2,ncnstaer) ! ditto but after call to resusp_conv
+ real(r8) sumprevap(2,ncnstaer) ! sum (over layers) of dp*dcondt_prevap
+ real(r8) sumwetdep(2,ncnstaer) ! sum (over layers) of dp*dconudt_wetdep
+
+ real(r8) cabv ! mix ratio of constituent above
+ real(r8) cbel ! mix ratio of constituent below
+ real(r8) cdifr ! normalized diff between cabv and cbel
+ real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt
+ real(r8) clw_cut ! threshold clw value for doing updraft
+ ! transformation and removal
+ real(r8) courantmax ! maximum courant no.
+ real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i
+ real(r8) dp_i(pver) ! dp(i,k) at current i
+ real(r8) dt_u(pver) ! lagrangian transport time in the updraft
+ real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i
+ real(r8) dqdt_i(pver,ncnstaer) ! dqdt(i,k,m) at current i
+ real(r8) dtsub ! dt/ntsub
+ real(r8) dz ! working layer thickness (m)
+ real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i
+ real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i
+ real(r8) expcdtm1 ! a work variable
+ real(r8) fa_u(pver) ! fractional area of in the updraft
+ real(r8) fa_u_dp ! current fa_u(k)*dp_i(k)
+ real(r8) f_ent ! fraction of the "before-detrainment" updraft
+ ! massflux at k/k-1 interface resulting from
+ ! entrainment of level k air
+ real(r8) fluxin ! a work variable
+ real(r8) fluxout ! a work variable
+ real(r8) maxc ! a work variable
+ real(r8) mbsth ! Threshold for mass fluxes
+ real(r8) minc ! a work variable
+ real(r8) md_m_eddp ! a work variable
+ real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension)
+ real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension)
+ real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension)
+ real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension)
+ ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes
+ ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry
+ ! the mu_i/md_i are next calculated by applying the mbsth threshold
+ real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k)
+ real(r8) netflux ! a work variable
+ real(r8) netsrce ! a work variable
+ real(r8) q_i(pver,ncnstaer) ! q(i,k,m) at current i
+ real(r8) qsrflx_i(ncnstaer,nsrflx) ! qsrflx(i,m,n) at current i
+ real(r8) rhoair_i(pver) ! air density at current i
+ real(r8) small ! a small number
+ real(r8) tmpa ! work variables
+ real(r8) tmpf ! work variables
+ real(r8) xinv_ntsub ! 1.0/ntsub
+ real(r8) wup(pver) ! working updraft velocity (m/s)
+ real(r8) conu2(pcols,pver,2,ncnstaer)
+ real(r8) dcondt2(pcols,pver,2,ncnstaer)
+
+ !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01
+ !Chosen to reproduce vertical velocities in GATEIII GIGALES (Khairoutdinov etal 2009, JAMES)
+ real(r8), parameter :: zm_areafrac = 0.01_r8
+
+!-----------------------------------------------------------------------
+!
+ iconvtype = -1
+ iflux_method = -1
+
+ if (convtype == 'deep') then
+ iconvtype = 1
+ iflux_method = 1
+ else if (convtype == 'uwsh') then
+ iconvtype = 2
+ iflux_method = 2
+ else
+ call endrun( '*** aero_convproc_tend -- convtype is not |deep| or |uwsh|' )
+ end if
+
+ nerr = 0
+ nerrmax = 99
+
+ dcondt_resusp3d(:,:,:) = 0._r8
+
+ small = 1.e-36_r8
+! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s)
+ mbsth = 1.e-15_r8
+
+ qsrflx(:,:,:) = 0.0_r8
+ dqdt(:,:,:) = 0.0_r8
+ xx_mfup_max(:) = 0.0_r8
+ xx_wcldbase(:) = 0.0_r8
+ xx_kcldbase(:) = 0.0_r8
+
+ wup(:) = 0.0_r8
+
+ dcondt2 = 0.0_r8
+ conu2 = 0.0_r8
+ aqfrac = 0.0_r8
+
+! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ aqfrac(2,mm) = 1.0_r8
+ enddo
+ enddo
+
+! Loop ever each column that has convection
+! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays
+i_loop_main_aa: &
+ do i = il1g, il2g
+ icol = ideep(i)
+
+
+ if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then
+! shallow conv case with jt,mx <= 0, which means there is no shallow conv
+! in this column -- skip this column
+ cycle i_loop_main_aa
+
+ else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then
+! invalid cloudtop and cloudbase indices -- skip this column
+ write(*,9010) 'illegal jt, mx', convtype, lchnk, icol, i, &
+ jt(i), mx(i)
+9010 format( '*** aero_convproc_tend error -- ', a, 5x, 'convtype = ', a / &
+ '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) )
+ cycle i_loop_main_aa
+
+ else if (jt(i) == mx(i)) then
+! cloudtop = cloudbase (1 layer cloud) -- skip this column
+ write(*,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i)
+ cycle i_loop_main_aa
+
+ end if
+
+
+!
+! cloudtop and cloudbase indices are valid so proceed with calculations
+!
+
+! Load dp_i and cldfrac_i, and calc rhoair_i
+ do k = 1, pver
+ dp_i(k) = dpdry(i,k)
+ cldfrac_i(k) = cldfrac(icol,k)
+ rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k))
+ end do
+
+! Calc dry mass fluxes
+! This is approximate because the updraft air is has different temp and qv than
+! the grid mean, but the whole convective parameterization is highly approximate
+ mu_x(:) = 0.0_r8
+ md_x(:) = 0.0_r8
+! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry
+ do k = pver, 1, -1
+ mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k)
+ xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) )
+ end do
+! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry
+ do k = 2, pver
+ md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1)
+ end do
+
+! Load mass fluxes over cloud layers
+! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding)
+! Zero out values below threshold
+! Zero out values at "top of cloudtop", "base of cloudbase"
+ ktop = jt(i)
+ kbot = mx(i)
+! usually the updraft ( & downdraft) start ( & end ) at kbot=pver, but sometimes kbot < pver
+! transport, activation, resuspension, and wet removal only occur between kbot >= k >= ktop
+! resuspension from evaporating precip can occur at k > kbot when kbot < pver
+ kbot_prevap = pver
+ mu_i(:) = 0.0_r8
+ md_i(:) = 0.0_r8
+ do k = ktop+1, kbot
+ mu_i(k) = mu_x(k)
+ if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8
+ md_i(k) = md_x(k)
+ if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8
+ end do
+ mu_i(ktop) = 0.0_r8
+ md_i(ktop) = 0.0_r8
+ mu_i(kbot+1) = 0.0_r8
+ md_i(kbot+1) = 0.0_r8
+
+! Compute updraft and downdraft "entrainment*dp" from eu and ed
+! Compute "detrainment*dp" from mass conservation
+ eudp(:) = 0.0_r8
+ dudp(:) = 0.0_r8
+ eddp(:) = 0.0_r8
+ dddp(:) = 0.0_r8
+ courantmax = 0.0_r8
+ do k = ktop, kbot
+ if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then
+ if (du(i,k) <= 0.0_r8) then
+ eudp(k) = mu_i(k) - mu_i(k+1)
+ else
+ eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 )
+ dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k)
+ if (dudp(k) < 1.0e-12_r8*eudp(k)) then
+ eudp(k) = mu_i(k) - mu_i(k+1)
+ dudp(k) = 0.0_r8
+ end if
+ end if
+ end if
+ if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then
+ eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 )
+ dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k)
+ if (dddp(k) < 1.0e-12_r8*eddp(k)) then
+ eddp(k) = md_i(k) - md_i(k+1)
+ dddp(k) = 0.0_r8
+ end if
+ end if
+ courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) )
+ end do ! k
+
+! number of time substeps needed to maintain "courant number" <= 1
+ ntsub = 1
+ if (courantmax > (1.0_r8 + 1.0e-6_r8)) then
+ ntsub = 1 + int( courantmax )
+ end if
+ xinv_ntsub = 1.0_r8/ntsub
+ dtsub = dt*xinv_ntsub
+ courantmax = courantmax*xinv_ntsub
+
+! load tracer mixing ratio array, which will be updated at the end of each jtsub interation
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ q_i(1:pver,mm) = q(icol,1:pver,mm)
+ conu2(icol,1:pver,1,mm) = q(icol,1:pver,mm)
+ end do
+ end do
+
+!
+! when method_reduce_actfrac = 2, need to do the updraft calc twice
+! (1st to get non-adjusted activation amount, 2nd to apply reduction factor)
+ npass_calc_updraft = 1
+ if ( (method_reduce_actfrac == 2) .and. &
+ (factor_reduce_actfrac >= 0.0_r8) .and. &
+ (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2
+
+
+jtsub_loop_main_aa: &
+ do jtsub = 1, ntsub
+
+
+ipass_calc_updraft_loop: &
+ do ipass_calc_updraft = 1, npass_calc_updraft
+
+ qsrflx_i(:,:) = 0.0_r8
+ dqdt_i(:,:) = 0.0_r8
+
+ const = 0.0_r8 ! zero cloud-phase species
+ chat = 0.0_r8 ! zero cloud-phase species
+ conu = 0.0_r8
+ cond = 0.0_r8
+
+ dcondt = 0.0_r8
+ dcondt_resusp = 0.0_r8
+ dcondt_wetdep = 0.0_r8
+ dcondt_prevap = 0.0_r8
+ dconudt_aqchem = 0.0_r8
+ dconudt_wetdep = 0.0_r8
+
+! only initialize the activation tendency on ipass=1
+ if (ipass_calc_updraft == 1) dconudt_activa = 0.0_r8
+
+ ! initialize mixing ratio arrays (chat, const, conu, cond)
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ const(1,mm,:) = q_i(:,mm)
+
+ ! From now on work only with gathered data
+ ! Interpolate environment tracer values to interfaces
+ do k = 1,pver
+ km1 = max(1,k-1)
+ minc = min(const(1,mm,km1),const(1,mm,k))
+ maxc = max(const(1,mm,km1),const(1,mm,k))
+ if (minc < 0) then
+ cdifr = 0._r8
+ else
+ cdifr = abs(const(1,mm,k)-const(1,mm,km1))/max(maxc,small)
+ endif
+
+ ! If the two layers differ significantly use a geometric averaging procedure
+ ! But only do that for deep convection. For shallow, use the simple
+ ! averaging which is used in subr cmfmca
+ if (iconvtype /= 1) then
+ chat(1,mm,k) = 0.5_r8* (const(1,mm,k)+const(1,mm,km1))
+ else if (cdifr > 1.E-6_r8) then
+ cabv = max(const(1,mm,km1),maxc*1.e-12_r8)
+ cbel = max(const(1,mm,k),maxc*1.e-12_r8)
+ chat(1,mm,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel
+ else ! Small diff, so just arithmetic mean
+ chat(1,mm,k) = 0.5_r8* (const(1,mm,k)+const(1,mm,km1))
+ end if
+
+ ! Set provisional up and down draft values, and tendencies
+ conu(1,mm,k) = chat(1,mm,k)
+ cond(1,mm,k) = chat(1,mm,k)
+ end do ! k
+
+ ! Values at surface inferface == values in lowest layer
+ chat(1,mm,pver+1) = const(1,mm,pver)
+ conu(1,mm,pver+1) = const(1,mm,pver)
+ cond(1,mm,pver+1) = const(1,mm,pver)
+ end do ! l
+ end do ! m
+
+
+
+! Compute updraft mixing ratios from cloudbase to cloudtop
+! No special treatment is needed at k=pver because arrays
+! are dimensioned 1:pver+1
+! A time-split approach is used. First, entrainment is applied to produce
+! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are
+! applied to the initial conu(m,k) to produce a final conu(m,k).
+! Detrainment from the updraft uses this final conu(m,k).
+! Note that different time-split approaches would give somewhat different
+! results
+ kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1
+k_loop_main_bb: &
+ do k = kbot, ktop, -1
+ kp1 = k+1
+
+! cldfrac = conv cloud fractional area. This could represent anvil cirrus area,
+! and may not useful for aqueous chem and wet removal calculations
+ cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 )
+! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k
+ mu_p_eudp(k) = mu_i(kp1) + eudp(k)
+
+ fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false.
+ if (mu_p_eudp(k) > mbsth) then
+! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top
+! of current layer,
+! so current layer is a "gap" between two unconnected updrafts,
+! so essentially skip all the updraft calculations for this layer
+
+! First apply changes from entrainment
+ f_ent = eudp(k)/mu_p_eudp(k)
+ f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) )
+ tmpa = 1.0_r8 - f_ent
+ do n = 1,2 ! phase
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ conu(n,mm,k) = tmpa*conu(n,mm,kp1) + f_ent*const(n,mm,k)
+ end do
+ end do
+ end do
+
+! estimate updraft velocity (wup)
+ if (iconvtype /= 1) then
+! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)]
+ wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
+ / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8))
+ else
+! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac
+ wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
+ / (rhoair_i(k) * zm_areafrac)
+ end if
+
+! compute lagrangian transport time (dt_u) and updraft fractional area (fa_u)
+! *** these must obey dt_u(k)*mu_p_eudp(k) = dp_i(k)*fa_u(k)
+ dz = dp_i(k)*hund_ovr_g/rhoair_i(k)
+ dt_u(k) = dz/wup(k)
+ dt_u(k) = min( dt_u(k), dt )
+ fa_u(k) = dt_u(k)*(mu_p_eudp(k)/dp_i(k))
+
+
+! Now apply transformation and removal changes
+! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate
+! occasional very small icwmr values from the ZM module
+ clw_cut = 1.0e-6_r8
+
+
+ if (convproc_method_activate <= 1) then
+! aerosol activation - method 1
+! skip levels that are completely glaciated (fracice(icol,k) == 1.0)
+! when kactcnt=1 (first/lowest layer with cloud water) apply
+! activatation to the entire updraft
+! when kactcnt>1 apply activatation to the amount entrained at this level
+ if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then
+ kactcnt = kactcnt + 1
+
+ if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then
+ kactcntb = kactcntb + 1
+ end if
+
+ if (kactcnt == 1) then
+ ! diagnostic fields
+ ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac
+ xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
+ / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8))
+ xx_kcldbase(icol) = k
+
+ kactfirst = k
+ tmpa = 1.0_r8
+ call activate_convproc( aero_props, &
+ conu(:,:,k), dconudt_activa(:,:,k), conu(:,:,k), &
+ tmpa, dt_u(k), wup(k), &
+ t(icol,k), rhoair_i(k), ipass_calc_updraft )
+ else if (f_ent > 0.0_r8) then
+ ! current layer is above cloud base (=first layer with activation)
+ ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1)
+ if (k >= kactfirst-(method1_activate_nlayers-1)) then
+ call activate_convproc( aero_props, &
+ conu(:,:,k), dconudt_activa(:,:,k), const(:,:,k), &
+ f_ent, dt_u(k), wup(k), &
+ t(icol,k), rhoair_i(k), ipass_calc_updraft )
+ end if
+ end if
+! the following was for cam2 shallow convection (hack),
+! but is not appropriate for cam5 (uwshcu)
+! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then
+! ! for shallow conv, when you move from activation occuring to
+! ! not occuring, reset kactcnt=0, because the hack scheme can
+! ! produce multiple "1.5 layer clouds" separated by clear air
+! kactcnt = 0
+! end if
+ end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then
+
+ else ! (convproc_method_activate >= 2)
+! aerosol activation - method 2
+! skip levels that are completely glaciated (fracice(icol,k) == 1.0)
+! when kactcnt=1 (first/lowest layer with cloud water)
+! apply "primary" activatation to the entire updraft
+! when kactcnt>1
+! apply secondary activatation to the entire updraft
+! do this for all levels above cloud base (even if completely glaciated)
+! (this is something for sensitivity testing)
+ do_act_this_lev = .false.
+ if (kactcnt <= 0) then
+ if (icwmr(icol,k) > clw_cut) then
+ do_act_this_lev = .true.
+ kactcnt = 1
+ kactfirst = k
+ ! diagnostic fields
+ ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac
+ xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
+ / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8))
+ xx_kcldbase(icol) = k
+ end if
+ else
+! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then
+ do_act_this_lev = .true.
+ kactcnt = kactcnt + 1
+! end if
+ end if
+
+ if ( do_act_this_lev ) then
+ kactcntb = kactcntb + 1
+
+ call activate_convproc_method2( aero_props, &
+ conu(:,:,k), dconudt_activa(:,:,k), &
+ f_ent, dt_u(k), wup(k), &
+ t(icol,k), rhoair_i(k), k, &
+ kactfirst, ipass_calc_updraft )
+
+ end if
+ conu2(icol,k,:,:) = conu(:,:,k)
+
+ end if ! (convproc_method_activate <= 1)
+
+! aqueous chemistry
+! do glaciated levels as aqchem_conv will eventually do acid vapor uptake
+! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff
+! if (icwmr(icol,k) > clw_cut) then
+! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, &
+! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), &
+! lh2o2(icol,k), lo3(icol,k), dt_u(k) )
+! end if
+
+! wet removal
+!
+! mirage2
+! rprd = precip formation as a grid-cell average (kgW/kgA/s)
+! icwmr = cloud water MR within updraft area (kgW/kgA)
+! fupdr = updraft fractional area (--)
+! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s)
+! B = A/icwmr = rprd/(icwmr*fupdr)
+! = first-order removal rate (1/s)
+! C = dp/(mup/fupdr) = updraft air residence time in the layer (s)
+!
+! fraction removed = (1.0 - exp(-cdt)) where
+! cdt = B*C = (dp/mup)*rprd/icwmr
+!
+! Note1: fupdr cancels out in cdt, so need not be specified
+! Note2: dp & mup units need only be consistent (e.g., mb & mb/s)
+! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme)
+! Note4: the "dp" in C above and code below should be the moist dp
+!
+! cam5
+! clw_preloss = cloud water MR before loss to precip
+! = icwmr + dt*(rprd/fupdr)
+! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr)
+! = rprd/(fupdr*icwmr + dt*rprd)
+! = first-order removal rate (1/s)
+!
+! fraction removed = (1.0 - exp(-cdt)) where
+! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)]
+!
+! Note1: *** cdt is now sensitive to fupdr, which we do not really know,
+! and is not the same as the convective cloud fraction
+! Note2: dt is appropriate in the above cdt expression, not dtsub
+!
+! Apply wet removal at levels where
+! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0
+! as wet removal occurs in both liquid and ice clouds
+!
+ cdt(k) = 0.0_r8
+ if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then
+! if (iconvtype == 1) then
+ tmpf = 0.5_r8*cldfrac_i(k)
+ cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / &
+ (tmpf*icwmr(icol,k) + dt*rprd(icol,k))
+! else if (k < pver) then
+! if (eudp(k+1) > 0) cdt(k) = &
+! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1))
+! end if
+ end if
+ if (cdt(k) > 0.0_r8) then
+ expcdtm1 = exp(-cdt(k)) - 1.0_r8
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ do n = 1,2
+ dconudt_wetdep(n,mm,k) = conu(n,mm,k)*aqfrac(n,mm)*expcdtm1
+ conu(n,mm,k) = conu(n,mm,k) + dconudt_wetdep(n,mm,k)
+ dconudt_wetdep(n,mm,k) = dconudt_wetdep(n,mm,k) / dt_u(k)
+ conu2(icol,k,n,mm) = conu(n,mm,k)
+ enddo
+ enddo
+ enddo
+
+ end if
+
+ end if ! "(mu_p_eudp(k) > mbsth)"
+ end do k_loop_main_bb ! "k = kbot, ktop, -1"
+
+! when doing updraft calcs twice, only need to go this far on the first pass
+ if ( (ipass_calc_updraft == 1) .and. &
+ (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop
+
+
+! Compute downdraft mixing ratios from cloudtop to cloudbase
+! No special treatment is needed at k=2
+! No transformation or removal is applied in the downdraft
+ do k = ktop, kbot
+ kp1 = k + 1
+! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1
+ md_m_eddp = md_i(k) - eddp(k)
+ if (md_m_eddp < -mbsth) then
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ do n = 1,2
+ cond(n,mm,kp1) = ( md_i(k)*cond(n,mm,k) &
+ - eddp(k)*const(n,mm,k) ) / md_m_eddp
+ end do
+ end do
+ end do
+ end if
+ end do ! k
+
+
+! Now computes fluxes and tendencies
+! NOTE: The approach used in convtran applies to inert tracers and
+! must be modified to include source and sink terms
+ sumflux = 0.0_r8
+ sumflux2 = 0.0_r8
+ sumsrce = 0.0_r8
+ sumchng = 0.0_r8
+ sumchng3 = 0.0_r8
+ sumwetdep = 0.0_r8
+ sumprevap = 0.0_r8
+
+ maxflux = 0.0_r8
+ maxflux2 = 0.0_r8
+ maxresusp = 0.0_r8
+ maxsrce = 0.0_r8
+ maxprevap = 0.0_r8
+
+k_loop_main_cc: &
+ do k = ktop, kbot
+ kp1 = k+1
+ km1 = k-1
+ kp1x = min( kp1, pver )
+ km1x = max( km1, 1 )
+ fa_u_dp = fa_u(k)*dp_i(k)
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ do n = 1,2
+
+ ! First compute fluxes using environment subsidence/lifting and
+ ! entrainment/detrainment into up/downdrafts,
+ ! to provide an additional mass balance check
+ ! (this could be deleted after the code is well tested)
+ fluxin = mu_i(k)*min(chat(n,mm,k),const(n,mm,km1x)) &
+ - md_i(kp1)*min(chat(n,mm,kp1),const(n,mm,kp1x)) &
+ + dudp(k)*conu(n,mm,k) + dddp(k)*cond(n,mm,kp1)
+ fluxout = mu_i(kp1)*min(chat(n,mm,kp1),const(n,mm,k)) &
+ - md_i(k)*min(chat(n,mm,k),const(n,mm,k)) &
+ + (eudp(k) + eddp(k))*const(n,mm,k)
+
+ netflux = fluxin - fluxout
+
+ sumflux2(n,mm) = sumflux2(n,mm) + netflux
+ maxflux2(n,mm) = max( maxflux2(n,mm), abs(fluxin), abs(fluxout) )
+
+ ! Now compute fluxes as in convtran, and also source/sink terms
+ ! (version 3 limit fluxes outside convection to mass in appropriate layer
+ ! (these limiters are probably only safe for positive definite quantitities
+ ! (it assumes that mu and md already satify a courant number limit of 1)
+ if (iflux_method /= 2) then
+ fluxin = mu_i(kp1)*conu(n,mm,kp1) &
+ + mu_i(k )*min(chat(n,mm,k ),const(n,mm,km1x)) &
+ - ( md_i(k )*cond(n,mm,k) &
+ + md_i(kp1)*min(chat(n,mm,kp1),const(n,mm,kp1x)) )
+ fluxout = mu_i(k )*conu(n,mm,k) &
+ + mu_i(kp1)*min(chat(n,mm,kp1),const(n,mm,k )) &
+ - ( md_i(kp1)*cond(n,mm,kp1) &
+ + md_i(k )*min(chat(n,mm,k ),const(n,mm,k )) )
+ else
+ fluxin = mu_i(kp1)*conu(n,mm,kp1) &
+ - ( md_i(k )*cond(n,mm,k) )
+ fluxout = mu_i(k )*conu(n,mm,k) &
+ - ( md_i(kp1)*cond(n,mm,kp1) )
+
+ ! new method -- simple upstream method for the env subsidence
+ ! tmpa = net env mass flux (positive up) at top of layer k
+ tmpa = -( mu_i(k ) + md_i(k ) )
+ if (tmpa <= 0.0_r8) then
+ fluxin = fluxin - tmpa*const(n,mm,km1x)
+ else
+ fluxout = fluxout + tmpa*const(n,mm,k )
+ end if
+ ! tmpa = net env mass flux (positive up) at base of layer k
+ tmpa = -( mu_i(kp1) + md_i(kp1) )
+ if (tmpa >= 0.0_r8) then
+ fluxin = fluxin + tmpa*const(n,mm,kp1x)
+ else
+ fluxout = fluxout - tmpa*const(n,mm,k )
+ end if
+ end if
+
+ netflux = fluxin - fluxout
+ netsrce = fa_u_dp*(dconudt_aqchem(n,mm,k) + &
+ dconudt_activa(n,mm,k) + dconudt_wetdep(n,mm,k))
+ dcondt(n,mm,k) = (netflux+netsrce)/dp_i(k)
+
+ dcondt_wetdep(n,mm,k) = fa_u_dp*dconudt_wetdep(n,mm,k)/dp_i(k)
+ sumwetdep(n,mm) = sumwetdep(n,mm) + fa_u_dp*dconudt_wetdep(n,mm,k)
+
+ dcondt2(icol,k,n,mm) = dcondt(n,mm,k)
+
+ end do
+ end do
+
+ end do
+ end do k_loop_main_cc ! "k = ktop, kbot"
+
+! calculate effects of precipitation evaporation
+ call precpevap_convproc( aero_props, dcondt, dcondt_wetdep, dcondt_prevap, &
+ rprd, evapc, dp_i, &
+ icol, ktop )
+
+! make adjustments to dcondt for activated & unactivated aerosol species
+! pairs to account any (or total) resuspension of convective-cloudborne aerosol
+ call resuspend_convproc( aero_props, dcondt, dcondt_resusp, ktop, kbot_prevap )
+
+ ! Do resuspension of aerosols from rain only when the rain has
+ ! totally evaporated.
+ if (convproc_do_evaprain_atonce) then
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ dcondt_resusp3d(mm,icol,:) = dcondt_resusp(2,mm,:)
+ end do
+ end do
+
+ dcondt_resusp(2,:,:) = 0._r8
+ end if
+
+! calculate new column-tendency variables
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ do n = 1,2
+ do k = ktop, kbot_prevap
+ sumprevap(n,mm) = sumprevap(n,mm) + dcondt_prevap(n,mm,k)*dp_i(k)
+ end do
+ end do
+ end do
+ end do
+
+!
+! note again the aero_convproc_tend does not apply convective cloud processing
+! to the stratiform-cloudborne aerosol
+! within this routine, cloudborne aerosols are convective-cloudborne
+!
+! before tendencies (dcondt, which is loaded into dqdt) are returned,
+! the convective-cloudborne aerosol tendencies must be combined
+! with the interstitial tendencies
+! resuspend_convproc has already done this for the dcondt
+!
+! the individual process column tendencies (sumwetdep, sumprevap, ...)
+! are just diagnostic fields that can be written to history
+! tendencies for interstitial and convective-cloudborne aerosol could
+! both be passed back and output, if desired
+! currently, however, the interstitial and convective-cloudborne tendencies
+! are combined (in the next code block) before being passed back (in qsrflx)
+!
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ sumwetdep(1,mm) = sumwetdep(1,mm) + sumwetdep(2,mm)
+ sumprevap(1,mm) = sumprevap(1,mm) + sumprevap(2,mm)
+ enddo
+ enddo
+
+!
+! scatter overall tendency back to full array
+!
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ ndx = aer_cnst_ndx(mm)
+ do k = ktop, kbot_prevap
+ dqdt_i(k,mm) = dcondt(1,mm,k)
+ dqdt(icol,k,mm) = dqdt(icol,k,mm) + dqdt_i(k,mm)*xinv_ntsub
+ end do
+
+ end do
+ end do ! m
+
+! scatter column burden tendencies for various processes to qsrflx
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ qsrflx_i(mm,4) = sumwetdep(1,mm)*hund_ovr_g
+ qsrflx_i(mm,5) = sumprevap(1,mm)*hund_ovr_g
+ qsrflx(icol,mm,1:5) = qsrflx(icol,mm,1:5) + qsrflx_i(mm,1:5)*xinv_ntsub
+ end do
+ end do
+
+ if (jtsub < ntsub) then
+ ! update the q_i for the next interation of the jtsub loop
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ ndx = aer_cnst_ndx(mm)
+ do k = ktop, kbot_prevap
+ q_i(k,mm) = max( (q_i(k,mm) + dqdt_i(k,mm)*dtsub), 0.0_r8 )
+ end do
+ end do
+ end do
+ end if
+
+ end do ipass_calc_updraft_loop
+
+ end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop
+
+
+ end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ call outfld( trim(cnst_name_extd(1,mm))//'WETC', dcondt2(:,:,1,mm), pcols, lchnk )
+ call outfld( trim(cnst_name_extd(1,mm))//'CONU', conu2(:,:,1,mm), pcols, lchnk )
+ call outfld( trim(cnst_name_extd(2,mm))//'WETC', dcondt2(:,:,2,mm), pcols, lchnk )
+ call outfld( trim(cnst_name_extd(2,mm))//'CONU', conu2(:,:,2,mm), pcols, lchnk )
+
+ end do
+ end do
+
+end subroutine aero_convproc_tend
+
+!=========================================================================================
+ subroutine precpevap_convproc( aero_props, &
+ dcondt, dcondt_wetdep, dcondt_prevap, &
+ rprd, evapc, dp_i, &
+ icol, ktop )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Calculate resuspension of wet-removed aerosol species resulting
+! from precip evaporation
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! arguments
+! (note: TMR = tracer mixing ratio)
+
+ class(aerosol_properties), intent(in) :: aero_props
+ real(r8), intent(inout) :: dcondt(2,ncnstaer,pver)
+ ! overall TMR tendency from convection
+ real(r8), intent(in) :: dcondt_wetdep(2,ncnstaer,pver)
+ ! portion of TMR tendency due to wet removal
+ real(r8), intent(inout) :: dcondt_prevap(2,ncnstaer,pver)
+ ! portion of TMR tendency due to precip evaporation
+ ! (actually, due to the adjustments made here)
+ ! (on entry, this is 0.0)
+
+ real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered)
+ real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered)
+ real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb)
+
+ integer, intent(in) :: icol ! normal (ungathered) i index for current column
+ integer, intent(in) :: ktop ! index of top cloud level for current column
+
+!-----------------------------------------------------------------------
+! local variables
+ integer :: k, l, m, mm, n
+ real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb]
+ real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb]
+ real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb]
+ real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation
+ real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb]
+ real(r8) :: pr_flux_old
+ real(r8) :: tmpdp ! delta-pressure (mb)
+ real(r8) :: wd_flux(2,ncnstaer) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb]
+!-----------------------------------------------------------------------
+
+ pr_flux = 0.0_r8
+ wd_flux = 0.0_r8
+
+ do k = ktop, pver
+ tmpdp = dp_i(k)
+
+ pr_flux_old = pr_flux
+ del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k))
+ pr_flux = pr_flux_old + del_pr_flux_prod
+
+ del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) )
+
+ ! Do resuspension of aerosols from rain only when the rain has
+ ! totally evaporated in one layer.
+ if (convproc_do_evaprain_atonce .and. &
+ (del_pr_flux_evap.ne.pr_flux)) del_pr_flux_evap = 0._r8
+
+ fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8)
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ do n = 1,2
+
+ ! use -dcondt_wetdep(m,k) as it is negative (or zero)
+ wd_flux(n,mm) = wd_flux(n,mm) + tmpdp*max(0.0_r8, -dcondt_wetdep(n,mm,k))
+ del_wd_flux_evap = wd_flux(n,mm)*fdel_pr_flux_evap
+
+ dcondt_prevap(n,mm,k) = del_wd_flux_evap/tmpdp
+
+ end do
+ end do
+ end do
+
+ ! resuspension --> create larger aerosols
+ if (convproc_do_evaprain_atonce) then
+ call aero_props%resuspension_resize( dcondt_prevap(1,:,k) )
+ endif
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ do n = 1,2
+ dcondt(n,mm,k) = dcondt(n,mm,k) + dcondt_prevap(n,mm,k)
+ end do
+ end do
+ end do
+
+ pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap )
+
+ end do ! k
+
+ end subroutine precpevap_convproc
+
+!=========================================================================================
+ subroutine activate_convproc( aero_props, &
+ conu, dconudt, conent, &
+ f_ent, dt_u, wup, &
+ tair, rhoair, ipass_calc_updraft )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Calculate activation of aerosol species in convective updraft
+! for a single column and level
+!
+! Method:
+! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface
+! conent(l) = TMR of air that is entrained into the updraft from level k
+! f_ent = Fraction of the "before-detrainment" updraft massflux at
+! k/k-1 interface" resulting from entrainment of level k air
+! (where k is the current level in subr aero_convproc_tend)
+!
+! On entry to this routine, the conu(l) represents the updraft TMR
+! after entrainment, but before chemistry/physics and detrainment,
+! and is equal to
+! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l)
+! where
+! conu_below(l) = updraft TMR at the k+1/k interface, and
+! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux
+! from level k entrainment
+!
+! This routine applies aerosol activation to the entrained tracer,
+! then adjusts the conu so that on exit,
+! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la)
+! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la)
+! where
+! la, lc = indices for an unactivated/activated aerosol component pair
+! f_act = fraction of conent(la) that is activated. The f_act are
+! calculated with the Razzak-Ghan activation parameterization.
+! The f_act differ for each mode, and for number/surface/mass.
+!
+! Note: At the lowest layer with cloud water, subr convproc calls this
+! routine with conent==conu and f_ent==1.0, with the result that
+! activation is applied to the entire updraft tracer flux
+!
+! *** The updraft velocity used for activation calculations is rather
+! uncertain and needs more work. However, an updraft of 1-3 m/s
+! will activate essentially all of accumulation and coarse mode particles.
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+ use ndrop, only: activate_aerosol
+
+!-----------------------------------------------------------------------
+! arguments (note: TMR = tracer mixing ratio)
+
+ class(aerosol_properties), intent(in) :: aero_props
+
+ ! conu = tracer mixing ratios in updraft at top of this (current) level
+ ! The conu are changed by activation
+ real(r8), intent(inout) :: conu(2,ncnstaer)
+ ! conent = TMRs in the entrained air at this level
+ real(r8), intent(in) :: conent(2,ncnstaer)
+ real(r8), intent(inout) :: dconudt(2,ncnstaer) ! TMR tendencies due to activation
+
+ real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was
+ ! entrained across this layer == eudp/mu_p_eudp
+ real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the
+ ! updraft at current level
+ real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s)
+ ! at current level updraft
+
+ real(r8), intent(in) :: tair ! Temperature in Kelvin
+ real(r8), intent(in) :: rhoair ! air density (kg/m3)
+
+ integer, intent(in) :: ipass_calc_updraft
+
+!-----------------------------------------------------------------------
+! local variables
+ integer :: l, m, mm
+
+ real(r8) :: delact ! working variable
+ real(r8) :: dt_u_inv ! 1.0/dt_u
+ real(r8) :: fluxm(nbins) ! to understand this, see subr activate_aerosol
+ real(r8) :: fluxn(nbins) ! to understand this, see subr activate_aerosol
+ real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol
+ real(r8) :: fm(nbins) ! mass fraction of aerosols activated
+ real(r8) :: fn(nbins) ! number fraction of aerosols activated
+ real(r8) :: hygro(nbins) ! current hygroscopicity for int+act
+ real(r8) :: naerosol(nbins) ! interstitial+activated number conc (#/m3)
+ real(r8) :: sigw ! standard deviation of updraft velocity (cm/s)
+ real(r8) :: tmp_fact ! working variable
+ real(r8) :: vaerosol(nbins) ! int+act volume (m3/m3)
+ real(r8) :: wbar ! mean updraft velocity (cm/s)
+ real(r8) :: wdiab ! diabatic vertical velocity (cm/s)
+ real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s)
+
+ real(r8) :: spec_hygro
+ real(r8) :: spec_dens
+ character(len=32) :: spec_type
+
+ real(r8) :: tmpa, tmpb, tmpc ! working variable
+ real(r8) :: naerosol_a(1) ! number conc (1/m3)
+ real(r8) :: vaerosol_a(1) ! volume conc (m3/m3)
+
+!-----------------------------------------------------------------------
+
+! when ipass_calc_updraft == 2, apply the activation tendencies
+! from pass 1, but multiplied by factor_reduce_actfrac
+! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2)
+ if (ipass_calc_updraft == 2) then
+
+ dt_u_inv = 1.0_r8/dt_u
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ delact = dconudt(2,mm)*dt_u * factor_reduce_actfrac
+ delact = min( delact, conu(1,mm) )
+ delact = max( delact, 0.0_r8 )
+ conu(1,mm) = conu(1,mm) - delact
+ conu(2,mm) = conu(2,mm) + delact
+ dconudt(1,mm) = -delact*dt_u_inv
+ dconudt(2,mm) = delact*dt_u_inv
+
+ end do
+ end do
+
+ return
+
+ end if ! (ipass_calc_updraft == 2)
+
+! check f_ent > 0
+ if (f_ent <= 0.0_r8) return
+
+ hygro = 0.0_r8
+ vaerosol = 0.0_r8
+ naerosol = 0.0_r8
+
+ do m = 1, nbins
+! compute a (or a+cw) volume and hygroscopicity
+ tmpa = 0.0_r8
+ tmpb = 0.0_r8
+ do l = 1, aero_props%nmasses(m)
+
+ mm = aero_props%indexer(m,l)
+
+ call aero_props%get(m, l, spectype=spec_type, density=spec_dens, hygro=spec_hygro)
+
+ tmpc = max( conent(1,mm), 0.0_r8 )
+ if ( use_cwaer_for_activate_maxsat ) &
+ tmpc = tmpc + max( conent(2,mm), 0.0_r8 )
+ tmpc = tmpc / spec_dens
+ tmpa = tmpa + tmpc
+ tmpb = tmpb + tmpc * spec_hygro
+ end do
+ vaerosol(m) = tmpa * rhoair
+ if (tmpa < 1.0e-35_r8) then
+ hygro(m) = 0.2_r8
+ else
+ hygro(m) = tmpb/tmpa
+ end if
+
+! load a (or a+cw) number and bound it
+ tmpa = max( conent(1,mm), 0.0_r8 )
+ if ( use_cwaer_for_activate_maxsat ) &
+ tmpa = tmpa + max( conent(2,mm), 0.0_r8 )
+ naerosol(m) = tmpa * rhoair
+
+ naerosol_a(1) = naerosol(m)
+ vaerosol_a(1) = vaerosol(m)
+
+ call aero_props%apply_number_limits( naerosol_a, vaerosol_a, 1, 1, m )
+
+ naerosol(m) = naerosol_a(1)
+ end do
+
+! call Razzak-Ghan activation routine with single updraft
+ wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now
+ sigw = 0.0_r8
+ wdiab = 0.0_r8
+ wminf = wbar
+ wmaxf = wbar
+
+ call activate_aerosol( &
+ wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
+ naerosol, nbins, vaerosol, hygro, aero_props, &
+ fn, fm, fluxn, fluxm, flux_fullact )
+
+! apply the activation fractions to the updraft aerosol mixing ratios
+ dt_u_inv = 1.0_r8/dt_u
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ if ( (method_reduce_actfrac == 1) .and. &
+ (factor_reduce_actfrac >= 0.0_r8) .and. &
+ (factor_reduce_actfrac < 1.0_r8) ) &
+ tmp_fact = tmp_fact * factor_reduce_actfrac
+
+ delact = min( conent(1,mm)*tmp_fact*f_ent, conu(1,mm) )
+ delact = max( delact, 0.0_r8 )
+ conu(1,mm) = conu(1,mm) - delact
+ conu(2,mm) = conu(2,mm) + delact
+ dconudt(1,mm) = -delact*dt_u_inv
+ dconudt(2,mm) = delact*dt_u_inv
+ end do
+ end do
+
+ end subroutine activate_convproc
+
+!=========================================================================================
+ subroutine activate_convproc_method2( aero_props, &
+ conu, dconudt, &
+ f_ent, dt_u, wup, &
+ tair, rhoair, k, &
+ kactfirst, ipass_calc_updraft )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Calculate activation of aerosol species in convective updraft
+! for a single column and level
+!
+! Method:
+! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface
+! f_ent = Fraction of the "before-detrainment" updraft massflux at
+! k/k-1 interface" resulting from entrainment of level k air
+! (where k is the current level in subr aero_convproc_tend)
+!
+! On entry to this routine, the conu(l) represents the updraft TMR
+! after entrainment, but before chemistry/physics and detrainment.
+!
+! This routine applies aerosol activation to the conu tracer mixing ratios,
+! then adjusts the conu so that on exit,
+! conu(la) = conu_incoming(la) - conu(la)*f_act(la)
+! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la)
+! where
+! la, lc = indices for an unactivated/activated aerosol component pair
+! f_act = fraction of conu(la) that is activated. The f_act are
+! calculated with the Razzak-Ghan activation parameterization.
+! The f_act differ for each mode, and for number/surface/mass.
+!
+! At cloud base (k==kactfirst), primary activation is done using the
+! "standard" code in subr activate do diagnose maximum supersaturation.
+! Above cloud base, secondary activation is done using a
+! prescribed supersaturation.
+!
+! *** The updraft velocity used for activation calculations is rather
+! uncertain and needs more work. However, an updraft of 1-3 m/s
+! will activate essentially all of accumulation and coarse mode particles.
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+ use ndrop, only: activate_aerosol
+
+!-----------------------------------------------------------------------
+! arguments (note: TMR = tracer mixing ratio)
+
+ class(aerosol_properties), intent(in) :: aero_props
+
+ ! conu = tracer mixing ratios in updraft at top of this (current) level
+ ! The conu are changed by activation
+ real(r8), intent(inout) :: conu(2,ncnstaer)
+ real(r8), intent(inout) :: dconudt(2,ncnstaer) ! TMR tendencies due to activation
+
+ real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was
+ ! entrained across this layer == eudp/mu_p_eudp
+ real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the
+ ! updraft at current level
+ real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s)
+ ! at current level updraft
+
+ real(r8), intent(in) :: tair ! Temperature in Kelvin
+ real(r8), intent(in) :: rhoair ! air density (kg/m3)
+ ! used as in-cloud wet removal rate
+ integer, intent(in) :: k ! level index
+ integer, intent(in) :: kactfirst ! k at cloud base
+ integer, intent(in) :: ipass_calc_updraft
+
+!-----------------------------------------------------------------------
+! local variables
+ integer :: l, m, mm
+
+ real(r8) :: delact ! working variable
+ real(r8) :: dt_u_inv ! 1.0/dt_u
+ real(r8) :: fluxm(nbins) ! to understand this, see subr activate_aerosol
+ real(r8) :: fluxn(nbins) ! to understand this, see subr activate_aerosol
+ real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol
+ real(r8) :: fm(nbins) ! mass fraction of aerosols activated
+ real(r8) :: fn(nbins) ! number fraction of aerosols activated
+ real(r8) :: hygro(nbins) ! current hygroscopicity for int+act
+ real(r8) :: naerosol(nbins) ! interstitial+activated number conc (#/m3)
+ real(r8) :: sigw ! standard deviation of updraft velocity (cm/s)
+ real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction)
+ real(r8) :: tmp_fact ! working variable
+ real(r8) :: vaerosol(nbins) ! int+act volume (m3/m3)
+ real(r8) :: wbar ! mean updraft velocity (cm/s)
+ real(r8) :: wdiab ! diabatic vertical velocity (cm/s)
+ real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s)
+
+ real(r8) :: spec_hygro
+ real(r8) :: spec_dens
+ character(len=32) :: spec_type
+
+ real(r8) :: tmpa, tmpb, tmpc ! working variable
+ real(r8) :: naerosol_a(1) ! number conc (1/m3)
+ real(r8) :: vaerosol_a(1) ! volume conc (m3/m3)
+
+!-----------------------------------------------------------------------
+
+! when ipass_calc_updraft == 2, apply the activation tendencies
+! from pass 1, but multiplied by factor_reduce_actfrac
+! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2)
+
+ if (ipass_calc_updraft == 2) then
+
+ dt_u_inv = 1.0_r8/dt_u
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ delact = dconudt(2,mm)*dt_u * factor_reduce_actfrac
+ delact = min( delact, conu(1,mm) )
+ delact = max( delact, 0.0_r8 )
+ conu(1,mm) = conu(1,mm) - delact
+ conu(2,mm) = conu(2,mm) + delact
+ dconudt(1,mm) = -delact*dt_u_inv
+ dconudt(2,mm) = delact*dt_u_inv
+ end do
+ end do ! "n = 1, ntot_amode"
+ return
+
+ end if ! (ipass_calc_updraft == 2)
+
+! check f_ent > 0
+ if (f_ent <= 0.0_r8) return
+
+ hygro = 0.0_r8
+ vaerosol = 0.0_r8
+ naerosol = 0.0_r8
+
+ do m = 1, nbins
+! compute a (or a+cw) volume and hygroscopicity
+ tmpa = 0.0_r8
+ tmpb = 0.0_r8
+ do l = 1, aero_props%nspecies(m)
+
+ mm = aero_props%indexer(m,l)
+
+ call aero_props%get(m, l, spectype=spec_type, density=spec_dens, hygro=spec_hygro)
+
+ tmpc = max( conu(1,mm), 0.0_r8 )
+ if ( use_cwaer_for_activate_maxsat ) &
+ tmpc = tmpc + max( conu(2,mm), 0.0_r8 )
+ tmpc = tmpc / spec_dens
+ tmpa = tmpa + tmpc
+
+ ! Change the hygroscopicity of POM based on the discussion with Prof.
+ ! Xiaohong Liu. Some observational studies found that the primary organic
+ ! material from biomass burning emission shows very high hygroscopicity.
+ ! Also, found that BC mass will be overestimated if all the aerosols in
+ ! the primary mode are free to be removed. Therefore, set the hygroscopicity
+ ! of POM here as 0.2 to enhance the wet scavenge of primary BC and POM.
+
+ if (spec_type=='p-organic' .and. convproc_pom_spechygro>0._r8) then
+ tmpb = tmpb + tmpc * convproc_pom_spechygro
+ else
+ tmpb = tmpb + tmpc * spec_hygro
+ end if
+ end do
+ vaerosol(m) = tmpa * rhoair
+ if (tmpa < 1.0e-35_r8) then
+ hygro(m) = 0.2_r8
+ else
+ hygro(m) = tmpb/tmpa
+ end if
+
+ mm = aero_props%indexer(m,0)
+
+! load a (or a+cw) number and bound it
+ tmpa = max( conu(1,mm), 0.0_r8 )
+ if ( use_cwaer_for_activate_maxsat ) &
+ tmpa = tmpa + max( conu(2,mm), 0.0_r8 )
+ naerosol(m) = tmpa * rhoair
+
+ naerosol_a(1) = naerosol(m)
+ vaerosol_a(1) = vaerosol(m)
+
+ call aero_props%apply_number_limits( naerosol_a, vaerosol_a, 1, 1, m )
+
+ naerosol(m) = naerosol_a(1)
+
+ end do
+
+! call Razzak-Ghan activation routine with single updraft
+ wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now
+ sigw = 0.0_r8
+ wdiab = 0.0_r8
+ wminf = wbar
+ wmaxf = wbar
+
+ if (k == kactfirst) then
+
+ call activate_aerosol( &
+ wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
+ naerosol, nbins, vaerosol, hygro, aero_props, &
+ fn, fm, fluxn, fluxm, flux_fullact )
+
+
+ else
+! above cloud base - do secondary activation with prescribed supersat
+! that is constant with height
+ smax_prescribed = method2_activate_smaxmax
+ call activate_aerosol( &
+ wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
+ naerosol, nbins, vaerosol, hygro, aero_props, &
+ fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed )
+ end if
+
+! apply the activation fractions to the updraft aerosol mixing ratios
+ dt_u_inv = 1.0_r8/dt_u
+
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+ if (l==0) then
+ tmp_fact = fn(m)
+ else
+ tmp_fact = fm(m)
+ end if
+
+ if ( (method_reduce_actfrac == 1) .and. &
+ (factor_reduce_actfrac >= 0.0_r8) .and. &
+ (factor_reduce_actfrac < 1.0_r8) ) &
+ tmp_fact = tmp_fact * factor_reduce_actfrac
+
+ delact = min( conu(1,mm)*tmp_fact, conu(1,mm) )
+ delact = max( delact, 0.0_r8 )
+ conu(1,mm) = conu(1,mm) - delact
+ conu(2,mm) = conu(2,mm) + delact
+ dconudt(1,mm) = -delact*dt_u_inv
+ dconudt(2,mm) = delact*dt_u_inv
+ end do
+ end do
+
+ end subroutine activate_convproc_method2
+
+!=========================================================================================
+ subroutine resuspend_convproc( aero_props, &
+ dcondt, dcondt_resusp, ktop, kbot_prevap )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Calculate resuspension of activated aerosol species resulting from both
+! detrainment from updraft and downdraft into environment
+! subsidence and lifting of environment, which may move air from
+! levels with large-scale cloud to levels with no large-scale cloud
+!
+! Method:
+! Three possible approaches were considered:
+!
+! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated
+! and unactivated portions of a particular aerosol species so that the
+! ratio of dcondt (activated/unactivate) is equal to the ratio of the
+! mixing ratios before convection.
+! THIS WAS IMPLEMENTED IN MIRAGE2
+!
+! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated
+! and unactivated portions of a particular aerosol species so that the
+! change to the activated portion is minimized (zero if possible). The
+! would minimize effects of convection on the large-scale cloud.
+! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective
+! clouds have no impact on the stratiform-cloudborne aerosol
+!
+! 3. Mechanistic approach that treats the details of interactions between
+! the large-scale and convective clouds. (Something for the future.)
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! arguments
+! (note: TMR = tracer mixing ratio)
+
+ class(aerosol_properties), intent(in) :: aero_props
+ real(r8), intent(inout) :: dcondt(2,ncnstaer,pver)
+ ! overall TMR tendency from convection
+ real(r8), intent(inout) :: dcondt_resusp(2,ncnstaer,pver)
+ ! portion of TMR tendency due to resuspension
+ ! (actually, due to the adjustments made here)
+ integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels
+
+!-----------------------------------------------------------------------
+! local variables
+ integer :: k, l, m, mm
+ real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies)
+ !-----------------------------------------------------------------------
+
+ ! apply adjustments to dcondt for pairs of unactivated and
+ ! activated aerosol species
+ do m = 1, aero_props%nbins()
+ do l = 0, aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ do k = ktop, kbot_prevap
+ if (convproc_do_evaprain_atonce) then
+ dcondt_resusp(1,mm,k) = dcondt(1,mm,k)
+ dcondt_resusp(2,mm,k) = dcondt(2,mm,k)
+ else
+ qdota = dcondt(1,mm,k)
+ qdotc = dcondt(2,mm,k)
+ qdotac = qdota + qdotc
+
+ dcondt(1,mm,k) = qdotac
+ dcondt(2,mm,k) = 0.0_r8
+
+ dcondt_resusp(1,mm,k) = (dcondt(1,mm,k) - qdota)
+ dcondt_resusp(2,mm,k) = (dcondt(2,mm,k) - qdotc)
+ end if
+ end do
+
+ end do
+ end do
+
+ end subroutine resuspend_convproc
+
+!=========================================================================================
+
+end module aero_convproc
diff --git a/src/chemistry/aerosol/aero_wetdep_cam.F90 b/src/chemistry/aerosol/aero_wetdep_cam.F90
new file mode 100644
index 0000000000..4a8a4e1ac4
--- /dev/null
+++ b/src/chemistry/aerosol/aero_wetdep_cam.F90
@@ -0,0 +1,1189 @@
+module aero_wetdep_cam
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+ use camsrfexch, only: cam_out_t
+ use physics_buffer,only: physics_buffer_desc, pbuf_get_index, pbuf_set_field, pbuf_get_field
+ use constituents, only: pcnst, cnst_name, cnst_get_ind
+ use phys_control, only: phys_getopts
+ use ppgrid, only: pcols, pver
+ use physconst, only: gravit
+
+ use cam_abortutils,only: endrun
+ use cam_logfile, only: iulog
+ use spmd_utils, only: masterproc
+ use infnan, only: nan, assignment(=)
+
+ use cam_history, only: addfld, add_default, horiz_only, outfld
+ use wetdep, only: wetdep_init
+
+ use rad_constituents, only: rad_cnst_get_info
+
+ use aerosol_properties_mod, only: aero_name_len
+ use aerosol_properties_mod, only: aerosol_properties
+ use modal_aerosol_properties_mod, only: modal_aerosol_properties
+
+ use aerosol_state_mod, only: aerosol_state, ptr2d_t
+ use modal_aerosol_state_mod, only: modal_aerosol_state
+
+ use aero_convproc, only: aero_convproc_readnl, aero_convproc_init, aero_convproc_intr
+ use aero_convproc, only: convproc_do_evaprain_atonce
+ use aero_convproc, only: deepconv_wetdep_history
+
+ use infnan, only: nan, assignment(=)
+ use perf_mod, only: t_startf, t_stopf
+
+ implicit none
+ private
+
+ public :: aero_wetdep_readnl
+ public :: aero_wetdep_init
+ public :: aero_wetdep_tend
+
+ real(r8), parameter :: NOTSET = -huge(1._r8)
+ real(r8) :: sol_facti_cloud_borne = NOTSET
+ real(r8) :: sol_factb_interstitial = NOTSET
+ real(r8) :: sol_factic_interstitial = NOTSET
+
+ integer :: fracis_idx = -1
+ integer :: rprddp_idx = -1
+ integer :: rprdsh_idx = -1
+ integer :: nevapr_shcu_idx = -1
+ integer :: nevapr_dpcu_idx = -1
+
+ logical :: wetdep_active = .false.
+ integer :: nwetdep = 0
+ logical :: convproc_do_aer = .false.
+ logical,allocatable :: aero_cnst_lq(:,:)
+ integer,allocatable :: aero_cnst_id(:,:)
+ logical, public, protected :: wetdep_lq(pcnst) ! set flags true for constituents with non-zero tendencies
+
+ ! variables for table lookup of aerosol impaction/interception scavenging rates
+ integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12
+ real(r8) :: dlndg_nimptblgrow
+ real(r8),allocatable :: scavimptblnum(:,:)
+ real(r8),allocatable :: scavimptblvol(:,:)
+
+ integer :: nmodes=0
+ integer :: nspec_max=0
+ integer :: nele_tot ! total number of aerosol elements
+ class(aerosol_properties), pointer :: aero_props=>null()
+
+contains
+
+ !------------------------------------------------------------------------------
+ !------------------------------------------------------------------------------
+ subroutine aero_wetdep_readnl(nlfile)
+ use namelist_utils, only: find_group_name
+ use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_integer, mpi_success
+ use spmd_utils, only: mpi_logical
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'aero_wetdep_readnl'
+
+ ! ===================
+ ! Namelist definition
+ ! ===================
+ namelist /aero_wetdep_nl/ sol_facti_cloud_borne, sol_factb_interstitial, sol_factic_interstitial
+
+ ! =============
+ ! Read namelist
+ ! =============
+ if (masterproc) then
+ open( newunit=unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'aero_wetdep_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, aero_wetdep_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+
+ ! ============================
+ ! Log namelist options
+ ! ============================
+ write(iulog,*) subname,' namelist settings: '
+ write(iulog,*) ' sol_facti_cloud_borne : ',sol_facti_cloud_borne
+ write(iulog,*) ' sol_factb_interstitial : ',sol_factb_interstitial
+ write(iulog,*) ' sol_factic_interstitial: ',sol_factic_interstitial
+ end if
+
+ ! ============================
+ ! Broadcast namelist variables
+ ! ============================
+ call mpi_bcast(sol_facti_cloud_borne, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr/=mpi_success) then
+ call endrun(subname//': MPI_BCAST ERROR: sol_facti_cloud_borne')
+ end if
+ call mpi_bcast(sol_factb_interstitial, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr/=mpi_success) then
+ call endrun(subname//': MPI_BCAST ERROR: sol_factb_interstitial')
+ end if
+ call mpi_bcast(sol_factic_interstitial, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr/=mpi_success) then
+ call endrun(subname//': MPI_BCAST ERROR: sol_factic_interstitial')
+ end if
+
+ call mpi_bcast(nwetdep, 1, mpi_integer, masterprocid, mpicom, ierr)
+ if (ierr/=mpi_success) then
+ call endrun(subname//': MPI_BCAST ERROR: nwetdep')
+ end if
+
+ wetdep_active = .true. !nwetdep>0
+
+ if (masterproc) then
+ write(iulog,*) subname,' wetdep_active = ',wetdep_active,' nwetdep = ',nwetdep
+ endif
+
+ call aero_convproc_readnl(nlfile)
+
+ end subroutine aero_wetdep_readnl
+
+ !------------------------------------------------------------------------------
+ !------------------------------------------------------------------------------
+ subroutine aero_wetdep_init( )
+
+ character(len=*), parameter :: subrname = 'aero_wetdep_init'
+
+ character(len=2) :: unit_basename ! Units 'kg' or '1'
+ character(len=aero_name_len) :: tmpname
+ character(len=aero_name_len) :: tmpname_cw
+
+ logical :: history_aerosol ! Output MAM or SECT aerosol tendencies
+ logical :: history_chemistry
+
+ integer :: l,m, id, astat
+ character(len=2) :: binstr
+
+ fracis_idx = pbuf_get_index('FRACIS')
+ rprddp_idx = pbuf_get_index('RPRDDP')
+ rprdsh_idx = pbuf_get_index('RPRDSH')
+ nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU')
+ nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU')
+
+ if (.not.wetdep_active) return
+
+ call phys_getopts(history_aerosol_out = history_aerosol, &
+ history_chemistry_out=history_chemistry, &
+ convproc_do_aer_out = convproc_do_aer)
+
+ call rad_cnst_get_info(0, nmodes=nmodes)
+
+ if (nmodes>0) then
+ aero_props => modal_aerosol_properties()
+ if (.not.associated(aero_props)) then
+ call endrun(subrname//' : construction of aero_props modal_aerosol_properties object failed')
+ end if
+ else
+ call endrun(subrname//' : cannot determine aerosol model')
+ endif
+
+ nele_tot = aero_props%ncnst_tot()
+
+ allocate(aero_cnst_lq(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat)
+ if (astat/=0) then
+ call endrun(subrname//' : not able to allocate aero_cnst_lq array')
+ end if
+ aero_cnst_lq(:,:) = .false.
+
+ allocate(aero_cnst_id(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat)
+ if (astat/=0) then
+ call endrun(subrname//' : not able to allocate aero_cnst_id array')
+ end if
+ aero_cnst_id(:,:) = -1
+
+ wetdep_lq = .false.
+
+ do m = 1, aero_props%nbins()
+ write(binstr,'(i2.2)') m
+ call addfld('SOLFACTB'//binstr, (/ 'lev' /), 'A', '1', 'below cld sol fact')
+
+ do l = 0, aero_props%nmasses(m)
+
+ if (l == 0) then ! number
+ call aero_props%num_names( m, tmpname, tmpname_cw)
+ else
+ call aero_props%mmr_names( m,l, tmpname, tmpname_cw)
+ end if
+
+ call cnst_get_ind(tmpname, id, abort=.false.)
+ aero_cnst_id(m,l) = id
+ aero_cnst_lq(m,l) = id > 0
+ if (id > 0) then
+ wetdep_lq(id) = .true.
+ end if
+
+ ! units --
+ if (l==0) then
+ unit_basename = ' 1' ! for num
+ else
+ unit_basename = 'kg'
+ endif
+
+ call add_hist_fields(tmpname, unit_basename)
+ call add_hist_fields(tmpname_cw, unit_basename)
+
+ call addfld( trim(tmpname_cw)//'RSPTD', (/ 'lev' /), 'A', unit_basename//'/kg/s', &
+ trim(tmpname_cw)//' resuspension tendency')
+
+ end do
+ end do
+
+ allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, aero_props%nbins()), stat=astat)
+ if (astat/=0) then
+ call endrun(subrname//' : not able to allocate scavimptblnum array')
+ end if
+ allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, aero_props%nbins()), stat=astat)
+ if (astat/=0) then
+ call endrun(subrname//' : not able to allocate scavimptblvol array')
+ end if
+ scavimptblnum = nan
+ scavimptblvol = nan
+
+ call wetdep_init()
+
+ nspec_max = maxval(aero_props%nspecies()) + 2
+
+ call init_bcscavcoef()
+
+ if (convproc_do_aer) then
+ call aero_convproc_init(aero_props)
+ end if
+
+ contains
+
+ subroutine add_hist_fields(name,baseunits)
+ character(len=*), intent(in) :: name
+ character(len=*), intent(in) :: baseunits
+
+ call addfld (trim(name)//'SFWET', &
+ horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux at surface')
+ call addfld (trim(name)//'SFSIC', &
+ horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (incloud, convective) at surface')
+ call addfld (trim(name)//'SFSIS', &
+ horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface')
+ call addfld (trim(name)//'SFSBC', &
+ horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface')
+ call addfld (trim(name)//'SFSBS', &
+ horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface')
+
+ if (convproc_do_aer) then
+ call addfld (trim(name)//'SFSEC', &
+ horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (precip evap, convective) at surface')
+ call addfld (trim(name)//'SFSES', &
+ horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (precip evap, stratiform) at surface')
+ call addfld (trim(name)//'SFSBD', &
+ horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (belowcloud, deep convective) at surface')
+ call addfld (trim(name)//'WETC', &
+ (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency')
+ call addfld (trim(name)//'CONU', &
+ (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio')
+ end if
+
+ call addfld (trim(name)//'WET',(/ 'lev' /), 'A',baseunits//'/kg/s ','wet deposition tendency')
+ call addfld (trim(name)//'INS',(/ 'lev' /), 'A',baseunits//'/kg/s ','insol frac')
+
+ call addfld (trim(name)//'SIC',(/ 'lev' /), 'A',baseunits//'/kg/s ', &
+ trim(name)//' ic wet deposition')
+ call addfld (trim(name)//'SIS',(/ 'lev' /), 'A',baseunits//'/kg/s ', &
+ trim(name)//' is wet deposition')
+ call addfld (trim(name)//'SBC',(/ 'lev' /), 'A',baseunits//'/kg/s ', &
+ trim(name)//' bc wet deposition')
+ call addfld (trim(name)//'SBS',(/ 'lev' /), 'A',baseunits//'/kg/s ', &
+ trim(name)//' bs wet deposition')
+
+ if ( history_aerosol .or. history_chemistry ) then
+ call add_default (trim(name)//'SFWET', 1, ' ')
+ endif
+ if ( history_aerosol ) then
+ call add_default (trim(name)//'SFSEC', 1, ' ')
+ call add_default (trim(name)//'SFSIC', 1, ' ')
+ call add_default (trim(name)//'SFSIS', 1, ' ')
+ call add_default (trim(name)//'SFSBC', 1, ' ')
+ call add_default (trim(name)//'SFSBS', 1, ' ')
+ if (convproc_do_aer) then
+ call add_default (trim(name)//'SFSES', 1, ' ')
+ call add_default (trim(name)//'SFSBD', 1, ' ')
+ end if
+ endif
+
+ end subroutine add_hist_fields
+
+ end subroutine aero_wetdep_init
+
+ !------------------------------------------------------------------------------
+ !------------------------------------------------------------------------------
+ subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf)
+ use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t
+ use aerodep_flx, only: aerodep_flx_prescribed
+ use aero_deposition_cam, only: aero_deposition_cam_setwet
+
+ type(physics_state), target, intent(in) :: state ! Physics state variables
+ real(r8), intent(in) :: dt ! time step
+ real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s]
+ type(cam_out_t), intent(inout) :: cam_out ! export state
+ type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ character(len=*), parameter :: subrname = 'aero_wetdep_tend'
+ type(wetdep_inputs_t) :: dep_inputs
+ real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble (pcols, pver, pcnst)
+ real(r8), target :: fracis_nadv(pcols,pver) ! fraction of not-transported aerosols
+
+ real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for
+ ! cloud-borne num & vol (0),
+ ! interstitial num (1), interstitial vol (2)
+ integer :: jnv ! index for scavcoefnv 3rd dimension
+ integer :: lphase ! index for interstitial / cloudborne aerosol
+ integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop
+
+ real(r8) :: sol_factb(pcols, pver)
+ real(r8) :: sol_facti(pcols, pver)
+ real(r8) :: sol_factic(pcols,pver)
+
+ real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species
+ real(r8) :: rcscavt(pcols, pver)
+ real(r8) :: rsscavt(pcols, pver)
+ real(r8) :: iscavt(pcols, pver)
+ real(r8) :: icscavt(pcols, pver)
+ real(r8) :: isscavt(pcols, pver)
+ real(r8) :: bcscavt(pcols, pver)
+ real(r8) :: bsscavt(pcols, pver)
+
+ real(r8) :: diam_wet(state%ncol, pver)
+ logical :: isprx(pcols,pver) ! true if precipation
+ real(r8) :: prec(pcols) ! precipitation rate
+
+ real(r8) :: rtscavt(pcols, pver, 0:nspec_max)
+
+ integer :: ncol, lchnk, m, ndx,mm, l
+ integer :: i,k
+
+ real(r8), pointer :: insolfr_ptr(:,:)
+ real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species
+ logical :: cldbrn
+
+ type(ptr2d_t) :: raer(nele_tot)
+ type(ptr2d_t) :: qqcw(nele_tot)
+
+ real(r8) :: sflx(pcols)
+ character(len=aero_name_len) :: aname, cname, name
+
+ real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max)
+ real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01
+
+ character(len=2) :: binstr
+ real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water)
+ real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial)
+ real(r8) :: dcondt_resusp3d(nele_tot,pcols,pver)
+
+ integer, parameter :: nsrflx_mzaer2cnvpr = 2
+ real(r8) :: qsrflx_mzaer2cnvpr(pcols,nele_tot,nsrflx_mzaer2cnvpr)
+
+ real(r8), pointer :: rprddp(:,:) ! rain production, deep convection
+ real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection
+ real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0.
+ real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0.
+
+ real(r8) :: rprddpsum(pcols)
+ real(r8) :: rprdshsum(pcols)
+ real(r8) :: evapcdpsum(pcols)
+ real(r8) :: evapcshsum(pcols)
+
+ real(r8) :: tmp_resudp, tmp_resush
+ real(r8) :: tmpa, tmpb
+ real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux
+ real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux
+ real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux
+
+ class(aerosol_state), pointer :: aero_state
+
+ nullify(aero_state)
+
+ if (.not.wetdep_active) return
+
+ dcondt_resusp3d(:,:,:) = 0._r8
+
+ if (nmodes>0) then
+ aero_state => modal_aerosol_state(state,pbuf)
+ if (.not.associated(aero_state)) then
+ call endrun(subrname//' : construction of aero_state modal_aerosol_state object failed')
+ end if
+ else
+ call endrun(subrname//' : cannot determine aerosol model')
+ endif
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ call physics_ptend_init(ptend, state%psetcols, subrname, lq=wetdep_lq)
+
+ call wetdep_inputs_set( state, pbuf, dep_inputs )
+
+ call pbuf_get_field(pbuf, fracis_idx, fracis)
+
+ call aero_state%get_states( aero_props, raer, qqcw )
+
+ qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8
+ aerdepwetis(:,:) = 0.0_r8
+ aerdepwetcw(:,:) = 0.0_r8
+
+ if (convproc_do_aer) then
+ !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne
+ !can be saved then applied to interstitial
+ strt_loop = 2
+ end_loop = 1
+ stride_loop = -1
+ else
+ ! Counters for "without" unified convective treatment (i.e. default case)
+ strt_loop = 1
+ end_loop = 2
+ stride_loop = 1
+ endif
+
+ prec(:ncol)=0._r8
+ do k=1,pver
+ where (prec(:ncol) >= 1.e-7_r8)
+ isprx(:ncol,k) = .true.
+ elsewhere
+ isprx(:ncol,k) = .false.
+ endwhere
+ prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) &
+ *state%pdel(:ncol,k)/gravit
+ end do
+
+ f_act_conv = 0._r8
+ scavcoefnv = nan
+ qqcw_sav = nan
+
+ if (convproc_do_aer) then
+
+ call t_startf('aero_convproc')
+ call aero_convproc_intr( aero_props, aero_state, state, ptend, pbuf, dt, &
+ nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d )
+
+ if (convproc_do_evaprain_atonce) then
+
+ do m = 1,aero_props%nbins()
+ do l = 0,aero_props%nmasses(m)
+ mm = aero_props%indexer(m,l)
+
+ if (l == 0) then ! number
+ call aero_props%num_names(m, aname, cname)
+ else
+ call aero_props%mmr_names(m,l, aname, cname)
+ end if
+
+ call outfld( trim(cname)//'RSPTD', dcondt_resusp3d(mm,:ncol,:), ncol, lchnk )
+
+ do k = 1,pver
+ do i = 1,ncol
+ qqcw(mm)%fld(i,k) = max(0._r8, qqcw(mm)%fld(i,k) + dcondt_resusp3d(mm,i,k)*dt)
+ end do
+ end do
+
+ end do
+ end do
+ end if
+ call t_stopf('aero_convproc')
+
+ end if
+
+ bins_loop: do m = 1,aero_props%nbins()
+
+ phase_loop: do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms
+
+ cldbrn = lphase==2
+
+ sol_factb = nan
+ sol_facti = nan
+ sol_factic = nan
+
+ if (lphase == 1) then ! interstial aerosol
+
+ sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial
+
+ sol_factic = sol_factic_interstitial
+
+ else ! cloud-borne aerosol (borne by stratiform cloud drops)
+
+ sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud")
+ sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor
+ sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
+ ! that conv precip collects strat droplets)
+ f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
+
+ end if
+ if (convproc_do_aer .and. lphase == 1) then
+ ! if modal aero convproc is turned on for aerosols, then
+ ! turn off the convective in-cloud removal for interstitial aerosols
+ ! (but leave the below-cloud on, as convproc only does in-cloud)
+ ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls
+ ! for (stratiform)-cloudborne aerosols, convective wet removal
+ ! (all forms) is zero, so no action is needed
+ sol_factic = 0.0_r8
+ endif
+
+ diam_wet = aero_state%wet_diameter(m,ncol,pver)
+
+ scavcoefnv = 0.0_r8
+
+ if (lphase == 1) then ! interstial aerosol
+ call get_bcscavcoefs( m, ncol, isprx, diam_wet, scavcoefnv(:,:,1), scavcoefnv(:,:,2) )
+
+ if ( sol_factb_interstitial /= NOTSET ) then
+ sol_factb(:ncol,:) = sol_factb_interstitial ! all below-cloud scav
+ else
+ sol_factb(:ncol,:) = aero_state%sol_factb_interstitial( m, ncol, pver, aero_props )
+ end if
+
+ write(binstr,'(i2.2)') m
+ call outfld('SOLFACTB'//binstr,sol_factb, pcols, lchnk)
+
+ end if
+
+ masses_loop: do l = 0,aero_props%nmasses(m)
+
+ ndx = aero_cnst_id(m,l)
+
+ if (.not. cldbrn .and. ndx>0) then
+ insolfr_ptr => fracis(:,:,ndx)
+ else
+ insolfr_ptr => fracis_nadv
+ endif
+
+ mm = aero_props%indexer(m,l)
+
+ if (l == 0) then ! number
+ call aero_props%num_names( m, aname, cname)
+ else
+ call aero_props%mmr_names( m,l, aname, cname)
+ end if
+
+ if (cldbrn) then
+ q_tmp(1:ncol,:) = qqcw(mm)%fld(1:ncol,:)
+ jnv = 0
+ if (convproc_do_aer) then
+ qqcw_sav(:ncol,:,l) = q_tmp(1:ncol,:)
+ endif
+ name = cname
+ qqcw_in = nan
+ f_act_conv = nan
+ else ! interstial aerosol
+ q_tmp(1:ncol,:) = raer(mm)%fld(1:ncol,:) + ptend%q(1:ncol,:,ndx)*dt
+ if (l==0) then
+ jnv = 1
+ else
+ jnv = 2
+ end if
+ if(convproc_do_aer) then
+ !Feed in the saved cloudborne mixing ratios from phase 2
+ qqcw_in(:ncol,:) = qqcw_sav(:ncol,:,l)
+ else
+ qqcw_in(:ncol,:) = qqcw(mm)%fld(:ncol,:)
+ end if
+
+ f_act_conv(:ncol,:) = aero_state%convcld_actfrac( m, l, ncol, pver)
+ name = aname
+ end if
+
+ dqdt_tmp(1:ncol,:) = 0.0_r8
+
+ call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, &
+ dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, &
+ dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, &
+ dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, &
+ dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, &
+ dlf, insolfr_ptr, sol_factb, ncol, &
+ scavcoefnv(:,:,jnv), &
+ is_strat_cloudborne=cldbrn, &
+ qqcw=qqcw_in(:,:), f_act_conv=f_act_conv, &
+ icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
+ convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, &
+ sol_facti_in=sol_facti, sol_factic_in=sol_factic, &
+ convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, &
+ bergso_in=dep_inputs%bergso )
+
+ if(convproc_do_aer) then
+ if(cldbrn) then
+ ! save resuspension of cloudborne species
+ rtscavt(1:ncol,:,l) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:)
+ ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source)
+ ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above)
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,l)
+ else
+ ! add resuspension of cloudborne species to dqdt of interstitial species
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,l)
+ end if
+ endif
+
+ if (cldbrn .or. ndx<0) then
+ do k = 1,pver
+ do i = 1,ncol
+ if ( (qqcw(mm)%fld(i,k) + dqdt_tmp(i,k) * dt) .lt. 0.0_r8 ) then
+ dqdt_tmp(i,k) = - qqcw(mm)%fld(i,k) / dt
+ end if
+ end do
+ end do
+
+ qqcw(mm)%fld(1:ncol,:) = qqcw(mm)%fld(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt
+
+ else
+ ptend%q(1:ncol,:,ndx) = ptend%q(1:ncol,:,ndx) + dqdt_tmp(1:ncol,:)
+ end if
+
+ call outfld( trim(name)//'WET', dqdt_tmp(:,:), pcols, lchnk)
+ call outfld( trim(name)//'SIC', icscavt, pcols, lchnk)
+ call outfld( trim(name)//'SIS', isscavt, pcols, lchnk)
+ call outfld( trim(name)//'SBC', bcscavt, pcols, lchnk)
+ call outfld( trim(name)//'SBS', bsscavt, pcols, lchnk)
+
+ call outfld( trim(name)//'INS', insolfr_ptr, pcols, lchnk)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ if (cldbrn) then
+ call outfld( trim(name)//'SFWET', sflx, pcols, lchnk)
+ if (ndx>0) aerdepwetcw(:ncol,ndx) = sflx(:ncol)
+ else
+ if (.not.convproc_do_aer) call outfld( trim(name)//'SFWET', sflx, pcols, lchnk)
+ if (ndx>0) aerdepwetis(:ncol,ndx) = aerdepwetis(:ncol,ndx) + sflx(:ncol)
+ end if
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ if (cldbrn) then
+ call outfld( trim(name)//'SFSIC', sflx, pcols, lchnk)
+ else
+ if (.not.convproc_do_aer) call outfld( trim(name)//'SFSIC', sflx, pcols, lchnk)
+ if (convproc_do_aer) sflxic = sflx
+ end if
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(name)//'SFSIS', sflx, pcols, lchnk)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(name)//'SFSBC', sflx, pcols, lchnk)
+ if (convproc_do_aer) sflxbc = sflx
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(name)//'SFSBS', sflx, pcols, lchnk)
+
+ if(convproc_do_aer) then
+
+ sflx(:)=0.0_r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(name)//'SFSES', sflx, pcols, lchnk)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ if (.not.convproc_do_aer) call outfld( trim(name)//'SFSEC', sflx, pcols, lchnk)
+ sflxec = sflx
+
+ if(.not.cldbrn) then
+
+ ! apportion convective surface fluxes to deep and shallow conv
+ ! this could be done more accurately in subr wetdepa
+ ! since deep and shallow rarely occur simultaneously, and these
+ ! fields are just diagnostics, this approximate method is adequate
+ ! only do this for interstitial aerosol, because conv clouds to not
+ ! affect the stratiform-cloudborne aerosol
+ if ( deepconv_wetdep_history) then
+
+ call pbuf_get_field(pbuf, rprddp_idx, rprddp )
+ call pbuf_get_field(pbuf, rprdsh_idx, rprdsh )
+ call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp )
+ call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh )
+
+ rprddpsum(:) = 0.0_r8
+ rprdshsum(:) = 0.0_r8
+ evapcdpsum(:) = 0.0_r8
+ evapcshsum(:) = 0.0_r8
+
+ do k = 1, pver
+ rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit
+ rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit
+ evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit
+ evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit
+ end do
+
+ do i = 1, ncol
+ rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 )
+ rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 )
+ evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 )
+ evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 )
+
+ ! assume that in- and below-cloud removal are proportional to column precip production
+ tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i))
+ tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) )
+ sflxicdp(i) = sflxic(i)*tmpa
+ sflxbcdp(i) = sflxbc(i)*tmpa
+
+ ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)]
+ tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 )
+ tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 )
+ tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 )
+ tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) )
+ sflxecdp(i) = sflxec(i)*tmpb
+ end do
+ call outfld( trim(name)//'SFSBD', sflxbcdp, pcols, lchnk)
+ else
+ sflxec(1:ncol) = 0.0_r8
+ sflxecdp(1:ncol) = 0.0_r8
+ end if
+
+ ! when ma_convproc_intr is used, convective in-cloud wet removal is done there
+ ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud
+ ! contributions
+ ! so pass the below-cloud contribution to ma_convproc_intr
+ qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol)
+ qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol)
+
+ end if
+ end if
+
+ end do masses_loop
+ end do phase_loop
+
+ end do bins_loop
+
+ if (associated(aero_state)) then
+ deallocate(aero_state)
+ nullify(aero_state)
+ end if
+
+ ! if the user has specified prescribed aerosol dep fluxes then
+ ! do not set cam_out dep fluxes according to the prognostic aerosols
+ if (.not. aerodep_flx_prescribed()) then
+ call aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out)
+ endif
+
+ contains
+
+ ! below cloud impaction scavenging coefs
+ subroutine get_bcscavcoefs( m, ncol, isprx, diam_wet, scavcoefnum, scavcoefvol )
+
+ integer,intent(in) :: m, ncol
+ logical,intent(in):: isprx(:,:)
+ real(r8), intent(in) :: diam_wet(:,:)
+ real(r8), intent(out) :: scavcoefnum(:,:), scavcoefvol(:,:)
+
+ integer i, k, jgrow
+ real(r8) dumdgratio, xgrow, dumfhi, dumflo, scavimpvol, scavimpnum
+
+ do k = 1, pver
+ do i = 1, ncol
+
+ ! do only if no precip
+ if ( isprx(i,k) .and. diam_wet(i,k)>0.0_r8) then
+ !
+ ! interpolate table values using log of (actual-wet-size)/(base-dry-size)
+
+ dumdgratio = diam_wet(i,k)/aero_props%scav_diam(m)
+ if ((dumdgratio >= 0.99_r8) .and. (dumdgratio <= 1.01_r8)) then
+ scavimpvol = scavimptblvol(0,m)
+ scavimpnum = scavimptblnum(0,m)
+ else
+ xgrow = log( dumdgratio ) / dlndg_nimptblgrow
+ jgrow = int( xgrow )
+ if (xgrow < 0._r8) jgrow = jgrow - 1
+ if (jgrow < nimptblgrow_mind) then
+ jgrow = nimptblgrow_mind
+ xgrow = jgrow
+ else
+ jgrow = min( jgrow, nimptblgrow_maxd-1 )
+ end if
+
+ dumfhi = xgrow - jgrow
+ dumflo = 1._r8 - dumfhi
+
+ scavimpvol = dumflo*scavimptblvol(jgrow,m) + &
+ dumfhi*scavimptblvol(jgrow+1,m)
+ scavimpnum = dumflo*scavimptblnum(jgrow,m) + &
+ dumfhi*scavimptblnum(jgrow+1,m)
+
+ end if
+
+ ! impaction scavenging removal amount for volume
+ scavcoefvol(i,k) = exp( scavimpvol )
+ ! impaction scavenging removal amount to number
+ scavcoefnum(i,k) = exp( scavimpnum )
+
+ else
+ scavcoefvol(i,k) = 0._r8
+ scavcoefnum(i,k) = 0._r8
+ end if
+
+ end do
+ end do
+
+ end subroutine get_bcscavcoefs
+
+ end subroutine aero_wetdep_tend
+
+ !------------------------------------------------------------------------------
+ !------------------------------------------------------------------------------
+ subroutine init_bcscavcoef( )
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Computes lookup table for aerosol impaction/interception scavenging rates
+ !
+ ! Authors: R. Easter
+ ! Simone Tilmes Nov 2021
+ ! added modifications for bin model, assuming sigma = 1.
+ !
+ !-----------------------------------------------------------------------
+
+ use mo_constants, only: pi
+
+ ! local variables
+ integer nnfit_maxd
+ parameter (nnfit_maxd=27)
+
+ integer m, jgrow, nnfit
+ integer lunerr
+
+ real(r8) dg0, dg0_cgs, press, dg0_base, &
+ rhodryaero, rhowetaero, rhowetaero_cgs, &
+ scavratenum, scavratevol, logsig, &
+ temp, wetdiaratio, wetvolratio
+
+ real(r8) :: xxfitnum(1,nnfit_maxd), yyfitnum(nnfit_maxd)
+ real(r8) :: xxfitvol(1,nnfit_maxd), yyfitvol(nnfit_maxd)
+
+ character(len=*), parameter :: subname = 'aero_wetdep_cam::init_bcscavcoef'
+
+ lunerr = iulog
+ dlndg_nimptblgrow = log( 1.25_r8 )
+
+ ! bin model: main loop over aerosol bins
+
+ modeloop: do m = 1, aero_props%nbins()
+
+ ! for setting up the lookup table, use the dry density of the first species
+ ! -- assume the first species of the mode/bin is the dominate species
+ call aero_props%get(m,1,density=rhodryaero)
+
+ dg0_base = aero_props%scav_diam(m)
+
+ logsig = aero_props%alogsig(m)
+
+ growloop: do jgrow = nimptblgrow_mind, nimptblgrow_maxd
+
+ wetdiaratio = exp( jgrow*dlndg_nimptblgrow )
+ dg0 = dg0_base*wetdiaratio
+
+ wetvolratio = exp( jgrow*dlndg_nimptblgrow*3._r8 )
+ rhowetaero = 1.0_r8 + (rhodryaero-1.0_r8)/wetvolratio
+ rhowetaero = min( rhowetaero, rhodryaero )
+
+ !
+ ! compute impaction scavenging rates at 1 temp-press pair and save
+ !
+ nnfit = 0
+
+ temp = 273.16_r8
+ press = 0.75e6_r8 ! dynes/cm2
+ rhowetaero = rhodryaero
+
+ dg0_cgs = dg0*1.0e2_r8 ! m to cm
+
+ rhowetaero_cgs = rhowetaero*1.0e-3_r8 ! kg/m3 to g/cm3
+
+ call calc_1_impact_rate( &
+ dg0_cgs, logsig, rhowetaero_cgs, temp, press, &
+ scavratenum, scavratevol, lunerr )
+
+ nnfit = nnfit + 1
+ if (nnfit > nnfit_maxd) then
+ write(lunerr,9110)
+ call endrun(subname//' : nnfit > nnfit_maxd')
+ end if
+9110 format( '*** subr. init_bcscavcoef -- nnfit too big' )
+
+ xxfitnum(1,nnfit) = 1._r8
+ yyfitnum(nnfit) = log( scavratenum )
+
+ xxfitvol(1,nnfit) = 1._r8
+ yyfitvol(nnfit) = log( scavratevol )
+
+ !depends on both bins and different species
+ scavimptblnum(jgrow,m) = yyfitnum(1)
+ scavimptblvol(jgrow,m) = yyfitvol(1)
+
+ enddo growloop
+ enddo modeloop
+
+ contains
+
+ !===============================================================================
+ subroutine calc_1_impact_rate( &
+ dg0, logsig, rhoaero, temp, press, &
+ scavratenum, scavratevol, lunerr )
+ !
+ ! routine computes a single impaction scavenging rate
+ ! for precipitation rate of 1 mm/h
+ !
+ ! dg0 = geometric mean diameter of aerosol number size distrib. (cm)
+ ! sigmag = geometric standard deviation of size distrib.
+ ! rhoaero = density of aerosol particles (g/cm^3)
+ ! temp = temperature (K)
+ ! press = pressure (dyne/cm^2)
+ ! scavratenum = number scavenging rate (1/h)
+ ! scavratevol = volume or mass scavenging rate (1/h)
+ ! lunerr = logical unit for error message
+ !
+ use mo_constants, only: boltz_cgs, pi, rhowater => rhoh2o_cgs, rgas => rgas_cgs
+
+ implicit none
+
+ ! subr. parameters
+ integer, intent(in) :: lunerr
+ real(r8), intent(in) :: dg0, logsig, rhoaero, temp, press
+ real(r8), intent(out) :: scavratenum, scavratevol
+
+ ! local variables
+ integer nrainsvmax
+ parameter (nrainsvmax=50)
+ real(r8) rrainsv(nrainsvmax), xnumrainsv(nrainsvmax),&
+ vfallrainsv(nrainsvmax)
+
+ integer naerosvmax
+ parameter (naerosvmax=51)
+ real(r8) aaerosv(naerosvmax), &
+ ynumaerosv(naerosvmax), yvolaerosv(naerosvmax)
+
+ integer i, ja, jr, na, nr
+ real(r8) a, aerodiffus, aeromass, ag0, airdynvisc, airkinvisc
+ real(r8) anumsum, avolsum, cair, chi
+ real(r8) d, dr, dum, dumfuchs, dx
+ real(r8) ebrown, eimpact, eintercept, etotal, freepath
+ real(r8) precip, precipmmhr, precipsum
+ real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum
+ real(r8) scavsumnum, scavsumnumbb
+ real(r8) scavsumvol, scavsumvolbb
+ real(r8) schmidt, sqrtreynolds, sstar, stokes, sx
+ real(r8) taurelax, vfall, vfallstp
+ real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair
+
+ rlo = .005_r8
+ rhi = .250_r8
+ dr = 0.005_r8
+ nr = 1 + nint( (rhi-rlo)/dr )
+ if (nr > nrainsvmax) then
+ write(lunerr,9110)
+ call endrun(subname//' : nr > nrainsvmax')
+ end if
+
+9110 format( '*** subr. calc_1_impact_rate -- nr > nrainsvmax' )
+
+ precipmmhr = 1.0_r8
+ precip = precipmmhr/36000._r8
+
+ ag0 = dg0/2._r8
+ sx = logsig
+ xg0 = log( ag0 )
+ xg3 = xg0 + 3._r8*sx*sx
+
+ xlo = xg3 - 4._r8*sx
+ xhi = xg3 + 4._r8*sx
+ dx = 0.2_r8*sx
+
+ dx = max( 0.2_r8*sx, 0.01_r8 )
+ xlo = xg3 - max( 4._r8*sx, 2._r8*dx )
+ xhi = xg3 + max( 4._r8*sx, 2._r8*dx )
+
+ na = 1 + nint( (xhi-xlo)/dx )
+ if (na > naerosvmax) then
+ write(lunerr,9120)
+ call endrun(subname//' : na > naerosvmax')
+ end if
+
+9120 format( '*** subr. calc_1_impact_rate -- na > naerosvmax' )
+
+ ! air molar density
+ cair = press/(rgas*temp)
+ ! air mass density
+ rhoair = 28.966_r8*cair
+ ! molecular freepath
+ freepath = 2.8052e-10_r8/cair
+ ! air dynamic viscosity
+ airdynvisc = 1.8325e-4_r8 * (416.16_r8/(temp+120._r8)) * &
+ ((temp/296.16_r8)**1.5_r8)
+ ! air kinemaic viscosity
+ airkinvisc = airdynvisc/rhoair
+ ! ratio of water viscosity to air viscosity (from Slinn)
+ xmuwaterair = 60.0_r8
+
+ !
+ ! compute rain drop number concentrations
+ ! rrainsv = raindrop radius (cm)
+ ! xnumrainsv = raindrop number concentration (#/cm^3)
+ ! (number in the bin, not number density)
+ ! vfallrainsv = fall velocity (cm/s)
+ !
+ precipsum = 0._r8
+ do i = 1, nr
+ r = rlo + (i-1)*dr
+ rrainsv(i) = r
+ xnumrainsv(i) = exp( -r/2.7e-2_r8 )
+
+ d = 2._r8*r
+ if (d <= 0.007_r8) then
+ vfallstp = 2.88e5_r8 * d**2._r8
+ else if (d <= 0.025_r8) then
+ vfallstp = 2.8008e4_r8 * d**1.528_r8
+ else if (d <= 0.1_r8) then
+ vfallstp = 4104.9_r8 * d**1.008_r8
+ else if (d <= 0.25_r8) then
+ vfallstp = 1812.1_r8 * d**0.638_r8
+ else
+ vfallstp = 1069.8_r8 * d**0.235_r8
+ end if
+
+ vfall = vfallstp * sqrt(1.204e-3_r8/rhoair)
+ vfallrainsv(i) = vfall
+ precipsum = precipsum + vfall*(r**3)*xnumrainsv(i)
+ end do
+ precipsum = precipsum*pi*1.333333_r8
+
+ rnumsum = 0._r8
+ do i = 1, nr
+ xnumrainsv(i) = xnumrainsv(i)*(precip/precipsum)
+ rnumsum = rnumsum + xnumrainsv(i)
+ end do
+
+ !
+ ! compute aerosol concentrations
+ ! aaerosv = particle radius (cm)
+ ! fnumaerosv = fraction of total number in the bin (--)
+ ! fvolaerosv = fraction of total volume in the bin (--)
+ !
+ anumsum = 0._r8
+ avolsum = 0._r8
+ do i = 1, na
+ x = xlo + (i-1)*dx
+ a = exp( x )
+ aaerosv(i) = a
+ dum = (x - xg0)/sx
+ ynumaerosv(i) = exp( -0.5_r8*dum*dum )
+ yvolaerosv(i) = ynumaerosv(i)*1.3333_r8*pi*a*a*a
+ anumsum = anumsum + ynumaerosv(i)
+ avolsum = avolsum + yvolaerosv(i)
+ end do
+
+ do i = 1, na
+ ynumaerosv(i) = ynumaerosv(i)/anumsum
+ yvolaerosv(i) = yvolaerosv(i)/avolsum
+ end do
+
+ !
+ ! compute scavenging
+ !
+ scavsumnum = 0._r8
+ scavsumvol = 0._r8
+ !
+ ! outer loop for rain drop radius
+ !
+ jr_loop: do jr = 1, nr
+
+ r = rrainsv(jr)
+ vfall = vfallrainsv(jr)
+
+ reynolds = r * vfall / airkinvisc
+ sqrtreynolds = sqrt( reynolds )
+
+ !
+ ! inner loop for aerosol particle radius
+ !
+ scavsumnumbb = 0._r8
+ scavsumvolbb = 0._r8
+
+ ja_loop: do ja = 1, na
+
+ a = aaerosv(ja)
+
+ chi = a/r
+
+ dum = freepath/a
+ dumfuchs = 1._r8 + 1.246_r8*dum + 0.42_r8*dum*exp(-0.87_r8/dum)
+ taurelax = 2._r8*rhoaero*a*a*dumfuchs/(9._r8*rhoair*airkinvisc)
+
+ aeromass = 4._r8*pi*a*a*a*rhoaero/3._r8
+ aerodiffus = boltz_cgs*temp*taurelax/aeromass
+
+ schmidt = airkinvisc/aerodiffus
+ stokes = vfall*taurelax/r
+
+ ebrown = 4._r8*(1._r8 + 0.4_r8*sqrtreynolds*(schmidt**0.3333333_r8)) / &
+ (reynolds*schmidt)
+
+ dum = (1._r8 + 2._r8*xmuwaterair*chi) / &
+ (1._r8 + xmuwaterair/sqrtreynolds)
+ eintercept = 4._r8*chi*(chi + dum)
+
+ dum = log( 1._r8 + reynolds )
+ sstar = (1.2_r8 + dum/12._r8) / (1._r8 + dum)
+ eimpact = 0._r8
+ if (stokes > sstar) then
+ dum = stokes - sstar
+ eimpact = (dum/(dum+0.6666667_r8)) ** 1.5_r8
+ end if
+
+ etotal = ebrown + eintercept + eimpact
+ etotal = min( etotal, 1.0_r8 )
+
+ rainsweepout = xnumrainsv(jr)*4._r8*pi*r*r*vfall
+
+ scavsumnumbb = scavsumnumbb + rainsweepout*etotal*ynumaerosv(ja)
+ scavsumvolbb = scavsumvolbb + rainsweepout*etotal*yvolaerosv(ja)
+
+ enddo ja_loop
+
+ scavsumnum = scavsumnum + scavsumnumbb
+ scavsumvol = scavsumvol + scavsumvolbb
+
+ enddo jr_loop
+
+ scavratenum = scavsumnum*3600._r8
+ scavratevol = scavsumvol*3600._r8
+
+ end subroutine calc_1_impact_rate
+
+ end subroutine init_bcscavcoef
+
+end module aero_wetdep_cam
diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90
index c94f277637..e7cea68ad4 100644
--- a/src/chemistry/aerosol/aerosol_properties_mod.F90
+++ b/src/chemistry/aerosol/aerosol_properties_mod.F90
@@ -70,6 +70,8 @@ module aerosol_properties_mod
procedure(aero_min_mass_mean_rad), deferred :: min_mass_mean_rad
procedure(aero_optics_params), deferred :: optics_params
procedure(aero_bin_name), deferred :: bin_name
+ procedure(aero_scav_diam), deferred :: scav_diam
+ procedure(aero_resuspension_resize), deferred :: resuspension_resize
procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes
procedure(aero_hydrophilic), deferred :: hydrophilic
@@ -382,6 +384,30 @@ function aero_bin_name(self, list_ndx, bin_ndx) result(name)
end function aero_bin_name
+ !------------------------------------------------------------------------------
+ ! returns scavenging diameter for a given aerosol bin number
+ !------------------------------------------------------------------------------
+ function aero_scav_diam(self, bin_ndx) result(diam)
+ import :: aerosol_properties, r8
+ class(aerosol_properties), intent(in) :: self
+ integer, intent(in) :: bin_ndx ! bin number
+
+ real(r8) :: diam
+
+ end function aero_scav_diam
+
+ !------------------------------------------------------------------------------
+ ! adjust aerosol concentration tendencies to create larger sizes of aerosols
+ ! during resuspension
+ !------------------------------------------------------------------------------
+ subroutine aero_resuspension_resize(self, dcondt)
+ import :: aerosol_properties, r8
+
+ class(aerosol_properties), intent(in) :: self
+ real(r8), intent(inout) :: dcondt(:)
+
+ end subroutine aero_resuspension_resize
+
!------------------------------------------------------------------------------
! returns bulk deposition fluxes of the specified species type
! rebinned to specified diameter limits
diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90
index b0e8d24a1e..363ce7ac99 100644
--- a/src/chemistry/aerosol/aerosol_state_mod.F90
+++ b/src/chemistry/aerosol/aerosol_state_mod.F90
@@ -56,6 +56,9 @@ module aerosol_state_mod
procedure(aero_volume), deferred :: dry_volume
procedure(aero_volume), deferred :: wet_volume
procedure(aero_volume), deferred :: water_volume
+ procedure(aero_wet_diam), deferred :: wet_diameter
+ procedure :: convcld_actfrac
+ procedure :: sol_factb_interstitial
end type aerosol_state
! for state fields
@@ -264,6 +267,21 @@ function aero_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol
end function aero_volume
+ !------------------------------------------------------------------------------
+ ! aerosol wet diameter
+ !------------------------------------------------------------------------------
+ function aero_wet_diam(self, bin_idx, ncol, nlev) result(diam)
+ import :: aerosol_state, r8
+
+ class(aerosol_state), intent(in) :: self
+ integer, intent(in) :: bin_idx ! bin number
+ integer, intent(in) :: ncol ! number of columns
+ integer, intent(in) :: nlev ! number of levels
+
+ real(r8) :: diam(ncol,nlev)
+
+ end function aero_wet_diam
+
end interface
contains
@@ -272,7 +290,7 @@ end function aero_volume
! returns aerosol number, volume concentrations, and bulk hygroscopicity
!------------------------------------------------------------------------------
subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, &
- naerosol, vaerosol, hygro, errnum, errstr)
+ naerosol, vaerosol, hygro, errnum, errstr, pom_hygro)
use aerosol_properties_mod, only: aerosol_properties
@@ -295,10 +313,13 @@ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, &
integer , intent(out) :: errnum
character(len=*), intent(out) :: errstr
+ real(r8), optional, intent(in) :: pom_hygro ! POM hygroscopicity override
+
! internal
real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios
real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios
real(r8) :: specdens, spechygro
+ character(len=aero_name_len) :: spectype
real(r8) :: vol(istart:istop) ! aerosol volume mixing ratio
integer :: i, l
@@ -314,7 +335,12 @@ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, &
call self%get_ambient_mmr(l,m, raer)
call self%get_cldbrne_mmr(l,m, qqcw)
- call aero_props%get(m,l, density=specdens, hygro=spechygro)
+ call aero_props%get(m,l, density=specdens, hygro=spechygro, spectype=spectype)
+ if (present(pom_hygro)) then
+ if (spectype=='p-organic'.and.pom_hygro>0._r8) then
+ spechygro=pom_hygro
+ endif
+ endif
if (phase == 3) then
do i = istart, istop
@@ -855,4 +881,84 @@ function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) re
end function refractive_index_lw
+ !------------------------------------------------------------------------------
+ ! prescribed aerosol activation fraction for convective cloud
+ !------------------------------------------------------------------------------
+ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac)
+
+ class(aerosol_state), intent(in) :: self
+ integer, intent(in) :: ibin ! bin index
+ integer, intent(in) :: ispc ! species index
+ integer, intent(in) :: ncol ! number of columns
+ integer, intent(in) :: nlev ! number of vertical levels
+
+ real(r8) :: frac(ncol,nlev)
+
+ frac = 0.8_r8 ! rce 2010/05/02
+
+ end function convcld_actfrac
+
+ !------------------------------------------------------------------------------
+ ! below cloud solubility factor for interstitial aerosols
+ !------------------------------------------------------------------------------
+ function sol_factb_interstitial(self, bin_ndx, ncol, nlev, aero_props) result(sol_factb)
+
+ class(aerosol_state), intent(in) :: self
+ integer, intent(in) :: bin_ndx ! bin number
+ integer, intent(in) :: ncol ! number of columns
+ integer, intent(in) :: nlev ! number of vertical levels
+ class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
+
+ real(r8) :: sol_factb(ncol,nlev)
+
+ real(r8), pointer :: aer_mmr(:,:)
+ real(r8) :: totmmr(ncol,nlev)
+ real(r8) :: solmmr(ncol,nlev)
+ integer :: ispc
+ character(len=aero_name_len) :: spectype
+
+ sol_factb(:,:) = 0.0_r8
+
+ totmmr(:,:) = 0._r8
+ solmmr(:,:) = 0._r8
+
+ do ispc = 1, aero_props%nspecies(bin_ndx)
+
+ call aero_props%species_type(bin_ndx, ispc, spectype)
+ call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr)
+
+ totmmr(:ncol,:) = totmmr(:ncol,:) + aer_mmr(:ncol,:)
+
+ if (trim(spectype) == 'sulfate') then
+ solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.5_r8
+ end if
+ if (trim(spectype) == 'p-organic') then
+ solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.2_r8
+ end if
+ if (trim(spectype) == 's-organic') then
+ solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.2_r8
+ end if
+ if (trim(spectype) == 'dust') then
+ solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.1_r8
+ end if
+ if (trim(spectype) == 'seasalt') then
+ solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.8_r8
+ end if
+
+ end do !nspec
+
+ where ( totmmr > 0._r8 )
+ sol_factb = solmmr/totmmr
+ end where
+
+ where ( sol_factb > 0.8_r8 )
+ sol_factb = 0.8_r8
+ end where
+ where ( sol_factb < 0.1_r8 )
+ sol_factb = 0.1_r8
+ end where
+
+ end function sol_factb_interstitial
+
+
end module aerosol_state_mod
diff --git a/src/chemistry/modal_aero/modal_aero_data.F90 b/src/chemistry/aerosol/modal_aero_data.F90
similarity index 100%
rename from src/chemistry/modal_aero/modal_aero_data.F90
rename to src/chemistry/aerosol/modal_aero_data.F90
diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90
index 54f64fa759..828b54ed99 100644
--- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90
+++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90
@@ -15,6 +15,18 @@ module modal_aerosol_properties_mod
real(r8), allocatable :: exp45logsig_(:)
real(r8), allocatable :: voltonumblo_(:)
real(r8), allocatable :: voltonumbhi_(:)
+ integer, allocatable :: sulfate_mode_ndxs_(:)
+ integer, allocatable :: dust_mode_ndxs_(:)
+ integer, allocatable :: ssalt_mode_ndxs_(:)
+ integer, allocatable :: ammon_mode_ndxs_(:)
+ integer, allocatable :: nitrate_mode_ndxs_(:)
+ integer, allocatable :: msa_mode_ndxs_(:)
+ integer, allocatable :: bcarbon_mode_ndxs_(:,:)
+ integer, allocatable :: porganic_mode_ndxs_(:,:)
+ integer, allocatable :: sorganic_mode_ndxs_(:,:)
+ integer :: num_soa_ = 0
+ integer :: num_poa_ = 0
+ integer :: num_bc_ = 0
contains
procedure :: number_transported
procedure :: get
@@ -36,6 +48,8 @@ module modal_aerosol_properties_mod
procedure :: soluble
procedure :: min_mass_mean_rad
procedure :: bin_name
+ procedure :: scav_diam
+ procedure :: resuspension_resize
procedure :: rebin_bulk_fluxes
procedure :: hydrophilic
@@ -56,7 +70,7 @@ function constructor() result(newobj)
type(modal_aerosol_properties), pointer :: newobj
- integer :: m, nmodes, ncnst_tot
+ integer :: l, m, nmodes, ncnst_tot, mm
real(r8) :: dgnumlo
real(r8) :: dgnumhi
integer,allocatable :: nspecies(:)
@@ -66,6 +80,10 @@ function constructor() result(newobj)
real(r8),allocatable :: f2(:)
integer :: ierr
+ character(len=aero_name_len) :: spectype
+
+ integer :: npoa, nsoa, nbc
+
allocate(newobj,stat=ierr)
if( ierr /= 0 ) then
nullify(newobj)
@@ -141,6 +159,123 @@ function constructor() result(newobj)
end do
call newobj%initialize(nmodes,ncnst_tot,nspecies,nspecies,alogsig,f1,f2,ierr)
+
+ npoa = 0
+ nsoa = 0
+ nbc = 0
+
+ m = 1
+ do l = 1,newobj%nspecies(m)
+ mm = newobj%indexer(m,l)
+ call newobj%species_type(m, l, spectype)
+ select case ( trim(spectype) )
+ case('p-organic')
+ npoa = npoa + 1
+ case('s-organic')
+ nsoa = nsoa + 1
+ case('black-c')
+ nbc = nbc + 1
+ end select
+ end do
+
+ newobj%num_soa_ = nsoa
+ newobj%num_poa_ = npoa
+ newobj%num_bc_ = nbc
+
+ allocate(newobj%sulfate_mode_ndxs_(newobj%nbins()),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%dust_mode_ndxs_(newobj%nbins()),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%ssalt_mode_ndxs_(newobj%nbins()),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%ammon_mode_ndxs_(newobj%nbins()),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%nitrate_mode_ndxs_(newobj%nbins()),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%msa_mode_ndxs_(newobj%nbins()),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+
+ newobj%sulfate_mode_ndxs_ = 0
+ newobj%dust_mode_ndxs_ = 0
+ newobj%ssalt_mode_ndxs_ = 0
+ newobj%ammon_mode_ndxs_ = 0
+ newobj%nitrate_mode_ndxs_ = 0
+ newobj%msa_mode_ndxs_ = 0
+
+ allocate(newobj%porganic_mode_ndxs_(newobj%nbins(),npoa),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%sorganic_mode_ndxs_(newobj%nbins(),nsoa),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+ allocate(newobj%bcarbon_mode_ndxs_(newobj%nbins(),nbc),stat=ierr)
+ if( ierr /= 0 ) then
+ nullify(newobj)
+ return
+ end if
+
+ newobj%porganic_mode_ndxs_ = 0._r8
+ newobj%sorganic_mode_ndxs_ = 0._r8
+ newobj%bcarbon_mode_ndxs_ = 0._r8
+
+ do m = 1,newobj%nbins()
+ npoa = 0
+ nsoa = 0
+ nbc = 0
+
+ do l = 1,newobj%nspecies(m)
+ mm = newobj%indexer(m,l)
+ call newobj%species_type(m, l, spectype)
+
+ select case ( trim(spectype) )
+ case('sulfate')
+ newobj%sulfate_mode_ndxs_(m) = mm
+ case('dust')
+ newobj%dust_mode_ndxs_(m) = mm
+ case('nitrate')
+ newobj%nitrate_mode_ndxs_(m) = mm
+ case('ammonium')
+ newobj%ammon_mode_ndxs_(m) = mm
+ case('seasalt')
+ newobj%ssalt_mode_ndxs_(m) = mm
+ case('msa')
+ newobj%msa_mode_ndxs_(m) = mm
+ case('p-organic')
+ npoa = npoa + 1
+ newobj%porganic_mode_ndxs_(m,npoa) = mm
+ case('s-organic')
+ nsoa = nsoa + 1
+ newobj%sorganic_mode_ndxs_(m,nsoa) = mm
+ case('black-c')
+ nbc = nbc + 1
+ newobj%bcarbon_mode_ndxs_(m,nbc) = mm
+ end select
+
+ end do
+ end do
+
if( ierr /= 0 ) then
nullify(newobj)
return
@@ -168,6 +303,34 @@ subroutine destructor(self)
deallocate(self%voltonumbhi_)
end if
+ if (allocated(self%sulfate_mode_ndxs_)) then
+ deallocate(self%sulfate_mode_ndxs_)
+ end if
+ if (allocated(self%dust_mode_ndxs_)) then
+ deallocate(self%dust_mode_ndxs_)
+ end if
+ if (allocated(self%ssalt_mode_ndxs_)) then
+ deallocate(self%ssalt_mode_ndxs_)
+ end if
+ if (allocated(self%ammon_mode_ndxs_)) then
+ deallocate(self%ammon_mode_ndxs_)
+ end if
+ if (allocated(self%nitrate_mode_ndxs_)) then
+ deallocate(self%nitrate_mode_ndxs_)
+ end if
+ if (allocated(self%msa_mode_ndxs_)) then
+ deallocate(self%msa_mode_ndxs_)
+ end if
+ if (allocated(self%porganic_mode_ndxs_)) then
+ deallocate(self%porganic_mode_ndxs_)
+ end if
+ if (allocated(self%sorganic_mode_ndxs_)) then
+ deallocate(self%sorganic_mode_ndxs_)
+ end if
+ if (allocated(self%bcarbon_mode_ndxs_)) then
+ deallocate(self%bcarbon_mode_ndxs_)
+ end if
+
call self%final()
end subroutine destructor
@@ -675,6 +838,99 @@ function bin_name(self, list_ndx, bin_ndx) result(name)
end function bin_name
+ !------------------------------------------------------------------------------
+ ! returns scavenging diameter (cm) for a given aerosol bin number
+ !------------------------------------------------------------------------------
+ function scav_diam(self, bin_ndx) result(diam)
+ use modal_aero_data, only: dgnum_amode
+
+ class(modal_aerosol_properties), intent(in) :: self
+ integer, intent(in) :: bin_ndx ! bin number
+
+ real(r8) :: diam
+
+ diam = dgnum_amode(bin_ndx)
+
+ end function scav_diam
+
+ !------------------------------------------------------------------------------
+ ! adjust aerosol concentration tendencies to create larger sizes of aerosols
+ ! during resuspension
+ !------------------------------------------------------------------------------
+ subroutine resuspension_resize(self, dcondt)
+
+ use modal_aero_data, only: mode_size_order
+
+ class(modal_aerosol_properties), intent(in) :: self
+ real(r8), intent(inout) :: dcondt(:)
+
+ integer :: i
+ character(len=4) :: spcstr
+
+ call accumulate_to_larger_mode( 'SO4', self%sulfate_mode_ndxs_, dcondt )
+ call accumulate_to_larger_mode( 'DUST',self%dust_mode_ndxs_,dcondt )
+ call accumulate_to_larger_mode( 'NACL',self%ssalt_mode_ndxs_,dcondt )
+ call accumulate_to_larger_mode( 'MSA', self%msa_mode_ndxs_, dcondt )
+ call accumulate_to_larger_mode( 'NH4', self%ammon_mode_ndxs_, dcondt )
+ call accumulate_to_larger_mode( 'NO3', self%nitrate_mode_ndxs_, dcondt )
+
+ spcstr = ' '
+ do i = 1,self%num_soa_
+ write(spcstr,'(i4)') i
+ call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), self%sorganic_mode_ndxs_(:,i), dcondt )
+ enddo
+ spcstr = ' '
+ do i = 1,self%num_poa_
+ write(spcstr,'(i4)') i
+ call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), self%porganic_mode_ndxs_(:,i), dcondt )
+ enddo
+ spcstr = ' '
+ do i = 1,self%num_bc_
+ write(spcstr,'(i4)') i
+ call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), self%bcarbon_mode_ndxs_(:,i), dcondt )
+ enddo
+
+ contains
+
+ !------------------------------------------------------------------------------
+ subroutine accumulate_to_larger_mode( spc_name, lptr, prevap )
+
+ use cam_logfile, only: iulog
+ use spmd_utils, only: masterproc
+
+ character(len=*), intent(in) :: spc_name
+ integer, intent(in) :: lptr(:)
+ real(r8), intent(inout) :: prevap(:)
+
+ integer :: m,n, nl,ns
+
+ logical, parameter :: debug = .false.
+
+ ! find constituent index of the largest mode for the species
+ loop1: do m = 1,self%nbins()-1
+ nl = lptr(mode_size_order(m))
+ if (nl>0) exit loop1
+ end do loop1
+
+ if (.not. nl>0) return
+
+ ! accumulate the smaller modes into the largest mode
+ do n = m+1,self%nbins()
+ ns = lptr(mode_size_order(n))
+ if (ns>0) then
+ prevap(nl) = prevap(nl) + prevap(ns)
+ prevap(ns) = 0._r8
+ if (masterproc .and. debug) then
+ write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl
+ endif
+ endif
+ end do
+
+ end subroutine accumulate_to_larger_mode
+ !------------------------------------------------------------------------------
+
+ end subroutine resuspension_resize
+
!------------------------------------------------------------------------------
! returns bulk deposition fluxes of the specified species type
! rebinned to specified diameter limits
diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90
index 8f50e5b7e9..819f20d1f0 100644
--- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90
+++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90
@@ -40,6 +40,8 @@ module modal_aerosol_state_mod
procedure :: dry_volume
procedure :: wet_volume
procedure :: water_volume
+ procedure :: wet_diameter
+ procedure :: convcld_actfrac
final :: destructor
@@ -595,4 +597,91 @@ function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vo
end function water_volume
+ !------------------------------------------------------------------------------
+ ! aerosol wet diameter
+ !------------------------------------------------------------------------------
+ function wet_diameter(self, bin_idx, ncol, nlev) result(diam)
+ class(modal_aerosol_state), intent(in) :: self
+ integer, intent(in) :: bin_idx ! bin number
+ integer, intent(in) :: ncol ! number of columns
+ integer, intent(in) :: nlev ! number of levels
+
+ real(r8) :: diam(ncol,nlev)
+
+ real(r8), pointer :: dgnumwet(:,:,:)
+
+ call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet)
+
+ diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx)
+
+ end function wet_diameter
+
+ !------------------------------------------------------------------------------
+ ! prescribed aerosol activation fraction for convective cloud
+ !------------------------------------------------------------------------------
+ function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac)
+
+ use modal_aero_data
+
+ class(modal_aerosol_state), intent(in) :: self
+ integer, intent(in) :: ibin ! bin index
+ integer, intent(in) :: ispc ! species index
+ integer, intent(in) :: ncol ! number of columns
+ integer, intent(in) :: nlev ! number of vertical levels
+
+ real(r8) :: frac(ncol,nlev)
+
+ real(r8) :: f_act_conv_coarse(ncol,nlev)
+ real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl
+ real(r8) :: tmpdust, tmpnacl
+ integer :: lcoardust, lcoarnacl
+ integer :: i,k
+
+ f_act_conv_coarse(:,:) = 0.60_r8
+ f_act_conv_coarse_dust = 0.40_r8
+ f_act_conv_coarse_nacl = 0.80_r8
+ if (modeptr_coarse > 0) then
+ lcoardust = lptr_dust_a_amode(modeptr_coarse)
+ lcoarnacl = lptr_nacl_a_amode(modeptr_coarse)
+ if ((lcoardust > 0) .and. (lcoarnacl > 0)) then
+ do k = 1, nlev
+ do i = 1, ncol
+ tmpdust = max( 0.0_r8, self%state%q(i,k,lcoardust) )
+ tmpnacl = max( 0.0_r8, self%state%q(i,k,lcoarnacl) )
+ if ((tmpdust+tmpnacl) > 1.0e-30_r8) then
+ f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust &
+ + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl)
+ end if
+ end do
+ end do
+ end if
+ end if
+
+ if (ibin == modeptr_pcarbon) then
+ frac = 0.0_r8
+ else if ((ibin == modeptr_finedust) .or. (ibin == modeptr_coardust)) then
+ frac = 0.4_r8
+ else
+ frac = 0.8_r8
+ end if
+
+ ! set f_act_conv for interstitial (lphase=1) coarse mode species
+ ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt
+ ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt
+ ! number and sulfate are conceptually partitioned to the dust and seasalt
+ ! on a mass basis, so the f_act_conv for number and sulfate are
+ ! mass-weighted averages of the values used for dust/seasalt
+ if (ibin == modeptr_coarse) then
+ frac = f_act_conv_coarse
+ if (ispc>0) then
+ if (lmassptr_amode(ispc,ibin) == lptr_dust_a_amode(ibin)) then
+ frac = f_act_conv_coarse_dust
+ else if (lmassptr_amode(ispc,ibin) == lptr_nacl_a_amode(ibin)) then
+ frac = f_act_conv_coarse_nacl
+ end if
+ end if
+ end if
+
+ end function convcld_actfrac
+
end module modal_aerosol_state_mod
diff --git a/src/chemistry/aerosol/wetdep.F90 b/src/chemistry/aerosol/wetdep.F90
index 810e063e1a..b63ebec338 100644
--- a/src/chemistry/aerosol/wetdep.F90
+++ b/src/chemistry/aerosol/wetdep.F90
@@ -330,7 +330,7 @@ subroutine wetdepa_v2( &
! sol_fact is used for below cloud scavenging
! sol_facti is used for in cloud scavenging
- real(r8), intent(in) :: sol_fact
+ real(r8), intent(in) :: sol_fact(pcols,pver)
integer, intent(in) :: ncol
real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO)
real(r8), intent(out) ::&
@@ -348,7 +348,7 @@ subroutine wetdepa_v2( &
real(r8), intent(in), optional :: qqcw(pcols,pver)
real(r8), intent(in), optional :: f_act_conv(pcols,pver)
- real(r8), intent(in), optional :: sol_facti_in ! solubility factor (frac of aerosol scavenged in cloud)
+ real(r8), intent(in), optional :: sol_facti_in(pcols,pver) ! solubility factor (frac of aerosol scavenged in cloud)
real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds
@@ -405,8 +405,8 @@ subroutine wetdepa_v2( &
! For convective cloud, cloudborne aerosol is not treated explicitly,
! and sol_factic is 1.0 for both cloudborne and interstitial.
- real(r8) :: sol_facti ! in cloud fraction of aerosol scavenged
- real(r8) :: sol_factb ! below cloud fraction of aerosol scavenged
+ real(r8) :: sol_facti(pcols,pver) ! in cloud fraction of aerosol scavenged
+ real(r8) :: sol_factb(pcols,pver) ! below cloud fraction of aerosol scavenged
real(r8) :: sol_factic(pcols,pver) ! in cloud fraction of aerosol scavenged for convective clouds
real(r8) :: rdeltat
@@ -527,7 +527,7 @@ subroutine wetdepa_v2( &
fracp(i) = max( 0._r8, min(1._r8, fracp(i)) )
- st_scav_ic(i) = sol_facti *fracp(i)*tracer(i,k)*rdeltat
+ st_scav_ic(i) = sol_facti(i,k) *fracp(i)*tracer(i,k)*rdeltat
st_scav_bc(i) = 0._r8
@@ -548,7 +548,7 @@ subroutine wetdepa_v2( &
odds(i) = precabc(i)/max(cldvcu(i,k),1.e-5_r8)*scavcoef(i,k)*deltat
odds(i) = max(min(1._r8,odds(i)),0._r8)
- conv_scav_bc(i) = sol_factb *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat
+ conv_scav_bc(i) = sol_factb(i,k) *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat
! stratiform scavenging
@@ -557,7 +557,7 @@ subroutine wetdepa_v2( &
odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat
odds(i) = max(min(1._r8,odds(i)),0._r8)
- st_scav_bc(i) = sol_factb *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat
+ st_scav_bc(i) = sol_factb(i,k) *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat
end if
@@ -569,7 +569,7 @@ subroutine wetdepa_v2( &
odds(i) = precabc(i)/max(cldvcu(i,k), 1.e-5_r8)*scavcoef(i,k)*deltat
odds(i) = max( min(1._r8, odds(i)), 0._r8)
- conv_scav_bc(i) = sol_factb*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat
+ conv_scav_bc(i) = sol_factb(i,k)*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat
! stratiform scavenging
@@ -581,11 +581,11 @@ subroutine wetdepa_v2( &
fracp(i) = max( 0._r8, min( 1._r8, fracp(i) ) )
! assume the corresponding amnt of tracer is removed
- st_scav_ic(i) = sol_facti*clds(i)*fracp(i)*tracer(i,k)*rdeltat
+ st_scav_ic(i) = sol_facti(i,k)*clds(i)*fracp(i)*tracer(i,k)*rdeltat
odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat
odds(i) = max(min(1._r8,odds(i)),0._r8)
- st_scav_bc(i) =sol_factb*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat
+ st_scav_bc(i) =sol_factb(i,k)*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat
end if
diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90
index 86236a0650..056b998a36 100644
--- a/src/chemistry/modal_aero/aero_model.F90
+++ b/src/chemistry/modal_aero/aero_model.F90
@@ -46,10 +46,9 @@ module aero_model
public :: calc_1_impact_rate
public :: nimptblgrow_mind, nimptblgrow_maxd
- public :: wetdep_lq
! Accessor functions
- public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow
+ public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow
! Misc private data
@@ -90,25 +89,16 @@ module aero_model
character(len=fieldname_len), allocatable :: dgnum_name(:), dgnumwet_name(:)
! Namelist variables
- character(len=16) :: wetdep_list(pcnst) = ' '
character(len=16) :: drydep_list(pcnst) = ' '
- real(r8) :: sol_facti_cloud_borne = 1._r8
- real(r8) :: sol_factb_interstitial = 0.1_r8
- real(r8) :: sol_factic_interstitial = 0.4_r8
real(r8) :: seasalt_emis_scale
integer :: ndrydep = 0
integer,allocatable :: drydep_indices(:)
- integer :: nwetdep = 0
- integer,allocatable :: wetdep_indices(:)
logical :: drydep_lq(pcnst)
- logical, protected :: wetdep_lq(pcnst)
logical :: modal_accum_coarse_exch = .false.
- logical :: convproc_do_aer
-
- class(modal_aerosol_properties), pointer :: aero_props=>null()
+ type(modal_aerosol_properties), pointer :: aero_props=>null()
contains
@@ -120,7 +110,7 @@ subroutine aero_model_readnl(nlfile)
use namelist_utils, only: find_group_name
use units, only: getunit, freeunit
use mpishorthand
- use modal_aero_convproc, only: ma_convproc_readnl
+ use aero_wetdep_cam, only: aero_wetdep_readnl
character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
@@ -129,11 +119,9 @@ subroutine aero_model_readnl(nlfile)
character(len=*), parameter :: subname = 'aero_model_readnl'
! Namelist variables
- character(len=16) :: aer_wetdep_list(pcnst) = ' '
character(len=16) :: aer_drydep_list(pcnst) = ' '
- namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list, sol_facti_cloud_borne, &
- sol_factb_interstitial, sol_factic_interstitial, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale
+ namelist /aerosol_nl/ aer_drydep_list, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale
!-----------------------------------------------------------------------------
@@ -154,20 +142,15 @@ subroutine aero_model_readnl(nlfile)
#ifdef SPMD
! Broadcast namelist variables
- call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom)
call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom)
- call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom)
- call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom)
- call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom)
call mpibcast(modal_strat_sulfate, 1, mpilog, 0, mpicom)
call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom)
call mpibcast(modal_accum_coarse_exch, 1, mpilog, 0, mpicom)
#endif
- wetdep_list = aer_wetdep_list
drydep_list = aer_drydep_list
- call ma_convproc_readnl(nlfile)
+ call aero_wetdep_readnl(nlfile)
end subroutine aero_model_readnl
@@ -193,7 +176,7 @@ subroutine aero_model_init( pbuf2d )
use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum
use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin
use aer_drydep_mod, only: inidrydep
- use wetdep, only: wetdep_init
+ use aero_wetdep_cam, only: aero_wetdep_init
use modal_aero_calcsize, only: modal_aero_calcsize_init
use modal_aero_coag, only: modal_aero_coag_init
@@ -201,7 +184,6 @@ subroutine aero_model_init( pbuf2d )
use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init
use modal_aero_newnuc, only: modal_aero_newnuc_init
use modal_aero_rename, only: modal_aero_rename_init
- use modal_aero_convproc, only: ma_convproc_init
! args
type(physics_buffer_desc), pointer :: pbuf2d(:,:)
@@ -240,8 +222,7 @@ subroutine aero_model_init( pbuf2d )
call phys_getopts(history_aerosol_out = history_aerosol, &
history_chemistry_out=history_chemistry, &
history_cesm_forcing_out=history_cesm_forcing, &
- history_dust_out=history_dust, &
- convproc_do_aer_out = convproc_do_aer)
+ history_dust_out=history_dust)
call rad_cnst_get_info(0, nmodes=nmodes)
@@ -263,28 +244,17 @@ subroutine aero_model_init( pbuf2d )
call aero_deposition_cam_init(aero_props)
endif
- if (convproc_do_aer) then
- call ma_convproc_init()
- endif
-
call dust_init()
call seasalt_init(seasalt_emis_scale)
- call wetdep_init()
- nwetdep = 0
ndrydep = 0
count_species: do m = 1,pcnst
- if ( len_trim(wetdep_list(m)) /= 0 ) then
- nwetdep = nwetdep+1
- endif
if ( len_trim(drydep_list(m)) /= 0 ) then
ndrydep = ndrydep+1
endif
enddo count_species
- if (nwetdep>0) &
- allocate(wetdep_indices(nwetdep))
if (ndrydep>0) &
allocate(drydep_indices(ndrydep))
@@ -300,18 +270,6 @@ subroutine aero_model_init( pbuf2d )
write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied'
endif
enddo
- do m = 1,nwetdep
- call cnst_get_ind ( wetdep_list(m), id, abort=.false. )
- if (id>0) then
- wetdep_indices(m) = id
- else
- call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) )
- endif
-
- if (masterproc) then
- write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal'
- endif
- enddo
if (ndrydep>0) then
@@ -381,13 +339,6 @@ subroutine aero_model_init( pbuf2d )
drydep_lq(id) = .true.
enddo
- ! set flags for wetdep tendencies
- wetdep_lq(:) = .false.
- do m=1,nwetdep
- id = wetdep_indices(m)
- wetdep_lq(id) = .true.
- enddo
-
wetdens_ap_idx = pbuf_get_index('WETDENS_AP')
qaerwat_idx = pbuf_get_index('QAERWAT')
pblh_idx = pbuf_get_index('pblh')
@@ -425,59 +376,6 @@ subroutine aero_model_init( pbuf2d )
enddo
- do m = 1,nwetdep
-
- ! units
- if (wetdep_list(m)(1:3) == 'num') then
- unit_basename = ' 1'
- else
- unit_basename = 'kg'
- endif
-
- call addfld (trim(wetdep_list(m))//'SFWET', &
- horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux at surface')
- call addfld (trim(wetdep_list(m))//'SFSIC', &
- horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, convective) at surface')
- call addfld (trim(wetdep_list(m))//'SFSIS', &
- horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface')
- call addfld (trim(wetdep_list(m))//'SFSBC', &
- horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface')
- call addfld (trim(wetdep_list(m))//'SFSBS', &
- horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface')
-
- if (convproc_do_aer) then
- call addfld (trim(wetdep_list(m))//'SFSES', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface')
- call addfld (trim(wetdep_list(m))//'SFSBD', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface')
- end if
-
- call addfld (trim(wetdep_list(m))//'WET',(/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency')
- call addfld (trim(wetdep_list(m))//'SIC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', &
- trim(wetdep_list(m))//' ic wet deposition')
- call addfld (trim(wetdep_list(m))//'SIS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', &
- trim(wetdep_list(m))//' is wet deposition')
- call addfld (trim(wetdep_list(m))//'SBC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', &
- trim(wetdep_list(m))//' bc wet deposition')
- call addfld (trim(wetdep_list(m))//'SBS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', &
- trim(wetdep_list(m))//' bs wet deposition')
-
- if ( history_aerosol .or. history_chemistry ) then
- call add_default (trim(wetdep_list(m))//'SFWET', 1, ' ')
- endif
- if ( history_aerosol ) then
- call add_default (trim(wetdep_list(m))//'SFSIC', 1, ' ')
- call add_default (trim(wetdep_list(m))//'SFSIS', 1, ' ')
- call add_default (trim(wetdep_list(m))//'SFSBC', 1, ' ')
- call add_default (trim(wetdep_list(m))//'SFSBS', 1, ' ')
- if (convproc_do_aer) then
- call add_default (trim(wetdep_list(m))//'SFSES', 1, ' ')
- call add_default (trim(wetdep_list(m))//'SFSBD', 1, ' ')
- end if
- endif
-
- enddo
-
do m = 1,gas_pcnst
if ( solsym(m)(1:3) == 'num') then
@@ -506,16 +404,6 @@ subroutine aero_model_init( pbuf2d )
call addfld( cnst_name_cw(n), (/ 'lev' /), 'A', unit_basename//'/kg ', &
trim(cnst_name_cw(n))//' in cloud water')
- call addfld (trim(cnst_name_cw(n))//'SFWET', horiz_only, 'A', unit_basename//'/m2/s ', &
- trim(cnst_name_cw(n))//' wet deposition flux at surface')
- call addfld (trim(cnst_name_cw(n))//'SFSIC', horiz_only, 'A', unit_basename//'/m2/s ', &
- trim(cnst_name_cw(n))//' wet deposition flux (incloud, convective) at surface')
- call addfld (trim(cnst_name_cw(n))//'SFSIS', horiz_only, 'A', unit_basename//'/m2/s ', &
- trim(cnst_name_cw(n))//' wet deposition flux (incloud, stratiform) at surface')
- call addfld (trim(cnst_name_cw(n))//'SFSBC', horiz_only, 'A', unit_basename//'/m2/s ', &
- trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, convective) at surface')
- call addfld (trim(cnst_name_cw(n))//'SFSBS', horiz_only, 'A', unit_basename//'/m2/s ', &
- trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, stratiform) at surface')
call addfld (trim(cnst_name_cw(n))//'DDF', horiz_only, 'A', unit_basename//'/m2/s ', &
trim(cnst_name_cw(n))//' dry deposition flux at bottom (grav + turb)')
call addfld (trim(cnst_name_cw(n))//'TBF', horiz_only, 'A', unit_basename//'/m2/s ', &
@@ -523,46 +411,13 @@ subroutine aero_model_init( pbuf2d )
call addfld (trim(cnst_name_cw(n))//'GVF', horiz_only, 'A', unit_basename//'/m2/s ', &
trim(cnst_name_cw(n))//' gravitational dry deposition flux')
- if (convproc_do_aer) then
- call addfld (trim(cnst_name_cw(n))//'SFSEC', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface')
- call addfld (trim(cnst_name_cw(n))//'SFSES', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface')
- call addfld (trim(cnst_name_cw(n))//'SFSBD', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface')
-
- call addfld (trim(cnst_name(n))//'WETC', &
- (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency')
- call addfld (trim(cnst_name(n))//'CONU', &
- (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio')
-
- call addfld (trim(cnst_name_cw(n))//'WETC', &
- (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency')
- call addfld (trim(cnst_name_cw(n))//'CONU', &
- (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio')
-
- call addfld( trim(cnst_name_cw(n))//'RSPTD', (/ 'lev' /), 'A', unit_basename//'/kg/s', &
- trim(cnst_name_cw(n))//' resuspension tendency')
-
- end if
-
if ( history_aerosol.or. history_chemistry ) then
call add_default( cnst_name_cw(n), 1, ' ' )
- call add_default (trim(cnst_name_cw(n))//'SFWET', 1, ' ')
endif
if ( history_aerosol ) then
call add_default (trim(cnst_name_cw(n))//'GVF', 1, ' ')
call add_default (trim(cnst_name_cw(n))//'TBF', 1, ' ')
call add_default (trim(cnst_name_cw(n))//'DDF', 1, ' ')
- call add_default (trim(cnst_name_cw(n))//'SFSBS', 1, ' ')
- call add_default (trim(cnst_name_cw(n))//'SFSIC', 1, ' ')
- call add_default (trim(cnst_name_cw(n))//'SFSBC', 1, ' ')
- call add_default (trim(cnst_name_cw(n))//'SFSIS', 1, ' ')
- if (convproc_do_aer) then
- call add_default (trim(cnst_name_cw(n))//'SFSEC', 1, ' ')
- call add_default (trim(cnst_name_cw(n))//'SFSES', 1, ' ')
- call add_default (trim(cnst_name_cw(n))//'SFSBD', 1, ' ')
- end if
endif
endif
enddo
@@ -681,6 +536,8 @@ subroutine aero_model_init( pbuf2d )
endif
endif
+ call aero_wetdep_init()
+
end subroutine aero_model_init
!=============================================================================
@@ -985,10 +842,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out,
!=============================================================================
subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf)
- use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t
- use modal_aero_data
- use modal_aero_convproc, only: deepconv_wetdep_history, ma_convproc_intr, convproc_do_evaprain_atonce
- use aero_deposition_cam, only: aero_deposition_cam_setwet
+ use aero_wetdep_cam, only: aero_wetdep_tend
! args
@@ -999,650 +853,9 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf)
type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
type(physics_buffer_desc), pointer :: pbuf(:)
- ! local vars
-
- integer :: m ! tracer index
-
- integer :: lchnk ! chunk identifier
- integer :: ncol ! number of atmospheric columns
-
- real(r8) :: iscavt(pcols, pver)
-
- integer :: mm
- integer :: i,k
-
- real(r8) :: icscavt(pcols, pver)
- real(r8) :: isscavt(pcols, pver)
- real(r8) :: bcscavt(pcols, pver)
- real(r8) :: bsscavt(pcols, pver)
- real(r8) :: sol_factb, sol_facti
- real(r8) :: sol_factic(pcols,pver)
-
- real(r8) :: sflx(pcols) ! deposition flux
-
- integer :: jnv ! index for scavcoefnv 3rd dimension
- integer :: lphase ! index for interstitial / cloudborne aerosol
- integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop
- integer :: lspec ! index for aerosol number / chem-mass / water-mass
- integer :: lcoardust, lcoarnacl ! indices for coarse mode dust and seasalt masses
- real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species
- real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01
- real(r8) :: f_act_conv_coarse(pcols,pver) ! similar but for coarse mode ! rce 2010/05/02
- real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl ! rce 2010/05/02
- real(r8) :: fracis_cw(pcols,pver)
- real(r8) :: hygro_sum_old(pcols,pver) ! before removal [sum of (mass*hydro/dens)]
- real(r8) :: hygro_sum_del(pcols,pver) ! removal change to [sum of (mass*hydro/dens)]
- real(r8) :: hygro_sum_old_ik, hygro_sum_new_ik
- real(r8) :: prec(pcols) ! precipitation rate
- real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species
- real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for
- ! cloud-borne num & vol (0),
- ! interstitial num (1), interstitial vol (2)
- real(r8) :: tmpa, tmpb
- real(r8) :: tmpdust, tmpnacl
- real(r8) :: water_old, water_new ! temporary old/new aerosol water mix-rat
- logical :: isprx(pcols,pver) ! true if precipation
- real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial)
- real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water)
-
- ! For unified convection scheme
- logical, parameter :: do_aero_water_removal = .false. ! True if aerosol water reduction by wet removal is to be calculated
- ! (this has not been fully tested, so best to leave it off)
- logical :: do_hygro_sum_del, do_lphase1, do_lphase2
-
- real(r8), pointer :: rprddp(:,:) ! rain production, deep convection
- real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection
- real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0.
- real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0.
-
- real(r8) :: rprddpsum(pcols)
- real(r8) :: rprdshsum(pcols)
- real(r8) :: evapcdpsum(pcols)
- real(r8) :: evapcshsum(pcols)
-
- real(r8) :: tmp_resudp, tmp_resush
-
- real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux
- real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux
- real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux
- real(r8) :: rcscavt(pcols, pver)
- real(r8) :: rsscavt(pcols, pver)
- real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max) ! temporary array to hold qqcw for the current mode
- real(r8) :: rtscavt(pcols, pver, 0:nspec_max)
-
- integer, parameter :: nsrflx_mzaer2cnvpr = 2
- real(r8) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr)
- ! End unified convection scheme
-
- real(r8), pointer :: fldcw(:,:)
-
- real(r8), pointer :: dgnumwet(:,:,:)
- real(r8), pointer :: qaerwat(:,:,:) ! aerosol water
-
- real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble
-
- type(wetdep_inputs_t) :: dep_inputs
-
- real(r8) :: dcondt_resusp3d(2*pcnst,pcols, pver)
-
- lchnk = state%lchnk
- ncol = state%ncol
-
- dcondt_resusp3d(:,:,:) = 0._r8
-
- call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq)
-
- if (nwetdep<1) return
-
- call wetdep_inputs_set( state, pbuf, dep_inputs )
-
- call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) )
- call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) )
- call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
-
- prec(:ncol)=0._r8
- do k=1,pver
- where (prec(:ncol) >= 1.e-7_r8)
- isprx(:ncol,k) = .true.
- elsewhere
- isprx(:ncol,k) = .false.
- endwhere
- prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) &
- *state%pdel(:ncol,k)/gravit
- end do
-
- qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8
- aerdepwetis(:,:) = 0.0_r8
- aerdepwetcw(:,:) = 0.0_r8
-
- ! calculate the mass-weighted sol_factic for coarse mode species
- ! sol_factic_coarse(:,:) = 0.30_r8 ! tuned 1/4
- f_act_conv_coarse(:,:) = 0.60_r8 ! rce 2010/05/02
- f_act_conv_coarse_dust = 0.40_r8 ! rce 2010/05/02
- f_act_conv_coarse_nacl = 0.80_r8 ! rce 2010/05/02
- if (modeptr_coarse > 0) then
- lcoardust = lptr_dust_a_amode(modeptr_coarse)
- lcoarnacl = lptr_nacl_a_amode(modeptr_coarse)
- if ((lcoardust > 0) .and. (lcoarnacl > 0)) then
- do k = 1, pver
- do i = 1, ncol
- tmpdust = max( 0.0_r8, state%q(i,k,lcoardust) )
- tmpnacl = max( 0.0_r8, state%q(i,k,lcoarnacl) )
- if ((tmpdust+tmpnacl) > 1.0e-30_r8) then
- ! sol_factic_coarse(i,k) = (0.2_r8*tmpdust + 0.4_r8*tmpnacl)/(tmpdust+tmpnacl) ! tuned 1/6
- f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust &
- + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) ! rce 2010/05/02
- end if
- end do
- end do
- end if
- end if
-
- scavcoefnv(:,:,0) = 0.0_r8 ! below-cloud scavcoef = 0.0 for cloud-borne species
-
- ! Counters for "without" unified convective treatment (i.e. default case)
- strt_loop = 1
- end_loop = 2
- stride_loop = 1
- if (convproc_do_aer) then
- !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne
- !can be saved then applied to interstitial
- strt_loop = 2
- end_loop = 1
- stride_loop = -1
- endif
-
- if (convproc_do_aer) then
- call t_startf('ma_convproc')
- call ma_convproc_intr( state, ptend, pbuf, dt, &
- nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d)
-
- if (convproc_do_evaprain_atonce) then
- do m = 1, ntot_amode ! main loop over aerosol modes
-
- do lspec = 0, nspec_amode(m) ! loop over number + chem constituents
- if (lspec == 0) then ! number
- mm = numptrcw_amode(m)
- else if (lspec <= nspec_amode(m)) then ! non-water mass
- mm = lmassptrcw_amode(lspec,m)
- endif
- fldcw => qqcw_get_field(pbuf, mm,lchnk)
-
- call outfld( trim(cnst_name_cw(mm))//'RSPTD', dcondt_resusp3d(mm+pcnst,:ncol,:), ncol, lchnk )
-
- do k = 1,pver
- do i = 1,ncol
- fldcw(i,k) = max(0._r8, fldcw(i,k) + dcondt_resusp3d(mm+pcnst,i,k)*dt)
- end do
- end do
- end do ! loop over number + chem constituents
- end do ! m aerosol modes
- end if
- call t_stopf('ma_convproc')
- endif
-
- do m = 1, ntot_amode ! main loop over aerosol modes
-
- do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms
-
- ! sol_factb and sol_facti values
- ! sol_factb - currently this is basically a tuning factor
- ! sol_facti & sol_factic - currently has a physical basis, and reflects activation fraction
- !
- ! 2008-mar-07 rce - sol_factb (interstitial) changed from 0.3 to 0.1
- ! - sol_factic (interstitial, dust modes) changed from 1.0 to 0.5
- ! - sol_factic (cloud-borne, pcarb modes) no need to set it to 0.0
- ! because the cloud-borne pcarbon == 0 (no activation)
- !
- ! rce 2010/05/02
- ! prior to this date, sol_factic was used for convective in-cloud wet removal,
- ! and its value reflected a combination of an activation fraction (which varied between modes)
- ! and a tuning factor
- ! from this date forward, two parameters are used for convective in-cloud wet removal
- ! f_act_conv is the activation fraction
- ! note that "non-activation" of aerosol in air entrained into updrafts should
- ! be included here
- ! eventually we might use the activate routine (with w ~= 1 m/s) to calculate
- ! this, but there is still the entrainment issue
- ! sol_factic is strictly a tuning factor
- !
- if (lphase == 1) then ! interstial aerosol
- hygro_sum_old(:,:) = 0.0_r8
- hygro_sum_del(:,:) = 0.0_r8
- call modal_aero_bcscavcoef_get( m, ncol, isprx, dgnumwet, &
- scavcoefnv(:,:,1), scavcoefnv(:,:,2) )
-
- sol_factb = sol_factb_interstitial ! all below-cloud scav ON (0.1 "tuning factor")
-
- sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial
-
- sol_factic = sol_factic_interstitial
-
- if (m == modeptr_pcarbon) then
- ! sol_factic = 0.0_r8 ! conv in-cloud scav OFF (0.0 activation fraction)
- f_act_conv = 0.0_r8 ! rce 2010/05/02
- else if ((m == modeptr_finedust) .or. (m == modeptr_coardust)) then
- ! sol_factic = 0.2_r8 ! conv in-cloud scav ON (0.5 activation fraction) ! tuned 1/4
- f_act_conv = 0.4_r8 ! rce 2010/05/02
- else
- ! sol_factic = 0.4_r8 ! conv in-cloud scav ON (1.0 activation fraction) ! tuned 1/4
- f_act_conv = 0.8_r8 ! rce 2010/05/02
- end if
-
- else ! cloud-borne aerosol (borne by stratiform cloud drops)
-
- sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud")
- sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor
- sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
- ! that conv precip collects strat droplets)
- f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
-
- end if
- if (convproc_do_aer .and. lphase == 1) then
- ! if modal aero convproc is turned on for aerosols, then
- ! turn off the convective in-cloud removal for interstitial aerosols
- ! (but leave the below-cloud on, as convproc only does in-cloud)
- ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls
- ! for (stratiform)-cloudborne aerosols, convective wet removal
- ! (all forms) is zero, so no action is needed
- sol_factic = 0.0_r8
- endif
-
- !
- ! rce 2010/05/03
- ! wetdepa has "sol_fact" parameters:
- ! sol_facti, sol_factic, sol_factb for liquid cloud
-
- do lspec = 0, nspec_amode(m)+1 ! loop over number + chem constituents + water
-
- if (lspec == 0) then ! number
- if (lphase == 1) then
- mm = numptr_amode(m)
- jnv = 1
- else
- mm = numptrcw_amode(m)
- jnv = 0
- endif
- else if (lspec <= nspec_amode(m)) then ! non-water mass
- if (lphase == 1) then
- mm = lmassptr_amode(lspec,m)
- jnv = 2
- else
- mm = lmassptrcw_amode(lspec,m)
- jnv = 0
- endif
- else ! water mass
- ! bypass wet removal of aerosol water
- if(convproc_do_aer) then
- if ( .not. do_aero_water_removal ) cycle
- else
- cycle
- endif
- if (lphase == 1) then
- mm = 0
- ! mm = lwaterptr_amode(m)
- jnv = 2
- else
- mm = 0
- jnv = 0
- endif
- endif
-
- if (mm <= 0) cycle
-
-
- ! set f_act_conv for interstitial (lphase=1) coarse mode species
- ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt
- ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt
- ! number and sulfate are conceptually partitioned to the dust and seasalt
- ! on a mass basis, so the f_act_conv for number and sulfate are
- ! mass-weighted averages of the values used for dust/seasalt
- if ((lphase == 1) .and. (m == modeptr_coarse)) then
- ! sol_factic = sol_factic_coarse
- f_act_conv = f_act_conv_coarse ! rce 2010/05/02
- if (lspec > 0) then
- if (lmassptr_amode(lspec,m) == lptr_dust_a_amode(m)) then
- ! sol_factic = 0.2_r8 ! tuned 1/4
- f_act_conv = f_act_conv_coarse_dust ! rce 2010/05/02
- else if (lmassptr_amode(lspec,m) == lptr_nacl_a_amode(m)) then
- ! sol_factic = 0.4_r8 ! tuned 1/6
- f_act_conv = f_act_conv_coarse_nacl ! rce 2010/05/02
- end if
- end if
- end if
-
- if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then
- ptend%lq(mm) = .TRUE.
- dqdt_tmp(:,:) = 0.0_r8
- ! q_tmp is the "most current" q
- q_tmp(1:ncol,:) = state%q(1:ncol,:,mm) + ptend%q(1:ncol,:,mm)*dt
- if(convproc_do_aer) then
- !Feed in the saved cloudborne mixing ratios from phase 2
- qqcw_in(:,:) = qqcw_sav(:,:,lspec)
- else
- fldcw => qqcw_get_field(pbuf, mm,lchnk)
- qqcw_in(:,:) = fldcw(:,:)
- endif
-
- call wetdepa_v2( state%pmid, state%q(:,:,1), state%pdel, &
- dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, &
- dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, &
- dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, &
- dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, &
- dlf, fracis(:,:,mm), sol_factb, ncol, &
- scavcoefnv(:,:,jnv), &
- is_strat_cloudborne=.false., &
- qqcw=qqcw_in(:,:), &
- f_act_conv=f_act_conv, &
- icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
- convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, &
- sol_facti_in=sol_facti, sol_factic_in=sol_factic, &
- convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce )
-
- do_hygro_sum_del = .false.
- if ( lspec > 0 ) do_hygro_sum_del = .true.
-
- if(convproc_do_aer) then
- do_hygro_sum_del = .false.
- ! add resuspension of cloudborne species to dqdt of interstitial species
- dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,lspec)
- if ( (lspec > 0) .and. do_aero_water_removal ) then
- do_hygro_sum_del = .true.
- endif
- endif
-
- ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:)
-
- call outfld( trim(cnst_name(mm))//'WET', dqdt_tmp(:,:), pcols, lchnk)
- call outfld( trim(cnst_name(mm))//'SIC', icscavt, pcols, lchnk)
- call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk)
- call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk)
- call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk)
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk)
- aerdepwetis(:ncol,mm) = aerdepwetis(:ncol,mm) + sflx(:ncol)
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFSIC', sflx, pcols, lchnk)
- if (convproc_do_aer) sflxic = sflx
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name(mm))//'SFSIS', sflx, pcols, lchnk)
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk)
- if (convproc_do_aer) sflxbc = sflx
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name(mm))//'SFSBS', sflx, pcols, lchnk)
-
- if (convproc_do_aer) then
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- sflxec = sflx
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name(mm))//'SFSES', sflx, pcols, lchnk)
-
- ! apportion convective surface fluxes to deep and shallow conv
- ! this could be done more accurately in subr wetdepa
- ! since deep and shallow rarely occur simultaneously, and these
- ! fields are just diagnostics, this approximate method is adequate
- ! only do this for interstitial aerosol, because conv clouds to not
- ! affect the stratiform-cloudborne aerosol
- if ( deepconv_wetdep_history) then
-
- call pbuf_get_field(pbuf, rprddp_idx, rprddp )
- call pbuf_get_field(pbuf, rprdsh_idx, rprdsh )
- call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp )
- call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh )
-
- rprddpsum(:) = 0.0_r8
- rprdshsum(:) = 0.0_r8
- evapcdpsum(:) = 0.0_r8
- evapcshsum(:) = 0.0_r8
-
- do k = 1, pver
- rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit
- rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit
- evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit
- evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit
- end do
-
- do i = 1, ncol
- rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 )
- rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 )
- evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 )
- evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 )
-
- ! assume that in- and below-cloud removal are proportional to column precip production
- tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i))
- tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) )
- sflxicdp(i) = sflxic(i)*tmpa
- sflxbcdp(i) = sflxbc(i)*tmpa
-
- ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)]
- tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 )
- tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 )
- tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 )
- tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) )
- sflxecdp(i) = sflxec(i)*tmpb
- end do
- call outfld( trim(cnst_name(mm))//'SFSBD', sflxbcdp, pcols, lchnk)
- else
- sflxec(1:ncol) = 0.0_r8
- sflxecdp(1:ncol) = 0.0_r8
- end if
-
- ! when ma_convproc_intr is used, convective in-cloud wet removal is done there
- ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud
- ! contributions
- ! so pass the below-cloud contribution to ma_convproc_intr
- qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol)
- qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol)
-
- endif
-
- if (do_hygro_sum_del) then
- tmpa = spechygro(lspec,m)/ &
- specdens_amode(lspec,m)
- tmpb = tmpa*dt
- hygro_sum_old(1:ncol,:) = hygro_sum_old(1:ncol,:) &
- + tmpa*q_tmp(1:ncol,:)
- hygro_sum_del(1:ncol,:) = hygro_sum_del(1:ncol,:) &
- + tmpb*dqdt_tmp(1:ncol,:)
- end if
-
- else if ((lphase == 1) .and. (lspec == nspec_amode(m)+1)) then
- do_lphase1 = .true.
- if(convproc_do_aer) then
- do_lphase1 = .false.
- if(do_aero_water_removal)do_lphase1 = .true.
- endif
- if(do_lphase1) then
- ! aerosol water -- because of how wetdepa treats evaporation of stratiform
- ! precip, it is not appropriate to apply wetdepa to aerosol water
- ! instead, "hygro_sum" = [sum of (mass*hygro/dens)] is calculated before and
- ! after wet removal, and new water is calculated using
- ! new_water = old_water*min(10,(hygro_sum_new/hygro_sum_old))
- ! the "min(10,...)" is to avoid potential problems when hygro_sum_old ~= 0
- ! also, individual wet removal terms (ic,is,bc,bs) are not output to history
- ! ptend%lq(mm) = .TRUE.
- ! dqdt_tmp(:,:) = 0.0_r8
- do k = 1, pver
- do i = 1, ncol
- ! water_old = max( 0.0_r8, state%q(i,k,mm)+ptend%q(i,k,mm)*dt )
- water_old = max( 0.0_r8, qaerwat(i,k,mm) )
- hygro_sum_old_ik = max( 0.0_r8, hygro_sum_old(i,k) )
- hygro_sum_new_ik = max( 0.0_r8, hygro_sum_old_ik+hygro_sum_del(i,k) )
- if (hygro_sum_new_ik >= 10.0_r8*hygro_sum_old_ik) then
- water_new = 10.0_r8*water_old
- else
- water_new = water_old*(hygro_sum_new_ik/hygro_sum_old_ik)
- end if
- ! dqdt_tmp(i,k) = (water_new - water_old)/dt
- qaerwat(i,k,mm) = water_new
- end do
- end do
-
- ! ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:)
-
- ! call outfld( trim(cnst_name(mm))
-
- ! sflx(:)=0._r8
- ! do k=1,pver
- ! do i=1,ncol
- ! sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
- ! enddo
- ! enddo
- ! call outfld( trim(cnst_name(mm))
- endif
-
- elseif (lphase == 2) then
-
- do_lphase2 = .true.
- if (convproc_do_aer) then
- do_lphase2 = .false.
- if (lspec <= nspec_amode(m)) do_lphase2 = .true.
- endif
-
- if (do_lphase2) then
-
- dqdt_tmp(:,:) = 0.0_r8
-
- if (convproc_do_aer) then
- fldcw => qqcw_get_field(pbuf,mm,lchnk)
- qqcw_sav(1:ncol,:,lspec) = fldcw(1:ncol,:)
- else
- fldcw => qqcw_get_field(pbuf, mm,lchnk)
- endif
-
- call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, &
- dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, &
- dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, &
- dep_inputs%evapr, dep_inputs%totcond, fldcw, dt, &
- dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, &
- dlf, fracis_cw, sol_factb, ncol, &
- scavcoefnv(:,:,jnv), &
- is_strat_cloudborne=.true., &
- icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
- convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, &
- sol_facti_in=sol_facti, sol_factic_in=sol_factic, &
- convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, &
- bergso_in=dep_inputs%bergso )
-
- if(convproc_do_aer) then
- ! save resuspension of cloudborne species
- rtscavt(1:ncol,:,lspec) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:)
- ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source)
- ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above)
- dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,lspec)
- endif
-
-
- fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFWET', sflx, pcols, lchnk)
- aerdepwetcw(:ncol,mm) = sflx(:ncol)
-
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFSIC', sflx, pcols, lchnk)
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFSIS', sflx, pcols, lchnk)
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFSBC', sflx, pcols, lchnk)
- sflx(:)=0._r8
- do k=1,pver
- do i=1,ncol
- sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit
- enddo
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFSBS', sflx, pcols, lchnk)
-
- if(convproc_do_aer) then
- sflx(:)=0.0_r8
- do k=1,pver
- sflx(1:ncol)=sflx(1:ncol)+rcscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFSEC', sflx, pcols, lchnk)
-
- sflx(:)=0.0_r8
- do k=1,pver
- sflx(1:ncol)=sflx(1:ncol)+rsscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit
- enddo
- call outfld( trim(cnst_name_cw(mm))//'SFSES', sflx, pcols, lchnk)
- endif
- endif
- endif
-
- enddo ! lspec = 0, nspec_amode(m)+1
- enddo ! lphase = 1, 2
- enddo ! m = 1, ntot_amode
-
- ! if the user has specified prescribed aerosol dep fluxes then
- ! do not set cam_out dep fluxes according to the prognostic aerosols
- if (.not. aerodep_flx_prescribed()) then
- call aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out)
- endif
+ call aero_wetdep_tend(state, dt, dlf, cam_out, ptend, pbuf)
- endsubroutine aero_model_wetdep
+ end subroutine aero_model_wetdep
!-------------------------------------------------------------------------
! provides wet tropospheric aerosol surface area info for modal aerosols
diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90
deleted file mode 100644
index 9def684ec0..0000000000
--- a/src/chemistry/modal_aero/modal_aero_convproc.F90
+++ /dev/null
@@ -1,3016 +0,0 @@
-
-module modal_aero_convproc
-!---------------------------------------------------------------------------------
-! Purpose:
-!
-! CAM interface to aerosol/trace-gas convective cloud processing scheme
-!
-! currently these routines assume stratiform and convective clouds only interact
-! through the detrainment of convective cloudborne material into stratiform clouds
-!
-! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed
-! by the convective up/downdrafts, but are affected by the detrainment
-!
-! Author: R. C. Easter
-!
-!---------------------------------------------------------------------------------
-
-use shr_kind_mod, only: r8=>shr_kind_r8
-use spmd_utils, only: masterproc
-use physconst, only: gravit, rair
-use ppgrid, only: pver, pcols, pverp
-use constituents, only: pcnst, cnst_name
-use constituents, only: cnst_species_class, cnst_spec_class_aerosol, cnst_spec_class_gas
-use phys_control, only: phys_getopts
-
-use physics_types, only: physics_state, physics_ptend
-use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field
-
-use time_manager, only: get_nstep
-use cam_history, only: outfld, addfld, add_default, horiz_only
-use cam_logfile, only: iulog
-use cam_abortutils, only: endrun
-
-use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode
-use modal_aero_data, only: lptr_so4_a_amode, lptr_dust_a_amode, lptr_nacl_a_amode, mode_size_order
-use modal_aero_data, only: lptr2_pom_a_amode, lptr2_soa_a_amode, lptr2_bc_a_amode, nsoa, npoa, nbc
-use modal_aero_data, only: lptr_msa_a_amode, lptr_nh4_a_amode, lptr_no3_a_amode
-
-use modal_aerosol_properties_mod, only: modal_aerosol_properties
-
-implicit none
-private
-save
-
-public :: &
- ma_convproc_register, &
- ma_convproc_init, &
- ma_convproc_intr, &
- ma_convproc_readnl
-
-! namelist options
-! NOTE: These are the defaults for CAM6.
-logical, protected, public :: convproc_do_gas = .false.
-logical, protected, public :: deepconv_wetdep_history = .true.
-logical, protected, public :: convproc_do_deep = .true.
-! NOTE: Shallow convection processing does not currently work with CLUBB.
-logical, protected, public :: convproc_do_shallow = .false.
-! NOTE: These are the defaults for the Eaton/Wang parameterization.
-logical, protected, public :: convproc_do_evaprain_atonce = .false.
-real(r8), protected, public :: convproc_pom_spechygro = -1._r8
-real(r8), protected, public :: convproc_wup_max = 4.0_r8
-
-logical, parameter :: use_cwaer_for_activate_maxsat = .false.
-logical, parameter :: apply_convproc_tend_to_ptend = .true.
-
-real(r8) :: hund_ovr_g ! = 100.0_r8/gravit
-! used with zm_conv mass fluxes and delta-p
-! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s]
-! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2]
-
-! method1_activate_nlayers = number of layers (including cloud base) where activation is applied
-integer, parameter :: method1_activate_nlayers = 2
-! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01)
-real(r8), parameter :: method2_activate_smaxmax = 0.003_r8
-
-! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac
-! (this works ok with convproc_method_activate = 1 but not for ... = 2)
-! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac
-! (this works ok with convproc_method_activate = 1 or 2)
-! = other -- do nothing involving reduce_actfrac
-integer, parameter :: method_reduce_actfrac = 0
-real(r8), parameter :: factor_reduce_actfrac = 0.5_r8
-
-! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers
-! 2=do secondary activation with prescribed supersat
-integer, parameter :: convproc_method_activate = 2
-
-logical :: convproc_do_aer
-
-! physics buffer indices
-integer :: fracis_idx = 0
-
-integer :: rprddp_idx = 0
-integer :: rprdsh_idx = 0
-integer :: nevapr_shcu_idx = 0
-integer :: nevapr_dpcu_idx = 0
-
-integer :: icwmrdp_idx = 0
-integer :: icwmrsh_idx = 0
-integer :: sh_frac_idx = 0
-integer :: dp_frac_idx = 0
-
-integer :: zm_mu_idx = 0
-integer :: zm_eu_idx = 0
-integer :: zm_du_idx = 0
-integer :: zm_md_idx = 0
-integer :: zm_ed_idx = 0
-integer :: zm_dp_idx = 0
-integer :: zm_dsubcld_idx = 0
-integer :: zm_jt_idx = 0
-integer :: zm_maxg_idx = 0
-integer :: zm_ideep_idx = 0
-
-integer :: cmfmc_sh_idx = 0
-integer :: sh_e_ed_ratio_idx = 0
-
-integer :: istat
-
-logical, parameter :: debug=.false.
-
-type(modal_aerosol_properties), pointer :: aero_props_obj => null()
-
-!=========================================================================================
-contains
-!=========================================================================================
-
-subroutine ma_convproc_register
-
-end subroutine ma_convproc_register
-
-!=========================================================================================
-subroutine ma_convproc_readnl(nlfile)
-
- use namelist_utils, only: find_group_name
- use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical
-
- character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
-
- ! Local variables
- integer :: unitn, ierr
- character(len=*), parameter :: subname = 'ma_convproc_readnl'
-
- namelist /aerosol_convproc_opts/ convproc_do_gas, deepconv_wetdep_history, convproc_do_deep, &
- convproc_do_shallow, convproc_do_evaprain_atonce, convproc_pom_spechygro, convproc_wup_max
-
- ! Read namelist
- if (masterproc) then
- open( newunit=unitn, file=trim(nlfile), status='old' )
- call find_group_name(unitn, 'aerosol_convproc_opts', status=ierr)
- if (ierr == 0) then
- read(unitn, aerosol_convproc_opts, iostat=ierr)
- if (ierr /= 0) then
- call endrun(subname // ':: ERROR reading namelist')
- end if
- end if
- close(unitn)
- end if
-
- ! Broadcast namelist variables
- call mpi_bcast( convproc_do_gas, 1, mpi_logical, masterprocid, mpicom, ierr)
- call mpi_bcast( deepconv_wetdep_history, 1, mpi_logical, masterprocid, mpicom, ierr)
- call mpi_bcast( convproc_do_deep, 1, mpi_logical, masterprocid, mpicom, ierr)
- call mpi_bcast( convproc_do_shallow, 1, mpi_logical, masterprocid, mpicom, ierr)
- call mpi_bcast( convproc_do_evaprain_atonce, 1, mpi_logical, masterprocid, mpicom, ierr)
- call mpi_bcast( convproc_pom_spechygro, 1, mpi_real8, masterprocid, mpicom, ierr)
- call mpi_bcast( convproc_wup_max, 1, mpi_real8, masterprocid, mpicom, ierr)
-
- if (masterproc) then
- write(iulog,*) subname//': convproc_do_gas = ', convproc_do_gas
- write(iulog,*) subname//': deepconv_wetdep_history = ',deepconv_wetdep_history
- write(iulog,*) subname//': convproc_do_deep = ',convproc_do_deep
- write(iulog,*) subname//': convproc_do_shallow = ',convproc_do_shallow
- write(iulog,*) subname//': convproc_do_evaprain_atonce = ',convproc_do_evaprain_atonce
- write(iulog,*) subname//': convproc_pom_spechygro = ',convproc_pom_spechygro
- write(iulog,*) subname//': convproc_wup_max = ', convproc_wup_max
- end if
-
-end subroutine ma_convproc_readnl
-
-!=========================================================================================
-
-subroutine ma_convproc_init
-
- integer :: n, l, ll
- integer :: npass_calc_updraft
- logical :: history_aerosol
-
- call phys_getopts( history_aerosol_out=history_aerosol, &
- convproc_do_aer_out = convproc_do_aer )
-
- call addfld('SH_MFUP_MAX', horiz_only, 'A', 'kg/m2', &
- 'Shallow conv. column-max updraft mass flux' )
- call addfld('SH_WCLDBASE', horiz_only, 'A', 'm/s', &
- 'Shallow conv. cloudbase vertical velocity' )
- call addfld('SH_KCLDBASE', horiz_only, 'A', '1', &
- 'Shallow conv. cloudbase level index' )
-
- call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', &
- 'Deep conv. column-max updraft mass flux' )
- call addfld('DP_WCLDBASE', horiz_only, 'A', 'm/s', &
- 'Deep conv. cloudbase vertical velocity' )
- call addfld('DP_KCLDBASE', horiz_only, 'A', '1', &
- 'Deep conv. cloudbase level index' )
-
- ! output wet deposition fields to history
- ! I = in-cloud removal; E = precip-evap resuspension
- ! C = convective (total); D = deep convective
- ! note that the precip-evap resuspension includes that resulting from
- ! below-cloud removal, calculated in mz_aero_wet_intr
- if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- l = numptr_amode(n)
- else
- l = lmassptr_amode(ll,n)
- end if
-
- call addfld (trim(cnst_name(l))//'SFSEC', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface')
- if (history_aerosol) then
- call add_default(trim(cnst_name(l))//'SFSEC', 1, ' ')
- end if
-
- if ( deepconv_wetdep_history ) then
- call addfld (trim(cnst_name(l))//'SFSID', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface')
- call addfld (trim(cnst_name(l))//'SFSED', &
- horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface')
- if (history_aerosol) then
- call add_default(trim(cnst_name(l))//'SFSID', 1, ' ')
- call add_default(trim(cnst_name(l))//'SFSED', 1, ' ')
- end if
- end if
- end do
- end do
- end if
-
- if ( history_aerosol .and. &
- ( convproc_do_aer .or. convproc_do_gas) ) then
- if (convproc_do_shallow) then
- call add_default( 'SH_MFUP_MAX', 1, ' ' )
- call add_default( 'SH_WCLDBASE', 1, ' ' )
- call add_default( 'SH_KCLDBASE', 1, ' ' )
- end if
- if (convproc_do_deep) then
- call add_default( 'DP_MFUP_MAX', 1, ' ' )
- call add_default( 'DP_WCLDBASE', 1, ' ' )
- call add_default( 'DP_KCLDBASE', 1, ' ' )
- end if
- end if
-
- fracis_idx = pbuf_get_index('FRACIS')
-
- rprddp_idx = pbuf_get_index('RPRDDP')
- rprdsh_idx = pbuf_get_index('RPRDSH')
- nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU')
- nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU')
-
- icwmrdp_idx = pbuf_get_index('ICWMRDP')
- icwmrsh_idx = pbuf_get_index('ICWMRSH')
- dp_frac_idx = pbuf_get_index('DP_FRAC')
- sh_frac_idx = pbuf_get_index('SH_FRAC')
-
- zm_mu_idx = pbuf_get_index('ZM_MU')
- zm_eu_idx = pbuf_get_index('ZM_EU')
- zm_du_idx = pbuf_get_index('ZM_DU')
- zm_md_idx = pbuf_get_index('ZM_MD')
- zm_ed_idx = pbuf_get_index('ZM_ED')
- zm_dp_idx = pbuf_get_index('ZM_DP')
- zm_dsubcld_idx = pbuf_get_index('ZM_DSUBCLD')
- zm_jt_idx = pbuf_get_index('ZM_JT')
- zm_maxg_idx = pbuf_get_index('ZM_MAXG')
- zm_ideep_idx = pbuf_get_index('ZM_IDEEP')
-
- cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
- sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat)
-
- if (masterproc ) then
-
- write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_aer = ', &
- convproc_do_aer
- write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_gas = ', &
- convproc_do_gas
- write(iulog,'(a,l12)') 'ma_convproc_init - use_cwaer_for_activate_maxsat = ', &
- use_cwaer_for_activate_maxsat
- write(iulog,'(a,l12)') 'ma_convproc_init - apply_convproc_tend_to_ptend = ', &
- apply_convproc_tend_to_ptend
- write(iulog,'(a,i12)') 'ma_convproc_init - convproc_method_activate = ', &
- convproc_method_activate
- write(iulog,'(a,i12)') 'ma_convproc_init - method1_activate_nlayers = ', &
- method1_activate_nlayers
- write(iulog,'(a,1pe12.4)') 'ma_convproc_init - method2_activate_smaxmax = ', &
- method2_activate_smaxmax
- write(iulog,'(a,i12)') 'ma_convproc_init - method_reduce_actfrac = ', &
- method_reduce_actfrac
- write(iulog,'(a,1pe12.4)') 'ma_convproc_init - factor_reduce_actfrac = ', &
- factor_reduce_actfrac
-
- npass_calc_updraft = 1
- if ( (method_reduce_actfrac == 2) .and. &
- (factor_reduce_actfrac >= 0.0_r8) .and. &
- (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2
- write(iulog,'(a,i12)') 'ma_convproc_init - npass_calc_updraft = ', &
- npass_calc_updraft
-
- end if
-
- aero_props_obj => modal_aerosol_properties()
- if (.not.associated(aero_props_obj)) then
- call endrun('ma_convproc_init: modal_aerosol_properties constructor failed')
- end if
-
-end subroutine ma_convproc_init
-
-!=========================================================================================
-
-subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
- nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, &
- aerdepwetis, dcondt_resusp3d )
-!-----------------------------------------------------------------------
-!
-! Convective cloud processing (transport, activation/resuspension,
-! wet removal) of aerosols and trace gases.
-! (Currently no aqueous chemistry and no trace-gas wet removal)
-! Does aerosols when convproc_do_aer is .true.
-! Does trace gases when convproc_do_gas is .true.
-!
-! Does deep and shallow convection
-! Uses mass fluxes, cloud water, precip production from the
-! convective cloud routines
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
-
- ! Arguments
- type(physics_state), intent(in ) :: state ! Physics state variables
- type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep
- type(physics_buffer_desc), pointer :: pbuf(:)
- real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
-
- integer, intent(in) :: nsrflx_mzaer2cnvpr
- real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr)
- real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial)
- real(r8), intent(inout) :: dcondt_resusp3d(2*pcnst,pcols,pver)
-
- ! Local variables
- integer, parameter :: nsrflx = 5 ! last dimension of qsrflx
- integer :: l, ll, lchnk
- integer :: n, ncol
-
- real(r8) :: dqdt(pcols,pver,pcnst)
- real(r8) :: dt
- real(r8) :: qa(pcols,pver,pcnst), qb(pcols,pver,pcnst)
- real(r8) :: qsrflx(pcols,pcnst,nsrflx)
- real(r8) :: sflxic(pcols,pcnst)
- real(r8) :: sflxid(pcols,pcnst)
- real(r8) :: sflxec(pcols,pcnst)
- real(r8) :: sflxed(pcols,pcnst)
-
- logical :: dotend(pcnst)
- !-------------------------------------------------------------------------------------------------
-
- ! Initialize
- lchnk = state%lchnk
- ncol = state%ncol
- dt = ztodt
-
- hund_ovr_g = 100.0_r8/gravit
- ! used with zm_conv mass fluxes and delta-p
- ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s]
- ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2]
-
- sflxic(:,:) = 0.0_r8
- sflxid(:,:) = 0.0_r8
- sflxec(:,:) = 0.0_r8
- sflxed(:,:) = 0.0_r8
- do l = 1, pcnst
- if ( (cnst_species_class(l) == cnst_spec_class_aerosol) .and. ptend%lq(l) ) then
- sflxec(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,1)
- sflxed(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,2)
- end if
- end do
-
- ! prepare for deep conv processing
- do l = 1, pcnst
- if ( ptend%lq(l) ) then
- ! calc new q (after calcaersize and mz_aero_wet_intr)
- qa(1:ncol,:,l) = state%q(1:ncol,:,l) + dt*ptend%q(1:ncol,:,l)
- qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) )
- else
- ! use old q
- qb(1:ncol,:,l) = state%q(1:ncol,:,l)
- end if
- end do
- dqdt(:,:,:) = 0.0_r8
- qsrflx(:,:,:) = 0.0_r8
-
- if (convproc_do_aer .or. convproc_do_gas) then
-
- ! do deep conv processing
- if (convproc_do_deep) then
- call ma_convproc_dp_intr( &
- state, pbuf, dt, &
- qb, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d )
-
-
- ! apply deep conv processing tendency and prepare for shallow conv processing
- do l = 1, pcnst
- if ( .not. dotend(l) ) cycle
-
- ! calc new q (after ma_convproc_dp_intr)
- qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l)
- qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) )
-
- if ( apply_convproc_tend_to_ptend ) then
- ! add dqdt onto ptend%q and set ptend%lq
- ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l)
- ptend%lq(l) = .true.
- end if
-
- if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. &
- (cnst_species_class(l) == cnst_spec_class_gas )) then
- ! these used for history file wetdep diagnostics
- sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4)
- sflxid(1:ncol,l) = sflxid(1:ncol,l) + qsrflx(1:ncol,l,4)
- sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5)
- sflxed(1:ncol,l) = sflxed(1:ncol,l) + qsrflx(1:ncol,l,5)
- end if
-
- if (cnst_species_class(l) == cnst_spec_class_aerosol) then
- ! this used for surface coupling
- aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) &
- + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5)
- end if
- end do
- end if
-
- dqdt(:,:,:) = 0.0_r8
- qsrflx(:,:,:) = 0.0_r8
- if (convproc_do_shallow) then
- call ma_convproc_sh_intr( &
- state, pbuf, dt, &
- qb, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d )
-
- ! apply shallow conv processing tendency
- do l = 1, pcnst
- if ( .not. dotend(l) ) cycle
-
- ! calc new q (after ma_convproc_sh_intr)
- qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l)
- qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) )
-
- if ( apply_convproc_tend_to_ptend ) then
- ! add dqdt onto ptend%q and set ptend%lq
- ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l)
- ptend%lq(l) = .true.
- end if
-
- if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. &
- (cnst_species_class(l) == cnst_spec_class_gas )) then
- sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4)
- sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5)
- end if
-
- if (cnst_species_class(l) == cnst_spec_class_aerosol) then
- aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) &
- + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5)
- end if
-
- end do
- end if
-
- end if ! (convproc_do_aer .or. convproc_do_gas) then
-
-
- if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- l = numptr_amode(n)
- else
- l = lmassptr_amode(ll,n)
- end if
-
- call outfld( trim(cnst_name(l))//'SFWET', aerdepwetis(:,l), pcols, lchnk )
- call outfld( trim(cnst_name(l))//'SFSIC', sflxic(:,l), pcols, lchnk )
- call outfld( trim(cnst_name(l))//'SFSEC', sflxec(:,l), pcols, lchnk )
-
- if ( deepconv_wetdep_history ) then
- call outfld( trim(cnst_name(l))//'SFSID', sflxid(:,l), pcols, lchnk )
- call outfld( trim(cnst_name(l))//'SFSED', sflxed(:,l), pcols, lchnk )
- end if
- end do
- end do
- end if
-
-end subroutine ma_convproc_intr
-
-!=========================================================================================
-
-subroutine ma_convproc_dp_intr( &
- state, pbuf, dt, &
- q, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d)
-!-----------------------------------------------------------------------
-!
-! Convective cloud processing (transport, activation/resuspension,
-! wet removal) of aerosols and trace gases.
-! (Currently no aqueous chemistry and no trace-gas wet removal)
-! Does aerosols when convproc_do_aer is .true.
-! Does trace gases when convproc_do_gas is .true.
-!
-! This routine does deep convection
-! Uses mass fluxes, cloud water, precip production from the
-! convective cloud routines
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
-
- ! Arguments
- type(physics_state), intent(in ) :: state ! Physics state variables
- type(physics_buffer_desc), pointer :: pbuf(:)
-
- real(r8), intent(in) :: dt ! delta t (model time increment)
-
- real(r8), intent(in) :: q(pcols,pver,pcnst)
- real(r8), intent(inout) :: dqdt(pcols,pver,pcnst)
- logical, intent(out) :: dotend(pcnst)
- integer, intent(in) :: nsrflx
- real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx)
- real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver)
-
- integer :: i
- integer :: itmpveca(pcols)
- integer :: l, lchnk, lun, ncol
- integer :: nstep
-
- real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb)
- real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets
- real(r8) :: qaa(pcols,pver,pcnst)
- real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols)
-
- ! physics buffer fields
- real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble
- real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg)
- real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg)
- real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud)
- real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1)
- ! mu, md, ..., ideep, lengath are all deep conv variables
- real(r8), pointer :: mu(:,:) ! Updraft mass flux (positive) (pcols,pver)
- real(r8), pointer :: md(:,:) ! Downdraft mass flux (negative) (pcols,pver)
- real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver)
- real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver)
- real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver)
- ! eu, ed, du are "d(massflux)/dp" and are all positive
- real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver)
- real(r8), pointer :: dsubcld(:) ! Delta pressure from cloud base to sfc (pcols)
-
- integer, pointer :: jt(:) ! Index of cloud top for each column (pcols)
- integer, pointer :: maxg(:) ! Index of cloud top for each column (pcols)
- integer, pointer :: ideep(:) ! Gathering array (pcols)
- integer :: lengath ! Gathered min lon indices over which to operate
-
-
- ! Initialize
-
- lchnk = state%lchnk
- ncol = state%ncol
- nstep = get_nstep()
- lun = iulog
-
- ! Associate pointers with physics buffer fields
- call pbuf_get_field(pbuf, fracis_idx, fracis)
- call pbuf_get_field(pbuf, rprddp_idx, rprddp)
- call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp)
- call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp)
- call pbuf_get_field(pbuf, dp_frac_idx, dp_frac)
- call pbuf_get_field(pbuf, fracis_idx, fracis)
- call pbuf_get_field(pbuf, zm_mu_idx, mu)
- call pbuf_get_field(pbuf, zm_eu_idx, eu)
- call pbuf_get_field(pbuf, zm_du_idx, du)
- call pbuf_get_field(pbuf, zm_md_idx, md)
- call pbuf_get_field(pbuf, zm_ed_idx, ed)
- call pbuf_get_field(pbuf, zm_dp_idx, dp)
- call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld)
- call pbuf_get_field(pbuf, zm_jt_idx, jt)
- call pbuf_get_field(pbuf, zm_maxg_idx, maxg)
- call pbuf_get_field(pbuf, zm_ideep_idx, ideep)
-
- lengath = count(ideep > 0)
- if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake
-
- fracice(:,:) = 0.0_r8
-
- ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type
- dpdry = 0._r8
- do i = 1, lengath
- dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8
- end do
-
- qaa = q
-
- ! turn on/off calculations for aerosols and trace gases
- do l = 1, pcnst
- dotend(l) = .false.
- if (cnst_species_class(l) == cnst_spec_class_aerosol) then
- if (convproc_do_aer) dotend(l) = .true.
- else if (cnst_species_class(l) == cnst_spec_class_gas) then
- if (convproc_do_gas) dotend(l) = .true.
- end if
- end do
-
- itmpveca(:) = -1
-
- call ma_convproc_tend( &
- 'deep', &
- lchnk, pcnst, nstep, dt, &
- state%t, state%pmid, state%pdel, qaa, &
- mu, md, du, eu, &
- ed, dp, dpdry, jt, &
- maxg, ideep, 1, lengath, &
- dp_frac, icwmrdp, rprddp, evapcdp, &
- fracice, &
- dqdt, dotend, nsrflx, qsrflx, &
- xx_mfup_max, xx_wcldbase, xx_kcldbase, &
- lun, itmpveca, dcondt_resusp3d )
-
- call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk )
- call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk )
- call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk )
-
-end subroutine ma_convproc_dp_intr
-
-
-
-!=========================================================================================
-subroutine ma_convproc_sh_intr( &
- state, pbuf, dt, &
- q, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d )
-!-----------------------------------------------------------------------
-!
-! Purpose:
-! Convective cloud processing (transport, activation/resuspension,
-! wet removal) of aerosols and trace gases.
-! (Currently no aqueous chemistry and no trace-gas wet removal)
-! Does aerosols when convproc_do_aer is .true.
-! Does trace gases when convproc_do_gas is .true.
-!
-! This routine does shallow convection
-! Uses mass fluxes, cloud water, precip production from the
-! convective cloud routines
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
-! Arguments
- type(physics_state), intent(in ) :: state ! Physics state variables
- type(physics_buffer_desc), pointer :: pbuf(:)
-
- real(r8), intent(in) :: dt ! delta t (model time increment)
-
- real(r8), intent(in) :: q(pcols,pver,pcnst)
- real(r8), intent(inout) :: dqdt(pcols,pver,pcnst)
- logical, intent(out) :: dotend(pcnst)
- integer, intent(in) :: nsrflx
- real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx)
- real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver)
-
- integer :: i
- integer :: itmpveca(pcols)
- integer :: k, kaa, kbb, kk
- integer :: l, lchnk, lun
- integer :: maxg_minval
- integer :: ncol, nstep
-
- real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb)
- real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets
- real(r8) :: qaa(pcols,pver,pcnst)
- real(r8) :: tmpa, tmpb
- real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols)
-
- ! variables that mimic the zm-deep counterparts
- real(r8) :: mu(pcols,pver) ! Updraft mass flux (positive)
- real(r8) :: md(pcols,pver) ! Downdraft mass flux (negative)
- real(r8) :: du(pcols,pver) ! Mass detrain rate from updraft
- real(r8) :: eu(pcols,pver) ! Mass entrain rate into updraft
- real(r8) :: ed(pcols,pver) ! Mass entrain rate into downdraft
- ! eu, ed, du are "d(massflux)/dp" and are all positive
- real(r8) :: dp(pcols,pver) ! Delta pressure between interfaces
-
- integer :: jt(pcols) ! Index of cloud top for each column
- integer :: maxg(pcols) ! Index of cloud bot for each column
- integer :: ideep(pcols) ! Gathering array
- integer :: lengath ! Gathered min lon indices over which to operate
-
- ! physics buffer fields
- real(r8), pointer :: rprdsh(:,:) ! Shallow conv precip production (kg/kg/s - grid avg)
- real(r8), pointer :: evapcsh(:,:) ! Shal conv precip evaporation (kg/kg/s - grid avg)
- real(r8), pointer :: icwmrsh(:,:) ! Shal conv cloud condensate (kg/kg - in cloud)
- real(r8), pointer :: sh_frac(:,:) ! Shal conv cloud frac (0-1)
-
- real(r8), pointer :: cmfmcsh(:,:) ! Shallow conv mass flux (pcols,pverp) (kg/m2/s)
- real(r8), pointer :: sh_e_ed_ratio(:,:) ! shallow conv [ent/(ent+det)] ratio (pcols,pver)
-
- ! Initialize
-
- lchnk = state%lchnk
- ncol = state%ncol
- nstep = get_nstep()
- lun = iulog
-
- ! Associate pointers with physics buffer fields
- call pbuf_get_field(pbuf, rprdsh_idx, rprdsh)
- call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh)
- call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh)
- call pbuf_get_field(pbuf, sh_frac_idx, sh_frac)
- call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmcsh)
- if (sh_e_ed_ratio_idx .gt. 0) then
- call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio)
- end if
-
- fracice(:,:) = 0.0_r8
-
- ! create mass flux, entrainment, detrainment, and delta-p arrays
- ! with same units as the zm-deep
- mu(:,:) = 0.0_r8
- md(:,:) = 0.0_r8
- du(:,:) = 0.0_r8
- eu(:,:) = 0.0_r8
- ed(:,:) = 0.0_r8
- jt(:) = -1
- maxg(:) = -1
- ideep(:) = -1
- lengath = ncol
- maxg_minval = pver*2
-
- ! these dp and dpdry have units of mb
- dpdry(1:ncol,:) = state%pdeldry(1:ncol,:)/100._r8
- dp( 1:ncol,:) = state%pdel( 1:ncol,:)/100._r8
-
- do i = 1, ncol
- ideep(i) = i
-
- ! load updraft mass flux from cmfmcsh
- kk = 0
- do k = 2, pver
- ! if mass-flux < 1e-7 kg/m2/s ~= 1e-7 m/s ~= 1 cm/day, treat as zero
- if (cmfmcsh(i,k) >= 1.0e-7_r8) then
- ! mu has units of mb/s
- mu(i,k) = cmfmcsh(i,k) / hund_ovr_g
- kk = kk + 1
- if (kk == 1) jt(i) = k - 1
- maxg(i) = k
- end if
- end do
- if (kk <= 0) cycle ! current column has no convection
-
- ! extend below-cloud source region downwards (how far?)
- maxg_minval = min( maxg_minval, maxg(i) )
- kaa = maxg(i)
- kbb = min( kaa+4, pver )
- ! kbb = pver
- if (kbb > kaa) then
- tmpa = sum( dpdry(i,kaa:kbb) )
- do k = kaa+1, kbb
- mu(i,k) = mu(i,kaa)*sum( dpdry(i,k:kbb) )/tmpa
- end do
- maxg(i) = kbb
- end if
-
- ! calc ent / detrainment, using the [ent/(ent+det)] ratio from uw scheme
- ! which is equal to [fer_out/(fer_out+fdr_out)] (see uwshcu.F90)
- !
- ! note that the ratio is set to -1.0 (invalid) when both fer and fdr are very small
- ! and the ratio values are often strange (??) at topmost layer
- !
- ! for initial testing, impose a limit of
- ! entrainment <= 4 * (net entrainment), OR
- ! detrainment <= 4 * (net detrainment)
- do k = jt(i), maxg(i)
- if (k < pver) then
- tmpa = (mu(i,k) - mu(i,k+1))/dpdry(i,k)
- else
- tmpa = mu(i,k)/dpdry(i,k)
- end if
- if (sh_e_ed_ratio_idx .gt. 0) then
- tmpb = sh_e_ed_ratio(i,k)
- else
- tmpb = -1.0_r8 ! force ent only or det only
- end if
- if (tmpb < -1.0e-5_r8) then
- ! do ent only or det only
- if (tmpa >= 0.0_r8) then
- ! net entrainment
- eu(i,k) = tmpa
- else
- ! net detrainment
- du(i,k) = -tmpa
- end if
- else
- if (tmpa >= 0.0_r8) then
- ! net entrainment
- if (k >= kaa .or. tmpb < 0.0_r8) then
- ! layers at/below initial maxg, or sh_e_ed_ratio is invalid
- eu(i,k) = tmpa
- else
- tmpb = max( tmpb, 0.571_r8 )
- eu(i,k) = tmpa*(tmpb/(2.0_r8*tmpb - 1.0_r8))
- du(i,k) = eu(i,k) - tmpa
- end if
- else
- ! net detrainment
- tmpa = -tmpa
- if (k <= jt(i) .or. tmpb < 0.0_r8) then
- ! layers at/above jt (where ratio is strange??), or sh_e_ed_ratio is invalid
- du(i,k) = tmpa
- else
- tmpb = min( tmpb, 0.429_r8 )
- du(i,k) = tmpa*(1.0_r8 - tmpb)/(1.0_r8 - 2.0_r8*tmpb)
- eu(i,k) = du(i,k) - tmpa
- end if
- end if
- end if
- end do ! k
-
- end do ! i
-
- qaa = q
-
- ! turn on/off calculations for aerosols and trace gases
- do l = 1, pcnst
- dotend(l) = .false.
- if (cnst_species_class(l) == cnst_spec_class_aerosol) then
- if (convproc_do_aer) dotend(l) = .true.
- else if (cnst_species_class(l) == cnst_spec_class_gas) then
- if (convproc_do_gas) dotend(l) = .true.
- end if
- end do
-
-
- itmpveca(:) = -1
-
- call ma_convproc_tend( &
- 'uwsh', &
- lchnk, pcnst, nstep, dt, &
- state%t, state%pmid, state%pdel, qaa, &
- mu, md, du, eu, &
- ed, dp, dpdry, jt, &
- maxg, ideep, 1, lengath, &
- sh_frac, icwmrsh, rprdsh, evapcsh, &
- fracice, &
- dqdt, dotend, nsrflx, qsrflx, &
- xx_mfup_max, xx_wcldbase, xx_kcldbase, &
- lun, itmpveca, dcondt_resusp3d)
-
- call outfld( 'SH_MFUP_MAX', xx_mfup_max, pcols, lchnk )
- call outfld( 'SH_WCLDBASE', xx_wcldbase, pcols, lchnk )
- call outfld( 'SH_KCLDBASE', xx_kcldbase, pcols, lchnk )
-
-end subroutine ma_convproc_sh_intr
-
-!=========================================================================================
-
-subroutine ma_convproc_tend( &
- convtype, &
- lchnk, ncnst, nstep, dt, &
- t, pmid, pdel, q, &
- mu, md, du, eu, &
- ed, dp, dpdry, jt, &
- mx, ideep, il1g, il2g, &
- cldfrac, icwmr, rprd, evapc, &
- fracice, &
- dqdt, doconvproc, nsrflx, qsrflx, &
- xx_mfup_max, xx_wcldbase, xx_kcldbase, &
- lun, idiag_in, dcondt_resusp3d )
-
-!-----------------------------------------------------------------------
-!
-! Purpose:
-! Convective transport of trace species.
-! The trace species need not be conservative, and source/sink terms for
-! activation, resuspension, aqueous chemistry and gas uptake, and
-! wet removal are all applied.
-! Currently this works with the ZM deep convection, but we should be able
-! to adapt it for both Hack and McCaa shallow convection
-!
-!
-! Compare to subr convproc which does conservative trace species.
-!
-! A distinction between "moist" and "dry" mixing ratios is not currently made.
-! (P. Rasch comment: Note that we are still assuming that the tracers are
-! in a moist mixing ratio this will change soon)
-
-!
-! Method:
-! Computes tracer mixing ratios in updraft and downdraft "cells" in a
-! Lagrangian manner, with source/sinks applied in the updraft other.
-! Then computes grid-cell-mean tendencies by considering
-! updraft and downdraft fluxes across layer boundaries
-! environment subsidence/lifting fluxes across layer boundaries
-! sources and sinks in the updraft
-! resuspension of activated species in the grid-cell as a whole
-!
-! Note1: A better estimate or calculation of either the updraft velocity
-! or fractional area is needed.
-! Note2: If updraft area is a small fraction of over cloud area,
-! then aqueous chemistry is underestimated. These are both
-! research areas.
-!
-! Authors: O. Seland and R. Easter, based on convtran by P. Rasch
-!
-!-----------------------------------------------------------------------
-
- use modal_aero_data, only: cnst_name_cw, &
- lmassptr_amode, lmassptrcw_amode, &
- ntot_amode, ntot_amode, &
- nspec_amode, numptr_amode, numptrcw_amode
-
- implicit none
-
-!-----------------------------------------------------------------------
-!
-! Input arguments
-!
- character(len=*), intent(in) :: convtype ! identifies the type of
- ! convection ("deep", "shcu")
- integer, intent(in) :: lchnk ! chunk identifier
- integer, intent(in) :: ncnst ! number of tracers to transport
- integer, intent(in) :: nstep ! Time step index
- real(r8), intent(in) :: dt ! Model timestep
- real(r8), intent(in) :: t(pcols,pver) ! Temperature
- real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels
- real(r8), intent(in) :: pdel(pcols,pver) ! Pressure thickness of levels
- real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture
-
- real(r8), intent(in) :: mu(pcols,pver) ! Updraft mass flux (positive)
- real(r8), intent(in) :: md(pcols,pver) ! Downdraft mass flux (negative)
- real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft
- real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft
- real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft
-! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS ***
-! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code
-! - eventually these should be changed to (kg/m2/s)
-! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0
-
- real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb)
- real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb)
-! real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc
- integer, intent(in) :: jt(pcols) ! Index of cloud top for each column
- integer, intent(in) :: mx(pcols) ! Index of cloud top for each column
- integer, intent(in) :: ideep(pcols) ! Gathering array indices
- integer, intent(in) :: il1g ! Gathered min lon indices over which to operate
- integer, intent(in) :: il2g ! Gathered max lon indices over which to operate
-! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index
-
- real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area
- real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang
- real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate
- real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate
- real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets
-
- real(r8), intent(out):: dqdt(pcols,pver,ncnst) ! Tracer tendency array
- logical, intent(in) :: doconvproc(ncnst) ! flag for doing convective transport
- integer, intent(in) :: nsrflx ! last dimension of qsrflx
- real(r8), intent(out):: qsrflx(pcols,pcnst,nsrflx)
- ! process-specific column tracer tendencies
- ! (1=activation, 2=resuspension, 3=aqueous rxn,
- ! 4=wet removal, 5=renaming)
- real(r8), intent(out) :: xx_mfup_max(pcols)
- real(r8), intent(out) :: xx_wcldbase(pcols)
- real(r8), intent(out) :: xx_kcldbase(pcols)
- integer, intent(in) :: lun ! unit number for diagnostic output
- integer, intent(in) :: idiag_in(pcols) ! flag for diagnostic output
- real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver)
-
-!--------------------------Local Variables------------------------------
-
-! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2
- integer, parameter :: pcnst_extd = pcnst*2
-
- integer :: i, icol ! Work index
- integer :: iconvtype ! 1=deep, 2=uw shallow
- integer :: idiag_act ! Work index
- integer :: iflux_method ! 1=as in convtran (deep), 2=simpler
- integer :: ipass_calc_updraft
- integer :: itmpa, itmpb ! Work variable
- integer :: j, jtsub ! Work index
- integer :: k ! Work index
- integer :: kactcnt ! Counter for no. of levels having activation
- integer :: kactcntb ! Counter for activation diagnostic output
- integer :: kactfirst ! Lowest layer with activation (= cloudbase)
- integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i))
- integer :: kbot_prevap ! Lowest layer for doing resuspension from evaporating precip
- integer :: ktop ! Cloud-flux top layer for current i (=jt(i))
- ! Layers between kbot,ktop have mass fluxes
- ! but not all have cloud water, because the
- ! updraft starts below the cloud base
- integer :: km1, km1x ! Work index
- integer :: kp1, kp1x ! Work index
- integer :: l, ll, la, lc ! Work index
- integer :: m, n ! Work index
- integer :: merr ! number of errors (i.e., failed diagnostics)
- ! for current column
- integer :: nerr ! number of errors for entire run
- integer :: nerrmax ! maximum number of errors to report
- integer :: ncnst_extd
- integer :: npass_calc_updraft
- integer :: ntsub !
-
- logical do_act_this_lev ! flag for doing activation at current level
- logical doconvproc_extd(pcnst_extd) ! flag for doing convective transport
-
- real(r8) aqfrac(pcnst_extd) ! aqueous fraction of constituent in updraft
- real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments)
-
- real(r8) chat(pcnst_extd,pverp) ! mix ratio in env at interfaces
- real(r8) cond(pcnst_extd,pverp) ! mix ratio in downdraft at interfaces
- real(r8) const(pcnst_extd,pver) ! gathered tracer array
- real(r8) conu(pcnst_extd,pverp) ! mix ratio in updraft at interfaces
-
- real(r8) dcondt(pcnst_extd,pver) ! grid-average TMR tendency for current column
- real(r8) dcondt_prevap(pcnst_extd,pver) ! portion of dcondt from precip evaporation
- real(r8) dcondt_resusp(pcnst_extd,pver) ! portion of dcondt from resuspension
-
- real(r8) dcondt_wetdep(pcnst_extd,pver) ! portion of dcondt from wet deposition
- real(r8) dconudt_activa(pcnst_extd,pverp) ! d(conu)/dt by activation
- real(r8) dconudt_aqchem(pcnst_extd,pverp) ! d(conu)/dt by aqueous chem
- real(r8) dconudt_wetdep(pcnst_extd,pverp) ! d(conu)/dt by wet removal
-
- real(r8) maxflux(pcnst_extd) ! maximum (over layers) of fluxin and fluxout
- real(r8) maxflux2(pcnst_extd) ! ditto but computed using method-2 fluxes
- real(r8) maxprevap(pcnst_extd) ! maximum (over layers) of dcondt_prevap*dp
- real(r8) maxresusp(pcnst_extd) ! maximum (over layers) of dcondt_resusp*dp
- real(r8) maxsrce(pcnst_extd) ! maximum (over layers) of netsrce
-
- real(r8) sumflux(pcnst_extd) ! sum (over layers) of netflux
- real(r8) sumflux2(pcnst_extd) ! ditto but computed using method-2 fluxes
- real(r8) sumsrce(pcnst_extd) ! sum (over layers) of dp*netsrce
- real(r8) sumchng(pcnst_extd) ! sum (over layers) of dp*dcondt
- real(r8) sumchng3(pcnst_extd) ! ditto but after call to resusp_conv
- real(r8) sumactiva(pcnst_extd) ! sum (over layers) of dp*dconudt_activa
- real(r8) sumaqchem(pcnst_extd) ! sum (over layers) of dp*dconudt_aqchem
- real(r8) sumprevap(pcnst_extd) ! sum (over layers) of dp*dcondt_prevap
- real(r8) sumresusp(pcnst_extd) ! sum (over layers) of dp*dcondt_resusp
- real(r8) sumwetdep(pcnst_extd) ! sum (over layers) of dp*dconudt_wetdep
-
- real(r8) cabv ! mix ratio of constituent above
- real(r8) cbel ! mix ratio of constituent below
- real(r8) cdifr ! normalized diff between cabv and cbel
- real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt
- real(r8) clw_cut ! threshold clw value for doing updraft
- ! transformation and removal
- real(r8) courantmax ! maximum courant no.
- real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i
- real(r8) dp_i(pver) ! dp(i,k) at current i
- real(r8) dt_u(pver) ! lagrangian transport time in the updraft
- real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i
- real(r8) dqdt_i(pver,pcnst) ! dqdt(i,k,m) at current i
- real(r8) dtsub ! dt/ntsub
- real(r8) dz ! working layer thickness (m)
- real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i
- real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i
- real(r8) expcdtm1 ! a work variable
- real(r8) fa_u(pver) ! fractional area of in the updraft
- real(r8) fa_u_dp ! current fa_u(k)*dp_i(k)
- real(r8) f_ent ! fraction of the "before-detrainment" updraft
- ! massflux at k/k-1 interface resulting from
- ! entrainment of level k air
- real(r8) fluxin ! a work variable
- real(r8) fluxout ! a work variable
- real(r8) maxc ! a work variable
- real(r8) mbsth ! Threshold for mass fluxes
- real(r8) minc ! a work variable
- real(r8) md_m_eddp ! a work variable
- real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension)
- real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension)
- real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension)
- real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension)
- ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes
- ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry
- ! the mu_i/md_i are next calculated by applying the mbsth threshold
- real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k)
- real(r8) netflux ! a work variable
- real(r8) netsrce ! a work variable
- real(r8) q_i(pver,pcnst) ! q(i,k,m) at current i
- real(r8) qsrflx_i(pcnst,nsrflx) ! qsrflx(i,m,n) at current i
- real(r8) relerr_cut ! relative error criterion for diagnostics
- real(r8) rhoair_i(pver) ! air density at current i
- real(r8) small ! a small number
- real(r8) tmpa, tmpb ! work variables
- real(r8) tmpf ! work variables
- real(r8) tmpveca(pcnst_extd) ! work variables
- real(r8) tmpmata(pcnst_extd,3) ! work variables
- real(r8) xinv_ntsub ! 1.0/ntsub
- real(r8) wup(pver) ! working updraft velocity (m/s)
-
- real(r8) :: dcondt2(pcols,pver,pcnst_extd)
- real(r8) :: conu2(pcols,pver,pcnst_extd)
-
- character(len=16) :: cnst_name_extd(pcnst_extd)
-
- !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01
- !Chosen to reproduce vertical vecocities in GATEIII GIGALES (Khairoutdinov etal 2009, JAMES)
- real(r8), parameter :: zm_areafrac = 0.01_r8
-!-----------------------------------------------------------------------
-!
-
-! if (nstep > 1) call endrun()
-
- if (convtype == 'deep') then
- iconvtype = 1
- iflux_method = 1
- else if (convtype == 'uwsh') then
- iconvtype = 2
- iflux_method = 2
- else
- call endrun( '*** ma_convproc_tend -- convtype is not |deep| or |uwsh|' )
- end if
-
- nerr = 0
- nerrmax = 99
-
- ncnst_extd = pcnst_extd
- dcondt_resusp3d(:,:,:) = 0._r8
-
- small = 1.e-36_r8
-! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s)
- mbsth = 1.e-15_r8
-
- qsrflx(:,:,:) = 0.0_r8
- dqdt(:,:,:) = 0.0_r8
- xx_mfup_max(:) = 0.0_r8
- xx_wcldbase(:) = 0.0_r8
- xx_kcldbase(:) = 0.0_r8
-
- wup(:) = 0.0_r8
-
- dcondt2 = 0.0_r8
- conu2 = 0.0_r8
-
-! set doconvproc_extd (extended array) values
-! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise
- doconvproc_extd(:) = .false.
- doconvproc_extd(2:ncnst) = doconvproc(2:ncnst)
- aqfrac(:) = 0.0_r8
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- end if
- if ( doconvproc(la) ) then
- doconvproc_extd(lc) = .true.
- aqfrac(lc) = 1.0_r8
- end if
- enddo
- enddo ! n
-
- do l = 1, pcnst_extd
- if (l <= pcnst) then
- cnst_name_extd(l) = cnst_name(l)
- else
- cnst_name_extd(l) = cnst_name_cw(l-pcnst)
- end if
- end do
-
-
-! Loop ever each column that has convection
-! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays
-i_loop_main_aa: &
- do i = il1g, il2g
- icol = ideep(i)
-
-
- if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then
-! shallow conv case with jt,mx <= 0, which means there is no shallow conv
-! in this column -- skip this column
- cycle i_loop_main_aa
-
- else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then
-! invalid cloudtop and cloudbase indices -- skip this column
- write(lun,9010) 'illegal jt, mx', convtype, lchnk, icol, i, &
- jt(i), mx(i)
-9010 format( '*** ma_convproc_tend error -- ', a, 5x, 'convtype = ', a / &
- '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) )
- cycle i_loop_main_aa
-
- else if (jt(i) == mx(i)) then
-! cloudtop = cloudbase (1 layer cloud) -- skip this column
- write(lun,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i)
- cycle i_loop_main_aa
-
- end if
-
-
-!
-! cloudtop and cloudbase indices are valid so proceed with calculations
-!
-
-! Load dp_i and cldfrac_i, and calc rhoair_i
- do k = 1, pver
- dp_i(k) = dpdry(i,k)
- cldfrac_i(k) = cldfrac(icol,k)
- rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k))
- end do
-
-! Calc dry mass fluxes
-! This is approximate because the updraft air is has different temp and qv than
-! the grid mean, but the whole convective parameterization is highly approximate
- mu_x(:) = 0.0_r8
- md_x(:) = 0.0_r8
-! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry
- do k = pver, 1, -1
- mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k)
- xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) )
- end do
-! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry
- do k = 2, pver
- md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1)
- end do
-
-! Load mass fluxes over cloud layers
-! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding)
-! Zero out values below threshold
-! Zero out values at "top of cloudtop", "base of cloudbase"
- ktop = jt(i)
- kbot = mx(i)
-! usually the updraft ( & downdraft) start ( & end ) at kbot=pver, but sometimes kbot < pver
-! transport, activation, resuspension, and wet removal only occur between kbot >= k >= ktop
-! resuspension from evaporating precip can occur at k > kbot when kbot < pver
- kbot_prevap = pver
- mu_i(:) = 0.0_r8
- md_i(:) = 0.0_r8
- do k = ktop+1, kbot
- mu_i(k) = mu_x(k)
- if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8
- md_i(k) = md_x(k)
- if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8
- end do
- mu_i(ktop) = 0.0_r8
- md_i(ktop) = 0.0_r8
- mu_i(kbot+1) = 0.0_r8
- md_i(kbot+1) = 0.0_r8
-
-! Compute updraft and downdraft "entrainment*dp" from eu and ed
-! Compute "detrainment*dp" from mass conservation
- eudp(:) = 0.0_r8
- dudp(:) = 0.0_r8
- eddp(:) = 0.0_r8
- dddp(:) = 0.0_r8
- courantmax = 0.0_r8
- do k = ktop, kbot
- if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then
- if (du(i,k) <= 0.0_r8) then
- eudp(k) = mu_i(k) - mu_i(k+1)
- else
- eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 )
- dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k)
- if (dudp(k) < 1.0e-12_r8*eudp(k)) then
- eudp(k) = mu_i(k) - mu_i(k+1)
- dudp(k) = 0.0_r8
- end if
- end if
- end if
- if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then
- eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 )
- dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k)
- if (dddp(k) < 1.0e-12_r8*eddp(k)) then
- eddp(k) = md_i(k) - md_i(k+1)
- dddp(k) = 0.0_r8
- end if
- end if
-! courantmax = max( courantmax, (eudp(k)+eddp(k))*dt/dp_i(k) ) ! old version - incorrect
- courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) )
- end do ! k
-
-! number of time substeps needed to maintain "courant number" <= 1
- ntsub = 1
- if (courantmax > (1.0_r8 + 1.0e-6_r8)) then
- ntsub = 1 + int( courantmax )
- end if
- xinv_ntsub = 1.0_r8/ntsub
- dtsub = dt*xinv_ntsub
- courantmax = courantmax*xinv_ntsub
-
-! load tracer mixing ratio array, which will be updated at the end of each jtsub interation
- q_i(1:pver,1:pcnst) = q(icol,1:pver,1:pcnst)
-
- do m = 1,pcnst
- conu2(icol,1:pver,m) = q(icol,1:pver,m)
- end do
-
-!
-! when method_reduce_actfrac = 2, need to do the updraft calc twice
-! (1st to get non-adjusted activation amount, 2nd to apply reduction factor)
- npass_calc_updraft = 1
- if ( (method_reduce_actfrac == 2) .and. &
- (factor_reduce_actfrac >= 0.0_r8) .and. &
- (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2
-
-
-jtsub_loop_main_aa: &
- do jtsub = 1, ntsub
-
-
-ipass_calc_updraft_loop: &
- do ipass_calc_updraft = 1, npass_calc_updraft
-
-
- if (idiag_in(icol) > 0) &
- write(lun,'(/a,3x,a,1x,i9,5i5)') 'qakr - convtype,lchnk,i,jt,mx,jtsub,ipass=', &
- trim(convtype), lchnk, icol, jt(i), mx(i), jtsub, ipass_calc_updraft
-
- qsrflx_i(:,:) = 0.0_r8
- dqdt_i(:,:) = 0.0_r8
-
- const(:,:) = 0.0_r8 ! zero cloud-phase species
- chat(:,:) = 0.0_r8 ! zero cloud-phase species
- conu(:,:) = 0.0_r8
- cond(:,:) = 0.0_r8
-
- dcondt(:,:) = 0.0_r8
- dcondt_resusp(:,:) = 0.0_r8
- dcondt_wetdep(:,:) = 0.0_r8
- dcondt_prevap(:,:) = 0.0_r8
- dconudt_aqchem(:,:) = 0.0_r8
- dconudt_wetdep(:,:) = 0.0_r8
-! only initialize the activation tendency on ipass=1
- if (ipass_calc_updraft == 1) dconudt_activa(:,:) = 0.0_r8
-
-! initialize mixing ratio arrays (chat, const, conu, cond)
- do m = 2, ncnst
- if ( doconvproc_extd(m) ) then
-
-! Gather up the constituent
- do k = 1,pver
- const(m,k) = q_i(k,m)
- end do
-
-! From now on work only with gathered data
-! Interpolate environment tracer values to interfaces
- do k = 1,pver
- km1 = max(1,k-1)
- minc = min(const(m,km1),const(m,k))
- maxc = max(const(m,km1),const(m,k))
- if (minc < 0) then
- cdifr = 0._r8
- else
- cdifr = abs(const(m,k)-const(m,km1))/max(maxc,small)
- endif
-
-! If the two layers differ significantly use a geometric averaging procedure
-! But only do that for deep convection. For shallow, use the simple
-! averaging which is used in subr cmfmca
- if (iconvtype /= 1) then
- chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1))
- else if (cdifr > 1.E-6_r8) then
-! if (cdifr > 1.E-6) then
- cabv = max(const(m,km1),maxc*1.e-12_r8)
- cbel = max(const(m,k),maxc*1.e-12_r8)
- chat(m,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel
- else ! Small diff, so just arithmetic mean
- chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1))
- end if
-
-! Set provisional up and down draft values, and tendencies
- conu(m,k) = chat(m,k)
- cond(m,k) = chat(m,k)
- end do ! k
-
-! Values at surface inferface == values in lowest layer
- chat(m,pver+1) = const(m,pver)
- conu(m,pver+1) = const(m,pver)
- cond(m,pver+1) = const(m,pver)
- end if
- end do ! m
-
-
-
-
-! Compute updraft mixing ratios from cloudbase to cloudtop
-! No special treatment is needed at k=pver because arrays
-! are dimensioned 1:pver+1
-! A time-split approach is used. First, entrainment is applied to produce
-! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are
-! applied to the initial conu(m,k) to produce a final conu(m,k).
-! Detrainment from the updraft uses this final conu(m,k).
-! Note that different time-split approaches would give somewhat different
-! results
- kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1
-k_loop_main_bb: &
- do k = kbot, ktop, -1
- kp1 = k+1
-
-! cldfrac = conv cloud fractional area. This could represent anvil cirrus area,
-! and may not useful for aqueous chem and wet removal calculations
- cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 )
-! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k
- mu_p_eudp(k) = mu_i(kp1) + eudp(k)
-
- fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false.
- if (mu_p_eudp(k) > mbsth) then
-! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top
-! of current layer,
-! so current layer is a "gap" between two unconnected updrafts,
-! so essentially skip all the updraft calculations for this layer
-
-! First apply changes from entrainment
- f_ent = eudp(k)/mu_p_eudp(k)
- f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) )
- tmpa = 1.0_r8 - f_ent
- do m = 2, ncnst_extd
- if (doconvproc_extd(m)) then
- conu(m,k) = tmpa*conu(m,kp1) + f_ent*const(m,k)
- end if
- end do
-
-! estimate updraft velocity (wup)
- if (iconvtype /= 1) then
-! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)]
- wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
- / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8))
- else
-! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac
- wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
- / (rhoair_i(k) * zm_areafrac)
- end if
-
-! compute lagrangian transport time (dt_u) and updraft fractional area (fa_u)
-! *** these must obey dt_u(k)*mu_p_eudp(k) = dp_i(k)*fa_u(k)
- dz = dp_i(k)*hund_ovr_g/rhoair_i(k)
- dt_u(k) = dz/wup(k)
- dt_u(k) = min( dt_u(k), dt )
- fa_u(k) = dt_u(k)*(mu_p_eudp(k)/dp_i(k))
-
-
-! Now apply transformation and removal changes
-! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate
-! occasional very small icwmr values from the ZM module
- clw_cut = 1.0e-6_r8
-
-
- if (convproc_method_activate <= 1) then
-! aerosol activation - method 1
-! skip levels that are completely glaciated (fracice(icol,k) == 1.0)
-! when kactcnt=1 (first/lowest layer with cloud water) apply
-! activatation to the entire updraft
-! when kactcnt>1 apply activatation to the amount entrained at this level
- if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then
- kactcnt = kactcnt + 1
-
- idiag_act = idiag_in(icol)
- if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then
- kactcntb = kactcntb + 1
- if ((kactcntb == 1) .and. (idiag_act > 0)) then
- write(lun,'(/a,i9,2i4)') &
- 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub
- end if
- end if
-
- if (kactcnt == 1) then
- ! diagnostic fields
- ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac
- xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
- / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8))
- xx_kcldbase(icol) = k
-
- kactfirst = k
- tmpa = 1.0_r8
- call ma_activate_convproc( &
- conu(:,k), dconudt_activa(:,k), conu(:,k), &
- tmpa, dt_u(k), wup(k), &
- t(icol,k), rhoair_i(k), fracice(icol,k), &
- pcnst_extd, lun, idiag_act, &
- lchnk, icol, k, &
- ipass_calc_updraft )
- else if (f_ent > 0.0_r8) then
- ! current layer is above cloud base (=first layer with activation)
- ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1)
- if (k >= kactfirst-(method1_activate_nlayers-1)) then
- call ma_activate_convproc( &
- conu(:,k), dconudt_activa(:,k), const(:,k), &
- f_ent, dt_u(k), wup(k), &
- t(icol,k), rhoair_i(k), fracice(icol,k), &
- pcnst_extd, lun, idiag_act, &
- lchnk, icol, k, &
- ipass_calc_updraft )
- end if
- end if
-! the following was for cam2 shallow convection (hack),
-! but is not appropriate for cam5 (uwshcu)
-! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then
-! ! for shallow conv, when you move from activation occuring to
-! ! not occuring, reset kactcnt=0, because the hack scheme can
-! ! produce multiple "1.5 layer clouds" separated by clear air
-! kactcnt = 0
-! end if
- end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then
-
- else ! (convproc_method_activate >= 2)
-! aerosol activation - method 2
-! skip levels that are completely glaciated (fracice(icol,k) == 1.0)
-! when kactcnt=1 (first/lowest layer with cloud water)
-! apply "primary" activatation to the entire updraft
-! when kactcnt>1
-! apply secondary activatation to the entire updraft
-! do this for all levels above cloud base (even if completely glaciated)
-! (this is something for sensitivity testing)
- do_act_this_lev = .false.
- if (kactcnt <= 0) then
- if (icwmr(icol,k) > clw_cut) then
- do_act_this_lev = .true.
- kactcnt = 1
- kactfirst = k
- ! diagnostic fields
- ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac
- xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g &
- / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8))
- xx_kcldbase(icol) = k
- end if
- else
-! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then
- do_act_this_lev = .true.
- kactcnt = kactcnt + 1
-! end if
- end if
-
- idiag_act = idiag_in(icol)
- if ( do_act_this_lev ) then
- kactcntb = kactcntb + 1
- if ((kactcntb == 1) .and. (idiag_act > 0)) then
- write(lun,'(/a,i9,2i4)') &
- 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub
- end if
-
- call ma_activate_convproc_method2( &
- conu(:,k), dconudt_activa(:,k), &
- f_ent, dt_u(k), wup(k), &
- t(icol,k), rhoair_i(k), fracice(icol,k), &
- pcnst_extd, lun, idiag_act, &
- lchnk, icol, k, &
- kactfirst, ipass_calc_updraft )
- end if
-
- conu2(icol,k,:) = conu(:,k)
-
- end if ! (convproc_method_activate <= 1)
-
-! aqueous chemistry
-! do glaciated levels as aqchem_conv will eventually do acid vapor uptake
-! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff
- if (icwmr(icol,k) > clw_cut) then
-! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, &
-! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), &
-! lh2o2(icol,k), lo3(icol,k), dt_u(k) )
- end if
-
-! wet removal
-!
-! mirage2
-! rprd = precip formation as a grid-cell average (kgW/kgA/s)
-! icwmr = cloud water MR within updraft area (kgW/kgA)
-! fupdr = updraft fractional area (--)
-! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s)
-! B = A/icwmr = rprd/(icwmr*fupdr)
-! = first-order removal rate (1/s)
-! C = dp/(mup/fupdr) = updraft air residence time in the layer (s)
-!
-! fraction removed = (1.0 - exp(-cdt)) where
-! cdt = B*C = (dp/mup)*rprd/icwmr
-!
-! Note1: fupdr cancels out in cdt, so need not be specified
-! Note2: dp & mup units need only be consistent (e.g., mb & mb/s)
-! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme)
-! Note4: the "dp" in C above and code below should be the moist dp
-!
-! cam5
-! clw_preloss = cloud water MR before loss to precip
-! = icwmr + dt*(rprd/fupdr)
-! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr)
-! = rprd/(fupdr*icwmr + dt*rprd)
-! = first-order removal rate (1/s)
-!
-! fraction removed = (1.0 - exp(-cdt)) where
-! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)]
-!
-! Note1: *** cdt is now sensitive to fupdr, which we do not really know,
-! and is not the same as the convective cloud fraction
-! Note2: dt is appropriate in the above cdt expression, not dtsub
-!
-! Apply wet removal at levels where
-! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0
-! as wet removal occurs in both liquid and ice clouds
-!
- cdt(k) = 0.0_r8
- if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then
-! if (iconvtype == 1) then
- tmpf = 0.5_r8*cldfrac_i(k)
- cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / &
- (tmpf*icwmr(icol,k) + dt*rprd(icol,k))
-! else if (k < pver) then
-! if (eudp(k+1) > 0) cdt(k) = &
-! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1))
-! end if
- end if
- if (cdt(k) > 0.0_r8) then
- expcdtm1 = exp(-cdt(k)) - 1.0_r8
- do m = 2, ncnst_extd
- if (doconvproc_extd(m)) then
- dconudt_wetdep(m,k) = conu(m,k)*aqfrac(m)*expcdtm1
- conu(m,k) = conu(m,k) + dconudt_wetdep(m,k)
- dconudt_wetdep(m,k) = dconudt_wetdep(m,k) / dt_u(k)
- conu2(icol,k,m) = conu(m,k)
- end if
- enddo
- end if
-
- end if ! "(mu_p_eudp(k) > mbsth)"
- end do k_loop_main_bb ! "k = kbot, ktop, -1"
-
-! when doing updraft calcs twice, only need to go this far on the first pass
- if ( (ipass_calc_updraft == 1) .and. &
- (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop
-
- if (idiag_in(icol) > 0) then
- ! do wet removal diagnostics here
- do k = kbot, ktop, -1
- if (mu_p_eudp(k) > mbsth) &
- write(lun,'(a,i9,3i4,1p,6e10.3)') &
- 'qakr - l,i,k,jt; cdt, cldfrac, icwmr, rprd, ...', lchnk, icol, k, jtsub, &
- cdt(k), cldfrac_i(k), icwmr(icol,k), rprd(icol,k), dp(i,k), mu_p_eudp(k)
- end do
- end if
-
-
-! Compute downdraft mixing ratios from cloudtop to cloudbase
-! No special treatment is needed at k=2
-! No transformation or removal is applied in the downdraft
- do k = ktop, kbot
- kp1 = k + 1
-! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1
- md_m_eddp = md_i(k) - eddp(k)
- if (md_m_eddp < -mbsth) then
- do m = 2, ncnst_extd
- if (doconvproc_extd(m)) then
- cond(m,kp1) = ( md_i(k)*cond(m,k) &
- - eddp(k)*const(m,k) ) / md_m_eddp
- endif
- end do
- end if
- end do ! k
-
-
-! Now computes fluxes and tendencies
-! NOTE: The approach used in convtran applies to inert tracers and
-! must be modified to include source and sink terms
- sumflux(:) = 0.0_r8
- sumflux2(:) = 0.0_r8
- sumsrce(:) = 0.0_r8
- sumchng(:) = 0.0_r8
- sumchng3(:) = 0.0_r8
- sumactiva(:) = 0.0_r8
- sumaqchem(:) = 0.0_r8
- sumwetdep(:) = 0.0_r8
- sumresusp(:) = 0.0_r8
- sumprevap(:) = 0.0_r8
-
- maxflux(:) = 0.0_r8
- maxflux2(:) = 0.0_r8
- maxresusp(:) = 0.0_r8
- maxsrce(:) = 0.0_r8
- maxprevap(:) = 0.0_r8
-
-k_loop_main_cc: &
- do k = ktop, kbot
- kp1 = k+1
- km1 = k-1
- kp1x = min( kp1, pver )
- km1x = max( km1, 1 )
- fa_u_dp = fa_u(k)*dp_i(k)
- do m = 2, ncnst_extd
- if (doconvproc_extd(m)) then
-
-! First compute fluxes using environment subsidence/lifting and
-! entrainment/detrainment into up/downdrafts,
-! to provide an additional mass balance check
-! (this could be deleted after the code is well tested)
- fluxin = mu_i(k)*min(chat(m,k),const(m,km1x)) &
- - md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) &
- + dudp(k)*conu(m,k) + dddp(k)*cond(m,kp1)
- fluxout = mu_i(kp1)*min(chat(m,kp1),const(m,k)) &
- - md_i(k)*min(chat(m,k),const(m,k)) &
- + (eudp(k) + eddp(k))*const(m,k)
-
- netflux = fluxin - fluxout
-
- sumflux2(m) = sumflux2(m) + netflux
- maxflux2(m) = max( maxflux2(m), abs(fluxin), abs(fluxout) )
-
-! Now compute fluxes as in convtran, and also source/sink terms
-! (version 3 limit fluxes outside convection to mass in appropriate layer
-! (these limiters are probably only safe for positive definite quantitities
-! (it assumes that mu and md already satify a courant number limit of 1)
- if (iflux_method /= 2) then
- fluxin = mu_i(kp1)*conu(m,kp1) &
- + mu_i(k )*min(chat(m,k ),const(m,km1x)) &
- - ( md_i(k )*cond(m,k) &
- + md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) )
- fluxout = mu_i(k )*conu(m,k) &
- + mu_i(kp1)*min(chat(m,kp1),const(m,k )) &
- - ( md_i(kp1)*cond(m,kp1) &
- + md_i(k )*min(chat(m,k ),const(m,k )) )
- else
- fluxin = mu_i(kp1)*conu(m,kp1) &
- - ( md_i(k )*cond(m,k) )
- fluxout = mu_i(k )*conu(m,k) &
- - ( md_i(kp1)*cond(m,kp1) )
- tmpveca(1) = fluxin ; tmpveca(4) = -fluxout
-
- ! new method -- simple upstream method for the env subsidence
- ! tmpa = net env mass flux (positive up) at top of layer k
- tmpa = -( mu_i(k ) + md_i(k ) )
- if (tmpa <= 0.0_r8) then
- fluxin = fluxin - tmpa*const(m,km1x)
- else
- fluxout = fluxout + tmpa*const(m,k )
- end if
- tmpveca(2) = fluxin ; tmpveca(5) = -fluxout
- ! tmpa = net env mass flux (positive up) at base of layer k
- tmpa = -( mu_i(kp1) + md_i(kp1) )
- if (tmpa >= 0.0_r8) then
- fluxin = fluxin + tmpa*const(m,kp1x)
- else
- fluxout = fluxout - tmpa*const(m,k )
- end if
- tmpveca(3) = fluxin ; tmpveca(6) = -fluxout
- end if
-
- netflux = fluxin - fluxout
- netsrce = fa_u_dp*(dconudt_aqchem(m,k) + &
- dconudt_activa(m,k) + dconudt_wetdep(m,k))
- dcondt(m,k) = (netflux+netsrce)/dp_i(k)
-
- dcondt_wetdep(m,k) = fa_u_dp*dconudt_wetdep(m,k)/dp_i(k)
-
- sumflux(m) = sumflux(m) + netflux
- maxflux(m) = max( maxflux(m), abs(fluxin), abs(fluxout) )
- sumsrce(m) = sumsrce(m) + netsrce
- maxsrce(m) = max( maxsrce(m), &
- fa_u_dp*max( abs(dconudt_aqchem(m,k)), &
- abs(dconudt_activa(m,k)), abs(dconudt_wetdep(m,k)) ) )
- sumchng(m) = sumchng(m) + dcondt(m,k)*dp_i(k)
- sumactiva(m) = sumactiva(m) + fa_u_dp*dconudt_activa(m,k)
- sumaqchem(m) = sumaqchem(m) + fa_u_dp*dconudt_aqchem(m,k)
- sumwetdep(m) = sumwetdep(m) + fa_u_dp*dconudt_wetdep(m,k)
-
- if ( idiag_in(icol)>0 .and. k==26 .and. &
- (m==16 .or. m==23 .or. m==16+pcnst .or. m==23+pcnst) ) then
- if (m==16) &
- write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') &
- 'qakww0-'//convtype(1:4), lchnk, icol, k, -1, jtsub, &
- dtsub*mu_i(k+1)/dp_i(k), dtsub*mu_i(k)/dp_i(k), dtsub*eudp(k)/dp_i(k), &
- dtsub*md_i(k+1)/dp_i(k), dtsub*md_i(k)/dp_i(k), dtsub*eddp(k)/dp_i(k)
-
- write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,6e11.3)') &
- 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, &
- const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k), &
- dtsub*fluxin/dp_i(k), -dtsub*fluxout/dp_i(k), &
- dtsub*fa_u_dp*dconudt_aqchem(m,k)/dp_i(k), &
- dtsub*fa_u_dp*dconudt_activa(m,k)/dp_i(k), &
- dtsub*fa_u_dp*dconudt_wetdep(m,k)/dp_i(k)
- write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') &
- 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, &
- dtsub*tmpveca(1:6)/dp_i(k)
- end if
-
- dcondt2(icol,k,m) = dcondt(m,k)
-
- end if ! "(doconvproc_extd(m))"
- end do ! "m = 2,ncnst_extd"
- end do k_loop_main_cc ! "k = ktop, kbot"
-
-
-! calculate effects of precipitation evaporation
- call ma_precpevap_convproc( dcondt, dcondt_wetdep, dcondt_prevap, &
- rprd, evapc, dp_i, &
- icol, ktop, pcnst_extd, &
- lun, idiag_in(icol), lchnk, &
- doconvproc_extd )
- if ( idiag_in(icol)>0 ) then
- k = 26
- do m = 16, 23, 7
- write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') &
- 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, &
- const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k)
- end do
- do m = 16+pcnst, 23+pcnst, 7
- write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') &
- 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, &
- const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k)
- end do
- end if
-
-
-
-! make adjustments to dcondt for activated & unactivated aerosol species
-! pairs to account any (or total) resuspension of convective-cloudborne aerosol
- call ma_resuspend_convproc( dcondt, dcondt_resusp, &
- const, dp_i, ktop, kbot_prevap, pcnst_extd )
-
- ! Do resuspension of aerosols from rain only when the rain has
- ! totally evaporated.
- if (convproc_do_evaprain_atonce) then
- dcondt_resusp3d(pcnst+1:pcnst_extd,icol,:) = dcondt_resusp(pcnst+1:pcnst_extd,:)
- dcondt_resusp(pcnst+1:pcnst_extd,:) = 0._r8
- end if
-
- if ( idiag_in(icol)>0 ) then
- k = 26
- do m = 16, 23, 7
- write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') &
- 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, &
- const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k)
- end do
- do m = 16+pcnst, 23+pcnst, 7
- write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') &
- 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, &
- const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k)
- end do
- end if
-
-
-! calculate new column-tendency variables
- do m = 2, ncnst_extd
- if (doconvproc_extd(m)) then
- do k = ktop, kbot_prevap
- sumchng3(m) = sumchng3(m) + dcondt(m,k)*dp_i(k)
- sumresusp(m) = sumresusp(m) + dcondt_resusp(m,k)*dp_i(k)
- maxresusp(m) = max( maxresusp(m), &
- abs(dcondt_resusp(m,k)*dp_i(k)) )
- sumprevap(m) = sumprevap(m) + dcondt_prevap(m,k)*dp_i(k)
- maxprevap(m) = max( maxprevap(m), &
- abs(dcondt_prevap(m,k)*dp_i(k)) )
- end do
- end if
- end do ! m
-
-
-! do checks for mass conservation
-! do not expect errors > 1.0e-14, but use a conservative 1.0e-10 here,
-! as an error of this size is still not a big concern
- relerr_cut = 1.0e-10_r8
- if (nerr < nerrmax) then
- merr = 0
- if (courantmax > (1.0_r8 + 1.0e-6_r8)) then
- write(lun,9161) '-', trim(convtype), courantmax
- merr = merr + 1
- end if
- do m = 2, ncnst_extd
- if (doconvproc_extd(m)) then
- itmpa = 0
- ! sumflux should be ~=0.0 because fluxout of one layer cancels
- ! fluxin to adjacent layer
- tmpa = sumflux(m)
- tmpb = max( maxflux(m), small )
- if (abs(tmpa) > relerr_cut*tmpb) then
- write(lun,9151) '1', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb)
- itmpa = itmpa + 1
- end if
- ! sumflux2 involve environment fluxes and entrainment/detrainment
- ! to up/downdrafts, and it should be equal to sumchng,
- ! and so (sumflux2 - sumsrce) should be ~=0.0
- tmpa = sumflux2(m) - sumsrce(m)
- tmpb = max( maxflux2(m), maxsrce(m), small )
- if (abs(tmpa) > relerr_cut*tmpb) then
- write(lun,9151) '2', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb)
- itmpa = itmpa + 10
- end if
- ! sunchng = sumflux + sumsrce, so (sumchng - sumsrc) should be ~=0.0
- tmpa = sumchng(m) - sumsrce(m)
- tmpb = max( maxflux(m), maxsrce(m), small )
- if (abs(tmpa) > relerr_cut*tmpb) then
- write(lun,9151) '3', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb)
- itmpa = itmpa + 100
- end if
- ! sumchng3 = sumchng + sumresusp + sumprevap,
- ! so tmpa (below) should be ~=0.0
- ! NOTE: This check needs to be redone if the rain is being
- ! evaporated all at once. Until then, skip this check for that case.
- if (.not. convproc_do_evaprain_atonce) then
- tmpa = sumchng3(m) - (sumsrce(m) + sumresusp(m) + sumprevap(m))
- tmpb = max( maxflux(m), maxsrce(m), maxresusp(m), maxprevap(m), small )
-
- if (abs(tmpa) > relerr_cut*tmpb) then
- write(lun,9151) '4', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb)
- itmpa = itmpa + 1000
- end if
- end if
-
- if (itmpa > 0) merr = merr + 1
- end if
- end do ! m
- if (merr > 0) write(lun,9181) convtype, lchnk, icol, i, jt(i), mx(i)
- nerr = nerr + merr
- if (nerr >= nerrmax) write(lun,9171) nerr
- end if ! (nerr < nerrmax) then
-
-9151 format( '*** ma_convproc_tend error, massbal', a, 1x, i5,1x,a, &
- ' -- maxflux, sumflux, relerr =', 3(1pe14.6) )
-9161 format( '*** ma_convproc_tend error, courantmax', 2a, 3x, 1pe14.6 )
-9171 format( '*** ma_convproc_tend error, stopping messages after nerr =', i10 )
-
-9181 format( '*** ma_convproc_tend error -- convtype, lchnk, icol, il, jt, mx = ', a,2x,5(1x,i10) )
-
-
-!
-! note again the ma_convproc_tend does not apply convective cloud processing
-! to the stratiform-cloudborne aerosol
-! within this routine, cloudborne aerosols are convective-cloudborne
-!
-! before tendencies (dcondt, which is loaded into dqdt) are returned,
-! the convective-cloudborne aerosol tendencies must be combined
-! with the interstitial tendencies
-! ma_resuspend_convproc has already done this for the dcondt
-!
-! the individual process column tendencies (sumwetdep, sumprevap, ...)
-! are just diagnostic fields that can be written to history
-! tendencies for interstitial and convective-cloudborne aerosol could
-! both be passed back and output, if desired
-! currently, however, the interstitial and convective-cloudborne tendencies
-! are combined (in the next code block) before being passed back (in qsrflx)
-!
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- end if
- if (doconvproc(la)) then
- sumactiva(la) = sumactiva(la) + sumactiva(lc)
- sumresusp(la) = sumresusp(la) + sumresusp(lc)
- sumaqchem(la) = sumaqchem(la) + sumaqchem(lc)
- sumwetdep(la) = sumwetdep(la) + sumwetdep(lc)
- sumprevap(la) = sumprevap(la) + sumprevap(lc)
-! if (n==1 .and. ll==1) then
-! write(lun,*) 'la, sumaqchem(la) =', la, sumaqchem(la)
-! endif
- end if
- enddo ! ll
- enddo ! n
-
-!
-! scatter overall tendency back to full array
-!
- do m = 2, ncnst
- if (doconvproc(m)) then
- do k = ktop, kbot_prevap
- dqdt_i(k,m) = dcondt(m,k)
- dqdt(icol,k,m) = dqdt(icol,k,m) + dqdt_i(k,m)*xinv_ntsub
- end do
-! dqdt_i(:,m) = 0.
- end if
- end do ! m
-
-! scatter column burden tendencies for various processes to qsrflx
- do m = 2, ncnst
- if (doconvproc(m)) then
- qsrflx_i(m,1) = sumactiva(m)*hund_ovr_g
- qsrflx_i(m,2) = sumresusp(m)*hund_ovr_g
- qsrflx_i(m,3) = sumaqchem(m)*hund_ovr_g
- qsrflx_i(m,4) = sumwetdep(m)*hund_ovr_g
- qsrflx_i(m,5) = sumprevap(m)*hund_ovr_g
-! qsrflx_i(m,1:4) = 0.
- qsrflx(icol,m,1:5) = qsrflx(icol,m,1:5) + qsrflx_i(m,1:5)*xinv_ntsub
- end if
- end do ! m
-
-
-! diagnostic output of profiles before
- if (idiag_in(icol) > 0) then
- write(lun, '(/3a,i9,2i4)' ) 'qakr-', trim(convtype), ' - lchnk,i,jtsub', lchnk, icol, jtsub
- n = 1
-
- do j = 1, 2
- if (j == 1) then
- write(lun, '(4a,i4)' ) &
- 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', &
- 'numb & numbcw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub
- else
- write(lun, '(/4a,i4)' ) &
- 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', &
- 'mass & masscw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub
- end if
-
- do k = 10, pver
- tmpveca(:) = 0.0_r8
- do ll = 1, nspec_amode(n)
- if (j == 1) then
- la = numptr_amode(n)
- lc = numptr_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptr_amode(ll,n) + pcnst
- end if
- tmpveca(1) = tmpveca(1) + q_i(k,la)
- tmpveca(2) = tmpveca(2) + const(la,k)
- tmpveca(3) = tmpveca(3) + const(lc,k)
- tmpveca(4) = tmpveca(4) + conu( la,k)
- tmpveca(5) = tmpveca(5) + conu( lc,k)
- tmpveca(6) = tmpveca(6) + cond( la,k)
- tmpveca(7) = tmpveca(7) + cond( lc,k)
- tmpveca(8) = tmpveca(8) + (dcondt(la,k)-dcondt_resusp(la,k))*dtsub
- tmpveca(9) = tmpveca(9) + (dcondt(lc,k)-dcondt_resusp(lc,k))*dtsub
- tmpveca(10) = tmpveca(8) + tmpveca(9)
- if (j == 1) exit
- end do ! ll
- if ((k > 15) .and. (mod(k,5) == 1)) write(lun,'(a)')
- write(lun, '(a,i3,1p,2e10.2, e11.2, 3(2x,2e9.2), 2x,3e10.2 )' ) 'qakr', k, &
- mu_i(k), md_i(k), tmpveca(1:10)
- end do ! k
- end do ! j
-
- if (pcnst < 0) then
- write(lun, '(/a,i4)' ) &
- 'qakr - name; burden; qsrflx tot, activa,resusp,aqchem,wetdep,resid', jtsub
- do m = 2, ncnst
- if ( .not. doconvproc(m) ) cycle
- tmpveca(1) = sum( q_i(:,m)*dp_i(:) ) * hund_ovr_g
- tmpveca(2) = sum( dqdt_i(:,m)*dp_i(:) ) * hund_ovr_g
- tmpveca(3:6) = qsrflx_i(m,1:4)
- tmpveca(7) = tmpveca(2) - sum( tmpveca(3:6) )
- write(lun, '(2a,1p,2(2x,e11.3),2x,4e11.3,2x,e11.3)' ) &
- 'qakr ', cnst_name_extd(m)(1:10), tmpveca(1:7)
- end do ! m
- end if ! (pcnst < 0) then
-
- write(lun, '(/3a,i4)' ) 'qakr-', trim(convtype), &
- ' - name; burden; sumchng3, sumactiva,resusp,aqchem,wetdep, resid,resid*dt/burden', jtsub
-! write(lun, '(/2a)' ) &
-! 'qakr - name; burden; sumchng3; ', &
-! 'sumactiva,resusp,aqchem,wetdep,prevap; resid,resid*dtsub/burden'
- tmpb = 0.0_r8
- itmpb = 0
- do m = 2, pcnst
- if ( .not. doconvproc_extd(m) ) cycle
-
- tmpmata(:,:) = 0.0_r8
- do j = 1, 3
- l = m
- if (j == 3) l = m + pcnst
- if ( .not. doconvproc_extd(l) ) cycle
-
- if (j == 1) then
- tmpmata(1,j) = sum( q_i(:,l)*dp_i(:) ) * hund_ovr_g
- tmpmata(2,j) = sum( dqdt_i(:,l)*dp_i(:) ) * hund_ovr_g
- tmpmata(3:7,j) = qsrflx_i(l,1:5)
- else
- tmpmata(1,j) = sum( const(l,1:pver)*dp_i(1:pver) ) * hund_ovr_g
- tmpmata(2,j) = sumchng3( l) * hund_ovr_g
- tmpmata(3,j) = sumactiva(l) * hund_ovr_g
- tmpmata(4,j) = sumresusp(l) * hund_ovr_g
- tmpmata(5,j) = sumaqchem(l) * hund_ovr_g
- tmpmata(6,j) = sumwetdep(l) * hund_ovr_g
- tmpmata(7,j) = sumprevap(l) * hund_ovr_g
- end if
- end do ! j
-
- tmpmata(3:7,2) = tmpmata(3:7,2) - tmpmata(3:7,3) ! because lc values were added onto la
- do j = 1, 3
- tmpmata(8,j) = tmpmata(2,j) - sum( tmpmata(3:7,j) ) ! residual
- tmpa = max( tmpmata(1,min(j,2)), 1.0e-20_r8 )
- tmpmata(9,j) = tmpmata(8,j) * dtsub / tmpa
- if (abs(tmpmata(9,j)) > tmpb) then
- tmpb = abs(tmpmata(9,j))
- itmpb = m
- end if
- end do
-
-! write(lun, '(/2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) &
-! 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:6,1), tmpmata(8:9,1)
- write(lun, '(/2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) &
- 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:9,1)
-! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) &
-! 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:6,2), tmpmata(8:9,2)
- write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) &
- 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:9,2)
- if ( .not. doconvproc_extd(l) ) cycle
-! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) &
-! 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:6,3), tmpmata(8:9,3)
- write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) &
- 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:9,3)
- end do ! m
- write(lun, '(/3a,2i4,1p,e11.2)' ) 'qakr-', trim(convtype), &
- ' - max(resid*dt/burden)', jtsub, itmpb, tmpb
-
- end if ! (idiag_in(icol) > 0) then
-
-
- if (jtsub < ntsub) then
- ! update the q_i for the next interation of the jtsub loop
- do m = 2, ncnst
- if (doconvproc(m)) then
- do k = ktop, kbot_prevap
- q_i(k,m) = max( (q_i(k,m) + dqdt_i(k,m)*dtsub), 0.0_r8 )
- end do
- end if
- end do ! m
- end if
-
- end do ipass_calc_updraft_loop
-
- end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop
-
-
- end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop
-
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- end if
-
- call outfld( trim(cnst_name_extd(la))//'WETC', dcondt2(:,:,la), pcols, lchnk )
- call outfld( trim(cnst_name_extd(la))//'CONU', conu2(:,:,la), pcols, lchnk )
- call outfld( trim(cnst_name_extd(lc))//'WETC', dcondt2(:,:,lc), pcols, lchnk )
- call outfld( trim(cnst_name_extd(lc))//'CONU', conu2(:,:,lc), pcols, lchnk )
-
- end do
- end do
-
- return
-end subroutine ma_convproc_tend
-
-
-
-!=========================================================================================
- subroutine ma_precpevap_convproc( &
- dcondt, dcondt_wetdep, dcondt_prevap, &
- rprd, evapc, dp_i, &
- icol, ktop, pcnst_extd, &
- lun, idiag_prevap, lchnk, &
- doconvproc_extd )
-!-----------------------------------------------------------------------
-!
-! Purpose:
-! Calculate resuspension of wet-removed aerosol species resulting
-! precip evaporation
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
- use modal_aero_data, only: &
- lmassptrcw_amode, nspec_amode, numptrcw_amode
-
- implicit none
-
-!-----------------------------------------------------------------------
-! arguments
-! (note: TMR = tracer mixing ratio)
- integer, intent(in) :: pcnst_extd
-
- real(r8), intent(inout) :: dcondt(pcnst_extd,pver)
- ! overall TMR tendency from convection
- real(r8), intent(in) :: dcondt_wetdep(pcnst_extd,pver)
- ! portion of TMR tendency due to wet removal
- real(r8), intent(inout) :: dcondt_prevap(pcnst_extd,pver)
- ! portion of TMR tendency due to precip evaporation
- ! (actually, due to the adjustments made here)
- ! (on entry, this is 0.0)
-
- real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered)
- real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered)
- real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb)
-
- integer, intent(in) :: icol ! normal (ungathered) i index for current column
- integer, intent(in) :: ktop ! index of top cloud level for current column
- integer, intent(in) :: lun ! logical unit for diagnostic output
- integer, intent(in) :: idiag_prevap ! flag for diagnostic output
- integer, intent(in) :: lchnk ! chunk index
-
- logical, intent(in) :: doconvproc_extd(pcnst_extd) ! indicates which species to process
-
-!-----------------------------------------------------------------------
-! local variables
- integer :: k, l, ll, m, n
- real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb]
- real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb]
- real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb]
- real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation
- real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb]
- real(r8) :: pr_flux_old
- real(r8) :: tmpa, tmpb, tmpc, tmpd
- real(r8) :: tmpdp ! delta-pressure (mb)
- real(r8) :: wd_flux(pcnst_extd) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb]
- integer :: i
- character(len=4) :: spcstr
-!-----------------------------------------------------------------------
-
-
- pr_flux = 0.0_r8
- wd_flux(:) = 0.0_r8
-
- if (idiag_prevap > 0) then
- write(lun,'(a,i9,i4,5x,a)') 'qakx - lchnk,i', lchnk, icol, &
- '// k; pr_flux old,new; delprod,devap; mode-1 numb wetdep,prevap; mass ...'
- end if
-
- do k = ktop, pver
- tmpdp = dp_i(k)
-
- pr_flux_old = pr_flux
- del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k))
- pr_flux = pr_flux_old + del_pr_flux_prod
-
- del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) )
-
- ! Do resuspension of aerosols from rain only when the rain has
- ! totally evaporated in one layer.
- if (convproc_do_evaprain_atonce .and. &
- (del_pr_flux_evap.ne.pr_flux)) del_pr_flux_evap = 0._r8
-
- fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8)
-
- do m = 2, pcnst_extd
- if ( doconvproc_extd(m) ) then
- ! use -dcondt_wetdep(m,k) as it is negative (or zero)
- wd_flux(m) = wd_flux(m) + tmpdp*max(0.0_r8, -dcondt_wetdep(m,k))
- del_wd_flux_evap = wd_flux(m)*fdel_pr_flux_evap
- dcondt_prevap(m,k) = del_wd_flux_evap/tmpdp
- end if
- end do
-
- ! Do resuspension of aerosol species from rain to coarse mode (large particle) rather
- ! than to individual modes.
- if (convproc_do_evaprain_atonce) then
-
- call accumulate_to_larger_mode( 'SO4', lptr_so4_a_amode, dcondt_prevap(:,k) )
- call accumulate_to_larger_mode( 'DUST',lptr_dust_a_amode,dcondt_prevap(:,k) )
- call accumulate_to_larger_mode( 'NACL',lptr_nacl_a_amode,dcondt_prevap(:,k) )
- call accumulate_to_larger_mode( 'MSA', lptr_msa_a_amode, dcondt_prevap(:,k) )
- call accumulate_to_larger_mode( 'NH4', lptr_nh4_a_amode, dcondt_prevap(:,k) )
- call accumulate_to_larger_mode( 'NO3', lptr_no3_a_amode, dcondt_prevap(:,k) )
-
- spcstr = ' '
- do i = 1,nsoa
- if (nsoa>1) write(spcstr,'(i4)') i
- call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), lptr2_soa_a_amode(:,i), dcondt_prevap(:,k) )
- enddo
- spcstr = ' '
- do i = 1,npoa
- if (npoa>1) write(spcstr,'(i4)') i
- call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), lptr2_pom_a_amode(:,i), dcondt_prevap(:,k) )
- enddo
- spcstr = ' '
- do i = 1,nbc
- if (nbc>1) write(spcstr,'(i4)') i
- call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), lptr2_bc_a_amode(:,i), dcondt_prevap(:,k) )
- enddo
-
- end if
-
- do m = 2, pcnst_extd
- if ( doconvproc_extd(m) ) then
- dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k)
- end if
- end do
-
- pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap )
-
- if (idiag_prevap > 0) then
- n = 1
- l = numptrcw_amode(n) + pcnst
- tmpa = dcondt_wetdep(l,k)
- tmpb = dcondt_prevap(l,k)
- tmpc = 0.0_r8
- tmpd = 0.0_r8
- do ll = 1, nspec_amode(n)
- l = lmassptrcw_amode(ll,n) + pcnst
- tmpc = tmpc + dcondt_wetdep(l,k)
- tmpd = tmpd + dcondt_prevap(l,k)
- end do
- write(lun,'(a,i4,1p,4(2x,2e10.2))') 'qakx', k, &
- pr_flux_old, pr_flux, del_pr_flux_prod, -del_pr_flux_evap, &
- -tmpa, tmpb, -tmpc, tmpd
- end if
- end do ! k
-
- return
- end subroutine ma_precpevap_convproc
-
-!=========================================================================================
- subroutine accumulate_to_larger_mode( spc_name, lptr, prevap )
-
- character(len=*), intent(in) :: spc_name
- integer, intent(in) :: lptr(:)
- real(r8), intent(inout) :: prevap(:)
-
- integer :: m,n, nl,ns
-
- nl = -1
- ! find constituent index of the largest mode for the species
- loop1: do m = 1,ntot_amode-1
- nl = lptr(mode_size_order(m))
- if (nl>0) exit loop1
- end do loop1
-
- if (.not. nl>0) return
-
- ! accumulate the smaller modes into the largest mode
- do n = m+1,ntot_amode
- ns = lptr(mode_size_order(n))
- if (ns>0) then
- prevap(nl) = prevap(nl) + prevap(ns)
- prevap(ns) = 0._r8
- if (masterproc .and. debug) then
- write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl
- endif
- endif
- end do
-
- end subroutine accumulate_to_larger_mode
-
-!=========================================================================================
- subroutine ma_activate_convproc( &
- conu, dconudt, conent, &
- f_ent, dt_u, wup, &
- tair, rhoair, fracice, &
- pcnst_extd, lun, idiag_act, &
- lchnk, i, k, &
- ipass_calc_updraft )
-!-----------------------------------------------------------------------
-!
-! Purpose:
-! Calculate activation of aerosol species in convective updraft
-! for a single column and level
-!
-! Method:
-! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface
-! conent(l) = TMR of air that is entrained into the updraft from level k
-! f_ent = Fraction of the "before-detrainment" updraft massflux at
-! k/k-1 interface" resulting from entrainment of level k air
-! (where k is the current level in subr ma_convproc_tend)
-!
-! On entry to this routine, the conu(l) represents the updraft TMR
-! after entrainment, but before chemistry/physics and detrainment,
-! and is equal to
-! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l)
-! where
-! conu_below(l) = updraft TMR at the k+1/k interface, and
-! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux
-! from level k entrainment
-!
-! This routine applies aerosol activation to the entrained tracer,
-! then adjusts the conu so that on exit,
-! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la)
-! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la)
-! where
-! la, lc = indices for an unactivated/activated aerosol component pair
-! f_act = fraction of conent(la) that is activated. The f_act are
-! calculated with the Razzak-Ghan activation parameterization.
-! The f_act differ for each mode, and for number/surface/mass.
-!
-! Note: At the lowest layer with cloud water, subr convproc calls this
-! routine with conent==conu and f_ent==1.0, with the result that
-! activation is applied to the entire updraft tracer flux
-!
-! *** The updraft velocity used for activation calculations is rather
-! uncertain and needs more work. However, an updraft of 1-3 m/s
-! will activate essentially all of accumulation and coarse mode particles.
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
- use ndrop, only: activate_aerosol
-
- use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, &
- ntot_amode, &
- nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, &
- specdens_amode, spechygro, &
- voltonumblo_amode, voltonumbhi_amode
-
- implicit none
-
-!-----------------------------------------------------------------------
-! arguments (note: TMR = tracer mixing ratio)
- integer, intent(in) :: pcnst_extd
- ! conu = tracer mixing ratios in updraft at top of this (current) level
- ! The conu are changed by activation
- real(r8), intent(inout) :: conu(pcnst_extd)
- ! conent = TMRs in the entrained air at this level
- real(r8), intent(in) :: conent(pcnst_extd)
- real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation
-
- real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was
- ! entrained across this layer == eudp/mu_p_eudp
- real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the
- ! updraft at current level
- real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s)
- ! at current level updraft
-
- real(r8), intent(in) :: tair ! Temperature in Kelvin
- real(r8), intent(in) :: rhoair ! air density (kg/m3)
-
- real(r8), intent(in) :: fracice ! Fraction of ice within the cloud
- ! used as in-cloud wet removal rate
- integer, intent(in) :: lun ! logical unit for diagnostic output
- integer, intent(in) :: idiag_act ! flag for diagnostic output
- integer, intent(in) :: lchnk ! chunk index
- integer, intent(in) :: i ! column index
- integer, intent(in) :: k ! level index
- integer, intent(in) :: ipass_calc_updraft
-
-!-----------------------------------------------------------------------
-! local variables
- integer :: ll, la, lc, n
-
- real(r8) :: delact ! working variable
- real(r8) :: dt_u_inv ! 1.0/dt_u
- real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_aerosol
- real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_aerosol
- real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol
- real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated
- real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated
- real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act
- real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3)
- real(r8) :: sigw ! standard deviation of updraft velocity (cm/s)
- real(r8) :: tmpa, tmpb, tmpc ! working variable
- real(r8) :: tmp_fact ! working variable
- real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3)
- real(r8) :: wbar ! mean updraft velocity (cm/s)
- real(r8) :: wdiab ! diabatic vertical velocity (cm/s)
- real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s)
-
-
-!-----------------------------------------------------------------------
-
-
-! when ipass_calc_updraft == 2, apply the activation tendencies
-! from pass 1, but multiplied by factor_reduce_actfrac
-! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2)
- if (ipass_calc_updraft == 2) then
-
- dt_u_inv = 1.0_r8/dt_u
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- end if
-
- delact = dconudt(lc)*dt_u * factor_reduce_actfrac
- delact = min( delact, conu(la) )
- delact = max( delact, 0.0_r8 )
- conu(la) = conu(la) - delact
- conu(lc) = conu(lc) + delact
- dconudt(la) = -delact*dt_u_inv
- dconudt(lc) = delact*dt_u_inv
- end do
- end do ! "n = 1, ntot_amode"
- return
-
- end if ! (ipass_calc_updraft == 2)
-
-
-! check f_ent > 0
- if (f_ent <= 0.0_r8) return
-
-
- do n = 1, ntot_amode
-! compute a (or a+cw) volume and hygroscopicity
- tmpa = 0.0_r8
- tmpb = 0.0_r8
- do ll = 1, nspec_amode(n)
- tmpc = max( conent(lmassptr_amode(ll,n)), 0.0_r8 )
- if ( use_cwaer_for_activate_maxsat ) &
- tmpc = tmpc + max( conent(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 )
- tmpc = tmpc / specdens_amode(ll,n)
- tmpa = tmpa + tmpc
- tmpb = tmpb + tmpc * spechygro(ll,n)
- end do
- vaerosol(n) = tmpa * rhoair
- if (tmpa < 1.0e-35_r8) then
- hygro(n) = 0.2_r8
- else
- hygro(n) = tmpb/tmpa
- end if
-
-! load a (or a+cw) number and bound it
- tmpa = max( conent(numptr_amode(n)), 0.0_r8 )
- if ( use_cwaer_for_activate_maxsat ) &
- tmpa = tmpa + max( conent(numptrcw_amode(n)+pcnst), 0.0_r8 )
- naerosol(n) = tmpa * rhoair
- naerosol(n) = max( naerosol(n), &
- vaerosol(n)*voltonumbhi_amode(n) )
- naerosol(n) = min( naerosol(n), &
- vaerosol(n)*voltonumblo_amode(n) )
-
-! diagnostic output for testing/development
-! if (lun > 0) then
-! if (n == 1) then
-! write(lun,9500)
-! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd)
-! write(lun,9520) tair, rhoaircgs, airconcgs
-! end if
-! write(lun,9530) n, ntype(n), vaerosol
-! write(lun,9540) naerosol(n), tmp*airconcgs, &
-! voltonumbhi_amode(n), voltonumblo_amode(n)
-! write(lun,9550) (maerosol(l,n), l=1,ntype(n))
-!9500 format( / 'activate_conv output -- conu values' )
-!9510 format( 3( a, 1pe11.3, 4x ) )
-!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) )
-!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) )
-!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) )
-!9550 format( 'masses ', 6(1pe11.3) )
-! end if
-
- end do
-
-
-! call Razzak-Ghan activation routine with single updraft
- wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now
- sigw = 0.0_r8
- wdiab = 0.0_r8
- wminf = wbar
- wmaxf = wbar
-
- call activate_aerosol( &
- wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
- naerosol, ntot_amode, vaerosol, hygro, aero_props_obj, &
- fn, fm, fluxn, fluxm, flux_fullact )
-
-
-
-! diagnostic output for testing/development
- if (idiag_act > 0) then
- n = min( ntot_amode, 3 )
- write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) &
- 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, &
- naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, &
- hygro(1:n), fn(1:n), fm(1:n)
- ! convert naer, vaer to number and (approx) mass TMRs
- end if
-! if (lun > 0) then
-! write(lun,9560) (fn(n), n=1,ntot_amode)
-! write(lun,9570) (fm(n), n=1,ntot_amode)
-!9560 format( 'fnact values ', 6(1pe11.3) )
-!9570 format( 'fmact values ', 6(1pe11.3) )
-! end if
-
-
-! apply the activation fractions to the updraft aerosol mixing ratios
- dt_u_inv = 1.0_r8/dt_u
-
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- tmp_fact = fn(n)
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- tmp_fact = fm(n)
- end if
-
- if ( (method_reduce_actfrac == 1) .and. &
- (factor_reduce_actfrac >= 0.0_r8) .and. &
- (factor_reduce_actfrac < 1.0_r8) ) &
- tmp_fact = tmp_fact * factor_reduce_actfrac
-
- delact = min( conent(la)*tmp_fact*f_ent, conu(la) )
- delact = max( delact, 0.0_r8 )
- conu(la) = conu(la) - delact
- conu(lc) = conu(lc) + delact
- dconudt(la) = -delact*dt_u_inv
- dconudt(lc) = delact*dt_u_inv
- end do
- end do ! "n = 1, ntot_amode"
-
- return
- end subroutine ma_activate_convproc
-
-
-
-!=========================================================================================
- subroutine ma_activate_convproc_method2( &
- conu, dconudt, &
- f_ent, dt_u, wup, &
- tair, rhoair, fracice, &
- pcnst_extd, lun, idiag_act, &
- lchnk, i, k, &
- kactfirst, ipass_calc_updraft )
-!-----------------------------------------------------------------------
-!
-! Purpose:
-! Calculate activation of aerosol species in convective updraft
-! for a single column and level
-!
-! Method:
-! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface
-! f_ent = Fraction of the "before-detrainment" updraft massflux at
-! k/k-1 interface" resulting from entrainment of level k air
-! (where k is the current level in subr ma_convproc_tend)
-!
-! On entry to this routine, the conu(l) represents the updraft TMR
-! after entrainment, but before chemistry/physics and detrainment.
-!
-! This routine applies aerosol activation to the conu tracer mixing ratios,
-! then adjusts the conu so that on exit,
-! conu(la) = conu_incoming(la) - conu(la)*f_act(la)
-! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la)
-! where
-! la, lc = indices for an unactivated/activated aerosol component pair
-! f_act = fraction of conu(la) that is activated. The f_act are
-! calculated with the Razzak-Ghan activation parameterization.
-! The f_act differ for each mode, and for number/surface/mass.
-!
-! At cloud base (k==kactfirst), primary activation is done using the
-! "standard" code in subr activate do diagnose maximum supersaturation.
-! Above cloud base, secondary activation is done using a
-! prescribed supersaturation.
-!
-! *** The updraft velocity used for activation calculations is rather
-! uncertain and needs more work. However, an updraft of 1-3 m/s
-! will activate essentially all of accumulation and coarse mode particles.
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
- use ndrop, only: activate_aerosol
-
- use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, &
- ntot_amode, &
- nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, &
- specdens_amode, spechygro, &
- voltonumblo_amode, voltonumbhi_amode
-
- use rad_constituents,only: rad_cnst_get_info
-
- implicit none
-
-!-----------------------------------------------------------------------
-! arguments (note: TMR = tracer mixing ratio)
- integer, intent(in) :: pcnst_extd
- ! conu = tracer mixing ratios in updraft at top of this (current) level
- ! The conu are changed by activation
- real(r8), intent(inout) :: conu(pcnst_extd)
- real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation
-
- real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was
- ! entrained across this layer == eudp/mu_p_eudp
- real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the
- ! updraft at current level
- real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s)
- ! at current level updraft
-
- real(r8), intent(in) :: tair ! Temperature in Kelvin
- real(r8), intent(in) :: rhoair ! air density (kg/m3)
-
- real(r8), intent(in) :: fracice ! Fraction of ice within the cloud
- ! used as in-cloud wet removal rate
- integer, intent(in) :: lun ! logical unit for diagnostic output
- integer, intent(in) :: idiag_act ! flag for diagnostic output
- integer, intent(in) :: lchnk ! chunk index
- integer, intent(in) :: i ! column index
- integer, intent(in) :: k ! level index
- integer, intent(in) :: kactfirst ! k at cloud base
- integer, intent(in) :: ipass_calc_updraft
-
-!-----------------------------------------------------------------------
-! local variables
- integer :: ll, la, lc, n
-
- real(r8) :: delact ! working variable
- real(r8) :: dt_u_inv ! 1.0/dt_u
- real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_aerosol
- real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_aerosol
- real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol
- real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated
- real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated
- real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act
- real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3)
- real(r8) :: sigw ! standard deviation of updraft velocity (cm/s)
- real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction)
- real(r8) :: tmpa, tmpb, tmpc ! working variable
- real(r8) :: tmp_fact ! working variable
- real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3)
- real(r8) :: wbar ! mean updraft velocity (cm/s)
- real(r8) :: wdiab ! diabatic vertical velocity (cm/s)
- real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s)
-
- character(len=32) :: spec_type
-
-!-----------------------------------------------------------------------
-
-
-! when ipass_calc_updraft == 2, apply the activation tendencies
-! from pass 1, but multiplied by factor_reduce_actfrac
-! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2)
- if (ipass_calc_updraft == 2) then
-
- dt_u_inv = 1.0_r8/dt_u
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- end if
-
- delact = dconudt(lc)*dt_u * factor_reduce_actfrac
- delact = min( delact, conu(la) )
- delact = max( delact, 0.0_r8 )
- conu(la) = conu(la) - delact
- conu(lc) = conu(lc) + delact
- dconudt(la) = -delact*dt_u_inv
- dconudt(lc) = delact*dt_u_inv
- end do
- end do ! "n = 1, ntot_amode"
- return
-
- end if ! (ipass_calc_updraft == 2)
-
-
-! check f_ent > 0
- if (f_ent <= 0.0_r8) return
-
-
- do n = 1, ntot_amode
-! compute a (or a+cw) volume and hygroscopicity
- tmpa = 0.0_r8
- tmpb = 0.0_r8
- do ll = 1, nspec_amode(n)
- tmpc = max( conu(lmassptr_amode(ll,n)), 0.0_r8 )
- if ( use_cwaer_for_activate_maxsat ) &
- tmpc = tmpc + max( conu(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 )
- tmpc = tmpc / specdens_amode(ll,n)
- tmpa = tmpa + tmpc
-
- ! Change the hygroscopicity of POM based on the discussion with Prof.
- ! Xiaohong Liu. Some observational studies found that the primary organic
- ! material from biomass burning emission shows very high hygroscopicity.
- ! Also, found that BC mass will be overestimated if all the aerosols in
- ! the primary mode are free to be removed. Therefore, set the hygroscopicity
- ! of POM here as 0.2 to enhance the wet scavenge of primary BC and POM.
-
- call rad_cnst_get_info(0, n, ll, spec_type=spec_type)
- if (spec_type=='p-organic' .and. convproc_pom_spechygro>0._r8) then
- tmpb = tmpb + tmpc * convproc_pom_spechygro
- else
- tmpb = tmpb + tmpc * spechygro(ll,n)
- end if
- end do
- vaerosol(n) = tmpa * rhoair
- if (tmpa < 1.0e-35_r8) then
- hygro(n) = 0.2_r8
- else
- hygro(n) = tmpb/tmpa
- end if
-
-! load a (or a+cw) number and bound it
- tmpa = max( conu(numptr_amode(n)), 0.0_r8 )
- if ( use_cwaer_for_activate_maxsat ) &
- tmpa = tmpa + max( conu(numptrcw_amode(n)+pcnst), 0.0_r8 )
- naerosol(n) = tmpa * rhoair
- naerosol(n) = max( naerosol(n), &
- vaerosol(n)*voltonumbhi_amode(n) )
- naerosol(n) = min( naerosol(n), &
- vaerosol(n)*voltonumblo_amode(n) )
-
-! diagnostic output for testing/development
-! if (lun > 0) then
-! if (n == 1) then
-! write(lun,9500)
-! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd)
-! write(lun,9520) tair, rhoaircgs, airconcgs
-! end if
-! write(lun,9530) n, ntype(n), vaerosol
-! write(lun,9540) naerosol(n), tmp*airconcgs, &
-! voltonumbhi_amode(n), voltonumblo_amode(n)
-! write(lun,9550) (maerosol(l,n), l=1,ntype(n))
-!9500 format( / 'activate_conv output -- conu values' )
-!9510 format( 3( a, 1pe11.3, 4x ) )
-!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) )
-!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) )
-!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) )
-!9550 format( 'masses ', 6(1pe11.3) )
-! end if
-
- end do
-
-
-! call Razzak-Ghan activation routine with single updraft
- wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now
- sigw = 0.0_r8
- wdiab = 0.0_r8
- wminf = wbar
- wmaxf = wbar
-
- if (k == kactfirst) then
-
- call activate_aerosol( &
- wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
- naerosol, ntot_amode, vaerosol, hygro, aero_props_obj, &
- fn, fm, fluxn, fluxm, flux_fullact )
-
-
- else
-! above cloud base - do secondary activation with prescribed supersat
-! that is constant with height
- smax_prescribed = method2_activate_smaxmax
- call activate_aerosol( &
- wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
- naerosol, ntot_amode, vaerosol, hygro, aero_props_obj, &
- fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed )
- end if
-
-
-! diagnostic output for testing/development
- if (idiag_act > 0) then
- n = min( ntot_amode, 3 )
- write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) &
- 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, &
- naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, &
- hygro(1:n), fn(1:n), fm(1:n)
- ! convert naer, vaer to number and (approx) mass TMRs
- end if
-! if (lun > 0) then
-! write(lun,9560) (fn(n), n=1,ntot_amode)
-! write(lun,9570) (fm(n), n=1,ntot_amode)
-!9560 format( 'fnact values ', 6(1pe11.3) )
-!9570 format( 'fmact values ', 6(1pe11.3) )
-! end if
-
-
-! apply the activation fractions to the updraft aerosol mixing ratios
- dt_u_inv = 1.0_r8/dt_u
-
- do n = 1, ntot_amode
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- tmp_fact = fn(n)
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- tmp_fact = fm(n)
- end if
-
- if ( (method_reduce_actfrac == 1) .and. &
- (factor_reduce_actfrac >= 0.0_r8) .and. &
- (factor_reduce_actfrac < 1.0_r8) ) &
- tmp_fact = tmp_fact * factor_reduce_actfrac
-
- delact = min( conu(la)*tmp_fact, conu(la) )
- delact = max( delact, 0.0_r8 )
- conu(la) = conu(la) - delact
- conu(lc) = conu(lc) + delact
- dconudt(la) = -delact*dt_u_inv
- dconudt(lc) = delact*dt_u_inv
- end do
- end do ! "n = 1, ntot_amode"
-
- return
- end subroutine ma_activate_convproc_method2
-
-
-
-!=========================================================================================
- subroutine ma_resuspend_convproc( &
- dcondt, dcondt_resusp, &
- const, dp_i, ktop, kbot_prevap, pcnst_extd )
-!-----------------------------------------------------------------------
-!
-! Purpose:
-! Calculate resuspension of activated aerosol species resulting from both
-! detrainment from updraft and downdraft into environment
-! subsidence and lifting of environment, which may move air from
-! levels with large-scale cloud to levels with no large-scale cloud
-!
-! Method:
-! Three possible approaches were considered:
-!
-! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated
-! and unactivated portions of a particular aerosol species so that the
-! ratio of dcondt (activated/unactivate) is equal to the ratio of the
-! mixing ratios before convection.
-! THIS WAS IMPLEMENTED IN MIRAGE2
-!
-! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated
-! and unactivated portions of a particular aerosol species so that the
-! change to the activated portion is minimized (zero if possible). The
-! would minimize effects of convection on the large-scale cloud.
-! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective
-! clouds have no impact on the stratiform-cloudborne aerosol
-!
-! 3. Mechanistic approach that treats the details of interactions between
-! the large-scale and convective clouds. (Something for the future.)
-!
-! Author: R. Easter
-!
-!-----------------------------------------------------------------------
-
- use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, &
- nspec_amode, ntot_amode, numptr_amode, numptrcw_amode
-
- implicit none
-
-!-----------------------------------------------------------------------
-! arguments
-! (note: TMR = tracer mixing ratio)
- integer, intent(in) :: pcnst_extd
- real(r8), intent(inout) :: dcondt(pcnst_extd,pver)
- ! overall TMR tendency from convection
- real(r8), intent(inout) :: dcondt_resusp(pcnst_extd,pver)
- ! portion of TMR tendency due to resuspension
- ! (actually, due to the adjustments made here)
- real(r8), intent(in) :: const(pcnst_extd,pver) ! TMRs before convection
-
- real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb)
- integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels
-
-!-----------------------------------------------------------------------
-! local variables
- integer :: k, ll, la, lc, n
- real(r8) :: qa, qc, qac ! working variables (mixing ratios)
- real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies)
-!-----------------------------------------------------------------------
-
-
- do n = 1, ntot_amode
-
- do ll = 0, nspec_amode(n)
- if (ll == 0) then
- la = numptr_amode(n)
- lc = numptrcw_amode(n) + pcnst
- else
- la = lmassptr_amode(ll,n)
- lc = lmassptrcw_amode(ll,n) + pcnst
- end if
-
-! apply adjustments to dcondt for pairs of unactivated (la) and
-! activated (lc) aerosol species
- if ( (la <= 0) .or. (la > pcnst_extd) ) cycle
- if ( (lc <= 0) .or. (lc > pcnst_extd) ) cycle
-
- do k = ktop, kbot_prevap
- qdota = dcondt(la,k)
- qdotc = dcondt(lc,k)
- qdotac = qdota + qdotc
-
-! mirage2 approach
-! qa = max( const(la,k), 0.0_r8 )
-! qc = max( const(lc,k), 0.0_r8 )
-! qac = qa + qc
-! if (qac <= 0.0) then
-! dcondt(la,k) = qdotac
-! dcondt(lc,k) = 0.0
-! else
-! dcondt(la,k) = qdotac*(qa/qac)
-! dcondt(lc,k) = qdotac*(qc/qac)
-! end if
-
-! cam5 approach
- if (convproc_do_evaprain_atonce) then
- dcondt(la,k) = qdota
- dcondt(lc,k) = qdotc
-
- dcondt_resusp(la,k) = dcondt(la,k)
- dcondt_resusp(lc,k) = dcondt(lc,k)
- else
- dcondt(la,k) = qdotac
- dcondt(lc,k) = 0.0_r8
-
- dcondt_resusp(la,k) = (dcondt(la,k) - qdota)
- dcondt_resusp(lc,k) = (dcondt(lc,k) - qdotc)
- end if
- end do
-
- end do ! "ll = -1, nspec_amode(n)"
- end do ! "n = 1, ntot_amode"
-
- return
- end subroutine ma_resuspend_convproc
-
-
-
-!=========================================================================================
-
-
-
-end module modal_aero_convproc
diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90
index d4c362f391..ba36670ce8 100644
--- a/src/physics/cam/physpkg.F90
+++ b/src/physics/cam/physpkg.F90
@@ -2048,7 +2048,8 @@ subroutine tphysbc (ztodt, state, &
use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
use check_energy, only: tot_energy_phys
use dycore, only: dycore_is
- use aero_model, only: aero_model_wetdep, wetdep_lq
+ use aero_model, only: aero_model_wetdep
+ use aero_wetdep_cam, only: wetdep_lq
use carma_intr, only: carma_wetdep_tend, carma_timestep_tend
use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep
use radiation, only: radiation_tend
diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90
index 4d3868de77..83d03c46d1 100644
--- a/src/physics/cam7/physpkg.F90
+++ b/src/physics/cam7/physpkg.F90
@@ -1402,7 +1402,8 @@ subroutine tphysac (ztodt, cam_in, &
use radiation, only: radiation_tend
use tropopause, only: tropopause_output
use cam_diagnostics, only: diag_phys_writeout, diag_conv, diag_clip_tend_writeout
- use aero_model, only: aero_model_wetdep, wetdep_lq
+ use aero_model, only: aero_model_wetdep
+ use aero_wetdep_cam, only: wetdep_lq
use physics_buffer, only: col_type_subcol
use check_energy, only: check_energy_timestep_init
use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_emission_tend
diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90
index 03d7ca5fab..e726c296c9 100644
--- a/src/physics/carma/cam/carma_intr.F90
+++ b/src/physics/carma/cam/carma_intr.F90
@@ -1941,7 +1941,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out)
integer :: ixcldliq
integer :: ixcldice
real(r8) :: totcond(pcols, pver) ! total condensate
- real(r8) :: solfac ! solubility factor
+ real(r8) :: solfac(pcols, pver) ! solubility factor
+ real(r8) :: solfactor
real(r8) :: scavcoef ! scavenging Coefficient
logical :: do_wetdep
integer :: ncol ! number of columns
@@ -2029,7 +2030,9 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out)
if (rc < 0) call endrun('carma_wetdep_tend::CARMAELEMENT_Get failed.')
call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, do_wetdep=do_wetdep, &
- solfac=solfac, scavcoef=scavcoef, maxbin=maxbin)
+ solfac=solfactor, scavcoef=scavcoef, maxbin=maxbin)
+ solfac(:ncol,:) = solfactor
+
if (rc < 0) call endrun('carma_wetdep_tend::CARMAGROUP_Get failed.')
if ((do_wetdep) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then
@@ -2096,7 +2099,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out)
iscavt, &
cldv, &
fracis(:, :, icnst), &
- solfac, &
+ solfactor, &
ncol, &
z_scavcoef)
else