diff --git a/components/cam/bld/build-namelist b/components/cam/bld/build-namelist
index 536078896b3e..c926820de1e7 100755
--- a/components/cam/bld/build-namelist
+++ b/components/cam/bld/build-namelist
@@ -685,6 +685,10 @@ add_default($nl, 'atm_cpl_dt', 'val'=>$nl->get_value('dtime'));
# Change default to using a single file.
add_default($nl, 'profile_single_file', 'val'=>'.true.');
+#BSINGH - Get the value of RAIN_EVAP_TO_COARSE_AERO variable
+my $rain_evap_to_coarse_aero = $cfg->get('rain_evap_to_coarse_aero'); #BSINGH - See if rain_evap_to_coarse_aero option is selected
+if ($print>=1) { print "Running model with rain_evap_to_coarse_aero (1-YES, 0-NO)?: $rain_evap_to_coarse_aero $eol"; }
+
#-----------------------------------------------------------------------------------------------
# Add defaults for the CAM component
@@ -1068,37 +1072,73 @@ if ($aer_model eq 'mam' ) {
@mode_types = qw(accum aitken coarse);
@mode_num = qw(num_a1 num_a2 num_a3);
@mode_num_cw = qw(num_c1 num_c2 num_c3);
- @mode_spec = (
- [qw(so4_a1 pom_a1 soa_a1 bc_a1 dst_a1 ncl_a1)],
- [qw(so4_a2 soa_a2 ncl_a2)],
- [qw(dst_a3 ncl_a3 so4_a3)],
- );
- @mode_spec_type = (
- [qw(sulfate p-organic s-organic black-c dust seasalt)],
- [qw(sulfate s-organic seasalt)],
- [qw(dust seasalt sulfate)],
- );
- @mode_spec_cw = (
- [qw(so4_c1 pom_c1 soa_c1 bc_c1 dst_c1 ncl_c1)],
- [qw(so4_c2 soa_c2 ncl_c2)],
- [qw(dst_c3 ncl_c3 so4_c3)],
- );
-
+ if ($rain_evap_to_coarse_aero == 0) { #default
+ @mode_spec = (
+ [qw(so4_a1 pom_a1 soa_a1 bc_a1 dst_a1 ncl_a1)],
+ [qw(so4_a2 soa_a2 ncl_a2)],
+ [qw(dst_a3 ncl_a3 so4_a3)],
+ );
+ @mode_spec_type = (
+ [qw(sulfate p-organic s-organic black-c dust seasalt)],
+ [qw(sulfate s-organic seasalt)],
+ [qw(dust seasalt sulfate)],
+ );
+ @mode_spec_cw = (
+ [qw(so4_c1 pom_c1 soa_c1 bc_c1 dst_c1 ncl_c1)],
+ [qw(so4_c2 soa_c2 ncl_c2)],
+ [qw(dst_c3 ncl_c3 so4_c3)],
+ );
+ }
+ else{
+ @mode_spec = (
+ [qw(so4_a1 pom_a1 soa_a1 bc_a1 dst_a1 ncl_a1)],
+ [qw(so4_a2 soa_a2 ncl_a2)],
+ [qw(dst_a3 ncl_a3 so4_a3 bc_a3 pom_a3 soa_a3)],
+ );
+ @mode_spec_type = (
+ [qw(sulfate p-organic s-organic black-c dust seasalt)],
+ [qw(sulfate s-organic seasalt)],
+ [qw(dust seasalt sulfate black-c p-organic s-organic)],
+ );
+ @mode_spec_cw = (
+ [qw(so4_c1 pom_c1 soa_c1 bc_c1 dst_c1 ncl_c1)],
+ [qw(so4_c2 soa_c2 ncl_c2)],
+ [qw(dst_c3 ncl_c3 so4_c3 bc_c3 pom_c3 soa_c3)],
+ );
+ }
if ($chem =~ /_mam3/) {
@mode_num_src = qw(A A A);
- @mode_spec_src = (
- [qw(A A A A A A)],
- [qw(A A A)],
- [qw(A A A)],
- );
+ if ($rain_evap_to_coarse_aero == 0) { #default
+ @mode_spec_src = (
+ [qw(A A A A A A)],
+ [qw(A A A)],
+ [qw(A A A)],
+ );
+ }
+ else{
+ @mode_spec_src = (
+ [qw(A A A A A A)],
+ [qw(A A A)],
+ [qw(A A A A A A)],
+ );
+ }
}
else {
@mode_num_src = qw(N N N);
- @mode_spec_src = (
- [qw(N N N N N N)],
- [qw(N N N)],
- [qw(N N N)],
- );
+ if ($rain_evap_to_coarse_aero == 0) { #default
+ @mode_spec_src = (
+ [qw(N N N N N N)],
+ [qw(N N N)],
+ [qw(N N N)],
+ );
+ }
+ else{
+ @mode_spec_src = (
+ [qw(N N N N N N)],
+ [qw(N N N)],
+ [qw(N N N N N N)],
+ );
+ }
}
} elsif($aero_modes eq '4mode') {
# For 4 modes
@@ -1113,32 +1153,62 @@ if ($aer_model eq 'mam' ) {
@mode_types = qw(accum aitken coarse primary_carbon);
@mode_num = qw(num_a1 num_a2 num_a3 num_a4);
@mode_num_cw = qw(num_c1 num_c2 num_c3 num_c4);
- @mode_spec = (
- [qw(so4_a1 pom_a1 soa_a1 bc_a1 dst_a1 ncl_a1)],
- [qw(so4_a2 soa_a2 ncl_a2)],
- [qw(dst_a3 ncl_a3 so4_a3)],
- [qw(pom_a4 bc_a4)],
- );
- @mode_spec_type = (
- [qw(sulfate p-organic s-organic black-c dust seasalt)],
- [qw(sulfate s-organic seasalt)],
- [qw(dust seasalt sulfate)],
- [qw(p-organic black-c)],
- );
- @mode_spec_cw = (
- [qw(so4_c1 pom_c1 soa_c1 bc_c1 dst_c1 ncl_c1)],
- [qw(so4_c2 soa_c2 ncl_c2)],
- [qw(dst_c3 ncl_c3 so4_c3)],
- [qw(pom_c4 bc_c4)],
- );
+ if ($rain_evap_to_coarse_aero == 0) { #default
+ @mode_spec = (
+ [qw(so4_a1 pom_a1 soa_a1 bc_a1 dst_a1 ncl_a1)],
+ [qw(so4_a2 soa_a2 ncl_a2)],
+ [qw(dst_a3 ncl_a3 so4_a3)],
+ [qw(pom_a4 bc_a4)],
+ );
+ @mode_spec_type = (
+ [qw(sulfate p-organic s-organic black-c dust seasalt)],
+ [qw(sulfate s-organic seasalt)],
+ [qw(dust seasalt sulfate)],
+ [qw(p-organic black-c)],
+ );
+ @mode_spec_cw = (
+ [qw(so4_c1 pom_c1 soa_c1 bc_c1 dst_c1 ncl_c1)],
+ [qw(so4_c2 soa_c2 ncl_c2)],
+ [qw(dst_c3 ncl_c3 so4_c3)],
+ [qw(pom_c4 bc_c4)],
+ );
- @mode_num_src = qw(A A A A);
- @mode_spec_src = (
- [qw(A A A A A A)],
- [qw(A A A)],
- [qw(A A A)],
- [qw(A A)],
- );
+ @mode_num_src = qw(A A A A);
+ @mode_spec_src = (
+ [qw(A A A A A A)],
+ [qw(A A A)],
+ [qw(A A A)],
+ [qw(A A)],
+ );
+ }
+ else{
+ @mode_spec = (
+ [qw(so4_a1 pom_a1 soa_a1 bc_a1 dst_a1 ncl_a1)],
+ [qw(so4_a2 soa_a2 ncl_a2)],
+ [qw(dst_a3 ncl_a3 so4_a3 bc_a3 pom_a3 soa_a3)],
+ [qw(pom_a4 bc_a4)],
+ );
+ @mode_spec_type = (
+ [qw(sulfate p-organic s-organic black-c dust seasalt)],
+ [qw(sulfate s-organic seasalt)],
+ [qw(dust seasalt sulfate black-c p-organic s-organic)],
+ [qw(p-organic black-c)],
+ );
+ @mode_spec_cw = (
+ [qw(so4_c1 pom_c1 soa_c1 bc_c1 dst_c1 ncl_c1)],
+ [qw(so4_c2 soa_c2 ncl_c2)],
+ [qw(dst_c3 ncl_c3 so4_c3 bc_c3 pom_c3 soa_c3)],
+ [qw(pom_c4 bc_c4)],
+ );
+
+ @mode_num_src = qw(A A A A);
+ @mode_spec_src = (
+ [qw(A A A A A A)],
+ [qw(A A A)],
+ [qw(A A A A A A)],
+ [qw(A A)],
+ );
+ }
} elsif($aero_modes eq '7mode') {
@@ -2608,6 +2678,7 @@ add_default($nl, 'convproc_do_gas');
add_default($nl, 'demott_ice_nuc');
#BSINGH - ENDS
+add_default($nl, 'mam_amicphys_optaa'); #for enabling amicphys code in cam
# Microphysics scheme
add_default($nl, 'use_subcol_microp');
diff --git a/components/cam/bld/config_files/definition.xml b/components/cam/bld/config_files/definition.xml
index bcfbb0d56d7f..eaf943c11439 100644
--- a/components/cam/bld/config_files/definition.xml
+++ b/components/cam/bld/config_files/definition.xml
@@ -208,6 +208,9 @@ User specified Fortran compiler overrides Makefile default.
Type of Fortran compiler. Used when -fc specifies a generic wrapper script
such as mpif90 or ftn.
+
+Switch to enable extra species (BC, POM and SOA) in coarse mode for MAM3 and MAM4 simulations: 0=off, 1=on.
+
Switch to enable debugging options for Fortran compiler: 0=off, 1=on.
diff --git a/components/cam/bld/configure b/components/cam/bld/configure
index ac5a78b6c5c8..f5472b90f00b 100755
--- a/components/cam/bld/configure
+++ b/components/cam/bld/configure
@@ -219,6 +219,7 @@ OPTIONS
Makefile defaults.
-cosp Enable the COSP simulator.
-debug Switch to turn on building CAM with debugging compiler options.
+ -rain_evap_to_coarse_aero Switch to turn on BC, POM and SOA in the MAM3 and MAM4 coarse mode (mam mode 3)
-defaults Specify a configuration file which will be used to supply defaults instead of
one of the config_files/defaults_*.xml files. This file is used to specify model
configuration parameters only. Parameters relating to the build which
@@ -318,6 +319,7 @@ GetOptions(
"cosp" => \$opts{'cosp'},
"cppdefs=s" => \$opts{'cppdefs'},
"debug" => \$opts{'debug'},
+ "rain_evap_to_coarse_aero" => \$opts{'rain_evap_to_coarse_aero'},
"defaults=s" => \$opts{'defaults'},
"dyn=s" => \$opts{'dyn'},
"edit_chem_mech" => \$opts{'edit_chem_mech'},
@@ -825,6 +827,14 @@ if (defined $opts{'waccmx'}) {
}
my $waccmx = $cfg_ref->get('waccmx');
+# Use "rain_evap_to_coarse_aero" in MAM3 or MAM4? [BSINGH - For extra coarse mode species for BC, POM and SOA]
+my $rain_evap_to_coarse_aero_opt = (defined $opts{'rain_evap_to_coarse_aero'}) ? 1 : 0;
+$cfg_ref->set('rain_evap_to_coarse_aero', $rain_evap_to_coarse_aero_opt);
+my $rain_evap_to_coarse_aero = $rain_evap_to_coarse_aero_opt ? 1:0;
+
+if ($print>=2) { print "Is rain_evap_to_coarse_aero active (0-NO; 1-YES)?: $rain_evap_to_coarse_aero$eol"; }
+
+
#-----------------------------------------------------------------------------------------------
# Prognostic species package(s)
@@ -1347,6 +1357,10 @@ if ($chem_pkg =~ '_mam3') {
$chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE ';
}
+if ($rain_evap_to_coarse_aero == 1 && ($chem_pkg =~ '_mam3' || $chem_pkg =~ '_mam4')) {
+ $chem_cppdefs = "$chem_cppdefs -DRAIN_EVAP_TO_COARSE_AERO "
+}
+
my $carma_nadv = 0;
my $carma_cppdefs = '';
diff --git a/components/cam/bld/namelist_files/master_aer_drydep_list.xml b/components/cam/bld/namelist_files/master_aer_drydep_list.xml
index bb8653588f0b..a350ffe7c56e 100644
--- a/components/cam/bld/namelist_files/master_aer_drydep_list.xml
+++ b/components/cam/bld/namelist_files/master_aer_drydep_list.xml
@@ -27,6 +27,7 @@
so4_a3
pom_a3
bc_a3
+ soa_a3
num_a3
ncl_a4
so4_a4
diff --git a/components/cam/bld/namelist_files/master_aer_wetdep_list.xml b/components/cam/bld/namelist_files/master_aer_wetdep_list.xml
index adc5b75c1299..c59b85753fe9 100644
--- a/components/cam/bld/namelist_files/master_aer_wetdep_list.xml
+++ b/components/cam/bld/namelist_files/master_aer_wetdep_list.xml
@@ -32,6 +32,7 @@
so4_a3
pom_a3
bc_a3
+ soa_a3
num_a3
ncl_a4
so4_a4
diff --git a/components/cam/bld/namelist_files/namelist_defaults_cam.xml b/components/cam/bld/namelist_files/namelist_defaults_cam.xml
index 7d5b8bc8c394..dfef1393cb22 100644
--- a/components/cam/bld/namelist_files/namelist_defaults_cam.xml
+++ b/components/cam/bld/namelist_files/namelist_defaults_cam.xml
@@ -859,6 +859,9 @@
2
.false.
+
+0
+
.false.
diff --git a/components/cam/bld/namelist_files/namelist_definition.xml b/components/cam/bld/namelist_files/namelist_definition.xml
index 53d939080799..3f146fcd1e04 100644
--- a/components/cam/bld/namelist_files/namelist_definition.xml
+++ b/components/cam/bld/namelist_files/namelist_definition.xml
@@ -3472,6 +3472,13 @@ Default: .false.
+
+
+invokes new microphysics code (single call to amicphys routine) if > 0
+Default: 0
+
+
diff --git a/components/cam/chem_proc/src/cam_chempp/eqrep.f b/components/cam/chem_proc/src/cam_chempp/eqrep.f
index 7869f8540ef1..f8add5f2f33d 100644
--- a/components/cam/chem_proc/src/cam_chempp/eqrep.f
+++ b/components/cam/chem_proc/src/cam_chempp/eqrep.f
@@ -162,7 +162,11 @@ subroutine EQUATION_REP( &
end if
production = .true.
rxno = rxmap(j,1,i)
- if( coeff_ind(rxno) /= 0 .and. coeffs(k-(i+1),coeff_ind(rxno)) /= 1.e0 ) then
+!BSINGH(12/20/2013): Original line: if( coeff_ind(rxno) /= 0 .and. coeffs(k-(i+1),coeff_ind(rxno)) /= 1.e0 ) then
+!BSINGH(12/20/2013): Mods start (first check if coeff_ind(rxno) is non zero before using it as an index of coeffs array)
+ if( coeff_ind(rxno) /= 0) then
+ if( coeffs(k-(i+1),coeff_ind(rxno)) /= 1.e0 ) then
+!BSINGH -ENDS
call NUMCON( eq_piece(buf_pos:), coeffs(k-(i+1),coeff_ind(rxno)), 'l' )
buf_pos = LEN_TRIM( eq_piece ) + 1
if( rxno > phtcnt ) then
@@ -179,6 +183,9 @@ subroutine EQUATION_REP( &
end if
buf_pos = buf_pos + 1
end if
+!BSINGH(12/20/2013): Mods start
+ endif
+!BSINGH -ENDS
if( rxno > phtcnt ) then
call NUMCON( eq_piece(buf_pos:), REAL(rxno-phtcnt), 'l' )
else
diff --git a/components/cam/src/chemistry/aerosol/wetdep.F90 b/components/cam/src/chemistry/aerosol/wetdep.F90
index 7bed3ceca0b1..973efe6fdc65 100644
--- a/components/cam/src/chemistry/aerosol/wetdep.F90
+++ b/components/cam/src/chemistry/aerosol/wetdep.F90
@@ -20,6 +20,7 @@ module wetdep
public :: wetdepa_v2 ! scavenging codes for very soluble aerosols -- CAM5 version
public :: wetdepg ! scavenging of gas phase constituents by henry's law
public :: clddiag ! calc of cloudy volume and rain mixing ratio
+public :: faer_resusp_vs_fprec_evap_mpln
public :: wetdep_inputs_t
public :: wetdep_init
@@ -272,16 +273,36 @@ end subroutine clddiag
!==============================================================================
-! This is the CAM5 version of wetdepa.
-
-subroutine wetdepa_v2( t, p, q, pdel, &
- cldt, cldc, cmfdqr, evapc, conicw, precs, conds, &
- evaps, cwat, tracer, deltat, &
- scavt, iscavt, cldv, cldvcu, cldvst, dlf, fracis, sol_fact, ncol, &
- scavcoef, is_strat_cloudborne, rate1ord_cw2pr_st, qqcw, f_act_conv, &
- icscavt, isscavt, bcscavt, bsscavt, rcscavt, rsscavt, &
- sol_facti_in, sol_factbi_in, sol_factii_in, &
- sol_factic_in, sol_factiic_in,resus_fix )
+! REASTER 08/05/2015
+! changed arguments
+! put them in a more logical order
+! optional arguments are now mandatory, and commented out:
+! all "if ( present(xx) )" tests
+! any code for ".not. present(xx)" cases
+! eliminated the sol_fact**_in - now just use sol_fact**
+
+! old argument order
+! ubroutine wetdepa_v2( t, p, q, pdel, &
+! cldt, cldc, cmfdqr, evapc, conicw, precs, conds, &
+! evaps, cwat, tracer, deltat, &
+! scavt, iscavt, cldv, cldvcu, cldvst, dlf, fracis, sol_fact, ncol, &
+! scavcoef, is_strat_cloudborne, rate1ord_cw2pr_st, qqcw, f_act_conv, &
+! icscavt, isscavt, bcscavt, bsscavt, rcscavt, rsscavt, &
+! sol_facti_in, sol_factbi_in, sol_factii_in, &
+! sol_factic_in, sol_factiic_in, resus_fix )
+! note - p, q, cldv not needed
+
+! new argument order
+subroutine wetdepa_v2( ncol, deltat, &
+ t, p, q, pdel, &
+ cmfdqr, evapc, dlf, conicw, &
+ precs, conds, evaps, cwat, &
+ cldt, cldc, cldv, cldvcu, cldvst, &
+ sol_factb, sol_factbi, sol_facti, sol_factii, sol_factic, sol_factiic, &
+ mam_prevap_resusp_optcc, is_strat_cloudborne, scavcoef, rate1ord_cw2pr_st, f_act_conv, &
+ tracer, qqcw, &
+ fracis, scavt, iscavt, &
+ icscavt, isscavt, bcscavt, bsscavt, rcscavt, rsscavt )
!-----------------------------------------------------------------------
! Purpose:
@@ -296,68 +317,72 @@ subroutine wetdepa_v2( t, p, q, pdel, &
implicit none
+ integer, intent(in) :: ncol
+
real(r8), intent(in) ::&
+ deltat, &! time step
t(pcols,pver), &! temperature
p(pcols,pver), &! pressure
q(pcols,pver), &! moisture
pdel(pcols,pver), &! pressure thikness
- cldt(pcols,pver), &! total cloud fraction
- cldc(pcols,pver), &! convective cloud fraction
cmfdqr(pcols,pver), &! rate of production of convective precip
! Sungsu
evapc(pcols,pver), &! Evaporation rate of convective precipitation
+ dlf(pcols,pver), &! Detrainment of convective condensate [kg/kg/s]
! Sungsu
conicw(pcols,pver), &! convective cloud water
- cwat(pcols,pver), &! cloud water amount
precs(pcols,pver), &! rate of production of stratiform precip
conds(pcols,pver), &! rate of production of condensate
evaps(pcols,pver), &! rate of evaporation of precip
+ cwat(pcols,pver), &! cloud water amount
+ cldt(pcols,pver), &! total cloud fraction
+ cldc(pcols,pver), &! convective cloud fraction
cldv(pcols,pver), &! total cloud fraction
! Sungsu
cldvcu(pcols,pver), &! Convective precipitation area at the top interface of each layer
cldvst(pcols,pver), &! Stratiform precipitation area at the top interface of each layer
- dlf(pcols,pver), &! Detrainment of convective condensate [kg/kg/s]
! Sungsu
- deltat, &! time step
tracer(pcols,pver) ! trace species
! If subroutine is called with just sol_fact:
! sol_fact is used for both in- and below-cloud scavenging
! If subroutine is called with optional argument sol_facti_in:
! sol_fact is used for below cloud scavenging
! sol_facti is used for in cloud scavenging
- real(r8), intent(in) :: sol_fact ! solubility factor (fraction of aer scavenged below & in, or just below or sol_facti_in is provided)
- 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) ::&
- scavt(pcols,pver), &! scavenging tend
- iscavt(pcols,pver), &! incloud scavenging tends
- fracis(pcols,pver) ! fraction of species not scavenged
- logical, intent(in),optional :: resus_fix
- ! rce 2010/05/01
- ! is_strat_cloudborne = .true. if tracer is stratiform-cloudborne aerosol; else .false.
- logical, intent(in), optional :: is_strat_cloudborne
- ! rate1ord_cw2pr_st = 1st order rate for strat cw to precip (1/s)
- real(r8), intent(in), optional :: rate1ord_cw2pr_st(pcols,pver)
- ! qqcw = strat-cloudborne aerosol corresponding to tracer when is_strat_cloudborne==.false.; else 0.0
- real(r8), intent(in), optional :: qqcw(pcols,pver)
- ! f_act_conv = conv-cloud activation fraction when is_strat_cloudborne==.false.; else 0.0
- real(r8), intent(in), optional :: f_act_conv(pcols,pver)
- ! end rce 2010/05/01
- real(r8), intent(in), optional :: sol_facti_in ! solubility factor (frac of aerosol scavenged in cloud)
- real(r8), intent(in), optional :: sol_factbi_in ! solubility factor (frac of aerosol scavenged below cloud by ice)
- real(r8), intent(in), optional :: sol_factii_in ! solubility factor (frac of aerosol scavenged in cloud by ice)
- real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds
- real(r8), intent(in), optional :: sol_factiic_in ! sol_factii_in for convective clouds
+ integer, intent(in) :: mam_prevap_resusp_optcc
+
+! logical, intent(in) :: resus_fix
+ ! rce 2010/05/01
+ ! is_strat_cloudborne = .true. if tracer is stratiform-cloudborne aerosol; else .false.
+ logical, intent(in) :: is_strat_cloudborne
+ real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO)
+ ! rate1ord_cw2pr_st = 1st order rate for strat cw to precip (1/s)
+ real(r8), intent(in) :: rate1ord_cw2pr_st(pcols,pver)
+ ! qqcw = strat-cloudborne aerosol corresponding to tracer when is_strat_cloudborne==.false.; else 0.0
+ ! f_act_conv = conv-cloud activation fraction when is_strat_cloudborne==.false.; else 0.0
+ real(r8), intent(in) :: f_act_conv(pcols,pver)
+
+ real(r8), intent(in) :: qqcw(pcols,pver)
+ ! end rce 2010/05/01
+
+! real(r8), intent(in) :: sol_fact ! solubility factor (fraction of aer scavenged below & in, or just below or sol_facti is provided)
+ real(r8), intent(in) :: sol_factb ! solubility factor (frac of aerosol scavenged below cloud)
+ real(r8), intent(in) :: sol_factbi ! solubility factor (frac of aerosol scavenged below cloud by ice)
+ real(r8), intent(in) :: sol_facti ! solubility factor (frac of aerosol scavenged in cloud)
+ real(r8), intent(in) :: sol_factii ! solubility factor (frac of aerosol scavenged in cloud by ice)
+ real(r8), intent(in) :: sol_factic(pcols,pver) ! sol_facti for convective clouds
+ real(r8), intent(in) :: sol_factiic ! sol_factii for convective clouds
+ real(r8), intent(out) :: fracis(pcols,pver) ! fraction of species not scavenged
+ real(r8), intent(out) :: scavt(pcols,pver) ! scavenging tend
+ real(r8), intent(out) :: iscavt(pcols,pver) ! incloud scavenging tends
- real(r8), intent(out), optional :: icscavt(pcols,pver) ! incloud, convective
- real(r8), intent(out), optional :: isscavt(pcols,pver) ! incloud, stratiform
- real(r8), intent(out), optional :: bcscavt(pcols,pver) ! below cloud, convective
- real(r8), intent(out), optional :: bsscavt(pcols,pver) ! below cloud, stratiform
-
- real(r8), intent(out), optional :: rcscavt(pcols,pver) ! resuspension, convective
- real(r8), intent(out), optional :: rsscavt(pcols,pver) ! resuspension, stratiform
+ real(r8), intent(out) :: icscavt(pcols,pver) ! incloud, convective
+ real(r8), intent(out) :: isscavt(pcols,pver) ! incloud, stratiform
+ real(r8), intent(out) :: bcscavt(pcols,pver) ! below cloud, convective
+ real(r8), intent(out) :: bsscavt(pcols,pver) ! below cloud, stratiform
+ real(r8), intent(out) :: rcscavt(pcols,pver) ! resuspension, convective
+ real(r8), intent(out) :: rsscavt(pcols,pver) ! resuspension, stratiform
! local variables
@@ -416,17 +441,45 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! End by Sungsu
- real(r8) sol_facti, sol_factb ! in cloud and below cloud fraction of aerosol scavenged
- real(r8) sol_factii, sol_factbi ! in cloud and below cloud fraction of aerosol scavenged by ice
- real(r8) sol_factic(pcols,pver) ! sol_facti for convective clouds
- real(r8) sol_factiic ! sol_factii for convective clouds
+! real(r8) sol_facti, sol_factb ! in cloud and below cloud fraction of aerosol scavenged
+! real(r8) sol_factii, sol_factbi ! in cloud and below cloud fraction of aerosol scavenged by ice
+! real(r8) sol_factic(pcols,pver) ! sol_facti for convective clouds
+! real(r8) sol_factiic ! sol_factii for convective clouds
! sol_factic & solfact_iic added for MODAL_AERO.
! For stratiform cloud, cloudborne aerosol is treated explicitly,
! and sol_facti is 1.0 for cloudborne, 0.0 for interstitial.
! For convective cloud, cloudborne aerosol is not treated explicitly,
! and sol_factic is 1.0 for both cloudborne and interstitial.
- ! ------------------------------------------------------------------------
+ integer jstrcnv
+
+ real(r8), parameter :: prec_smallaa = 1.0e-30_r8 ! 1e-30 kg/m2/s (or mm/s) = 3.2e-23 mm/yr
+ real(r8), parameter :: x_smallaa = 1.0e-30_r8
+
+ real(r8) arainx
+ real(r8) evapx
+ real(r8) pprdx
+ real(r8) precabc_base(pcols) ! conv precip at an effective cloud base for calculations in a particular layer
+ real(r8) precabs_base(pcols) ! strat precip at an effective cloud base for calculations in a particular layer
+ real(r8) precabx_old, precabx_tmp, precabx_new
+ real(r8) precabx_base_old, precabx_base_tmp, precabx_base_new
+ real(r8) precnums_base(pcols) ! stratiform precip number flux at the bottom of a particular layer
+ real(r8) precnumc_base(pcols) ! convective precip number flux at the bottom of a particular layer
+ real(r8) precnumx_base_old, precnumx_base_tmp, precnumx_base_new
+ real(r8) resusp_c ! aerosol mass re-suspension in a particular layer from convective rain
+ real(r8) resusp_s ! aerosol mass re-suspension in a particular layer from stratiform rain
+
+ real(r8) resusp_x
+ real(r8) resusp_c_sv(pcols)
+ real(r8) resusp_s_sv(pcols)
+ real(r8) scavabx_old, scavabx_tmp, scavabx_new
+ real(r8) srcx
+ real(r8) tmpa, tmpb
+ real(r8) u_old, u_tmp
+ real(r8) x_old, x_tmp, x_ratio
+
+
+! ------------------------------------------------------------------------
! omsm = 1.-1.e-10 ! used to prevent roundoff errors below zero
omsm = 1._r8-2*epsilon(1._r8) ! used to prevent roundoff errors below zero
precmin = 0.1_r8/8.64e4_r8 ! set critical value to 0.1 mm/day in kg/m2/s
@@ -437,19 +490,24 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! vfall = 4.
! default (if other sol_facts aren't in call, set all to required sol_fact
- sol_facti = sol_fact
- sol_factb = sol_fact
- sol_factii = sol_fact
- sol_factbi = sol_fact
-
- if ( present(sol_facti_in) ) sol_facti = sol_facti_in
- if ( present(sol_factii_in) ) sol_factii = sol_factii_in
- if ( present(sol_factbi_in) ) sol_factbi = sol_factbi_in
-
- sol_factic = sol_facti
- sol_factiic = sol_factii
- if ( present(sol_factic_in ) ) sol_factic = sol_factic_in
- if ( present(sol_factiic_in) ) sol_factiic = sol_factiic_in
+! sol_facti = sol_fact
+! sol_factb = sol_fact
+! sol_factii = sol_fact
+! sol_factbi = sol_fact
+
+! if ( present(sol_facti_in) ) sol_facti = sol_facti_in
+! if ( present(sol_factii_in) ) sol_factii = sol_factii_in
+! if ( present(sol_factbi_in) ) sol_factbi = sol_factbi_in
+! sol_facti = sol_facti_in
+! sol_factii = sol_factii_in
+! sol_factbi = sol_factbi_in
+
+! sol_factic = sol_facti
+! sol_factiic = sol_factii
+! if ( present(sol_factic_in ) ) sol_factic = sol_factic_in
+! if ( present(sol_factiic_in) ) sol_factiic = sol_factiic_in
+! sol_factic = sol_factic_in
+! sol_factiic = sol_factiic_in
! this section of code is for highly soluble aerosols,
! the assumption is that within the cloud that
@@ -458,7 +516,6 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! for both convective and stratiform clouds,
! the fraction of cloud water converted to precip defines
! the amount of tracer which is pulled out.
- !
do i = 1,pcols
precabs(i) = 0
@@ -469,6 +526,13 @@ subroutine wetdepa_v2( t, p, q, pdel, &
cldmabs(i) = 0
cldmabc(i) = 0
+ precabs_base(i) = 0.0_r8
+ precabc_base(i) = 0.0_r8
+ precnums_base(i) = 0.0_r8
+ precnumc_base(i) = 0.0_r8
+ resusp_c_sv(i) = 0.0_r8
+ resusp_s_sv(i) = 0.0_r8
+
! Jan.16. Sungsu
! I added below to compute vertically projected cumulus and stratus fractions from the top to the
! current model layer by assuming a simple independent maximum overlapping assumption for
@@ -479,7 +543,9 @@ subroutine wetdepa_v2( t, p, q, pdel, &
end do
+main_k_loop: &
do k = 1,pver
+main_i_loop: &
do i = 1,ncol
tc = t(i,k) - tmelt
weight = max(0._r8,min(-tc*0.05_r8,1.0_r8)) ! fraction of condensate that is ice
@@ -500,6 +566,12 @@ subroutine wetdepa_v2( t, p, q, pdel, &
fracev_cu(i) = evapc(i,k)*pdel(i,k)/gravit/max(1.e-12_r8,precabc(i))
fracev_cu(i) = max(0._r8,min(1._r8,fracev_cu(i)))
! Sungsu
+
+ if (mam_prevap_resusp_optcc <= 0) then
+ fracev(i) = 0.0_r8
+ fracev_cu(i) = 0.0_r8
+ endif
+
! ****************** Convection ***************************
! now do the convective scavenging
@@ -539,7 +611,7 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! srcs1 = 0.
! Jan.02.2010. Sungsu : cldt --> cldc below.
! rce 2010/05/01
- if (present(is_strat_cloudborne)) then ! Tianyi, 2011/03/29
+! if (present(is_strat_cloudborne)) then ! Tianyi, 2011/03/29
if ( is_strat_cloudborne ) then
! only strat in-cloud removal affects strat-cloudborne aerosol
srcs1 = 0._r8
@@ -549,10 +621,10 @@ subroutine wetdepa_v2( t, p, q, pdel, &
srcs1 = sol_factic(i,k)*cldc(i,k)*fracp*tracer_incu*(1._r8-weight)/deltat & ! Liquid
+ sol_factiic *cldc(i,k)*fracp*tracer_incu*(weight)/deltat ! Ice
end if
- else
- srcs1 = sol_factic(i,k)*cldc(i,k)*fracp*tracer(i,k)*(1._r8-weight)/deltat & ! liquid
- + sol_factiic*cldc(i,k)*fracp*tracer(i,k)*(weight)/deltat ! ice
- end if
+! else
+! srcs1 = sol_factic(i,k)*cldc(i,k)*fracp*tracer(i,k)*(1._r8-weight)/deltat & ! liquid
+! + sol_factiic*cldc(i,k)*fracp*tracer(i,k)*(weight)/deltat ! ice
+! end if
!--mcb
@@ -570,7 +642,7 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! End by Sungsu
! rce 2010/05/01
- if (present(is_strat_cloudborne)) then ! Tianyi, 2011/03/29
+! if (present(is_strat_cloudborne)) then ! Tianyi, 2011/03/29
if ( is_strat_cloudborne ) then
! only strat in-cloud removal affects strat-cloudborne aerosol
srcs2 = 0._r8
@@ -582,13 +654,13 @@ subroutine wetdepa_v2( t, p, q, pdel, &
srcs2 = sol_factb *cldmabc(i)*odds*tracer_mean*(1._r8-weight)/deltat & ! Liquid
+ sol_factbi*cldmabc(i)*odds*tracer_mean*(weight)/deltat ! Ice
end if
- else
- odds=max( &
- min(1._r8,precabc(i)/max(cldmabc(i),1.e-5_r8) &
- *scavcoef(i,k)*deltat),0._r8) ! Dana and Hales coefficient (/mm)
- srcs2 = sol_factb*cldmabc(i)*odds*tracer(i,k)*(1._r8-weight)/deltat & ! liquid
- + sol_factbi*cldmabc(i)*odds*tracer(i,k)*(weight)/deltat !ice
- end if
+! else
+! odds=max( &
+! min(1._r8,precabc(i)/max(cldmabc(i),1.e-5_r8) &
+! *scavcoef(i,k)*deltat),0._r8) ! Dana and Hales coefficient (/mm)
+! srcs2 = sol_factb*cldmabc(i)*odds*tracer(i,k)*(1._r8-weight)/deltat & ! liquid
+! + sol_factbi*cldmabc(i)*odds*tracer(i,k)*(weight)/deltat !ice
+! end if
!Note that using the temperature-determined weight doesn't make much sense here
@@ -603,7 +675,7 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! incloud scavenging
! rce 2010/05/01
- if(present(is_strat_cloudborne)) then ! Tianyi 2011/03/29
+! if(present(is_strat_cloudborne)) then ! Tianyi 2011/03/29
if ( is_strat_cloudborne ) then
! new code for stratiform incloud scav of cloudborne (modal) aerosol
! >> use the 1st order cw to precip rate calculated in microphysics routine
@@ -618,26 +690,26 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! strat in-cloud removal only affects strat-cloudborne aerosol
srcs1 = 0._r8
end if
- else
- ! fracp is the fraction of cloud water converted to precip
- ! Sungsu modified fracp as the convectiv case.
- ! Below new formula by Sungsu of 'fracp' is necessary since 'cwat' is a LWC/IWC
- ! that has already precipitated out, that is, 'cwat' does not contain
- ! precipitation at all !
- ! fracp = precs(i,k)*deltat/max(cwat(i,k),1.e-12_r8)
- fracp = precs(i,k)*deltat/max(cwat(i,k)+precs(i,k)*deltat,1.e-12_r8) ! Sungsu. Mar.19.2010.
- fracp = max(0._r8,min(1._r8,fracp))
- ! fracp = 0. ! for debug
-
- ! assume the corresponding amnt of tracer is removed
- !++mcb -- remove cldc; change cldt to cldv
- ! srcs1 = (cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat
- ! srcs1 = cldv(i,k)*fracp*tracer(i,k)/deltat &
- ! srcs1 = cldt(i,k)*fracp*tracer(i,k)/deltat ! all condensate
- ! Jan.02.2010. Sungsu : cldt --> cldt - cldc below.
- srcs1 = sol_facti*(cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat*(1._r8-weight) & ! liquid
- + sol_factii*(cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat*(weight) ! ice
- end if
+! else
+! ! fracp is the fraction of cloud water converted to precip
+! ! Sungsu modified fracp as the convectiv case.
+! ! Below new formula by Sungsu of 'fracp' is necessary since 'cwat' is a LWC/IWC
+! ! that has already precipitated out, that is, 'cwat' does not contain
+! ! precipitation at all !
+! ! fracp = precs(i,k)*deltat/max(cwat(i,k),1.e-12_r8)
+! fracp = precs(i,k)*deltat/max(cwat(i,k)+precs(i,k)*deltat,1.e-12_r8) ! Sungsu. Mar.19.2010.
+! fracp = max(0._r8,min(1._r8,fracp))
+! ! fracp = 0. ! for debug
+!
+! ! assume the corresponding amnt of tracer is removed
+! !++mcb -- remove cldc; change cldt to cldv
+! ! srcs1 = (cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat
+! ! srcs1 = cldv(i,k)*fracp*tracer(i,k)/deltat &
+! ! srcs1 = cldt(i,k)*fracp*tracer(i,k)/deltat ! all condensate
+! ! Jan.02.2010. Sungsu : cldt --> cldt - cldc below.
+! srcs1 = sol_facti*(cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat*(1._r8-weight) & ! liquid
+! + sol_factii*(cldt(i,k)-cldc(i,k))*fracp*tracer(i,k)/deltat*(weight) ! ice
+! end if
! end rce 2010/05/01
@@ -653,7 +725,7 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! End by Sungsu
! rce 2010/05/01
- if (present(is_strat_cloudborne)) then ! Tianyi 2011/03/29
+! if (present(is_strat_cloudborne)) then ! Tianyi 2011/03/29
if ( is_strat_cloudborne ) then
! only strat in-cloud removal affects strat-cloudborne aerosol
srcs2 = 0._r8
@@ -663,12 +735,12 @@ subroutine wetdepa_v2( t, p, q, pdel, &
srcs2 = sol_factb *cldmabs(i)*odds*tracer_mean*(1._r8-weight)/deltat & ! Liquid
+ sol_factbi*cldmabs(i)*odds*tracer_mean*(weight)/deltat ! Ice
end if
- else
- odds = precabs(i)/max(cldmabs(i),1.e-5_r8)*scavcoef(i,k)*deltat
- odds = max(min(1._r8,odds),0._r8)
- srcs2 =sol_factb*(cldmabs(i)*odds) *tracer(i,k)*(1._r8-weight)/deltat & ! liquid
- + sol_factbi*(cldmabs(i)*odds) *tracer(i,k)*(weight)/deltat ! ice
- end if
+! else
+! odds = precabs(i)/max(cldmabs(i),1.e-5_r8)*scavcoef(i,k)*deltat
+! odds = max(min(1._r8,odds),0._r8)
+! srcs2 =sol_factb*(cldmabs(i)*odds) *tracer(i,k)*(1._r8-weight)/deltat & ! liquid
+! + sol_factbi*(cldmabs(i)*odds) *tracer(i,k)*(weight)/deltat ! ice
+! end if
!Note that using the temperature-determined weight doesn't make much sense here
@@ -694,53 +766,272 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! tend is all tracer removed by scavenging, plus all re-appearing from evaporation above
! Sungsu added cumulus contribution in the below 3 blocks
- scavt(i,k) = -srct(i) + (fracev(i)*scavab(i)+fracev_cu(i)*scavabc(i))*gravit/pdel(i,k)
- iscavt(i,k) = -(srcc*finc + srcs*fins)*omsm
- if ( present(icscavt) ) icscavt(i,k) = -(srcc*finc) * omsm
- if ( present(isscavt) ) isscavt(i,k) = -(srcs*fins) * omsm
+! mam_prevap_resusp_optcc values:
+! 0 = no resuspension
+! 1 = linear resuspension of aerosol mass or number following original mam coding
+! 2 = same as 1 but resuspension tendencies are in rc/sscavt rather than combined with bc/sscavt
+! 3 = same as 2 but with some added "xxx = max( 0, xxx)" lines
+! 130 = non-linear resuspension of aerosol mass based on scavenged aerosol mass
+! 230 = non-linear resuspension of aerosol number based on raindrop number
+resusp_block_aa: &
+ if ( mam_prevap_resusp_optcc >= 100) then
+
+jstrcnv_loop_aa: &
+ do jstrcnv = 1, 2
+
+! step 1 - load working ("x") variables from stratiform ("s") or convective ("c") variables
+ if (jstrcnv == 1) then
+ pprdx = precs(i,k)
+ evapx = evaps(i,k)
+ precabx_old = precabs(i)
+ precabx_base_old = precabs_base(i)
+ if ( mam_prevap_resusp_optcc <= 130) then
+ scavabx_old = scavab(i)
+ srcx = srcs
+ else
+ precnumx_base_old = precnums_base(i)
+ arainx = cldvst(i,min(k+1,pver))
+ end if
+ else
+ pprdx = cmfdqr(i,k)
+ evapx = evapc(i,k)
+ precabx_old = precabc(i)
+ precabx_base_old = precabc_base(i)
+ if ( mam_prevap_resusp_optcc <= 130) then
+ scavabx_old = scavabc(i)
+ srcx = srcc
+ else
+ precnumx_base_old = precnumc_base(i)
+ arainx = cldvcu(i,min(k+1,pver))
+ end if
+ end if
- if(.not.present(resus_fix)) then
- if ( present(bcscavt) ) bcscavt(i,k) = -(srcc * (1-finc)) * omsm + &
- fracev_cu(i)*scavabc(i)*gravit/pdel(i,k)
- if ( present(bsscavt) ) bsscavt(i,k) = -(srcs * (1-fins)) * omsm + &
- fracev(i)*scavab(i)*gravit/pdel(i,k)
+! force these to be non-negative
+ precabx_base_old = max( 0.0_r8, precabx_base_old )
+ precabx_old = max( 0.0_r8, precabx_old )
+ precabx_old = min( precabx_base_old, precabx_old )
+ if ( mam_prevap_resusp_optcc <= 130) then
+ scavabx_old = max( 0.0_r8, scavabx_old )
+ else
+ precnumx_base_old = max( 0.0_r8, precnumx_base_old )
+ precnumx_base_tmp = precnumx_base_old
+ end if
+
+! step 2 - do evaporation and resuspension
+ precabx_base_tmp = precabx_base_old
+ tmpa = max( 0.0_r8, evapx*pdel(i,k)/gravit )
+ precabx_tmp = max( 0.0_r8, precabx_old - tmpa )
+ precabx_tmp = min( precabx_base_tmp, precabx_tmp )
+
+ if (precabx_tmp < prec_smallaa) then
+ ! precip rate is essentially zero so do complete resuspension
+ if ( mam_prevap_resusp_optcc <= 130) then
+ ! linear resuspension based on scavenged aerosol mass or number
+ scavabx_tmp = 0.0_r8
+ resusp_x = scavabx_old
+ else
+ ! non-linear resuspension of aerosol number based on raindrop number
+ if (precabx_base_old < prec_smallaa) then
+ resusp_x = 0.0_r8
+ else
+ u_old = precabx_old/precabx_base_old
+ u_old = max( 0.0_r8, min( 1.0_r8, u_old ) )
+ x_old = 1.0_r8 - fprecn_resusp_vs_fprec_evap_mpln( 1.0_r8-u_old, jstrcnv )
+ x_old = max( 0.0_r8, min( 1.0_r8, x_old ) )
+ x_tmp = 0.0_r8
+ resusp_x = max( 0.0_r8, precnumx_base_tmp*(x_old - x_tmp) )
+ end if
+ end if
+ ! setting both these precip rates to zero causes the resuspension
+ ! calculations to start fresh if there is any more precip production
+ precabx_tmp = 0.0_r8
+ precabx_base_tmp = 0.0_r8
+
+ else if (evapx <= 0.0_r8) then
+ ! no evap so no resuspension
+ if ( mam_prevap_resusp_optcc <= 130) then
+ scavabx_tmp = scavabx_old
+ end if
+ resusp_x = 0.0_r8
+
+ else
+ u_old = precabx_old/precabx_base_old
+ u_old = max( 0.0_r8, min( 1.0_r8, u_old ) )
+ if ( mam_prevap_resusp_optcc <= 130) then
+ ! non-linear resuspension of aerosol mass
+ x_old = 1.0_r8 - faer_resusp_vs_fprec_evap_mpln( 1.0_r8-u_old, jstrcnv )
+ else
+ ! non-linear resuspension of aerosol number based on raindrop number
+ x_old = 1.0_r8 - fprecn_resusp_vs_fprec_evap_mpln( 1.0_r8-u_old, jstrcnv )
+ end if
+ x_old = max( 0.0_r8, min( 1.0_r8, x_old ) )
+
+ if (x_old < x_smallaa) then
+ x_tmp = 0.0_r8
+ x_ratio = 0.0_r8
+ else
+ u_tmp = precabx_tmp/precabx_base_tmp
+ u_tmp = max( 0.0_r8, min( 1.0_r8, u_tmp ) )
+ u_tmp = min( u_tmp, u_old )
+ if ( mam_prevap_resusp_optcc <= 130) then
+ ! non-linear resuspension of aerosol mass
+ x_tmp = 1.0_r8 - faer_resusp_vs_fprec_evap_mpln( 1.0_r8-u_tmp, jstrcnv )
+ else
+ ! non-linear resuspension of aerosol number based on raindrop number
+ x_tmp = 1.0_r8 - fprecn_resusp_vs_fprec_evap_mpln( 1.0_r8-u_tmp, jstrcnv )
+ end if
+ x_tmp = max( 0.0_r8, min( 1.0_r8, x_tmp ) )
+ x_tmp = min( x_tmp, x_old )
+ x_ratio = x_tmp/x_old
+ x_ratio = max( 0.0_r8, min( 1.0_r8, x_ratio ) )
+ end if
+
+ if ( mam_prevap_resusp_optcc <= 130) then
+ ! aerosol mass resuspension
+ scavabx_tmp = max( 0.0_r8, scavabx_old * x_ratio )
+ resusp_x = max( 0.0_r8, scavabx_old - scavabx_tmp )
+ else
+ ! number resuspension
+ resusp_x = max( 0.0_r8, precnumx_base_tmp*(x_old - x_tmp) )
+ end if
+ end if
+
+! step 3 - do precip production and scavenging
+ tmpa = max( 0.0_r8, pprdx*pdel(i,k)/gravit )
+ precabx_base_new = max( 0.0_r8, precabx_base_tmp + tmpa )
+ precabx_new = max( 0.0_r8, precabx_tmp + tmpa )
+ precabx_new = min( precabx_base_new, precabx_new )
+
+ if ( mam_prevap_resusp_optcc <= 130) then
+ ! aerosol mass scavenging
+ tmpa = max( 0.0_r8, srcx*pdel(i,k)/gravit )
+ scavabx_new = max( 0.0_r8, scavabx_tmp + tmpa )
+ else
+ ! raindrop number increase
+ if (precabx_base_new < prec_smallaa) then
+ precnumx_base_new = 0.0_r8
+ else if (precabx_base_new > precabx_base_tmp) then
+ ! note - calc rainshaft number flux from rainshaft water flux,
+ ! then multiply by rainshaft area to get grid-average number flux
+ arainx = max( arainx, 0.01_r8 )
+ tmpa = arainx * flux_precnum_vs_flux_prec_mpln( (precabx_base_new/arainx), jstrcnv )
+ precnumx_base_new = max( 0.0_r8, tmpa )
+ else
+ precnumx_base_new = precnumx_base_tmp
+ end if
+ end if
+
+! step 4 - update stratiform ("s") or convective ("c") variables from working ("x") variables
+ if (jstrcnv == 1) then
+ resusp_s = resusp_x
+ precabs(i) = precabx_new
+ precabs_base(i) = precabx_base_new
+ if ( mam_prevap_resusp_optcc <= 130) then
+ scavab(i) = scavabx_new
+ else
+ precnums_base(i) = precnumx_base_new
+ end if
+ else
+ resusp_c = resusp_x
+ precabc(i) = precabx_new
+ precabc_base(i) = precabx_base_new
+ if ( mam_prevap_resusp_optcc <= 130) then
+ scavabc(i) = scavabx_new
+ else
+ precnumc_base(i) = precnumx_base_new
+ end if
+ end if
+
+ end do jstrcnv_loop_aa
+
+
+ else resusp_block_aa
+ resusp_c = fracev_cu(i)*scavabc(i)
+ resusp_s = fracev(i)*scavab(i)
+
+ end if resusp_block_aa
+
+ resusp_s_sv(i) = resusp_s
+ resusp_c_sv(i) = resusp_c
+
+
+ if ( mam_prevap_resusp_optcc <= 3) then
+ scavt(i,k) = -srct(i) + (fracev(i)*scavab(i)+fracev_cu(i)*scavabc(i))*gravit/pdel(i,k)
+ else
+ scavt(i,k) = -srct(i) + (resusp_s+resusp_c)*gravit/pdel(i,k)
endif
- if(present(resus_fix)) then
- if(.not.resus_fix) then
- if ( present(bcscavt) ) bcscavt(i,k) = -(srcc * (1-finc)) * omsm + &
+
+ iscavt(i,k) = -(srcc*finc + srcs*fins)*omsm
+
+! if ( present(icscavt) ) icscavt(i,k) = -(srcc*finc) * omsm
+! if ( present(isscavt) ) isscavt(i,k) = -(srcs*fins) * omsm
+ icscavt(i,k) = -(srcc*finc) * omsm
+ isscavt(i,k) = -(srcs*fins) * omsm
+
+! if(.not.present(resus_fix)) then
+! if ( present(bcscavt) ) bcscavt(i,k) = -(srcc * (1-finc)) * omsm + &
+! fracev_cu(i)*scavabc(i)*gravit/pdel(i,k)
+! if ( present(bsscavt) ) bsscavt(i,k) = -(srcs * (1-fins)) * omsm + &
+! fracev(i)*scavab(i)*gravit/pdel(i,k)
+! endif
+
+! if(present(resus_fix)) then
+! if ( .not. resus_fix ) then
+ if (mam_prevap_resusp_optcc <= 1) then
+! if ( present(bcscavt) ) bcscavt(i,k) = -(srcc * (1-finc)) * omsm + &
+! fracev_cu(i)*scavabc(i)*gravit/pdel(i,k)
+! if ( present(bsscavt) ) bsscavt(i,k) = -(srcs * (1-fins)) * omsm + &
+! fracev(i)*scavab(i)*gravit/pdel(i,k)
+ bcscavt(i,k) = -(srcc * (1-finc)) * omsm + &
fracev_cu(i)*scavabc(i)*gravit/pdel(i,k)
- if ( present(bsscavt) ) bsscavt(i,k) = -(srcs * (1-fins)) * omsm + &
+ bsscavt(i,k) = -(srcs * (1-fins)) * omsm + &
fracev(i)*scavab(i)*gravit/pdel(i,k)
- else
- if ( present(bcscavt) ) then
- if ( present(rcscavt) ) then
+ rcscavt(i,k) = 0.0
+ rsscavt(i,k) = 0.0
+ else if (mam_prevap_resusp_optcc == 2 .or. mam_prevap_resusp_optcc == 3) then
+! if ( present(bcscavt) ) then
+! if ( present(rcscavt) ) then
bcscavt(i,k) = -(srcc * (1-finc)) * omsm !RCE
rcscavt(i,k) = fracev_cu(i)*scavabc(i)*gravit/pdel(i,k) !RCE
- else
- bcscavt(i,k) = -(srcc * (1-finc)) * omsm &
- + fracev_cu(i)*scavabc(i)*gravit/pdel(i,k)
- end if
- end if
- if ( present(bsscavt) ) then
- if ( present(rsscavt) ) then
+! else
+! bcscavt(i,k) = -(srcc * (1-finc)) * omsm &
+! + fracev_cu(i)*scavabc(i)*gravit/pdel(i,k)
+! end if
+! end if
+! if ( present(bsscavt) ) then
+! if ( present(rsscavt) ) then
bsscavt(i,k) = -(srcs * (1-fins)) * omsm !RCE
rsscavt(i,k) = + fracev(i)*scavab(i)*gravit/pdel(i,k) !RCE
- else
- bsscavt(i,k) = -(srcs * (1-fins)) * omsm &
- + fracev(i)*scavab(i)*gravit/pdel(i,k)
- end if
- end if
+! else
+! bsscavt(i,k) = -(srcs * (1-fins)) * omsm &
+! + fracev(i)*scavab(i)*gravit/pdel(i,k)
+! end if
+! end if
+ else ! here mam_prevap_resusp_optcc == 130, 210, 230
+ bcscavt(i,k) = -(srcc * (1-finc)) * omsm
+ rcscavt(i,k) = resusp_c*gravit/pdel(i,k)
+ bsscavt(i,k) = -(srcs * (1-fins)) * omsm
+ rsscavt(i,k) = resusp_s*gravit/pdel(i,k)
endif
- endif
+! endif
dblchek(i) = tracer(i,k) + deltat*scavt(i,k)
! now keep track of scavenged mass and precip
- scavab(i) = scavab(i)*(1-fracev(i)) + srcs*pdel(i,k)/gravit
- precabs(i) = precabs(i) + (precs(i,k) - evaps(i,k))*pdel(i,k)/gravit
- scavabc(i) = scavabc(i)*(1-fracev_cu(i)) + srcc*pdel(i,k)/gravit
- precabc(i) = precabc(i) + (cmfdqr(i,k) - evapc(i,k))*pdel(i,k)/gravit
+ if (mam_prevap_resusp_optcc <= 3) then
+ scavab(i) = scavab(i)*(1-fracev(i)) + srcs*pdel(i,k)/gravit
+ precabs(i) = precabs(i) + (precs(i,k) - evaps(i,k))*pdel(i,k)/gravit
+ scavabc(i) = scavabc(i)*(1-fracev_cu(i)) + srcc*pdel(i,k)/gravit
+ precabc(i) = precabc(i) + (cmfdqr(i,k) - evapc(i,k))*pdel(i,k)/gravit
+ if (mam_prevap_resusp_optcc == 3) then
+ scavab(i) = max( 0.0_r8, scavab(i) )
+ scavabc(i) = max( 0.0_r8, scavabc(i) )
+ precabs(i) = max( 0.0_r8, precabs(i) )
+ precabc(i) = max( 0.0_r8, precabc(i) )
+ endif
+ endif
+
tracab(i) = tracab(i) + tracer(i,k)*pdel(i,k)/gravit
! Jan.16.2010. Sungsu
@@ -756,7 +1047,7 @@ subroutine wetdepa_v2( t, p, q, pdel, &
! End by Sungsu
- end do ! End of i = 1, ncol
+ end do main_i_loop ! End of i = 1, ncol
found = .false.
do i = 1,ncol
@@ -769,17 +1060,285 @@ subroutine wetdepa_v2( t, p, q, pdel, &
if ( found ) then
do i = 1,ncol
if (dblchek(i) .lt. 0._r8) then
- write(iulog,*) ' wetdapa: negative value ', i, k, tracer(i,k), &
- dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i)
+ write(iulog,*) ' wetdepa_v2: negative value ', i, k, tracer(i,k), &
+ dblchek(i), scavt(i,k), srct(i), rat(i), fracev(i)
+ write(iulog,*) ' wetdepa_v2: negative value ', i, k, &
+ mam_prevap_resusp_optcc, is_strat_cloudborne, tracer(i,k), &
+ dblchek(i), deltat*scavt(i,k), deltat*srct(i), &
+ deltat*resusp_s_sv(i)*gravit/pdel(i,k), deltat*resusp_c_sv(i)*gravit/pdel(i,k)
endif
end do
endif
- end do ! End of k = 1, pver
+ end do main_k_loop ! End of k = 1, pver
end subroutine wetdepa_v2
+!==============================================================================
+ function flux_precnum_vs_flux_prec_mpln( flux_prec, jstrcnv )
+ real(r8) :: flux_precnum_vs_flux_prec_mpln
+ real(r8), intent(in) :: flux_prec
+ integer, intent(in) :: jstrcnv
+
+ if (jstrcnv <= 1) then
+ flux_precnum_vs_flux_prec_mpln = flux_precnum_vs_flux_prec_mp( flux_prec )
+ else
+ flux_precnum_vs_flux_prec_mpln = flux_precnum_vs_flux_prec_ln( flux_prec )
+ end if
+
+ return
+ end function flux_precnum_vs_flux_prec_mpln
+
+
+!==============================================================================
+ function faer_resusp_vs_fprec_evap_mpln( fprec_evap, jstrcnv )
+ real(r8) :: faer_resusp_vs_fprec_evap_mpln
+ real(r8), intent(in) :: fprec_evap
+ integer, intent(in) :: jstrcnv
+
+ if (jstrcnv <= 1) then
+ faer_resusp_vs_fprec_evap_mpln = faer_resusp_vs_fprec_evap_mp( fprec_evap )
+ else
+ faer_resusp_vs_fprec_evap_mpln = faer_resusp_vs_fprec_evap_ln( fprec_evap )
+ end if
+
+ return
+ end function faer_resusp_vs_fprec_evap_mpln
+
+
+!==============================================================================
+ function fprecn_resusp_vs_fprec_evap_mpln( fprec_evap, jstrcnv )
+ real(r8) :: fprecn_resusp_vs_fprec_evap_mpln
+ real(r8), intent(in) :: fprec_evap
+ integer, intent(in) :: jstrcnv
+
+ if (jstrcnv <= 1) then
+ fprecn_resusp_vs_fprec_evap_mpln = fprecn_resusp_vs_fprec_evap_mp( fprec_evap )
+ else
+ fprecn_resusp_vs_fprec_evap_mpln = fprecn_resusp_vs_fprec_evap_ln( fprec_evap )
+ end if
+
+ return
+ end function fprecn_resusp_vs_fprec_evap_mpln
+
+
+!==============================================================================
+ function flux_precnum_vs_flux_prec_mp( flux_prec )
+!
+! flux_prec = precipitation mass flux at the cloud base (kg/m^2/s)
+! flux_precnum_vs_flux_prec_mp = precipitation number flux
+! at the cloud base (drops/m^2/s), assuming marshall-palmer raindrop size distribution
+!
+!
+ real(r8) :: flux_precnum_vs_flux_prec_mp
+ real(r8), intent(in) :: flux_prec
+
+ real(r8), parameter :: a0 = 1.0885896550304022E+01_r8
+ real(r8), parameter :: a1 = 4.3660645528167907E-01_r8
+
+ real(r8) :: x, y
+
+ if (flux_prec >= 1.0e-36_r8) then
+ x = log( flux_prec )
+ y = exp( a0 + a1*x )
+ else
+ y = 0.0_r8
+ end if
+ flux_precnum_vs_flux_prec_mp = y
+
+ return
+ end function flux_precnum_vs_flux_prec_mp
+
+
+!==============================================================================
+ function flux_precnum_vs_flux_prec_ln( flux_prec )
+!
+! flux_prec = precipitation mass flux at the cloud base (kg/m^2/s)
+! flux_precnum_vs_flux_prec_ln = precipitation number flux
+! at the cloud base (drops/m^2/s), assuming log-normal raindrop size distribution
+!
+!
+ real(r8) :: flux_precnum_vs_flux_prec_ln
+ real(r8), intent(in) :: flux_prec
+
+ real(r8), parameter :: a0 = 9.9067806476181524E+00_r8
+ real(r8), parameter :: a1 = 4.2690709912134056E-01_r8
+
+ real(r8) :: x, y
+
+ if (flux_prec >= 1.0e-36_r8) then
+ x = log( flux_prec )
+ y = exp( a0 + a1*x )
+ else
+ y = 0.0_r8
+ end if
+ flux_precnum_vs_flux_prec_ln = y
+
+ return
+ end function flux_precnum_vs_flux_prec_ln
+
+
+!==============================================================================
+ function faer_resusp_vs_fprec_evap_mp( fprec_evap )
+!
+! fprec_evap = fraction of precipitation flux that has evaporated (below cloud base)
+! faer_resusp_vs_fprec_evap_mp = corresponding fraction of precipitation-borne aerosol
+! flux that is resuspended, assuming marshall-palmer raindrop size distribution
+!
+! note that these fractions are relative to the cloud-base fluxes,
+! and not to the layer immediately above fluxes
+!
+ real(r8) :: faer_resusp_vs_fprec_evap_mp
+ real(r8), intent(in) :: fprec_evap
+
+ real(r8), parameter :: a01 = 8.6591133737322856E-02_r8
+ real(r8), parameter :: a02 = -1.7389168499601941E+00_r8
+ real(r8), parameter :: a03 = 2.7401882373663732E+01_r8
+ real(r8), parameter :: a04 = -1.5861714653209464E+02_r8
+ real(r8), parameter :: a05 = 5.1338179363011193E+02_r8
+ real(r8), parameter :: a06 = -9.6835933124501412E+02_r8
+ real(r8), parameter :: a07 = 1.0588489932213311E+03_r8
+ real(r8), parameter :: a08 = -6.2184513459217271E+02_r8
+ real(r8), parameter :: a09 = 1.5184126886039758E+02_r8
+ real(r8), parameter :: x_lox_lin = 5.0000000000000003E-02_r8
+ real(r8), parameter :: y_lox_lin = 2.5622471203221014E-03_r8
+
+ real(r8) :: x, y
+
+ x = max( 0.0_r8, min( 1.0_r8, fprec_evap ) )
+ if (x < x_lox_lin) then
+ y = y_lox_lin * (x/x_lox_lin)
+ else
+ y = x*( a01 + x*( a02 + x*( a03 + x*( a04 + x*( a05 &
+ + x*( a06 + x*( a07 + x*( a08 + x*a09 ))))))))
+ end if
+ faer_resusp_vs_fprec_evap_mp = y
+
+ return
+ end function faer_resusp_vs_fprec_evap_mp
+
+
+!==============================================================================
+ function faer_resusp_vs_fprec_evap_ln( fprec_evap )
+!
+! fprec_evap = fraction of precipitation flux that has evaporated (below cloud base)
+! faer_resusp_vs_fprec_evap_ln = corresponding fraction of precipitation-borne aerosol
+! flux that is resuspended, assuming log-normal raindrop size distribution
+!
+! note that these fractions are relative to the cloud-base fluxes,
+! and not to the layer immediately above fluxes
+!
+ real(r8) :: faer_resusp_vs_fprec_evap_ln
+ real(r8), intent(in) :: fprec_evap
+
+ real(r8), parameter :: a01 = 6.1944215103685640E-02_r8
+ real(r8), parameter :: a02 = -2.0095166685965378E+00_r8
+ real(r8), parameter :: a03 = 2.3882460251821236E+01_r8
+ real(r8), parameter :: a04 = -1.2695611774753374E+02_r8
+ real(r8), parameter :: a05 = 4.0086943562320101E+02_r8
+ real(r8), parameter :: a06 = -7.4954272875943707E+02_r8
+ real(r8), parameter :: a07 = 8.1701055892023624E+02_r8
+ real(r8), parameter :: a08 = -4.7941894659538502E+02_r8
+ real(r8), parameter :: a09 = 1.1710291076059025E+02_r8
+ real(r8), parameter :: x_lox_lin = 1.0000000000000001E-01_r8
+ real(r8), parameter :: y_lox_lin = 6.2227889828044350E-04_r8
+
+ real(r8) :: x, y
+
+ x = max( 0.0_r8, min( 1.0_r8, fprec_evap ) )
+ if (x < x_lox_lin) then
+ y = y_lox_lin * (x/x_lox_lin)
+ else
+ y = x*( a01 + x*( a02 + x*( a03 + x*( a04 + x*( a05 &
+ + x*( a06 + x*( a07 + x*( a08 + x*a09 ))))))))
+ end if
+ faer_resusp_vs_fprec_evap_ln = y
+
+ return
+ end function faer_resusp_vs_fprec_evap_ln
+
+
+!==============================================================================
+ function fprecn_resusp_vs_fprec_evap_mp( fprec_evap )
+!
+! fprec_evap = fraction of precipitation flux that has evaporated (below cloud base)
+! fprecn_resusp_vs_fprec_evap_mp = Rain number evaporation fraction,
+! assuming marshall-palmer raindrop size distribution
+!
+! note that these fractions are relative to the cloud-base fluxes,
+! and not to the layer immediately above fluxes
+!
+ real(r8) :: fprecn_resusp_vs_fprec_evap_mp
+ real(r8), intent(in) :: fprec_evap
+
+ real(r8), parameter :: a01 = 4.5461070198414655E+00_r8
+ real(r8), parameter :: a02 = -3.0381753620077529E+01_r8
+ real(r8), parameter :: a03 = 1.7959619926085665E+02_r8
+ real(r8), parameter :: a04 = -6.7152282193785618E+02_r8
+ real(r8), parameter :: a05 = 1.5651931323557126E+03_r8
+ real(r8), parameter :: a06 = -2.2743927701175126E+03_r8
+ real(r8), parameter :: a07 = 2.0004645897056735E+03_r8
+ real(r8), parameter :: a08 = -9.7351466279626209E+02_r8
+ real(r8), parameter :: a09 = 2.0101198012962413E+02_r8
+ real(r8), parameter :: x_lox_lin = 5.0000000000000003E-02_r8
+ real(r8), parameter :: y_lox_lin = 1.7005858490684875E-01_r8
+
+ real(r8) :: x, y
+
+ x = max( 0.0_r8, min( 1.0_r8, fprec_evap ) )
+ if (x < x_lox_lin) then
+ y = y_lox_lin * (x/x_lox_lin)
+ else
+ y = x*( a01 + x*( a02 + x*( a03 + x*( a04 + x*( a05 &
+ + x*( a06 + x*( a07 + x*( a08 + x*a09 ))))))))
+ end if
+ fprecn_resusp_vs_fprec_evap_mp = y
+
+ return
+ end function fprecn_resusp_vs_fprec_evap_mp
+
+
+!==============================================================================
+ function fprecn_resusp_vs_fprec_evap_ln( fprec_evap )
+!
+! fprec_evap = fraction of precipitation flux that has evaporated (below cloud base)
+! fprecn_resusp_vs_fprec_evap_ln = Rain number evaporation fraction,
+! assuming log-normal raindrop size distribution
+!
+! note that these fractions are relative to the cloud-base fluxes,
+! and not to the layer immediately above fluxes
+!
+ real(r8) :: fprecn_resusp_vs_fprec_evap_ln
+ real(r8), intent(in) :: fprec_evap
+
+ real(r8), parameter :: a01 = -5.2335291116884175E-02_r8
+ real(r8), parameter :: a02 = 2.7203158069178226E+00_r8
+ real(r8), parameter :: a03 = 9.4730878152409375E+00_r8
+ real(r8), parameter :: a04 = -5.0573187592544798E+01_r8
+ real(r8), parameter :: a05 = 9.4732631441282862E+01_r8
+ real(r8), parameter :: a06 = -8.8265926556465814E+01_r8
+ real(r8), parameter :: a07 = 3.5247835268269142E+01_r8
+ real(r8), parameter :: a08 = 1.5404586576716444E+00_r8
+ real(r8), parameter :: a09 = -3.8228795492549068E+00_r8
+ real(r8), parameter :: x_lox_lin = 1.0000000000000001E-01_r8
+ real(r8), parameter :: y_lox_lin = 2.7247994766566485E-02_r8
+
+ real(r8) :: x, y
+
+ x = max( 0.0_r8, min( 1.0_r8, fprec_evap ) )
+ if (x < x_lox_lin) then
+ y = y_lox_lin * (x/x_lox_lin)
+ else
+ y = x*( a01 + x*( a02 + x*( a03 + x*( a04 + x*( a05 &
+ + x*( a06 + x*( a07 + x*( a08 + x*a09 ))))))))
+ end if
+ fprecn_resusp_vs_fprec_evap_ln = y
+
+ return
+ end function fprecn_resusp_vs_fprec_evap_ln
+
+
!==============================================================================
! This is the frozen CAM4 version of wetdepa.
diff --git a/components/cam/src/chemistry/modal_aero/aero_model.F90 b/components/cam/src/chemistry/modal_aero/aero_model.F90
index 2a58393440bc..e18305a66e68 100644
--- a/components/cam/src/chemistry/modal_aero/aero_model.F90
+++ b/components/cam/src/chemistry/modal_aero/aero_model.F90
@@ -62,6 +62,7 @@ module aero_model
integer :: dp_frac_idx = 0
integer :: imozart = -1
+ logical :: history_aero_prevap_resusp = .false. ! controls output of prevap resusp tendencies to history
! variables for table lookup of aerosol impaction/interception scavenging rates
integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12
@@ -82,6 +83,7 @@ module aero_model
integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop
! Namelist variables
+ integer :: mam_amicphys_optaa
logical :: sscav_tuning, convproc_do_aer, convproc_do_gas, resus_fix
character(len=16) :: wetdep_list(pcnst) = ' '
character(len=16) :: drydep_list(pcnst) = ' '
@@ -170,61 +172,169 @@ end subroutine aero_model_register
!=============================================================================
!=============================================================================
- subroutine aero_model_init( pbuf2d, species_class )
+ subroutine aero_model_init( pbuf2d, species_class, iflagaa )
use mo_chem_utls, only: get_inv_ndx
use cam_history, only: addfld, add_default, phys_decomp
use phys_control, only: phys_getopts
use mo_chem_utls, only: get_rxt_ndx, get_spc_ndx
- use modal_aero_data, only: cnst_name_cw
+ use modal_aero_data, only: cnst_name_cw, rain_evap_to_coarse_aero, mam_prevap_resusp_optaa
use modal_aero_initialize_data, only: modal_aero_initialize
+ use modal_aero_convproc, only: deepconv_wetdep_history
use rad_constituents, only: rad_cnst_get_info
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 drydep_mod, only: inidrydep
use wetdep, only: wetdep_init
use mo_chem_utls, only: get_het_ndx
+ use gas_wetdep_opts, only: gas_wetdep_cnt, gas_wetdep_list, gas_wetdep_method ! REASTER 08/04/2015
! args
type(physics_buffer_desc), pointer :: pbuf2d(:,:)
integer, intent(inout) :: species_class(:)
+ integer, intent(in) :: iflagaa
! local vars
- character(len=*), parameter :: subrname = 'aero_model_init'
- integer :: m, n, id
- character(len=20) :: dummy
+ integer :: id, l, m, n, nspc
logical :: history_aerosol ! Output MAM or SECT aerosol tendencies
- integer :: l
- integer :: nspc
+ character(len=*), parameter :: subrname = 'aero_model_init'
+ character(len=20) :: dummy
character(len=fieldname_len) :: wetdep_name, depflx_name
character(len=6) :: test_name
- character(len=64) :: errmes
-
+ character(len=100) :: errmes
character(len=2) :: unit_basename ! Units 'kg' or '1'
- dgnum_idx = pbuf_get_index('DGNUM')
- dgnumwet_idx = pbuf_get_index('DGNUMWET')
-
+ if ( masterproc ) write(iulog,'(a,i5)') 'aero_model_init iflagaa=', iflagaa ! REASTER 08/04/2015
+
call phys_getopts( history_aerosol_out=history_aerosol, &
convproc_do_aer_out = convproc_do_aer, &
convproc_do_gas_out = convproc_do_gas, &
- resus_fix_out = resus_fix )
- if(masterproc) then
- if(convproc_do_aer .or. convproc_do_gas) then
- if(.not. resus_fix)write(iulog,*)'WARNING: resus_fix=.false. and convproc_do_aer (or convproc_do_gas)=.true.' //&
+ resus_fix_out = resus_fix, &
+ mam_amicphys_optaa_out = mam_amicphys_optaa ) ! REASTER 08/04/2015
+
+
+ ! REASTER 08/04/2015 BEGIN
+ ! This section cannot execute until chemini, ..., chm_diags_inti have been called
+ if ( iflagaa == 2 ) then
+ if ( masterproc ) then
+ write(iulog,'(a,i5,2x,a)') 'gas_wetdep_cnt,meth', gas_wetdep_cnt, gas_wetdep_method
+ do m = 1, gas_wetdep_cnt
+ write(iulog,'(a,i5,2x,a)') 'gas_wetdep_list ', m, trim(gas_wetdep_list(m))
+ end do
+ end if
+
+ ! These WD_ and DF_ fields should always been in a MAM history file,
+ ! but for now they are conditional on convproc_do_aer
+ if ( convproc_do_aer ) then
+ do m = 1,gas_pcnst
+ call cnst_get_ind( solsym(m), l, abort=.false. )
+ if ( ( history_aerosol ) .and. &
+ (species_class(l) == spec_class_gas) ) then !RCE - only output WD_xxx and DF_xxx for gases
+ wetdep_name = 'WD_'//trim(solsym(m))
+ depflx_name = 'DF_'//trim(solsym(m))
+ nspc = get_het_ndx(solsym(m))
+ if (nspc > 0) call add_default( wetdep_name, 1, ' ' )
+ call add_default( depflx_name, 1, ' ' )
+ endif
+ end do ! m = 1,gas_pcnst
+ endif
+ return
+ endif ! ( iflagaa == 2 )
+
+
+ m = mam_prevap_resusp_optaa
+ if ( rain_evap_to_coarse_aero ) then
+ if ( mam_prevap_resusp_optaa /= 30 ) then
+ mam_prevap_resusp_optaa = 30
+ if ( masterproc ) write(iulog,'(2a,i4,a)') 'aero_model_init - ', &
+ 'mam_prevap_resusp_optaa changed from ', m, ' to 30 because rain_evap_to_coarse_aero = .true.'
+ end if
+
+ else
+ if ( mam_prevap_resusp_optaa == 10 .and. resus_fix ) then
+ ! this case is mam_prevap_resusp_optaa = 20, so change the default value
+ mam_prevap_resusp_optaa = 20
+ if ( masterproc ) write(iulog,'(2a)') 'aero_model_init - ', &
+ 'mam_prevap_resusp_optaa changed from 10 to 20 because resus_fix = .true.'
+ else if ( mam_prevap_resusp_optaa == 10 .and. convproc_do_aer ) then
+ ! when convproc_do_aer, the prevap_resusp tendencies are always written
+ ! to history, so change mam_prevap_resusp_optaa to 11
+ mam_prevap_resusp_optaa = 11
+ if ( masterproc ) write(iulog,'(2a)') 'aero_model_init - ', &
+ 'mam_prevap_resusp_optaa changed from 10 to 11 because convproc_do_aer = .true.'
+ endif
+ endif
+
+! *** activate this to override mam_prevap_resusp_optaa value for testing ***
+! mam_prevap_resusp_optaa = 20
+! if ( masterproc ) write(iulog,'(2a)') 'aero_model_init - ', &
+! 'mam_prevap_resusp_optaa changed from ?? to 20 for special test run'
+
+ if ( masterproc ) then
+ write(iulog,'(2a,4l5,2i5)') 'aero_model_init - ', &
+ 'convproc_do_aer & _gas, resus_fix, rain_evap_to_coarse, mam_prevap_resusp_optaa_v1/v2', &
+ convproc_do_aer, convproc_do_gas, resus_fix, &
+ rain_evap_to_coarse_aero, m, mam_prevap_resusp_optaa
+ endif
+
+ ! The unified convective transport/removal for aerosols does not
+ ! do gases yet, and convproc_do_gas is just a place holder. For that reason,
+ ! (1) All of the "if ( convproc_do_aer .or. convproc_do_gas ) then" statements
+ ! in aero_model.F90 have been changed to "if ( convproc_do_aer ) then"
+ ! (2) convproc_do_aer=.false. and convproc_do_gas=.true. is no longer allowed.
+ if ( ( .not. convproc_do_aer ) .and. convproc_do_gas ) then
+ errmes = 'aero_model_init - ' // &
+ 'convproc_do_aer MUST BE .true. when convproc_do_gas is .true.'
+ call endrun( errmes )
+ endif
+
+ if (masterproc) then
+ if ( convproc_do_aer .and. ( .not. resus_fix ) ) then
+ write(iulog,*)'WARNING: resus_fix=.false. and convproc_do_aer=.true.' //&
' is not a well tested configuration, may produce incorrect results!!'
endif
endif
+
+! mam_prevap_resusp_optaa values
+! 0 = no resuspension
+! 10 = original mam method with resus_fix=.false. (so4_a1 --> so4_a1, so4_c1 --> so4_c1)
+! 20 = original mam method with resus_fix=.true. (so4_a1 & so4_c1 --> so4_a1)
+! 30 = resuspend to coarse mode, full non-linear method (so4_a1 & so4_c1 --> so4_a3)
+! 11 = like 10 but output column resuspension tendencies (rcscavt & rsscavt) to history
+! 21 = like 20 but a with a few xxx = max( 0.0, xxx) added in werdepa_v2
+ m = 0
+ if ( mam_prevap_resusp_optaa == 0 ) m = 1
+ if ( mam_prevap_resusp_optaa == 10 ) m = 1
+ if ( mam_prevap_resusp_optaa == 11 ) m = 1
+ if ( mam_prevap_resusp_optaa == 20 ) m = 1
+ if ( mam_prevap_resusp_optaa == 21 ) m = 1
+ if ( rain_evap_to_coarse_aero ) then
+ if ( mam_prevap_resusp_optaa == 30 ) m = 1
+ endif
+ if (m <= 0) then
+ write(errmes,'(2a,l5,i10)') 'aero_model_init - ', &
+ 'illegal rain_evap_to_coarse_aero, bad mam_prevap_resusp_optaa = ', &
+ rain_evap_to_coarse_aero, mam_prevap_resusp_optaa
+ call endrun( errmes )
+ endif
+
+ history_aero_prevap_resusp = .false.
+ if ( mam_prevap_resusp_optaa /= 10 ) history_aero_prevap_resusp = .true.
+ ! REASTER 08/04/2015 END
+
+
+ dgnum_idx = pbuf_get_index('DGNUM')
+ dgnumwet_idx = pbuf_get_index('DGNUMWET')
+
!BSINGH: Decide the loop counters for the lphase loop in aero_model_wetdep subroutine
!for cases with and without the unified convective transport
-
!Counters for "without" unified convective treatment (i.e. default case)
strt_loop = 1
end_loop = 2
stride_loop = 1
- if(convproc_do_aer .or. convproc_do_gas) then
+ if (convproc_do_aer) then
!BSINGH (09/12/2014):Do cloudborne first for unified convection scheme so that the resuspension of cloudborne
!can be saved then applied to interstitial (RCE)
strt_loop = 2
@@ -235,6 +345,7 @@ subroutine aero_model_init( pbuf2d, species_class )
call modal_aero_initialize(pbuf2d, imozart, species_class)
call modal_aero_bcscavcoef_init()
+ call mam_prevap_resusp_init( ) ! REASTER 08/04/2015
call dust_init()
call seasalt_init()
@@ -408,6 +519,7 @@ subroutine aero_model_init( pbuf2d, species_class )
enddo
do m = 1,nwetdep
+ if ( masterproc ) write(iulog,'(a,i3,2x,a)') 'm, wetdep_list', m, trim(wetdep_list(m)) ! REASTER 08/04/2015
! units
if (wetdep_list(m)(1:3) == 'num') then
@@ -426,17 +538,22 @@ subroutine aero_model_init( pbuf2d, species_class )
1, 'A','Wet deposition flux (belowcloud, convective) at surface',phys_decomp)
call addfld (trim(wetdep_list(m))//'SFSBS',unit_basename//'/m2/s ', &
1, 'A','Wet deposition flux (belowcloud, stratiform) at surface',phys_decomp)
- if(convproc_do_aer) then
+
+ if ( history_aero_prevap_resusp ) then
call addfld (trim(wetdep_list(m))//'SFSEC','kg/m2/s ', &
1, 'A','Wet deposition flux (precip evap, convective) at surface',phys_decomp) !RCE
call addfld (trim(wetdep_list(m))//'SFSES','kg/m2/s ', &
1, 'A','Wet deposition flux (precip evap, stratiform) at surface',phys_decomp) !RCE
+ if (convproc_do_aer .and. deepconv_wetdep_history) then
+ call addfld (trim(wetdep_list(m))//'SFSED','kg/m2/s ', &
+ 1, 'A','Wet deposition flux (precip evap, deep convective) at surface',phys_decomp) !RCE
+ endif
+ endif
+ if (convproc_do_aer .and. deepconv_wetdep_history) then
call addfld (trim(wetdep_list(m))//'SFSID','kg/m2/s ', &
1, 'A','Wet deposition flux (incloud, deep convective) at surface',phys_decomp) !RCE
call addfld (trim(wetdep_list(m))//'SFSBD','kg/m2/s ', &
1, 'A','Wet deposition flux (belowcloud, deep convective) at surface',phys_decomp) !RCE
- call addfld (trim(wetdep_list(m))//'SFSED','kg/m2/s ', &
- 1, 'A','Wet deposition flux (precip evap, deep convective) at surface',phys_decomp) !RCE
endif
call addfld (trim(wetdep_list(m))//'WET',unit_basename//'/kg/s ',pver, 'A','wet deposition tendency',phys_decomp)
@@ -455,9 +572,13 @@ subroutine aero_model_init( pbuf2d, species_class )
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 ( history_aero_prevap_resusp ) then
+ call add_default (trim(wetdep_list(m))//'SFSEC', 1, ' ')
+ call add_default (trim(wetdep_list(m))//'SFSES', 1, ' ')
+ endif
endif
- enddo
+ enddo ! m = 1,nwetdep
do m = 1,gas_pcnst
@@ -476,32 +597,11 @@ subroutine aero_model_init( pbuf2d, species_class )
call add_default( 'AQ_'//trim(solsym(m)), 1, ' ')
endif
- if(convproc_do_gas) then
- wetdep_name = 'WD_'//trim(solsym(m))
- depflx_name = 'DF_'//trim(solsym(m))
-
- if ( history_aerosol ) then
- nspc = get_het_ndx(solsym(m))
- if (nspc > 0) then
- call cnst_get_ind( solsym(m), nspc, abort=.false. )
- if (nspc > 0) then
- if (species_class(nspc) == spec_class_gas) & !RCE - only output WD_xxx for gases
- call add_default( wetdep_name, 1, ' ' )
- endif
- endif
- endif
- endif
-
- call cnst_get_ind(trim(solsym(m)), nspc, abort=.false. )
- if(convproc_do_gas) then
- if ( history_aerosol .and. (nspc > 0) ) then
- if (species_class(nspc) == spec_class_gas) & !RCE - only output DF_xxx for gases
- call add_default( depflx_name, 1, ' ' )
- endif
- endif
-
- if(nspc > 0 .and. .not.cnst_name_cw(nspc) == ' ') then
- if(convproc_do_aer) then
+ call cnst_get_ind(trim(solsym(m)), nspc, abort=.false. ) ! REASTER 08/04/2015
+! if(nspc > 0 .and. .not.cnst_name_cw(nspc) == ' ') then ! REASTER 08/04/2015
+ if( nspc > 0 ) then ! REASTER 08/04/2015
+ if ( .not. cnst_name_cw(nspc) == ' ') then ! REASTER 08/04/2015
+ if ( history_aero_prevap_resusp ) then
call addfld (trim(cnst_name_cw(nspc))//'SFSEC','kg/m2/s ',1, 'A', &
trim(cnst_name_cw(nspc))//' wet deposition flux (precip evap, convective) at surface',phys_decomp) !RCE
call addfld (trim(cnst_name_cw(nspc))//'SFSES','kg/m2/s ',1, 'A', &
@@ -511,9 +611,11 @@ subroutine aero_model_init( pbuf2d, species_class )
call add_default (trim(cnst_name_cw(nspc))//'SFSES', 1, ' ') !RCE
endif
endif
+ endif
endif
enddo
+
do n = 1,pcnst
if( .not. (cnst_name_cw(n) == ' ') ) then
@@ -555,6 +657,7 @@ subroutine aero_model_init( pbuf2d, species_class )
endif
endif
enddo
+
do n=1,ntot_amode
dgnum_name(n) = ' '
write(dgnum_name(n),fmt='(a,i1)') 'dgnumwet',n
@@ -969,6 +1072,103 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out,
endsubroutine aero_model_drydep
+
+! REASTER 08/04/2015 BEGIN
+ !=============================================================================
+ !=============================================================================
+ subroutine mam_prevap_resusp_init( )
+
+ use modal_aero_data, only: &
+ lmassptr_amode, lspectype_amode, &
+ modeptr_coarse, &
+ nspec_amode, ntot_amode, numptr_amode, &
+ mam_prevap_resusp_optaa, mmtoo_prevap_resusp, ntoo_prevap_resusp
+ use phys_control, only: phys_getopts
+
+ integer :: lspec, lspec2
+ integer :: mm, mmtoo, mm2
+ integer :: n, ntoo, nch
+ character(len=100) :: msg
+
+ if ( masterproc ) then
+ write(iulog,'(/a)') 'mam_prevap_resusp_init'
+ write(iulog,'(a,i10)') 'mam_prevap_resusp_optaa', mam_prevap_resusp_optaa
+ end if
+
+! calculate pointers for resuspension
+! when mam_prevap_resusp_optaa = 30, mmtoo_prevap_resusp values are
+! >0 for aerosol mass species with coarse mode counterpart
+! -1 for aerosol mass species WITHOUT coarse mode counterpart
+! -2 for aerosol number species
+! 0 for other species
+! when mam_prevap_resusp_optaa = 0, 10, 11, 20, 21, mmtoo_prevap_resusp values are 0
+
+ mmtoo_prevap_resusp(:) = 0
+ ntoo_prevap_resusp(:) = 0
+
+ if ( mam_prevap_resusp_optaa == 30 ) then
+
+#if ( defined MODAL_AERO_3MODE ) || ( defined MODAL_AERO_4MODE )
+ ntoo = modeptr_coarse
+#else
+ call endrun( 'modal_aero_wetscav_init: new resuspension not implemented for 7-mode')
+#endif
+
+ do n = 1, ntot_amode ! loop over aerosol modes that was wet-removed
+
+ do lspec = 1, nspec_amode(n) ! loop over chem constituents that was wet-removed
+ mm = lmassptr_amode(lspec,n) ! q-array index of the species that was wet-removed
+ nch = len( trim( cnst_name(mm) ) ) - 1
+ if (n >= 10) nch = nch - 1
+ if (n >= 100) nch = nch - 1
+! lspectype = lspectype_amode(lspec,n)
+
+ mmtoo = -1 ! q-array index of the coarse mode species that gets the resuspension
+ do lspec2 = 1, nspec_amode(ntoo)
+! match based on the cnst_name (except for the last 1-2 characters)
+ mm2 = lmassptr_amode(lspec2,ntoo)
+ if ( cnst_name(mm)(1:nch) == cnst_name(mm2)(1:nch) ) then
+ mmtoo = mm2
+ exit
+ end if
+ end do
+
+ if (mmtoo <= 0) then
+ msg = 'modal_aero_wetscav_init: cannot find mmtoo for resuspension of: ' // cnst_name(mm)
+ write(iulog,'(a)') msg
+ call endrun( msg )
+ end if
+ if ( masterproc ) then
+ write(iulog,'(a,3(2x,a))') 'modal_aero_wetscav_init mmfrm/too: ', &
+ cnst_name(mm), cnst_name(mmtoo), cnst_name(numptr_amode(ntoo))
+ end if
+
+ mmtoo_prevap_resusp(mm) = mmtoo
+ ntoo_prevap_resusp(mm) = ntoo
+ end do ! lspec
+
+ mm = numptr_amode(n)
+ mmtoo_prevap_resusp(mm) = -2
+ ntoo_prevap_resusp(mm) = ntoo
+ end do ! n
+
+ end if
+
+ if ( masterproc ) then
+ do mm = 1, pcnst
+ mmtoo = mmtoo_prevap_resusp(mm)
+ ntoo = ntoo_prevap_resusp(mm)
+ msg = ' '
+ if (mmtoo > 0) msg = cnst_name(mmtoo)
+ write(iulog,'(2a,3(1x,i9),2x,a)') 'name, mm, mmtoo, ntoo = ', &
+ cnst_name(mm), mm, mmtoo, ntoo, trim(msg)
+ end do
+ end if
+
+ end subroutine mam_prevap_resusp_init
+! REASTER 08/04/2015 END
+
+
!=============================================================================
!=============================================================================
subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!Intent-ins
@@ -984,7 +1184,8 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
use modal_aero_calcsize, only: modal_aero_calcsize_sub
use modal_aero_wateruptake,only: modal_aero_wateruptake_dr
use modal_aero_convproc, only: deepconv_wetdep_history, ma_convproc_intr
- use infnan, only : nan, assignment(=)
+ use mo_constants, only: pi
+ use infnan, only: nan, assignment(=)
! args
@@ -1016,18 +1217,25 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
- ! local vars
- integer :: m ! tracer index
+ ! local vars
+ integer :: i
+ integer :: jnv ! index for scavcoefnv 3rd dimension
+ integer :: jnummaswtr ! indicates current aerosol species type (0 = number, 1 = dry mass, 2 = water)
+ integer, parameter :: jaeronumb=0, jaeromass=1, jaerowater=2
+ integer :: k
integer :: lchnk ! chunk identifier
+ integer :: lphase ! index for interstitial / cloudborne aerosol
+ integer :: lspec ! index for aerosol number / chem-mass / water-mass
+ integer :: lspectype
+ integer :: lcoardust, lcoarnacl ! indices for coarse mode dust and seasalt masses
+ integer :: m, mtmp ! mode index
+ integer :: mm, mmai, mmtoo ! tracer (q-array) index
integer :: ncol ! number of atmospheric columns
+ integer :: mam_prevap_resusp_optaa10, mam_prevap_resusp_optcc
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)
@@ -1038,11 +1246,9 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
real(r8) :: sflx(pcols) ! deposition flux
- integer :: jnv ! index for scavcoefnv 3rd dimension
- integer :: lphase ! index for interstitial / cloudborne aerosol
- 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) :: d1p_prevap_resusp, v1p_prevap_resusp
+ real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for the "current" aerosol species
+ real(r8) :: dqdt_sv(pcols,pver,pcnst) ! temporary array to hold tendency for all interstitial aerosol 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
@@ -1059,6 +1265,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
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
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)
@@ -1073,7 +1280,10 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
real(r8) :: rcscavt(pcols, pver) !RCE
real(r8) :: rsscavt(pcols, pver) !RCE
real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:maxd_aspectype) ! temporary array to hold qqcw for the current mode !RCE
- real(r8) :: rtscavt(pcols, pver, 0:maxd_aspectype) !RCE
+! real(r8) :: rtscavt_sv(pcols, pver, 0:maxd_aspectype) !RCE
+ real(r8) :: rtscavt_sv(pcols, pver, pcnst) ! REASTER 08/12/2015
+ real(r8) :: rcscavt_cn_sv(pcols, pver) ! REASTER 08/12/2015
+ real(r8) :: rsscavt_cn_sv(pcols, pver) ! REASTER 08/12/2015
real(r8), pointer :: fldcw(:,:)
@@ -1099,9 +1309,11 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
real(r8), pointer :: sh_frac(:,:) ! Shallow convective cloud fraction
real(r8), pointer :: dp_frac(:,:) ! Deep convective cloud fraction
+ character(len=100) :: msg
type(wetdep_inputs_t) :: dep_inputs
+
lchnk = state%lchnk
ncol = state%ncol
@@ -1158,7 +1370,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
*state%pdel(:ncol,k)/gravit
end do
- if(convproc_do_aer .or. convproc_do_gas) then
+ if (convproc_do_aer) then
qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 !RCE
aerdepwetis(:,:) = 0.0_r8 !RCE
aerdepwetcw(:,:) = 0.0_r8 !RCE
@@ -1195,9 +1407,31 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
scavcoefnv(:,:,0) = 0.0_r8 ! below-cloud scavcoef = 0.0 for cloud-borne species
- do m = 1, ntot_amode ! main loop over aerosol modes
+ if ( mam_prevap_resusp_optaa >= 20 ) then
+ ! resuspension goes to a different phase or mode
+ rtscavt_sv(:,:,:) = 0.0_r8
+ rcscavt_cn_sv(:,:) = 0.0_r8
+ rsscavt_cn_sv(:,:) = 0.0_r8
+ endif
+
+mmode_loop_aa: &
+! REASTER 08/11/2015 BEGIN
+ do mtmp = 1, ntot_amode ! main loop over aerosol modes
+ m = mtmp
+ if (ntot_amode == 4) then
+ ! for mam4, do accum, aitken, pcarbon, then coarse
+ if (mtmp == modeptr_coarse) then
+ m = ntot_amode
+ else if (mtmp > modeptr_coarse) then
+ m = mtmp - 1
+ endif
+ endif
+! REASTER 08/11/2015 END
+
!BSINGH: loop counters (strt_loop,end_loop and stride_loop) are selected based on whether
! convproc_do_aer is true or false in the aero_model_init subroutine above
+
+lphase_loop_aa: &
do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms
! sol_factb and sol_facti values
@@ -1282,7 +1516,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
end if
- if((convproc_do_aer .or. convproc_do_gas ).and. lphase == 1) then
+ if( convproc_do_aer .and. lphase == 1 ) then
! RCE 2012/01/12
! if modal aero convproc is turned on for aerosols, then
! turn off the convective in-cloud removal for interstitial aerosols
@@ -1311,27 +1545,35 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
sol_factiic = sol_factic(1,1)
- do lspec = 0, nspec_amode(m)+1 ! loop over number + chem constituents + water
+! REASTER 08/12/2015 - changed ordering (mass then number) for prevap resuspend to coarse
+lspec_loop_aa: &
+ do lspec = 1, nspec_amode(m)+2 ! loop over number + chem constituents + water
- if (lspec == 0) then ! number
+ mmai = 0
+ if (lspec <= nspec_amode(m)) then ! non-water mass
+ jnummaswtr = jaeromass
if (lphase == 1) then
- mm = numptr_amode(m)
- jnv = 1
+ mm = lmassptr_amode(lspec,m)
+ jnv = 2
else
- mm = numptrcw_amode(m)
+ mm = lmassptrcw_amode(lspec,m)
+ mmai = lmassptr_amode(lspec,m)
jnv = 0
endif
- else if (lspec <= nspec_amode(m)) then ! non-water mass
+ else if (lspec == nspec_amode(m)+1) then ! number
+ jnummaswtr = jaeronumb
if (lphase == 1) then
- mm = lmassptr_amode(lspec,m)
- jnv = 2
+ mm = numptr_amode(m)
+ jnv = 1
else
- mm = lmassptrcw_amode(lspec,m)
+ mm = numptrcw_amode(m)
+ mmai = numptr_amode(m)
jnv = 0
endif
else ! water mass
! bypass wet removal of aerosol water
- if(convproc_do_aer .or. convproc_do_gas) then
+ jnummaswtr = jaerowater
+ if (convproc_do_aer) then
if ( .not. do_aero_water_removal ) cycle
else
cycle
@@ -1349,6 +1591,58 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
if (mm <= 0) cycle
+ mam_prevap_resusp_optaa10 = mam_prevap_resusp_optaa/10
+
+! mam_prevap_resusp_optcc values control the prevap_resusp calculations in wetdepa_v2:
+! 0 = no resuspension
+! 1 = linear resuspension of aerosol mass or number following original mam coding
+! and history_aero_prevap_resusp = .false.
+! 2 = same as 1 but history_aero_prevap_resusp = .true.
+! 3 = same as 2 but with some added "xxx = max( 0, xxx)" lines
+!
+! 130 = non-linear resuspension of aerosol mass based on scavenged aerosol mass
+! 230 = non-linear resuspension of aerosol number based on raindrop number
+! the 130 thru 230 all use the new prevap_resusp code block in subr wetdepa_v2
+! and all have history_aero_prevap_resusp = .true.
+!
+ mam_prevap_resusp_optcc = 0
+
+ if ( mam_prevap_resusp_optaa == 0 ) then
+ mam_prevap_resusp_optcc = 0
+ else if ( mam_prevap_resusp_optaa == 10 ) then
+ mam_prevap_resusp_optcc = 1
+ else if ( mam_prevap_resusp_optaa == 11) then
+ mam_prevap_resusp_optcc = 2
+
+ else if ( mam_prevap_resusp_optaa == 20 ) then
+ mam_prevap_resusp_optcc = 2
+ else if ( mam_prevap_resusp_optaa == 21 ) then
+ mam_prevap_resusp_optcc = 3
+
+ else if ( mam_prevap_resusp_optaa == 30 ) then
+ if ( jnummaswtr == jaeromass ) then
+ mam_prevap_resusp_optcc = 130
+ else if ( jnummaswtr == jaeronumb .and. &
+ lphase == 1 .and. &
+ m == modeptr_coarse ) then
+ mam_prevap_resusp_optcc = 230
+ endif
+
+ endif
+
+ if ( mam_prevap_resusp_optcc /= 0 .and. &
+ mam_prevap_resusp_optcc /= 1 .and. &
+ mam_prevap_resusp_optcc /= 2 .and. &
+ mam_prevap_resusp_optcc /= 3 .and. &
+ mam_prevap_resusp_optcc /= 130 .and. &
+ mam_prevap_resusp_optcc /= 230 ) then
+ write(msg,'(a,2(1x,i10))') &
+ 'aero_model_wetdep - bad mam_prevap_resusp_optaa & cc =', &
+ mam_prevap_resusp_optaa, mam_prevap_resusp_optcc
+ call endrun( msg )
+ endif
+
+
! 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
@@ -1358,7 +1652,8 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
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 (lspec > 0) then
+ if (jnummaswtr == jaeromass) 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
@@ -1370,12 +1665,14 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
end if
- if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then
+lphase_jnmw_conditional: &
+ if ((lphase == 1) .and. (jnummaswtr /= jaerowater)) then
+! if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then
ptend%lq(mm) = .TRUE.
dqdt_tmp(:,:) = 0.0_r8
! q_tmp reflects changes from modal_aero_calcsize and is the "most current" q
q_tmp(1:ncol,:) = state%q(1:ncol,:,mm) + ptend%q(1:ncol,:,mm)*dt
- if(convproc_do_aer .or. convproc_do_gas) then
+ if (convproc_do_aer) then
!Feed in the saved cloudborne mixing ratios from phase 2
qqcw_in(:,:) = qqcw_sav(:,:,lspec)
else
@@ -1383,31 +1680,50 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
qqcw_in(:,:) = fldcw(:,:)
endif
- call wetdepa_v2( state%t, 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%cldv, dep_inputs%cldvcu, dep_inputs%cldvst, &
- dlf, fracis(:,:,mm), sol_factb, ncol, &
- scavcoefnv(:,:,jnv), &
- is_strat_cloudborne=.false., &
- rate1ord_cw2pr_st=rate1ord_cw2pr_st, &
- qqcw=qqcw_in(:,:), &
- f_act_conv=f_act_conv, &
- icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
- rcscavt=rcscavt, rsscavt=rsscavt, &
- sol_facti_in=sol_facti, sol_factbi_in=sol_factbi, sol_factii_in=sol_factii, &
- sol_factic_in=sol_factic, sol_factiic_in=sol_factiic, resus_fix=resus_fix)
+ call wetdepa_v2( &
+ ncol, dt, &
+ state%t, state%pmid, state%q(:,:,1), state%pdel, &
+ dep_inputs%cmfdqr, dep_inputs%evapc, dlf, dep_inputs%conicw, &
+ dep_inputs%prain, dep_inputs%qme, dep_inputs%evapr, dep_inputs%totcond, &
+ dep_inputs%cldt, dep_inputs%cldcu, &
+ dep_inputs%cldv, dep_inputs%cldvcu, dep_inputs%cldvst, &
+ sol_factb, sol_factbi, sol_facti, sol_factii, sol_factic, sol_factiic, &
+ mam_prevap_resusp_optcc, .false., scavcoefnv(:,:,jnv), rate1ord_cw2pr_st, f_act_conv, &
+ q_tmp, qqcw_in(:,:), &
+ fracis(:,:,mm), dqdt_tmp, iscavt, &
+ icscavt, isscavt, bcscavt, bsscavt, rcscavt, rsscavt )
+
+! REASTER 08/12/2015 BEGIN
+ if ( mam_prevap_resusp_optaa10 == 3 ) then
+ ! resuspension goes to coarse mode
+ ! first deduct the current resuspension from the dqdt_tmp of the current species
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - ( rcscavt(1:ncol,:) + rsscavt(1:ncol,:) )
+ ! then add the current resuspension to the rtscavt_sv of the appropriate coarse mode species
+ mmtoo = mmtoo_prevap_resusp(mm)
+ if (mmtoo > 0) rtscavt_sv(1:ncol,:,mmtoo) = rtscavt_sv(1:ncol,:,mmtoo) &
+ + ( rcscavt(1:ncol,:) + rsscavt(1:ncol,:) )
+ ! then add the rtscavt_sv of the current species to the dqdt_tmp of the current species
+ ! note that for so4_a3 and mam3, the rtscavt_sv at this point will have resuspension contributions
+ ! from so4_a1/2/3 and so4c1/2/3
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt_sv(1:ncol,:,mm)
- do_hygro_sum_del = .false.
- if ( lspec > 0 ) do_hygro_sum_del = .true.
+ endif
+! REASTER 08/12/2015 END
- if(convproc_do_aer .or. convproc_do_gas) then
- do_hygro_sum_del = .false.
+! if (convproc_do_aer) then
+ if ( mam_prevap_resusp_optaa10 == 2 ) then
! add resuspension of cloudborne species to dqdt of interstitial species
- dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,lspec) ! RCE 2012/01/12
+! dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt_sv(1:ncol,:,lspec) ! RCE 2012/01/12
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt_sv(1:ncol,:,mm) ! REASTER 08/12/2015
+ endif
- if ( (lspec > 0) .and. do_aero_water_removal ) then !RCE 2012/01/12
+ do_hygro_sum_del = .false.
+! if ( lspec > 0 ) do_hygro_sum_del = .true.
+ if ( jnummaswtr == jaeromass ) do_hygro_sum_del = .true.
+ if (convproc_do_aer) then
+ do_hygro_sum_del = .false.
+! if ( (lspec > 0) .and. do_aero_water_removal ) then !RCE 2012/01/12
+ if ( (jnummaswtr == jaeromass) .and. do_aero_water_removal ) then
do_hygro_sum_del = .true.
endif
endif
@@ -1426,7 +1742,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
enddo
enddo
- if (.not. (convproc_do_aer .or. convproc_do_gas)) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk)
+ if ( .not. convproc_do_aer ) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk)
aerdepwetis(:ncol,mm) = sflx(:ncol)
sflx(:)=0._r8
@@ -1435,8 +1751,9 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit
enddo
enddo
- if (.not.(convproc_do_aer .or. convproc_do_gas))call outfld( trim(cnst_name(mm))//'SFSIC', sflx, pcols, lchnk)
- if (convproc_do_aer .or. convproc_do_gas)sflxic = sflx
+ 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
@@ -1444,6 +1761,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name(mm))//'SFSIS', sflx, pcols, lchnk)
+
sflx(:)=0._r8
do k=1,pver
do i=1,ncol
@@ -1451,7 +1769,8 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk)
- if (convproc_do_aer .or. convproc_do_gas)sflxbc = sflx
+ if (convproc_do_aer) sflxbc = sflx
+
sflx(:)=0._r8
do k=1,pver
do i=1,ncol
@@ -1459,8 +1778,9 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name(mm))//'SFSBS', sflx, pcols, lchnk)
-
- if(convproc_do_aer .or. convproc_do_gas) then
+
+ if ( history_aero_prevap_resusp ) then
+ ! here the prevap resuspension is in rcscavt & rsscavt and column integral is written to history
!BSINGH(09/15/2014):Following two nested do-loops are new additions for unified convection
!BSINGH(09/15/2014):After these do-loops, code was added by RCE, the comments by RCE are kept as it is
sflx(:)=0._r8
@@ -1469,7 +1789,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit
enddo
enddo
- sflxec = sflx
+ if (convproc_do_aer) sflxec = sflx
sflx(:)=0._r8
do k=1,pver
@@ -1478,66 +1798,75 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name(mm))//'SFSES', sflx, pcols, lchnk)
- !RCE 2012/01/12 end - prev ~40 lines are modified
+ else
+ if (convproc_do_aer) sflxec(:) = 0._r8
+ end if ! ( history_aero_prevap_resusp )
- !RCE 2012/01/12 bgn - next ~40 lines are new
- ! 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
+ !RCE 2012/01/12 bgn - next ~40 lines are new
+ ! 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 ( convproc_do_aer ) then
+ if ( deepconv_wetdep_history ) then
do i = 1, ncol
tmp_precdp = max( rprddpsum(i), 1.0e-35_r8 )
tmp_precsh = max( rprdshsum(i), 1.0e-35_r8 )
tmp_evapdp = max( evapcdpsum(i), 0.1e-35_r8 )
tmp_evapsh = max( evapcshsum(i), 0.1e-35_r8 )
-
+
! assume that in- and below-cloud removal are proportional to column precip production
tmpa = tmp_precdp / (tmp_precdp + tmp_precsh)
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( (tmp_evapdp/tmp_precdp), 1.0_r8 )
- tmp_resush = (1.0_r8 - tmpa) * min( (tmp_evapsh/tmp_precsh), 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
+ if ( history_aero_prevap_resusp ) then
+ tmp_resudp = tmpa * min( (tmp_evapdp/tmp_precdp), 1.0_r8 )
+ tmp_resush = (1.0_r8 - tmpa) * min( (tmp_evapsh/tmp_precsh), 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
+ else
+ sflxecdp(i) = 0.0_r8
+ end if
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
+ ! 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)
- !RCE 2012/01/12 end - prev ~40 lines are new
- endif
+ end if ! ( convproc_do_aer )
+ !RCE 2012/01/12 end - prev ~40 lines are new
- if (do_hygro_sum_del) then
- tmpa = spechygro(lspectype_amode(lspec,m))/ &
- specdens_amode(lspectype_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
+
+ if (do_hygro_sum_del) then
+ tmpa = spechygro(lspectype_amode(lspec,m))/ &
+ specdens_amode(lspectype_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
+ else if ((lphase == 1) .and. (jnummaswtr == jaerowater)) then lphase_jnmw_conditional
do_lphase1 = .true.
- if(convproc_do_aer .or. convproc_do_gas) then
+ if (convproc_do_aer) then
do_lphase1 = .false.
- if(do_aero_water_removal)do_lphase1 = .true.
+ if (do_aero_water_removal) do_lphase1 = .true.
endif
- if(do_lphase1) then
+ 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
@@ -1574,17 +1903,27 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
! enddo
! enddo
! call outfld( trim(cnst_name(mm))
- endif
+ endif ! (do_lphase1)
+
+
- elseif(lphase == 2) then ! lphase == 2
+ elseif (lphase == 2) then lphase_jnmw_conditional ! lphase == 2
do_lphase2 = .true.
- if(convproc_do_aer .or. convproc_do_gas) then
- do_lphase2 = .false.
- if(lspec <= nspec_amode(m))do_lphase2 = .true.
- endif
- if( do_lphase2 ) then
+! REASTER 08/11/2015 start
+! There is no cloud-borne aerosol water in the model, so the do_lphase2 code block
+! should NEVER execute for lspec = nspec_amode(m)+1 (i.e., jnummaswtr = jaerowater).
+! The code only worked because the "do lspec" loop cycles when lspec = nspec_amode(m)+1,
+! but that does not make the code correct.
+! if (convproc_do_aer) then
+! do_lphase2 = .false.
+! if (lspec <= nspec_amode(m)) do_lphase2 = .true.
+! endif
+ if (jnummaswtr == jaerowater) do_lphase2 = .false.
+! REASTER 08/11/2015 end
+do_lphase2_conditional: &
+ if ( do_lphase2 ) then
dqdt_tmp(:,:) = 0.0_r8
- if(convproc_do_aer .or. convproc_do_gas) then
+ if (convproc_do_aer) then
fldcw => qqcw_get_field(pbuf,mm,lchnk)
qqcw_sav(1:ncol,:,lspec) = fldcw(1:ncol,:) !RCE 2012/01/12
else
@@ -1592,30 +1931,49 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
fldcw => qqcw_get_field(pbuf, mm,lchnk)
endif
- call wetdepa_v2(state%t, 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%cldv, dep_inputs%cldvcu, dep_inputs%cldvst, &
- dlf, fracis_cw, sol_factb, ncol, &
- scavcoefnv(:,:,jnv), &
- is_strat_cloudborne=.true., &
- rate1ord_cw2pr_st=rate1ord_cw2pr_st, &
- qqcw=qqcw_tmp, &
- f_act_conv=f_act_conv, &
- icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
- rcscavt=rcscavt, rsscavt=rsscavt, &
- sol_facti_in=sol_facti, sol_factbi_in=sol_factbi, sol_factii_in=sol_factii, &
- sol_factic_in=sol_factic, sol_factiic_in=sol_factiic, resus_fix=resus_fix)
-
- if(convproc_do_aer .or. convproc_do_gas) then
- ! save resuspension of cloudborne species
-
- rtscavt(1:ncol,:,lspec) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) ! RCE 2012/01/12
-
- ! 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) ! RCE 2012/01/12
+ call wetdepa_v2( &
+ ncol, dt, &
+ state%t, state%pmid, state%q(:,:,1), state%pdel, &
+ dep_inputs%cmfdqr, dep_inputs%evapc, dlf, dep_inputs%conicw, &
+ dep_inputs%prain, dep_inputs%qme, dep_inputs%evapr, dep_inputs%totcond, &
+ dep_inputs%cldt, dep_inputs%cldcu, &
+ dep_inputs%cldv, dep_inputs%cldvcu, dep_inputs%cldvst, &
+ sol_factb, sol_factbi, sol_facti, sol_factii, sol_factic, sol_factiic, &
+ mam_prevap_resusp_optcc, .true., scavcoefnv(:,:,jnv), rate1ord_cw2pr_st, f_act_conv, &
+ fldcw, qqcw_tmp, &
+ fracis_cw, dqdt_tmp, iscavt, &
+ icscavt, isscavt, bcscavt, bsscavt, rcscavt, rsscavt )
+
+! REASTER 08/12/2015 BEGIN
+ if ( mam_prevap_resusp_optaa10 == 3 ) then
+ ! resuspension goes to coarse mode
+ ! first deduct the current resuspension from the dqdt_tmp of the current species
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - ( rcscavt(1:ncol,:) + rsscavt(1:ncol,:) )
+ ! then add the current resuspension to the rtscavt_sv of the appropriate coarse mode species
+ mmtoo = mmtoo_prevap_resusp(mm)
+ if (mmtoo > 0) rtscavt_sv(1:ncol,:,mmtoo) = rtscavt_sv(1:ncol,:,mmtoo) &
+ + ( rcscavt(1:ncol,:) + rsscavt(1:ncol,:) )
+
+ endif
+! REASTER 08/12/2015 END
+
+! if (convproc_do_aer) then
+ if ( mam_prevap_resusp_optaa10 == 2 ) then
+ ! the original wetdepa_v2 adds the resuspension of cloudborne aerosol species
+ ! to the dqdt of cloudborne species (as a source)
+ ! when resus_fix=.true. and/or mam_prevap_resusp_optaa=20,21 ) then
+ ! > save resuspension of cloudborne species to rtscavt_sv
+ ! > deduct it from the tendency (dqdt_tmp) of the cloudborne species
+ ! > add it to the tendency (dqdt_tmp) of the interstitial species (which is done above)
+! rtscavt_sv(1:ncol,:,lspec) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) ! RCE 2012/01/12
+ if ( 0 < mmai .and. mmai <= pcnst ) then
+ rtscavt_sv(1:ncol,:,mmai) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) ! REASTER 08/11/2015
+ else
+ write(msg,'(a,3(1x,i5))') 'aero_model_wetdep - bad mmai - m, mm, mmai =', m, mm, mmai
+ call endrun( msg )
+ endif
+! dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt_sv(1:ncol,:,lspec) ! RCE 2012/01/12
+ dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt_sv(1:ncol,:,mmai) ! REASTER 08/11/2015
endif
@@ -1637,6 +1995,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name_cw(mm))//'SFSIC', sflx, pcols, lchnk)
+
sflx(:)=0._r8
do k=1,pver
do i=1,ncol
@@ -1644,6 +2003,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name_cw(mm))//'SFSIS', sflx, pcols, lchnk)
+
sflx(:)=0._r8
do k=1,pver
do i=1,ncol
@@ -1651,6 +2011,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
enddo
call outfld( trim(cnst_name_cw(mm))//'SFSBC', sflx, pcols, lchnk)
+
sflx(:)=0._r8
do k=1,pver
do i=1,ncol
@@ -1659,8 +2020,10 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
enddo
call outfld( trim(cnst_name_cw(mm))//'SFSBS', sflx, pcols, lchnk)
- if(convproc_do_aer .or. convproc_do_gas) then
- !BSINGH(09/15/2014):Following two nested do-loops are new additions for unified convection
+! if (convproc_do_aer) then
+! !BSINGH(09/15/2014):Following two nested do-loops are new additions for unified convection
+ ! REASTER 08/10/2015 - NO. They are new additions for resus_fix=.true.
+ if ( history_aero_prevap_resusp ) 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
@@ -1674,12 +2037,14 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
call outfld( trim(cnst_name_cw(mm))//'SFSES', sflx, pcols, lchnk)
!RCE 2012/01/12 end - prev ~40 lines are changed
endif
- endif
- endif
- enddo ! lspec = 0, nspec_amode(m)+1
- enddo ! lphase = 1, 2
- enddo ! m = 1, ntot_amode
+ endif do_lphase2_conditional
+
+ endif lphase_jnmw_conditional
+
+ enddo lspec_loop_aa ! lspec = 1, nspec_amode(m)+2
+ enddo lphase_loop_aa ! lphase = 1, 2
+ enddo mmode_loop_aa ! 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
@@ -1687,7 +2052,7 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
call set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out)
endif
- if(convproc_do_aer .or. convproc_do_gas) then
+ if (convproc_do_aer) then
call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp )
call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh )
@@ -1701,7 +2066,8 @@ subroutine aero_model_wetdep(dt, dlf, dlf2, cmfmc2, state, &!
dlf, dlf2, cmfmc2, sh_e_ed_ratio, &
nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, &
mu, md, du, eu, ed, dp, dsubcld, jt, maxg, ideep, lengath, &
- species_class)
+ species_class, mam_prevap_resusp_optaa, &
+ history_aero_prevap_resusp )
call t_stopf('ma_convproc')
endif
@@ -1798,13 +2164,15 @@ end subroutine aero_model_surfarea
!=============================================================================
!=============================================================================
- subroutine aero_model_gasaerexch( loffset, ncol, lchnk, delt, reaction_rates, &
+ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, delt, &
+ latndx, lonndx, reaction_rates, &
tfld, pmid, pdel, mbar, relhum, &
zm, qh2o, cwat, cldfr, cldnum, &
airdens, invariants, del_h2so4_gasprod, &
vmr0, vmr, pbuf )
use time_manager, only : get_nstep
+ use modal_aero_amicphys, only : modal_aero_amicphys_intr
use modal_aero_coag, only : modal_aero_coag_sub
use modal_aero_gasaerexch, only : modal_aero_gasaerexch_sub
use modal_aero_newnuc, only : modal_aero_newnuc_sub
@@ -1817,6 +2185,8 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, delt, reaction_rates, &
integer, intent(in) :: loffset ! offset applied to modal aero "pointers"
integer, intent(in) :: ncol ! number columns in chunk
integer, intent(in) :: lchnk ! chunk index
+ integer, intent(in) :: latndx(pcols) ! latitude indices
+ integer, intent(in) :: lonndx(pcols) ! longitude indices
real(r8), intent(in) :: delt ! time step size (sec)
real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates
real(r8), intent(in) :: tfld(:,:) ! temperature (K)
@@ -1910,67 +2280,125 @@ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, delt, reaction_rates, &
endif
! Tendency due to aqueous chemistry
- dvmrdt = (vmr - dvmrdt) / delt
- dvmrcwdt = (vmrcw - dvmrcwdt) / delt
+! When mam_amicphys_optaa > 0, dvmrdt & dvmrcwdt to hold vmr & vmrcw
+! before aqueous chemistry, and cannot be used to hold aq. chem. tendencies
+!***Note - should calc & output tendencies for cloud-borne aerosol species
+! rather than interstitial here
+ if (mam_amicphys_optaa <= 0) then
+ dvmrdt = (vmr - dvmrdt) / delt
+ dvmrcwdt = (vmrcw - dvmrcwdt) / delt
+ endif
do m = 1, gas_pcnst
wrk(:) = 0._r8
do k = 1,pver
- wrk(:ncol) = wrk(:ncol) + dvmrdt(:ncol,k,m) * adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit
+ if (mam_amicphys_optaa <= 0) then
+ ! here dvmrdt is (delta vmr from aqueous chemistry)/(delt)
+ wrk(:ncol) = wrk(:ncol) + dvmrdt(:ncol,k,m) * adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit
+ else
+ ! here dvmrdt is vmr before aqueous chemistry, so need to calculate (delta vmr)/(delt)
+ wrk(:ncol) = wrk(:ncol) + ((vmr(:ncol,k,m)-dvmrdt(:ncol,k,m))/delt) &
+ * adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit
+ endif
end do
name = 'AQ_'//trim(solsym(m))
call outfld( name, wrk(:ncol), ncol, lchnk )
enddo
-! do gas-aerosol exchange (h2so4, msa, nh3 condensation)
+ if (mam_amicphys_optaa <= 0) then
+ ! do gas-aerosol exchange, nucleation, and coagulation using old routines
- if (ndx_h2so4 > 0) then
- del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4)
- else
- del_h2so4_aeruptk(:,:) = 0.0_r8
- endif
-
- call t_startf('modal_gas-aer_exchng')
-
- call modal_aero_gasaerexch_sub( &
- lchnk, ncol, nstep, &
- loffset, delt, &
- tfld, pmid, pdel, &
- vmr, vmrcw, &
- dvmrdt, dvmrcwdt, &
- dgnum, dgnumwet )
-
- if (ndx_h2so4 > 0) then
- del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_aeruptk(1:ncol,:)
- endif
-
- call t_stopf('modal_gas-aer_exchng')
-
- call t_startf('modal_nucl')
+ ! do gas-aerosol exchange (h2so4, msa, nh3 condensation)
+ if (ndx_h2so4 > 0) then
+ del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4)
+ else
+ del_h2so4_aeruptk(:,:) = 0.0_r8
+ endif
- ! do aerosol nucleation (new particle formation)
- call modal_aero_newnuc_sub( &
- lchnk, ncol, nstep, &
- loffset, delt, &
- tfld, pmid, pdel, &
- zm, pblh, &
- qh2o, cldfr, &
- vmr, &
- del_h2so4_gasprod, del_h2so4_aeruptk )
+ call t_startf('modal_gas-aer_exchng')
- call t_stopf('modal_nucl')
+ call modal_aero_gasaerexch_sub( &
+ lchnk, ncol, nstep, &
+ loffset, delt, &
+ tfld, pmid, pdel, &
+ vmr, vmrcw, &
+ dvmrdt, dvmrcwdt, &
+ dgnum, dgnumwet )
- call t_startf('modal_coag')
+ if (ndx_h2so4 > 0) then
+ del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_aeruptk(1:ncol,:)
+ endif
- ! do aerosol coagulation
- call modal_aero_coag_sub( &
- lchnk, ncol, nstep, &
- loffset, delt, &
- tfld, pmid, pdel, &
- vmr, &
- dgnum, dgnumwet, &
- wetdens )
+ call t_stopf('modal_gas-aer_exchng')
+
+ ! do aerosol nucleation (new particle formation)
+ call t_startf('modal_nucl')
+
+ call modal_aero_newnuc_sub( &
+ lchnk, ncol, nstep, &
+ loffset, delt, &
+ tfld, pmid, pdel, &
+ zm, pblh, &
+ qh2o, cldfr, &
+ vmr, &
+ del_h2so4_gasprod, del_h2so4_aeruptk )
+
+ call t_stopf('modal_nucl')
+
+ ! do aerosol coagulation
+ call t_startf('modal_coag')
+
+ call modal_aero_coag_sub( &
+ lchnk, ncol, nstep, &
+ loffset, delt, &
+ tfld, pmid, pdel, &
+ vmr, &
+ dgnum, dgnumwet, &
+ wetdens )
+
+ call t_stopf('modal_coag')
+
+ else ! (mam_amicphys_optaa > 0)
+ ! do gas-aerosol exchange, nucleation, and coagulation using new routines
+
+ call t_startf('modal_aero_amicphys')
+
+ ! note that:
+ ! vmr0 holds vmr before gas-phase chemistry
+ ! dvmrdt and dvmrcwdt hold vmr and vmrcw before aqueous chemistry
+ call modal_aero_amicphys_intr( &
+ 1, 1, &
+ 1, 1, &
+ lchnk, ncol, nstep, &
+ loffset, delt, &
+ latndx, lonndx, &
+ tfld, pmid, pdel, &
+ zm, pblh, &
+ qh2o, cldfr, &
+ vmr, vmrcw, &
+ vmr0, &
+ dvmrdt, dvmrcwdt, &
+ dgnum, dgnumwet, &
+ wetdens )
+! subroutine modal_aero_amicphys_intr( &
+! mdo_gasaerexch, mdo_rename, &
+! mdo_newnuc, mdo_coag, &
+! lchnk, ncol, nstep, &
+! loffset, deltat, &
+! latndx, lonndx, &
+! t, pmid, pdel, &
+! zm, pblh, &
+! qv, cld, &
+! q, qqcw, &
+! q_pregaschem, &
+! q_precldchem, qqcw_precldchem, &
+! dgncur_a, dgncur_awet, &
+! wetdens_host, &
+! qaerwat )
+
+ call t_startf('modal_aero_amicphys')
+
+ endif ! (mam_amicphys_optaa <= 0 OR > 0)
- call t_stopf('modal_coag')
call vmr2qqcw( lchnk, vmrcw, mbar, ncol, loffset, pbuf )
diff --git a/components/cam/src/chemistry/modal_aero/modal_aero_amicphys.F90 b/components/cam/src/chemistry/modal_aero/modal_aero_amicphys.F90
new file mode 100644
index 000000000000..7cbfbacba7d8
--- /dev/null
+++ b/components/cam/src/chemistry/modal_aero/modal_aero_amicphys.F90
@@ -0,0 +1,6042 @@
+#define CAM_VERSION_IS_ACME
+
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: modal_aero_amicphys --- does modal aerosol gas-aerosol exchange
+!
+! !INTERFACE:
+ module modal_aero_amicphys
+
+! !USES:
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use cam_abortutils, only: endrun
+ use cam_logfile, only: iulog
+ use chem_mods, only: gas_pcnst
+ use physconst, only: pi
+ use ppgrid, only: pcols, pver
+ use modal_aero_data, only: ntot_aspectype, ntot_amode, nsoa, npoa, nbc
+! use ref_pres, only: top_lev => clim_modal_aero_top_lev ! this is for gg02a
+ use ref_pres, only: top_lev => trop_cloud_top_lev ! this is for ee02c
+
+ implicit none
+ private
+ save
+
+! !PUBLIC MEMBER FUNCTIONS:
+ public modal_aero_amicphys_intr, modal_aero_amicphys_init
+
+! !PUBLIC DATA MEMBERS:
+ type :: misc_vars_aa_type
+! using this derived type reduces the number of changes needed to add more mosaic diagnostics to history
+ real(r8) :: ncluster_tend_nnuc_1grid
+#if ( defined( MOSAIC_SPECIES ) )
+ real(r8) :: cnvrg_fail_1grid
+ real(r8) :: max_kelvin_iter_1grid
+ real(r8), dimension(5,4) :: xnerr_astem_negative_1grid
+#endif
+ end type misc_vars_aa_type
+
+ logical, public :: mosaic = .true. !BSINGH - Added logical for mosaic model
+
+ integer, parameter :: pcnstxx = gas_pcnst
+
+! real(r8), parameter, public :: n_so4_monolayers_pcage = 1.0_r8
+ real(r8), parameter, public :: n_so4_monolayers_pcage = 3.0_r8
+! number of so4(+nh4) monolayers needed to "age" a carbon particle
+
+ real(r8), parameter, public :: &
+ dr_so4_monolayers_pcage = n_so4_monolayers_pcage * 4.76e-10
+! thickness of the so4 monolayers (m)
+! for so4(+nh4), use bi-sulfate mw and 1.77 g/cm3,
+! --> 1 mol so4(+nh4) = 65 cm^3 --> 1 molecule = (4.76e-10 m)^3
+! aging criterion is approximate so do not try to distinguish
+! sulfuric acid, bisulfate, ammonium sulfate
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ integer, public :: cldy_rh_sameas_clear = 0
+! this is only used for some specific box model tests
+#endif
+
+ integer, public :: mdo_gaexch_cldy_subarea = 0
+! controls if gas condensation is done in cloudy subarea
+! 1 = yes ; 0 = no
+
+ integer, public :: gaexch_h2so4_uptake_optaa = 2
+! controls treatment of h2so4 condensation in mam_gasaerexch_1subarea
+! 1 = sequential calc. of gas-chem prod then condensation loss
+! 2 = simultaneous calc. of gas-chem prod and condensation loss
+
+ integer, public :: newnuc_h2so4_conc_optaa = 2
+! controls treatment of h2so4 concentrationin mam_newnuc_1subarea
+! 1 = use average value calculated in standard cam5.2.10 and earlier
+! 2 = use average value calculated in mam_gasaerexch_1subarea
+! 11 = use average of initial and final values from mam_gasaerexch_1subarea
+! 12 = use final value from mam_gasaerexch_1subarea
+
+ integer, public :: rename_method_optaa = 40
+! controls renaming parameterization
+
+ integer, public :: update_qaerwat = 0
+ integer, public :: update_dgncur_a = 0
+ integer, public :: update_dgncur_awet = 0
+! controls updating of qaerwat
+! controls updating of dgncur_a
+! controls updating of dgncur_awet and wetdens_host
+
+ real (r8) :: newnuc_adjust_factor_dnaitdt = 1.0_r8
+ real (r8) :: newnuc_adjust_factor_pbl = 1.0_r8
+
+
+#if ( defined MODAL_AERO_3MODE )
+ integer, parameter :: max_gas = nsoa + 1
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 3
+#elif ( defined MODAL_AERO_4MODE )
+ integer, parameter :: max_gas = nsoa + 1
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 3
+#elif ( ( defined MODAL_AERO_7MODE ) && ( defined MOSAIC_SPECIES ) )
+ integer, parameter :: max_gas = nsoa + 4
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 8
+#elif ( defined MODAL_AERO_7MODE )
+ integer, parameter :: max_gas = nsoa + 2
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 4
+#elif ( defined MODAL_AERO_8MODE )
+ integer, parameter :: max_gas = nsoa + 2
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 4
+#elif ( defined MODAL_AERO_9MODE )
+ integer, parameter :: max_gas = nsoa + 2
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 4 + 5
+#endif
+
+#if ( defined MODAL_AERO_8MODE ) || ( defined MODAL_AERO_4MODE )
+ integer, parameter :: ntot_amode_extd = ntot_amode
+#else
+ integer, parameter :: ntot_amode_extd = ntot_amode + 1
+! integer, parameter :: ntot_amode_extd = ntot_amode
+#endif
+
+ integer, parameter :: max_mode_fresh = 1
+
+ integer, parameter :: max_mode = ntot_amode_extd + max_mode_fresh
+ public max_mode !BSINGH - used in module_mosaic_cam_init.F90
+
+ integer, parameter :: max_coagpair = 100
+
+#if ( defined MODAL_AERO_9MODE )
+ integer, parameter :: max_agepair = 3
+#else
+ integer, parameter :: max_agepair = 1
+#endif
+
+ integer, parameter :: maxsubarea = 2
+
+ integer, parameter :: nqtendaa = 4
+ integer, parameter :: iqtend_cond = 1
+ integer, parameter :: iqtend_rnam = 2
+ integer, parameter :: iqtend_nnuc = 3
+ integer, parameter :: iqtend_coag = 4
+ integer, parameter :: nqqcwtendaa = 1
+ integer, parameter :: iqqcwtend_rnam = 1
+
+ integer, parameter :: iqqcwtend_match_iqtend(nqtendaa) = (/ 0, iqqcwtend_rnam, 0, 0 /)
+
+ logical, parameter :: aging_include_seasalt = .false.
+ ! when .true., aging (by coagulation) includes contribution of seasalt
+ ! early versions of mam neglected the seasalt contribution
+
+ ! species indices for various qgas_--- arrays
+ integer :: igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl
+ ! species indices for various qaer_--- arrays
+ ! when nsoa > 1, igas_soa and iaer_soa are indices of the first soa species
+ ! when nbc > 1, iaer_bc is index of the first bc species
+ ! when npom > 1, iaer_pom is index of the first pom species
+ integer :: iaer_bc, iaer_dst, iaer_ncl, iaer_nh4, iaer_pom, iaer_soa, iaer_so4, &
+ iaer_mpoly, iaer_mprot, iaer_mlip, iaer_mhum, iaer_mproc, &
+ iaer_no3, iaer_cl, iaer_ca, iaer_co3
+ integer :: i_agepair_pca, i_agepair_macc, i_agepair_mait
+ integer :: lmap_gas(max_gas)
+ integer :: lmap_aer(max_aer,max_mode), lmapbb_aer(max_aer,max_mode), &
+ lmap_aercw(max_aer,max_mode)
+ integer :: lmap_num(max_mode), lmap_numcw(max_mode)
+ integer :: lmapcc_all(gas_pcnst)
+ integer, parameter :: lmapcc_val_gas = 1, lmapcc_val_aer = 2, lmapcc_val_num = 3
+ integer :: ngas, naer
+ integer :: nacc, nait, npca, nufi, nmacc, nmait
+
+ integer :: n_agepair, n_coagpair
+ integer :: modefrm_agepair(max_agepair), modetoo_agepair(max_agepair)
+ integer :: mode_aging_optaa(max_mode)
+ integer :: modefrm_coagpair(max_coagpair), modetoo_coagpair(max_coagpair), &
+ modeend_coagpair(max_coagpair)
+
+ integer :: lun82, lun97, lun98, lun13n, lun15n
+ logical :: ldiag82, ldiag97, ldiag98, ldiag13n, ldiag15n
+ logical :: ldiagd1
+
+ real(r8) :: accom_coef_gas(max_gas)
+ real(r8) :: alnsg_aer(max_mode)
+ real(r8) :: dgnum_aer(max_mode), dgnumhi_aer(max_mode), dgnumlo_aer(max_mode)
+ real(r8) :: dens_aer(max_aer)
+ real(r8) :: dens_so4a_host
+ real(r8) :: fac_m2v_aer(max_aer) ! converts (mol-aero/mol-air) to (m3-aero/mol-air)
+ real(r8) :: fac_eqvso4hyg_aer(max_aer) ! converts a species volume to a volume of so4
+ ! (or nh4hso4) having same hygroscopicity
+ real(r8) :: fac_m2v_eqvhyg_aer(max_aer) ! = fac_m2v_aer * fac_eqvso4hyg_aer
+
+ real(r8) :: fcvt_gas(max_gas), fcvt_aer(max_aer), fcvt_num, fcvt_wtr
+ real(r8) :: fcvt_dgnum_dvolmean(max_mode)
+ real(r8) :: hygro_aer(max_aer)
+ real(r8) :: mw_gas(max_gas), mw_aer(max_aer)
+ real(r8) :: mwhost_gas(max_gas), mwhost_aer(max_aer), mwhost_num
+ real(r8) :: mw_nh4a_host, mw_so4a_host
+ real(r8) :: mwuse_soa(nsoa), mwuse_poa(npoa)
+ real(r8) :: sigmag_aer(max_mode)
+ real(r8) :: vol_molar_gas(max_gas)
+
+! following were used in aging calcs but are no longer needed
+! fac_m2v_so4, fac_m2v_nh4, fac_m2v_soa(:)
+! fac_m2v_pcarbon(:)
+! soa_equivso4_factor(:)
+
+
+ character(len=16) :: name_gas(max_gas), name_aerpfx(max_aer), &
+ name_aer(max_aer,max_mode), name_aercw(max_aer,max_mode), &
+ name_num(max_mode), name_numcw(max_mode)
+
+ character(len=8) :: suffix_q_coltendaa(nqtendaa) = &
+ (/ '_sfgaex1', '_sfgaex2', '_sfnnuc1', '_sfcoag1' /)
+ character(len=8) :: suffix_qqcw_coltendaa(nqqcwtendaa) = &
+ '_sfgaex2'
+
+ logical :: do_q_coltendaa(gas_pcnst,nqtendaa) = .false.
+ logical :: do_qqcw_coltendaa(gas_pcnst,nqqcwtendaa) = .false.
+
+! *** following 3 variables should eventually be in modal_aero_data
+ real(r8) :: specmw2_amode(ntot_aspectype,ntot_amode)
+ real(r8) :: specdens2_amode(ntot_aspectype,ntot_amode)
+ real(r8) :: spechygro2(ntot_aspectype,ntot_amode)
+
+
+! !DESCRIPTION: This module implements ...
+!
+! !REVISION HISTORY:
+!
+! RCE 07.04.13: Adapted from MIRAGE2 code
+!
+!EOP
+!----------------------------------------------------------------------
+!BOC
+
+! list private module data here
+
+!EOC
+!----------------------------------------------------------------------
+
+
+ contains
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+subroutine modal_aero_amicphys_intr( &
+ mdo_gasaerexch, mdo_rename, &
+ mdo_newnuc, mdo_coag, &
+ lchnk, ncol, nstep, &
+ loffset, deltat, &
+ latndx, lonndx, &
+ t, pmid, pdel, &
+ zm, pblh, &
+ qv, cld, &
+ q, qqcw, &
+ q_pregaschem, &
+ q_precldchem, qqcw_precldchem, &
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ nqtendbb, nqqcwtendbb, &
+ q_tendbb, qqcw_tendbb, &
+#endif
+ dgncur_a, dgncur_awet, &
+ wetdens_host, &
+ qaerwat )
+
+
+! !USES:
+use cam_history, only: outfld, fieldname_len
+use chem_mods, only: adv_mass
+use constituents, only: cnst_name
+use physconst, only: gravit, mwdry, r_universal
+use wv_saturation, only: qsat
+use phys_control, only: phys_getopts
+
+use modal_aero_data, only: &
+ cnst_name_cw, &
+ lmassptr_amode, lmassptrcw_amode, lptr2_soa_g_amode, &
+ nspec_amode, &
+ numptr_amode, numptrcw_amode
+use modal_aero_newnuc, only: adjust_factor_pbl_ratenucl
+
+
+implicit none
+
+! !PARAMETERS:
+ integer, intent(in) :: mdo_gasaerexch, mdo_rename, mdo_newnuc, mdo_coag
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns in the chunk
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: loffset ! offset applied to modal aero "ptrs"
+ integer, intent(in) :: latndx(pcols), lonndx(pcols)
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ integer, intent(in) :: nqtendbb ! dimension for q_tendbb
+ integer, intent(in) :: nqqcwtendbb ! dimension for qqcw_tendbb
+#endif
+
+ real(r8), intent(in) :: deltat ! time step (s)
+
+ real(r8), intent(inout) :: q(ncol,pver,pcnstxx) ! current tracer mixing ratios (TMRs)
+ ! these values are updated (so out /= in)
+ ! *** MUST BE #/kmol-air for number
+ ! *** MUST BE mol/mol-air for mass
+ ! *** NOTE ncol dimension
+ real(r8), intent(inout) :: qqcw(ncol,pver,pcnstxx)
+ ! like q but for cloud-borner tracers
+ ! these values are updated
+ real(r8), intent(in) :: q_pregaschem(ncol,pver,pcnstxx) ! q TMRs before gas-phase chemistry
+ real(r8), intent(in) :: q_precldchem(ncol,pver,pcnstxx) ! q TMRs before cloud chemistry
+ real(r8), intent(in) :: qqcw_precldchem(ncol,pver,pcnstxx) ! qqcw TMRs before cloud chemistry
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ real(r8), intent(inout) :: q_tendbb(ncol,pver,pcnstxx,nqtendbb) ! TMR tendencies for box-model diagnostic output
+ real(r8), intent(inout) :: qqcw_tendbb(ncol,pver,pcnstxx,nqqcwtendbb)
+#endif
+
+ real(r8), intent(in) :: t(pcols,pver) ! temperature at model levels (K)
+ real(r8), intent(in) :: pmid(pcols,pver) ! pressure at model level centers (Pa)
+ real(r8), intent(in) :: pdel(pcols,pver) ! pressure thickness of levels (Pa)
+ real(r8), intent(in) :: zm(pcols,pver) ! altitude (above ground) at level centers (m)
+ real(r8), intent(in) :: pblh(pcols) ! planetary boundary layer depth (m)
+ real(r8), intent(in) :: qv(pcols,pver) ! specific humidity (kg/kg)
+ real(r8), intent(in) :: cld(ncol,pver) ! cloud fraction (-) *** NOTE ncol dimension
+ real(r8), intent(inout) :: dgncur_a(pcols,pver,ntot_amode)
+ real(r8), intent(inout) :: dgncur_awet(pcols,pver,ntot_amode)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+ real(r8), intent(inout) :: wetdens_host(pcols,pver,ntot_amode)
+ ! interstitial aerosol wet density (kg/m3)
+ real(r8), intent(inout), optional :: &
+ qaerwat(pcols,pver,ntot_amode)
+ ! aerosol water mixing ratio (kg/kg, NOT mol/mol)
+
+! !DESCRIPTION:
+! calculates changes to gas and aerosol TMRs (tracer mixing ratios) from
+! gas-aerosol exchange (condensation/evaporation)
+! growth from smaller to larger modes (renaming) due to both
+! condensation and cloud chemistry
+! new particle nucleation
+! coagulation
+! transfer of particles from hydrophobic modes to hydrophilic modes (aging)
+! due to condensation and coagulation
+!
+! the incoming mixing ratios (q and qqcw) are updated before output
+!
+! !REVISION HISTORY:
+! RCE 07.04.13: Adapted from earlier version of CAM5 modal aerosol routines
+! for these processes
+!
+!EOP
+!----------------------------------------------------------------------
+!BOC
+
+! local variables
+ integer, parameter :: ldiag1=-1, ldiag2=-1, ldiag3=-1, ldiag4=-1
+ integer, parameter :: method_soa = 2
+! method_soa=0 is no uptake
+! method_soa=1 is irreversible uptake done like h2so4 uptake
+! method_soa=2 is reversible uptake using subr modal_aero_soaexch
+
+ integer :: i, icol_diag, ipass, iq
+ integer :: itmpa, itmpb, itmpc, itmpd
+ integer :: iqtend, iqqcwtend
+ integer :: iaer, igas
+ integer :: j, jac, jsoa, jsub
+ integer :: jclea, jcldy
+ integer :: k
+ integer :: l, l2, l3, la, lb, lc, lmz, lsfrm, lstoo
+ integer :: lun, lund
+ integer :: m
+ integer :: n, niter, niter_max, ntot_soamode
+ integer :: nsubarea, ncldy_subarea
+
+ logical :: do_cond, do_rename, do_newnuc, do_coag
+ logical :: iscldy_subarea(maxsubarea)
+
+ character(len=fieldname_len+3) :: fieldname
+ character(len=6) :: tmpch6a, tmpch6c
+ character(len=200) :: tmp_str
+
+ real (r8) :: pdel_fac
+
+!----------------------------------------------------------------------
+ logical :: history_aerocom ! Output the aerocom history
+!-----------------------------------------------------------------------
+
+
+ real(8), parameter :: fcld_locutoff = 1.0e-5_r8
+! cloud chemistry is only on when cld(i,k) >= 1.0e-5_r8
+! it may be that the macrophysics has a higher threshold that this
+ real(8), parameter :: fcld_hicutoff = 0.999_r8
+
+ real(r8) :: afracsub(maxsubarea)
+ real(r8) :: dgn_a(max_mode), dgn_awet(max_mode)
+ real(r8) :: ev_sat(pcols,pver)
+ real(r8) :: fclea, fcldy, fcldybb
+ real(r8) :: nufine_3dtend_nnuc(pcols,pver)
+ real(r8) :: ncluster_3dtend_nnuc(pcols,pver)
+ real(r8) :: qv_sat(pcols,pver)
+ real(r8) :: relhumgcm, relhumsub(maxsubarea)
+ real(r8) :: soag_3dtend_cond(pcols,pver,nsoa)
+ real(r8) :: tmpa, tmpb, tmpc
+ real(r8) :: tmp_qa_clea, tmp_qa_cldy, tmp_qa_gcav
+ real(r8) :: tmp_qc_cldy, tmp_qc_gcav
+ real(r8) :: tmp_aa, tmp_aa_clea, tmp_aa_cldy
+ real(r8) :: tmp_kxt, tmp_kxt2, tmp_pxt, tmp_pok
+ real(r8) :: tmp_q1, tmp_q2, tmp_q3, tmp_q4, tmp_q5, tmp_qdot4
+ real(r8) :: wetdens(max_mode)
+
+
+! qgcmN and qqcwgcmN (N=1:4) are grid-cell mean tracer mixing ratios (TMRs, mol/mol or #/kmol)
+! N=1 - before gas-phase chemistry
+! N=2 - before cloud chemistry
+! N=3 - incoming values (before gas-aerosol exchange, newnuc, coag)
+! N=4 - outgoing values (after gas-aerosol exchange, newnuc, coag)
+ real(r8), dimension( 1:gas_pcnst ) :: &
+ qgcm1, qgcm2, qgcm3, qgcm4, &
+ qqcwgcm1, qqcwgcm2, qqcwgcm3, qqcwgcm4
+ real(r8), dimension( 1:gas_pcnst, 1:nqtendaa ) :: &
+ qgcm_tendaa
+ real(r8), dimension( 1:gas_pcnst, 1:nqqcwtendaa ) :: &
+ qqcwgcm_tendaa
+ real(r8), dimension( 1:ntot_amode_extd ) :: &
+ qaerwatgcm3, qaerwatgcm4 ! aerosol water mixing ratios (mol/mol)
+
+! qsubN and qqcwsubN (N=1:4) are TMRs in sub-areas
+! currently there are just clear and cloudy sub-areas
+! the N=1:4 have same meanings as for qgcmN
+ real(r8), dimension( 1:gas_pcnst, 1:maxsubarea ) :: &
+ qsub1, qsub2, qsub3, qsub4, &
+ qqcwsub1, qqcwsub2, qqcwsub3, qqcwsub4
+ real(r8), dimension( 1:gas_pcnst, 1:nqtendaa, 1:maxsubarea ) :: &
+ qsub_tendaa
+ real(r8), dimension( 1:gas_pcnst, 1:nqqcwtendaa, 1:maxsubarea ) :: &
+ qqcwsub_tendaa
+ real(r8), dimension( 1:ntot_amode_extd, 1:maxsubarea ) :: &
+ qaerwatsub3, qaerwatsub4 ! aerosol water mixing ratios (mol/mol)
+
+! q_coltendaa and qqcw_coltendaa are column-integrated tendencies
+! for different processes, which are output to history
+! the processes are condensation/evaporation (and associated aging),
+! renaming, coagulation, and nucleation
+ real(r8), dimension( 1:pcols, 1:gas_pcnst, 1:nqtendaa ) :: &
+ q_coltendaa
+ real(r8), dimension( 1:pcols, 1:gas_pcnst, 1:nqqcwtendaa ) :: &
+ qqcw_coltendaa
+
+#if ( defined( MOSAIC_SPECIES ) )
+ real(r8) :: cnvrg_fail(pcols,pver) !BSINGH - For tracking MOSAIC convergence failures
+ real(r8) :: max_kelvin_iter(pcols,pver) !BSINGH - For tracking when max is hit for kelvin iterations
+ real(r8) :: xnerr_astem_negative(pcols,pver,5,4)
+#endif
+
+ type ( misc_vars_aa_type ) :: misc_vars_aa
+
+
+
+
+ adjust_factor_pbl_ratenucl = newnuc_adjust_factor_pbl
+
+#if ( defined CAM_VERSION_IS_ACME )
+ history_aerocom = .false.
+#else
+ call phys_getopts( history_aerocom_out = history_aerocom )
+#endif
+
+
+ icol_diag = -1
+ if (ldiag1 > 0) then
+ if (nstep < 3) then
+ do i = 1, ncol
+! if ((latndx(i) == 23) .and. (lonndx(i) == 37)) icol_diag = i
+ if ((latndx(i) == 47) .and. (lonndx(i) ==121)) icol_diag = i ! amazon
+ end do
+ end if
+ end if
+
+ do_cond = ( mdo_gasaerexch > 0 )
+ do_rename = ( mdo_rename > 0 )
+ do_newnuc = ( mdo_newnuc > 0 )
+ do_coag = ( mdo_coag > 0 )
+
+ q_coltendaa = 0.0_r8 ; qqcw_coltendaa = 0.0_r8
+ nufine_3dtend_nnuc = 0.0_r8
+ ncluster_3dtend_nnuc = 0.0_r8
+ soag_3dtend_cond = 0.0_r8
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+! these variables otherwise undefined
+ q_tendbb = 0.0_r8 ; qqcw_tendbb = 0.0_r8
+#endif
+
+#if ( defined( MOSAIC_SPECIES ) )
+ cnvrg_fail(1:pcols,1:pver) = 0.0_r8
+ max_kelvin_iter(1:pcols,1:pver) = 0.0_r8
+ xnerr_astem_negative(1:pcols,1:pver,1:5,1:4) = 0.0_r8
+#endif
+
+! turn off history selectively for comparison with dd06f
+ if ( (.not. do_cond) .and. (.not. do_rename) ) then
+ do_q_coltendaa(:,iqtend_cond) = .false.
+ do_q_coltendaa(:,iqtend_rnam) = .false.
+ do_qqcw_coltendaa(:,iqqcwtend_rnam) = .false.
+ end if
+ if ( .not. do_newnuc ) then
+ do_q_coltendaa(:,iqtend_nnuc) = .false.
+ end if
+ if ( .not. do_coag ) then
+ do_q_coltendaa(:,iqtend_coag) = .false.
+ end if
+
+! get saturation mixing ratio
+ call qsat( t(1:ncol,1:pver), pmid(1:ncol,1:pver), &
+ ev_sat(1:ncol,1:pver), qv_sat(1:ncol,1:pver) )
+
+main_k_loop: &
+ do k = top_lev, pver
+main_i_loop: &
+ do i = 1, ncol
+
+ if ( ldiag13n ) lun13n = 129 + i
+
+
+!
+! determine the number of sub-areas, their fractional areas, and relative humidities
+!
+! if cloud fraction ~= 0, the grid-cell has a single clear sub-area (nsubarea = 1)
+! if cloud fraction ~= 1, the grid-cell has a single cloudy sub-area (nsubarea = 1)
+! otherwise, the grid-cell has a clear and a cloudy sub-area (nsubarea = 2)
+!
+ if (cld(i,k) < fcld_locutoff) then
+! note that cloud chemistry is only on when cld(i,k) >= 1.0e-5_r8
+! it may be that the macrophysics has a higher threshold that this
+ fcldy = 0.0_r8
+ nsubarea = 1 ; ncldy_subarea = 0
+ jclea = 1 ; jcldy = 0
+ else if (cld(i,k) > fcld_hicutoff) then
+ fcldy = 1.0_r8
+ nsubarea = 1 ; ncldy_subarea = 1
+ jclea = 0 ; jcldy = 1
+ else
+ fcldy = cld(i,k)
+ nsubarea = 2 ; ncldy_subarea = 1
+ jclea = 1 ; jcldy = 2
+ end if
+ fclea = 1.0_r8 - fcldy
+ fcldybb = max( cld(i,k), 1.0e-6_r8 )
+
+ iscldy_subarea(:) = .false.
+ if (jcldy > 0) iscldy_subarea(jcldy) = .true.
+
+ afracsub(:) = 0.0_r8
+ if (jclea > 0) afracsub(jclea) = fclea
+ if (jcldy > 0) afracsub(jcldy) = fcldy
+
+ relhumgcm = max( 0.0_r8, min( 1.0_r8, qv(i,k)/qv_sat(i,k) ) )
+ if (ncldy_subarea <= 0) then
+ relhumsub(:) = relhumgcm
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ else if (cldy_rh_sameas_clear > 0) then
+ relhumsub(:) = relhumgcm
+#endif
+ else
+ relhumsub(jcldy) = 1.0_r8
+ if (jclea > 0) then
+ tmpa = (relhumgcm - afracsub(jcldy))/afracsub(jclea)
+ relhumsub(jclea) = max( 0.0_r8, min( 1.0_r8, tmpa ) )
+ end if
+ end if
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag13n ) then
+ write(lun13n,'(/a,3i5)') 'modal_aero_amicphys_intr mapping at nstep, i, k', nstep, i, k
+ write(lun13n,'(a,1p,5i12 )') 'jclea, jcldy, ncldy, nsubc', &
+ jclea, jcldy, ncldy_subarea, nsubarea
+ write(lun13n,'(a,1p,5e12.4)') 'cld, fcldy, fcldybb, fclea', &
+ cld(i,k), fcldy, fcldybb, fclea
+ write(lun13n,'(a,1p,5e12.4)') 'relhumav, relhumsub(1:2) ', &
+ relhumgcm, relhumsub(1:2)
+ end if
+#endif
+
+
+ do lmz = 1, gas_pcnst
+ qgcm1(lmz) = max( 0.0_r8, q_pregaschem(i,k,lmz) )
+ qgcm2(lmz) = max( 0.0_r8, q_precldchem(i,k,lmz) )
+ qqcwgcm2(lmz) = max( 0.0_r8, qqcw_precldchem(i,k,lmz) )
+ qgcm3(lmz) = max( 0.0_r8, q(i,k,lmz) )
+ qqcwgcm3(lmz) = max( 0.0_r8, qqcw(i,k,lmz) )
+ end do
+ qaerwatgcm3(:) = 0.0_r8
+ if ( present( qaerwat ) ) then
+ qaerwatgcm3(1:ntot_amode) = max( 0.0_r8, qaerwat(i,k,1:ntot_amode) )
+ end if
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ n = min( maxsubarea, nsubarea+1 )
+#else
+ n = nsubarea
+#endif
+ qsub1(:,1:n) = 0.0_r8
+ qsub2(:,1:n) = 0.0_r8
+ qsub3(:,1:n) = 0.0_r8
+ qsub4(:,1:n) = 0.0_r8
+ qqcwsub1(:,1:n) = 0.0_r8
+ qqcwsub2(:,1:n) = 0.0_r8
+ qqcwsub3(:,1:n) = 0.0_r8
+ qqcwsub4(:,1:n) = 0.0_r8
+ qaerwatsub3(:,1:n) = 0.0_r8
+ qaerwatsub4(:,1:n) = 0.0_r8
+
+!
+! calculate initial (i.e., before cond/rnam/nnuc/coag) tracer mixing ratios within the sub-areas
+! for all-clear or all-cloudy cases, the sub-area TMRs are equal to the grid-cell means
+! for partly cloudy case, they are different. This is primarily because the
+! interstitial aerosol mixing ratios are assumed lower in the cloudy sub-area than in
+! the clear sub-area, because much of the aerosol is activated in the cloudy sub-area.
+!
+ if ( (jclea > 0) .and. (jcldy > 0) .and. &
+ (jclea+jcldy == 3) .and. (nsubarea == 2) ) then
+! partly cloudy case
+
+! set gas mixing ratios in sub-areas (for the condensing gases only!!)
+ do lmz = 1, gas_pcnst
+ if (lmapcc_all(lmz) /= lmapcc_val_gas) cycle
+
+ ! assume gas in both sub-areas before gas-chem and cloud-chem equal grid-cell mean
+ qsub1(lmz,1:nsubarea) = qgcm1(lmz)
+ qsub2(lmz,1:nsubarea) = qgcm2(lmz)
+
+ ! assume gas in clear sub-area after cloud-chem equals before cloud-chem value
+ qsub3(lmz,jclea) = qsub2(lmz,jclea)
+ ! gas in cloud sub-area then determined by grid-cell mean and clear values
+ qsub3(lmz,jcldy) = (qgcm3(lmz) - fclea*qsub3(lmz,jclea))/fcldy
+ ! check that this does not produce a negative value
+ if (qsub3(lmz,jcldy) < 0.0_r8) then
+ qsub3(lmz,jcldy) = 0.0_r8
+ qsub3(lmz,jclea) = qgcm3(lmz)/fclea
+ end if
+ end do
+
+! set aerosol mixing ratios in sub-areas
+ do n = 1, ntot_amode
+
+ do l2 = 0, nspec_amode(n)
+
+ if (l2 <= 1) then
+ ! calculcate partitioning factors
+ if (l2 == 0) then
+ la = numptr_amode(n) - loffset
+ lc = numptrcw_amode(n) - loffset
+ tmp_qa_gcav = qgcm2(la)
+ tmp_qc_gcav = qqcwgcm2(lc)
+ else
+ tmp_qa_gcav = 0.0_r8
+ tmp_qc_gcav = 0.0_r8
+ do l3 = 1, nspec_amode(n)
+ la = lmassptr_amode(l3,n) - loffset
+ tmp_qa_gcav = tmp_qa_gcav + qgcm2(la)
+ lc = lmassptrcw_amode(l3,n) - loffset
+ tmp_qc_gcav = tmp_qc_gcav + qqcwgcm2(lc)
+ end do
+ end if
+
+ tmp_qc_cldy = tmp_qc_gcav/fcldy
+ tmp_qa_cldy = max( 0.0_r8, ((tmp_qa_gcav+tmp_qc_gcav) - tmp_qc_cldy) )
+ tmp_qa_clea = (tmp_qa_gcav - fcldy*tmp_qa_cldy)/fclea
+
+ ! *** question ***
+ ! use same tmp_aa_clea/cldy for everything ?
+ ! use one for number and one for all masses (based on total mass) ?
+ ! use separate ones for everything ?
+ ! maybe one for number and one for all masses is best,
+ ! because number and mass have different activation fractions
+ ! *** question ***
+ tmp_aa = max( 1.e-35_r8, tmp_qa_clea*fclea ) / max( 1.e-35_r8, tmp_qa_gcav )
+ tmp_aa = max( 0.0_r8, min( 1.0_r8, tmp_aa ) )
+ tmp_aa_clea = tmp_aa/fclea
+ tmp_aa_cldy = (1.0_r8-tmp_aa)/fcldy
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( n <= 2 .and. ldiag13n ) then
+ if (n==1 .and. l2==0) write(lun13n,'(a)')
+ write(lun13n,'(a,2i3, 1p,6e12.4)') 'n, l2, tmp_aa, tmp_aa_clea, tmp_aa_cldy', &
+ n, l2, tmp_aa, tmp_aa_clea, tmp_aa_cldy
+ tmpa = 1.0e-6_r8*mwhost_num/mwdry
+ if (l2 > 0) tmpa = 1.0e9_r8
+ write(lun13n,'(a, 6x, 1p,6e12.4)') 'qct, qcy, qat, qay, qax, qtt ', &
+ tmpa*tmp_qc_gcav, tmpa*tmp_qc_cldy, tmpa*tmp_qa_gcav, &
+ tmpa*tmp_qa_cldy, tmpa*tmp_qa_clea, tmpa*(tmp_qc_gcav+tmp_qa_gcav)
+ end if
+#endif
+ end if ! (l2 <= 1)
+
+ if (l2 == 0) then
+ la = numptr_amode(n) - loffset
+ lc = numptrcw_amode(n) - loffset
+ else
+ la = lmassptr_amode(l2,n) - loffset
+ lc = lmassptrcw_amode(l2,n) - loffset
+ end if
+
+ qsub2(la,jclea) = qgcm2(la)*tmp_aa_clea
+ qsub2(la,jcldy) = qgcm2(la)*tmp_aa_cldy
+ qqcwsub2(lc,jclea) = 0.0_r8
+ qqcwsub2(lc,jcldy) = qqcwgcm2(lc)/fcldy
+
+ qsub3(la,jclea) = qgcm3(la)*tmp_aa_clea
+ qsub3(la,jcldy) = qgcm3(la)*tmp_aa_cldy
+ qqcwsub3(lc,jclea) = 0.0_r8
+ qqcwsub3(lc,jcldy) = qqcwgcm3(lc)/fcldy
+
+ end do ! l2
+ end do ! n
+
+ else if ((jclea == 1) .and. (jcldy == 0) .and. (nsubarea == 1)) then
+! all clear, or cld < 1e-5
+! in this case, fclea=1 and fcldy=0
+!
+! put all the gases and interstitial aerosols in the clear sub-area
+! and set mix-ratios = 0 in cloudy sub-area
+! for cloud-borne aerosol, do nothing
+! because the grid-cell-mean cloud-borne aerosol will be left unchanged
+! (i.e., this routine only changes qqcw when cld >= 1e-5)
+!
+ do lmz = 1, gas_pcnst
+ if (lmapcc_all(lmz) <= 0) cycle
+ qsub1(lmz,jclea) = qgcm1(lmz)
+ qsub2(lmz,jclea) = qgcm2(lmz)
+ qsub3(lmz,jclea) = qgcm3(lmz)
+ qqcwsub2(lmz,jclea) = qqcwgcm2(lmz)
+ qqcwsub3(lmz,jclea) = qqcwgcm3(lmz)
+ end do
+
+ else if ((jclea == 0) .and. (jcldy == 1) .and. (nsubarea == 1)) then
+! all cloudy, or cld > 0.999
+! in this case, fcldy= and fclea=0
+!
+! put all the gases and interstitial aerosols in the cloudy sub-area
+! and set mix-ratios = 0 in clear sub-area
+!
+ do lmz = 1, gas_pcnst
+ if (lmapcc_all(lmz) <= 0) cycle
+ qsub1(lmz,jcldy) = qgcm1(lmz)
+ qsub2(lmz,jcldy) = qgcm2(lmz)
+ qsub3(lmz,jcldy) = qgcm3(lmz)
+ qqcwsub2(lmz,jcldy) = qqcwgcm2(lmz)
+ qqcwsub3(lmz,jcldy) = qqcwgcm3(lmz)
+ end do
+
+ else
+! this should not happen
+ write(tmp_str,'(a,3(1x,i10))') &
+ '*** modal_aero_amicphys - bad jclea, jcldy, nsubarea', &
+ jclea, jcldy, nsubarea
+ call endrun( tmp_str )
+ end if
+
+! aerosol water -- how to treat this in sub-areas needs more work/thinking
+! currently modal_aero_water_uptake calculates qaerwat using
+! the grid-cell mean interstital-aerosol mix-rats and the clear-area rh
+ do jsub = 1, nsubarea
+ qaerwatsub3(:,jsub) = qaerwatgcm3(:)
+ end do
+
+ if (nsubarea == 1) then
+! the j=2 subarea is used for some diagnostics
+! but is not used in actual calculations
+ j = 2
+ qsub1(:,j) = 0.0_r8
+ qsub2(:,j) = 0.0_r8
+ qsub3(:,j) = 0.0_r8
+ qqcwsub2(:,j) = 0.0_r8
+ qqcwsub3(:,j) = 0.0_r8
+ end if
+
+
+! diagnostics after forming sub-areas
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag13n ) then
+ do l2 = 1, 4
+ if (l2 == 1) then
+ igas = igas_h2so4
+ else if (l2 == 3) then
+ igas = igas_nh3
+ if (igas <= 0) cycle
+ else if (l2 == 4) then
+ igas = -3
+ else
+ igas = 1
+ end if
+ if (igas > 0) then
+ l = lmap_gas(igas)
+ tmpch6a = name_gas(igas)
+ else
+ l = -igas
+ tmpch6a = cnst_name(l+loffset)
+ end if
+ tmpa = 1.0e9
+ write(lun13n,'(a)')
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' host 1-3', &
+ q_pregaschem(i,k,l)*tmpa, q_precldchem(i,k,l)*tmpa, q(i,k,l)*tmpa
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' gm 1-3', &
+ qgcm1(l)*tmpa, qgcm2(l)*tmpa, qgcm3(l)*tmpa
+ j = jclea ; if (j <= 0) j = nsubarea+1
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' clear 1-3', &
+ qsub1(l,j)*tmpa, qsub2(l,j)*tmpa, qsub3(l,j)*tmpa
+ j = jcldy ; if (j <= 0) j = nsubarea+1
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' cloud 1-3', &
+ qsub1(l,j)*tmpa, qsub2(l,j)*tmpa, qsub3(l,j)*tmpa
+ end do ! l2
+
+ n = 1
+ do l2 = 1, 3
+ if (l2 == 1) then
+ tmpa = 1.0e-6_r8/28.966_r8
+ la = lmap_num(n)
+ lc = lmap_numcw(n)
+ tmpch6a = name_num(n)
+ tmpch6c = name_numcw(n)
+ else
+ if (l2 == 2) then
+ iaer = iaer_so4
+ else
+ iaer = iaer_soa
+ end if
+ tmpa = 1.0e9_r8
+ la = lmap_aer(iaer,n)
+ lc = lmap_aercw(iaer,n)
+ tmpch6a = name_aer(iaer,n)
+ tmpch6c = name_aercw(iaer,n)
+ end if
+ write(lun13n,'(a)')
+ write(lun13n,'(4a,1p,2(2x,2e12.4))') tmpch6a, ' host 2-3; ', tmpch6c, ' ...', &
+ q_precldchem(i,k,la)*tmpa, q(i,k,la)*tmpa, &
+ qqcw_precldchem(i,k,lc)*tmpa, qqcw(i,k,lc)*tmpa
+ write(lun13n,'(4a,1p,2(2x,2e12.4))') tmpch6a, ' gm 2-3; ', tmpch6c, ' ...', &
+ qgcm2(la)*tmpa, qgcm3(la)*tmpa, &
+ qqcwgcm2(lc)*tmpa, qqcwgcm3(lc)*tmpa
+ j = jclea ; if (j <= 0) j = nsubarea+1
+ write(lun13n,'(4a,1p,2(2x,2e12.4))') tmpch6a, ' clear 2-3; ', tmpch6c, ' ...', &
+ qsub2(la,j)*tmpa, qsub3(la,j)*tmpa, &
+ qqcwsub2(lc,j)*tmpa, qqcwsub3(lc,j)*tmpa
+ j = jcldy ; if (j <= 0) j = nsubarea+1
+ write(lun13n,'(4a,1p,2(2x,2e12.4))') tmpch6a, ' cloud 2-3; ', tmpch6c, ' ...', &
+ qsub2(la,j)*tmpa, qsub3(la,j)*tmpa, &
+ qqcwsub2(lc,j)*tmpa, qqcwsub3(lc,j)*tmpa
+ end do ! l2
+ end if ! ( ldiag13n )
+#endif
+
+!
+! start integration
+!
+ do n = 1, max_mode
+ if (n <= ntot_amode) then
+ dgn_a(n) = dgncur_a(i,k,n)
+ dgn_awet(n) = dgncur_awet(i,k,n)
+ wetdens(n) = max( 1000.0_r8, wetdens_host(i,k,n) )
+ else
+ dgn_a(n) = 0.0_r8
+ dgn_awet(n) = 0.0_r8
+ wetdens(n) = 1000.0_r8
+ end if
+ end do
+
+ misc_vars_aa%ncluster_tend_nnuc_1grid = ncluster_3dtend_nnuc(i,k)
+#if ( defined ( MOSAIC_SPECIES ) )
+ misc_vars_aa%cnvrg_fail_1grid = cnvrg_fail(i,k)
+ misc_vars_aa%max_kelvin_iter_1grid = max_kelvin_iter(i,k)
+ misc_vars_aa%xnerr_astem_negative_1grid(1:5,1:4) = xnerr_astem_negative(pcols,pver,1:5,1:4)
+#endif
+
+
+ lund = iulog ! for cambox, iulog=93 at this point
+
+! ubroutine mam_amicphys_1gridcell( &
+! do_cond, do_rename, &
+! do_newnuc, do_coag, &
+! nstep, lchnk, i, k, &
+! latndx, lonndx, lund, &
+! loffset, deltat, &
+! nsubarea, ncldy_subarea, &
+! iscldy_subarea, afracsub, &
+! temp, pmid, pdel, &
+! zmid, pblh, relhumsub, &
+! dgn_a, dgn_awet, wetdens, &
+! qsub1, &
+! qsub2, qqcwsub2, &
+! qsub3, qqcwsub3, &
+! qsub4, qqcwsub4, &
+! qsub_tendaa, qqcwsub_tendaa )
+
+ call mam_amicphys_1gridcell( &
+ do_cond, do_rename, &
+ do_newnuc, do_coag, &
+ nstep, lchnk, i, k, &
+ latndx(i), lonndx(i), lund, &
+ loffset, deltat, &
+ nsubarea, ncldy_subarea, &
+ iscldy_subarea, afracsub, &
+ t(i,k), pmid(i,k), pdel(i,k), &
+ zm(i,k), pblh(i), relhumsub, &
+ dgn_a, dgn_awet, wetdens, &
+ qsub1, &
+ qsub2, qqcwsub2, &
+ qsub3, qqcwsub3, qaerwatsub3, &
+ qsub4, qqcwsub4, qaerwatsub4, &
+ qsub_tendaa, qqcwsub_tendaa, &
+ misc_vars_aa )
+
+
+!
+! form new grid-mean mix-ratios
+!
+ if (nsubarea == 1) then
+ qgcm4(:) = qsub4(:,1)
+ qgcm_tendaa(:,:) = qsub_tendaa(:,:,1)
+ qaerwatgcm4(1:ntot_amode) = qaerwatsub4(1:ntot_amode,1)
+ else
+ qgcm4(:) = 0.0_r8
+ qgcm_tendaa(:,:) = 0.0_r8
+ do j = 1, nsubarea
+ qgcm4(:) = qgcm4(:) + qsub4(:,j)*afracsub(j)
+ qgcm_tendaa(:,:) = qgcm_tendaa(:,:) + qsub_tendaa(:,:,j)*afracsub(j)
+ end do
+ ! for aerosol water use the clear sub-area value
+ qaerwatgcm4(1:ntot_amode) = qaerwatsub4(1:ntot_amode,jclea)
+ end if
+
+ if (ncldy_subarea <= 0) then
+ qqcwgcm4(:) = qqcwgcm3(:)
+ qqcwgcm_tendaa(:,:) = 0.0_r8
+ else if (nsubarea == 1) then
+ qqcwgcm4(:) = qqcwsub4(:,1)
+ qqcwgcm_tendaa(:,:) = qqcwsub_tendaa(:,:,1)
+ else
+ qqcwgcm4(:) = 0.0_r8
+ qqcwgcm_tendaa(:,:) = 0.0_r8
+ do j = 1, nsubarea
+ if ( .not. iscldy_subarea(j) ) cycle
+ qqcwgcm4(:) = qqcwgcm4(:) + qqcwsub4(:,j)*afracsub(j)
+ qqcwgcm_tendaa(:,:) = qqcwgcm_tendaa(:,:) + qqcwsub_tendaa(:,:,j)*afracsub(j)
+ end do
+ end if
+
+ do lmz = 1, gas_pcnst
+ if (lmapcc_all(lmz) > 0) then
+ q(i,k,lmz) = qgcm4(lmz)
+ if (lmapcc_all(lmz) >= lmapcc_val_aer) then
+ qqcw(i,k,lmz) = qqcwgcm4(lmz)
+ end if
+ end if
+ end do
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if (iqtend_cond <= nqtendbb) q_tendbb(i,k,:,iqtend_cond) = qgcm_tendaa(:,iqtend_cond)
+ if (iqtend_rnam <= nqtendbb) q_tendbb(i,k,:,iqtend_rnam) = qgcm_tendaa(:,iqtend_rnam)
+ if (iqtend_nnuc <= nqtendbb) q_tendbb(i,k,:,iqtend_nnuc) = qgcm_tendaa(:,iqtend_nnuc)
+ if (iqtend_coag <= nqtendbb) q_tendbb(i,k,:,iqtend_coag) = qgcm_tendaa(:,iqtend_coag)
+ if (iqqcwtend_rnam <= nqqcwtendbb) qqcw_tendbb(i,k,:,iqqcwtend_rnam) = qqcwgcm_tendaa(:,iqqcwtend_rnam)
+#endif
+ if ( update_qaerwat > 0 .and. present( qaerwat ) ) then
+ qaerwat(i,k,1:ntot_amode) = qaerwatgcm4(1:ntot_amode)
+ end if
+
+
+! diagnostics after forming sub-areas
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag13n ) then
+ do l2 = 1, 4
+ if (l2 == 1) then
+ igas = igas_h2so4
+ else if (l2 == 3) then
+ igas = igas_nh3
+ if (igas <= 0) cycle
+ else if (l2 == 4) then
+ igas = -3
+ else
+ igas = 1
+ end if
+ if (igas > 0) then
+ l = lmap_gas(igas)
+ tmpch6a = name_gas(igas)
+ else
+ l = -igas
+ tmpch6a = cnst_name(l+loffset)
+ end if
+ tmpa = 1.0e9
+ write(lun13n,'(a)')
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' host 1-4', &
+ q_pregaschem(i,k,l)*tmpa, q_precldchem(i,k,l)*tmpa, 0.0, q(i,k,l)*tmpa
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' gm 1-4', &
+ qgcm1(l)*tmpa, qgcm2(l)*tmpa, qgcm3(l)*tmpa, qgcm4(l)*tmpa
+ j = jclea ; if (j <= 0) j = nsubarea+1
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' clear 1-4', &
+ qsub1(l,j)*tmpa, qsub2(l,j)*tmpa, qsub3(l,j)*tmpa, qsub4(l,j)*tmpa
+ j = jcldy ; if (j <= 0) j = nsubarea+1
+ write(lun13n,'(2a,1p,4e12.4)') tmpch6a, ' cloud 1-4', &
+ qsub1(l,j)*tmpa, qsub2(l,j)*tmpa, qsub3(l,j)*tmpa, qsub4(l,j)*tmpa
+ end do ! l2
+ end if ! ( ldiag13n )
+#endif
+
+
+! increment column tendencies
+ pdel_fac = pdel(i,k)/gravit
+ do iqtend = 1, nqtendaa
+ do l = 1, gas_pcnst
+ if ( do_q_coltendaa(l,iqtend) ) then
+ q_coltendaa(i,l,iqtend) = q_coltendaa(i,l,iqtend) + qgcm_tendaa(l,iqtend)*pdel_fac
+ end if
+ if (iqtend <= nqqcwtendaa) then
+ if ( do_qqcw_coltendaa(l,iqtend) ) then
+ qqcw_coltendaa(i,l,iqtend) = qqcw_coltendaa(i,l,iqtend) + qqcwgcm_tendaa(l,iqtend)*pdel_fac
+ end if
+ end if
+ end do ! l
+ end do ! iqtend
+
+ if ( history_aerocom ) then
+ ! 3d soa tendency for aerocom
+ ! note that flux units (kg/m2/s) are used here instead of tendency units (kg/kg/s or kg/m3/s)
+ do jsoa = 1, nsoa
+ l = lptr2_soa_g_amode(jsoa) - loffset
+ soag_3dtend_cond(i,k,jsoa) = qgcm_tendaa(l,iqtend_cond)*(adv_mass(l)/mwdry)*(pdel(i,k)/gravit)
+ end do
+ ! 3d number nucleation tendency for aerocom - units are (#/m3/s)
+ ! so multiply qgcm_tendaa (#/kmol/s) by air molar density (kmol/m3)
+ l = numptr_amode(nait) - loffset
+ nufine_3dtend_nnuc(i,k) = qgcm_tendaa(l,iqtend_nnuc) * (pmid(i,k)/(r_universal*t(i,k)))
+ end if
+
+
+ ncluster_3dtend_nnuc(i,k) = misc_vars_aa%ncluster_tend_nnuc_1grid
+#if ( defined ( MOSAIC_SPECIES ) )
+ cnvrg_fail(i,k) = misc_vars_aa%cnvrg_fail_1grid
+ max_kelvin_iter(i,k) = misc_vars_aa%max_kelvin_iter_1grid
+ xnerr_astem_negative(pcols,pver,1:5,1:4) = misc_vars_aa%xnerr_astem_negative_1grid(1:5,1:4)
+#endif
+
+ end do main_i_loop
+
+ end do main_k_loop
+
+
+! output column tendencies to history
+! the ordering here is to allow comparison of fort.90 files from box model testing
+! but is not important for regular cam simulations
+ do ipass = 1, 3
+
+ if (ipass == 1) then
+ itmpa = iqtend_cond ; itmpb = iqtend_rnam
+ itmpc = iqqcwtend_rnam ; itmpd = iqqcwtend_rnam
+ else if (ipass == 2) then
+ itmpa = iqtend_nnuc ; itmpb = iqtend_nnuc
+ itmpc = 0 ; itmpd = 0
+ else
+ itmpa = iqtend_coag ; itmpb = iqtend_coag
+ itmpc = 0 ; itmpd = 0
+ end if
+
+ do l = 1, gas_pcnst
+ do iqtend = itmpa, itmpb
+ if (iqtend <= 0) cycle
+ if ( do_q_coltendaa(l,iqtend) ) then
+ q_coltendaa(1:ncol,l,iqtend) = q_coltendaa(1:ncol,l,iqtend)*(adv_mass(l)/mwdry)
+ fieldname = trim(cnst_name(l+loffset)) // suffix_q_coltendaa(iqtend)
+ call outfld( fieldname, q_coltendaa(1:ncol,l,iqtend), ncol, lchnk )
+ end if
+ end do ! iqtend
+ do iqqcwtend = itmpc, itmpd
+ if (iqqcwtend <= 0) cycle
+ if ( do_qqcw_coltendaa(l,iqqcwtend) ) then
+ qqcw_coltendaa(1:ncol,l,iqqcwtend) = qqcw_coltendaa(1:ncol,l,iqqcwtend)* (adv_mass(l)/mwdry)
+ fieldname = trim(cnst_name_cw(l+loffset)) // suffix_qqcw_coltendaa(iqqcwtend)
+ call outfld( fieldname, qqcw_coltendaa(1:ncol,l,iqqcwtend), ncol, lchnk )
+ end if
+ end do ! iqqcwtend
+ end do ! l
+
+ if ( ipass==1 .and. history_aerocom ) then
+ do jsoa = 1, nsoa
+ l = lptr2_soa_g_amode(jsoa)
+ fieldname = trim(cnst_name(l)) // '_sfgaex3d'
+ call outfld( fieldname, soag_3dtend_cond(1:ncol,:,jsoa), ncol, lchnk )
+ end do
+ l = numptr_amode(nait)
+ fieldname = trim(cnst_name(l)) // '_nuc1'
+ call outfld( fieldname, nufine_3dtend_nnuc(1:ncol,:), ncol, lchnk )
+ fieldname = trim(cnst_name(l)) // '_nuc2'
+ call outfld( fieldname, ncluster_3dtend_nnuc(1:ncol,:), ncol, lchnk )
+ end if
+
+ end do ! ipass
+
+#if ( defined( MOSAIC_SPECIES ) )
+ if ( mosaic ) then
+ !BSINGH - output MOSAIC convergence fail tracking:
+ call outfld( 'convergence_fail', cnvrg_fail(1:ncol,:), ncol, lchnk )
+ call outfld( 'max_kelvin_iter' , max_kelvin_iter(1:ncol,:), ncol, lchnk )
+
+ do n = 1, 4
+ do m = 1, 5
+ fieldname = ' '
+ write( fieldname(1:16), '(a,i1,a,i1)') 'astem_negval_', m, '_', n
+ call outfld( fieldname, xnerr_astem_negative(1:ncol,1:pver,m,n), ncol, lchnk )
+ end do
+ end do
+ end if
+#endif
+
+ return
+!EOC
+ end subroutine modal_aero_amicphys_intr
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine mam_amicphys_1gridcell( &
+ do_cond, do_rename, &
+ do_newnuc, do_coag, &
+ nstep, lchnk, i, k, &
+ latndx, lonndx, lund, &
+ loffset, deltat, &
+ nsubarea, ncldy_subarea, &
+ iscldy_subarea, afracsub, &
+ temp, pmid, pdel, &
+ zmid, pblh, relhumsub, &
+ dgn_a, dgn_awet, wetdens, &
+ qsub1, &
+ qsub2, qqcwsub2, &
+ qsub3, qqcwsub3, qaerwatsub3, &
+ qsub4, qqcwsub4, qaerwatsub4, &
+ qsub_tendaa, qqcwsub_tendaa, &
+ misc_vars_aa )
+!
+! calculates changes to gas and aerosol sub-area TMRs (tracer mixing ratios)
+! for the current grid cell (with indices = lchnk,i,k)
+! qsub3 and qqcwsub3 are the incoming current TMRs
+! qsub4 and qqcwsub4 are the outgoing updated TMRs
+!
+ logical, intent(in) :: do_cond, do_rename, do_newnuc, do_coag
+ logical, intent(in) :: iscldy_subarea(maxsubarea)
+
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: loffset
+ integer, intent(in) :: nsubarea, ncldy_subarea
+
+ real(r8), intent(in) :: deltat ! time step (s)
+ real(r8), intent(in) :: afracsub(maxsubarea) ! sub-area fractional area (0-1)
+
+ real(r8), intent(in) :: temp ! temperature at model levels (K)
+ real(r8), intent(in) :: pmid ! pressure at layer center (Pa)
+ real(r8), intent(in) :: pdel ! pressure thickness of layer (Pa)
+ real(r8), intent(in) :: zmid ! altitude (above ground) at layer center (m)
+ real(r8), intent(in) :: pblh ! planetary boundary layer depth (m)
+ real(r8), intent(in) :: relhumsub(maxsubarea) ! sub-area relative humidity (0-1)
+ real(r8), intent(inout) :: dgn_a(max_mode)
+ real(r8), intent(inout) :: dgn_awet(max_mode)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+ real(r8), intent(inout) :: wetdens(max_mode)
+ ! interstitial aerosol wet density (kg/m3)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+
+! qsubN and qqcwsubN (N=1:4) are tracer mixing ratios (TMRs, mol/mol or #/kmol) in sub-areas
+! currently there are just clear and cloudy sub-areas
+! the N=1:4 have same meanings as for qgcmN
+! N=1 - before gas-phase chemistry
+! N=2 - before cloud chemistry
+! N=3 - incoming values (before gas-aerosol exchange, newnuc, coag)
+! N=4 - outgoing values (after gas-aerosol exchange, newnuc, coag)
+ real(r8), intent(in ), dimension( 1:gas_pcnst, 1:maxsubarea ) :: &
+ qsub1, qsub2, qsub3, qqcwsub2, qqcwsub3
+ real(r8), intent(inout), dimension( 1:gas_pcnst, 1:maxsubarea ) :: &
+ qsub4, qqcwsub4
+ real(r8), intent(inout), dimension( 1:ntot_amode_extd, 1:maxsubarea ) :: &
+ qaerwatsub3, qaerwatsub4 ! aerosol water mixing ratios (mol/mol)
+! qsub_tendaa and qqcwsub_tendaa are TMR tendencies
+! for different processes, which are used to produce history output
+! the processes are condensation/evaporation (and associated aging),
+! renaming, coagulation, and nucleation
+ real(r8), intent(inout), dimension( 1:gas_pcnst, 1:nqtendaa, 1:maxsubarea ) :: &
+ qsub_tendaa
+ real(r8), intent(inout), dimension( 1:gas_pcnst, 1:nqqcwtendaa, 1:maxsubarea ) :: &
+ qqcwsub_tendaa
+ type ( misc_vars_aa_type ), intent(inout) :: misc_vars_aa
+
+! local
+ integer :: iaer, igas
+ integer :: jsub
+ integer :: l
+ integer :: n
+ logical :: do_cond_sub, do_rename_sub, do_newnuc_sub, do_coag_sub
+ logical :: do_map_gas_sub
+
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas1, qgas2, qgas3, qgas4
+ real(r8), dimension( 1:max_mode ) :: &
+ qnum2, qnum3, qnum4, &
+ qnumcw2, qnumcw3, qnumcw4
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer2, qaer3, qaer4, &
+ qaercw2, qaercw3, qaercw4
+ real(r8), dimension( 1:max_mode ) :: &
+ qwtr3, qwtr4
+
+ real(r8), dimension( 1:max_gas, 1:nqtendaa ) :: &
+ qgas_delaa
+ real(r8), dimension( 1:max_mode, 1:nqtendaa ) :: &
+ qnum_delaa
+ real(r8), dimension( 1:max_mode, 1:nqqcwtendaa ) :: &
+ qnumcw_delaa
+ real(r8), dimension( 1:max_aer, 1:max_mode, 1:nqtendaa ) :: &
+ qaer_delaa
+ real(r8), dimension( 1:max_aer, 1:max_mode, 1:nqqcwtendaa ) :: &
+ qaercw_delaa
+
+ real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf, tmpn
+
+ type ( misc_vars_aa_type ), dimension(nsubarea) :: misc_vars_aa_sub
+
+
+! the q--4 values will be equal to q--3 values unless they get changed
+ qsub4(:,1:nsubarea) = qsub3(:,1:nsubarea)
+ qqcwsub4(:,1:nsubarea) = qqcwsub3(:,1:nsubarea)
+ qaerwatsub4(:,1:nsubarea) = qaerwatsub3(:,1:nsubarea)
+
+ qsub_tendaa(:,:,1:nsubarea) = 0.0_r8
+ qqcwsub_tendaa(:,:,1:nsubarea) = 0.0_r8
+
+ do jsub = 1, nsubarea
+ misc_vars_aa_sub(jsub) = misc_vars_aa
+ end do
+
+
+main_jsub_loop: &
+ do jsub = 1, nsubarea
+
+ if ( iscldy_subarea(jsub) .eqv. .true. ) then
+ do_cond_sub = do_cond
+ do_rename_sub = do_rename
+ do_newnuc_sub = .false.
+ do_coag_sub = .false.
+ if (mdo_gaexch_cldy_subarea <= 0) do_cond_sub = .false.
+ else
+ do_cond_sub = do_cond
+ do_rename_sub = do_rename
+ do_newnuc_sub = do_newnuc
+ do_coag_sub = do_coag
+ end if
+ do_map_gas_sub = do_cond_sub .or. do_newnuc_sub
+
+
+! map incoming sub-area mix-ratios to gas/aer/num arrays
+
+ qgas1(:) = 0.0_r8
+ qgas2(:) = 0.0_r8
+ qgas3(:) = 0.0_r8
+ qgas4(:) = 0.0_r8
+ if ( do_map_gas_sub .eqv. .true. ) then
+! for cldy subarea, only do gases if doing gaexch
+ do igas = 1, ngas
+ l = lmap_gas(igas)
+ qgas1(igas) = qsub1(l,jsub)*fcvt_gas(igas)
+ qgas2(igas) = qsub2(l,jsub)*fcvt_gas(igas)
+ qgas3(igas) = qsub3(l,jsub)*fcvt_gas(igas)
+ qgas4(igas) = qgas3(igas)
+ end do
+ end if
+
+ qaer2(:,:) = 0.0_r8
+ qnum2(:) = 0.0_r8
+ qaer3(:,:) = 0.0_r8
+ qnum3(:) = 0.0_r8
+ qaer4(:,:) = 0.0_r8
+ qnum4(:) = 0.0_r8
+ qwtr3(:) = 0.0_r8
+ qwtr4(:) = 0.0_r8
+ do n = 1, ntot_amode
+ l = lmap_num(n)
+ qnum2(n) = qsub2(l,jsub)*fcvt_num
+ qnum3(n) = qsub3(l,jsub)*fcvt_num
+ qnum4(n) = qnum3(n)
+ do iaer = 1, naer
+ l = lmap_aer(iaer,n)
+ if (l > 0) then
+ qaer2(iaer,n) = qsub2(l,jsub)*fcvt_aer(iaer)
+ qaer3(iaer,n) = qsub3(l,jsub)*fcvt_aer(iaer)
+ qaer4(iaer,n) = qaer3(iaer,n)
+ end if
+ end do
+ qwtr3(n) = qaerwatsub3(n,jsub)*fcvt_wtr
+ qwtr4(n) = qwtr3(n)
+ end do ! n
+
+ if ( iscldy_subarea(jsub) .eqv. .true. ) then
+! only do cloud-borne for cloudy
+ qaercw2(:,:) = 0.0_r8
+ qnumcw2(:) = 0.0_r8
+ qaercw3(:,:) = 0.0_r8
+ qnumcw3(:) = 0.0_r8
+ qaercw4(:,:) = 0.0_r8
+ qnumcw4(:) = 0.0_r8
+ do n = 1, ntot_amode
+ l = lmap_numcw(n)
+ qnumcw2(n) = qqcwsub2(l,jsub)*fcvt_num
+ qnumcw3(n) = qqcwsub3(l,jsub)*fcvt_num
+ qnumcw4(n) = qnumcw3(n)
+ do iaer = 1, naer
+ l = lmap_aercw(iaer,n)
+ if (l > 0) then
+ qaercw2(iaer,n) = qqcwsub2(l,jsub)*fcvt_aer(iaer)
+ qaercw3(iaer,n) = qqcwsub3(l,jsub)*fcvt_aer(iaer)
+ qaercw4(iaer,n) = qaercw3(iaer,n)
+ end if
+ end do
+ end do ! n
+ end if
+
+
+ if ( iscldy_subarea(jsub) .eqv. .true. ) then
+
+ call mam_amicphys_1subarea_cloudy( &
+ do_cond_sub, do_rename_sub, &
+ do_newnuc_sub, do_coag_sub, &
+ nstep, lchnk, i, k, &
+ latndx, lonndx, lund, &
+ loffset, deltat, &
+ jsub, nsubarea, &
+ iscldy_subarea(jsub), afracsub(jsub), &
+ temp, pmid, pdel, &
+ zmid, pblh, relhumsub(jsub), &
+ dgn_a, dgn_awet, wetdens, &
+ qgas1, qgas3, qgas4, &
+ qgas_delaa, &
+ qnum3, qnum4, &
+ qnum_delaa, &
+ qaer2, qaer3, qaer4, &
+ qaer_delaa, &
+ qwtr3, qwtr4, &
+ qnumcw3, qnumcw4, &
+ qnumcw_delaa, &
+ qaercw2, qaercw3, qaercw4, &
+ qaercw_delaa, &
+ misc_vars_aa_sub(jsub) )
+
+ else
+
+ call mam_amicphys_1subarea_clear( &
+ do_cond_sub, do_rename_sub, &
+ do_newnuc_sub, do_coag_sub, &
+ nstep, lchnk, i, k, &
+ latndx, lonndx, lund, &
+ loffset, deltat, &
+ jsub, nsubarea, &
+ iscldy_subarea(jsub), afracsub(jsub), &
+ temp, pmid, pdel, &
+ zmid, pblh, relhumsub(jsub), &
+ dgn_a, dgn_awet, wetdens, &
+ qgas1, qgas3, qgas4, &
+ qgas_delaa, &
+ qnum3, qnum4, qnum_delaa, &
+ qaer3, qaer4, qaer_delaa, &
+ qwtr3, qwtr4, &
+ misc_vars_aa_sub(jsub) )
+
+ end if
+
+ if ((nsubarea == 1) .or. (iscldy_subarea(jsub) .eqv. .false.)) then
+ misc_vars_aa%ncluster_tend_nnuc_1grid = misc_vars_aa%ncluster_tend_nnuc_1grid &
+ + misc_vars_aa_sub(jsub)%ncluster_tend_nnuc_1grid*afracsub(jsub)
+#if ( defined ( MOSAIC_SPECIES ) )
+ misc_vars_aa%cnvrg_fail_1grid = misc_vars_aa_sub(jsub)%cnvrg_fail_1grid
+ misc_vars_aa%max_kelvin_iter_1grid = misc_vars_aa_sub(jsub)%max_kelvin_iter_1grid
+ misc_vars_aa%xnerr_astem_negative_1grid(1:5,1:4) = misc_vars_aa_sub(jsub)%xnerr_astem_negative_1grid(1:5,1:4)
+#endif
+ end if
+
+
+
+! map gas/aer/num arrays (mix-ratio and del=change) back to sub-area arrays
+
+ if ( do_map_gas_sub .eqv. .true. ) then
+ do igas = 1, ngas
+ l = lmap_gas(igas)
+ qsub4(l,jsub) = qgas4(igas)/fcvt_gas(igas)
+ qsub_tendaa(l,:,jsub) = qgas_delaa(igas,:)/(fcvt_gas(igas)*deltat)
+ end do
+ end if
+
+ do n = 1, ntot_amode
+ l = lmap_num(n)
+ qsub4(l,jsub) = qnum4(n)/fcvt_num
+ qsub_tendaa(l,:,jsub) = qnum_delaa(n,:)/(fcvt_num*deltat)
+ do iaer = 1, naer
+ l = lmap_aer(iaer,n)
+ if (l > 0) then
+ qsub4(l,jsub) = qaer4(iaer,n)/fcvt_aer(iaer)
+ qsub_tendaa(l,:,jsub) = qaer_delaa(iaer,n,:)/(fcvt_aer(iaer)*deltat)
+ end if
+ end do
+ qaerwatsub4(n,jsub) = qwtr4(n)/fcvt_wtr
+
+ if ( iscldy_subarea(jsub) ) then
+ l = lmap_numcw(n)
+ qqcwsub4(l,jsub) = qnumcw4(n)/fcvt_num
+ qqcwsub_tendaa(l,:,jsub) = qnumcw_delaa(n,:)/(fcvt_num*deltat)
+ do iaer = 1, naer
+ l = lmap_aercw(iaer,n)
+ if (l > 0) then
+ qqcwsub4(l,jsub) = qaercw4(iaer,n)/fcvt_aer(iaer)
+ qqcwsub_tendaa(l,:,jsub) = qaercw_delaa(iaer,n,:)/(fcvt_aer(iaer)*deltat)
+ end if
+ end do
+ end if
+ end do ! n
+
+
+ end do main_jsub_loop
+
+
+
+ return
+ end subroutine mam_amicphys_1gridcell
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine mam_amicphys_1subarea_cloudy( &
+ do_cond, do_rename, &
+ do_newnuc, do_coag, &
+ nstep, lchnk, i, k, &
+ latndx, lonndx, lund, &
+ loffset, deltat, &
+ jsub, nsubarea, &
+ iscldy_subarea, afracsub, &
+ temp, pmid, pdel, &
+ zmid, pblh, relhum, &
+ dgn_a, dgn_awet, wetdens, &
+ qgas1, qgas3, qgas4, &
+ qgas_delaa, &
+ qnum3, qnum4, &
+ qnum_delaa, &
+ qaer2, qaer3, qaer4, &
+ qaer_delaa, &
+ qwtr3, qwtr4, &
+ qnumcw3, qnumcw4, &
+ qnumcw_delaa, &
+ qaercw2, qaercw3, qaercw4, &
+ qaercw_delaa, &
+ misc_vars_aa_sub )
+!
+! calculates changes to gas and aerosol sub-area TMRs (tracer mixing ratios)
+! for a single cloudy sub-area (with indices = lchnk,i,k,jsub)
+! qgas3, qaer3, qaercw3, qnum3, qnumcw3 are the current incoming TMRs
+! qgas4, qaer4, qaercw4, qnum4, qnumcw4 are the updated outgoing TMRs
+!
+! when do_cond = false, this routine only calculates changes involving
+! growth from smaller to larger modes (renaming) following cloud chemistry
+! so gas TMRs are not changed
+! when do_cond = true, this routine also calculates changes involving
+! gas-aerosol exchange (condensation/evaporation)
+! transfer of particles from hydrophobic modes to hydrophilic modes (aging)
+! due to condensation
+! currently this routine does not do
+! new particle nucleation - because h2so4 gas conc. should be very low in cloudy air
+! coagulation - because cloud-borne aerosol would need to be included
+!
+ use physconst, only: r_universal
+
+ logical, intent(in) :: do_cond, do_rename, do_newnuc, do_coag
+ logical, intent(in) :: iscldy_subarea ! true if sub-area is cloudy
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: loffset
+ integer, intent(in) :: jsub, nsubarea ! sub-area index, number of sub-areas
+
+ real(r8), intent(in) :: afracsub ! fractional area of sub-area (0-1)
+ real(r8), intent(in) :: deltat ! time step (s)
+
+ real(r8), intent(in) :: temp ! temperature at model levels (K)
+ real(r8), intent(in) :: pmid ! pressure at layer center (Pa)
+ real(r8), intent(in) :: pdel ! pressure thickness of layer (Pa)
+ real(r8), intent(in) :: zmid ! altitude (above ground) at layer center (m)
+ real(r8), intent(in) :: pblh ! planetary boundary layer depth (m)
+ real(r8), intent(in) :: relhum ! relative humidity (0-1)
+
+ real(r8), intent(inout) :: dgn_a(max_mode)
+ real(r8), intent(inout) :: dgn_awet(max_mode)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+ real(r8), intent(inout) :: wetdens(max_mode)
+ ! interstitial aerosol wet density (kg/m3)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+
+! qXXXN (X=gas,aer,wat,num; N=1:4) are sub-area mixing ratios
+! XXX=gas - gas species
+! XXX=aer - aerosol mass species (excluding water)
+! XXX=wat - aerosol water
+! XXX=num - aerosol number
+! N=1 - before gas-phase chemistry
+! N=2 - before cloud chemistry
+! N=3 - current incoming values (before gas-aerosol exchange, newnuc, coag)
+! N=4 - updated outgoing values (after gas-aerosol exchange, newnuc, coag)
+!
+! qXXX_delaa are TMR changes (not tendencies)
+! for different processes, which are used to produce history output
+! for a clear sub-area, the processes are condensation/evaporation (and associated aging),
+! renaming, coagulation, and nucleation
+ real(r8), intent(in ), dimension( 1:max_gas ) :: &
+ qgas1, qgas3
+ real(r8), intent(inout), dimension( 1:max_gas ) :: &
+ qgas4
+ real(r8), intent(inout), dimension( 1:max_gas, 1:nqtendaa ) :: &
+ qgas_delaa
+
+ real(r8), intent(in ), dimension( 1:max_mode ) :: &
+ qnum3
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum4
+ real(r8), intent(inout), dimension( 1:max_mode, 1:nqtendaa ) :: &
+ qnum_delaa
+
+ real(r8), intent(in ), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer2, qaer3
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer4
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode, 1:nqtendaa ) :: &
+ qaer_delaa
+
+ real(r8), intent(in ), dimension( 1:max_mode ) :: &
+ qwtr3
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr4
+
+ real(r8), intent(in ), dimension( 1:max_mode ) :: &
+ qnumcw3
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnumcw4
+ real(r8), intent(inout), dimension( 1:max_mode, 1:nqqcwtendaa ) :: &
+ qnumcw_delaa
+
+ real(r8), intent(in ), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaercw2, qaercw3
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaercw4
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode, 1:nqqcwtendaa ) :: &
+ qaercw_delaa
+
+ type ( misc_vars_aa_type ), intent(inout) :: misc_vars_aa_sub
+
+! local
+ integer, parameter :: ntot_poaspec = npoa
+ integer, parameter :: ntot_soaspec = nsoa
+
+ integer :: iaer, igas, ip
+ integer :: jtsubstep
+ integer :: ll
+ integer :: modefrm, modetoo
+! if mtoo_renamexf(n) > 0, then mode n gets renamed into mode mtoo_renamexf(n)
+! if mtoo_renamexf(n) <= 0, then mode n does not have renaming
+ integer :: mtoo_renamexf(max_mode)
+ integer :: n, ntsubstep
+ integer :: n_mode
+ integer :: ntot_soamode
+
+ logical, parameter :: flag_pcarbon_opoa_frac_zero = .true.
+ logical, parameter :: flag_nh4_lt_2so4_each_step = .false.
+
+ logical :: skip_soamode(max_mode) ! true if this mode does not have soa
+
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas_cur, qgas_sv1, qgas_avg
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas_del_cond, qgas_del_nnuc, qgas_netprod_otrproc
+ ! qgas_netprod_otrproc = gas net production rate from other processes
+ ! such as gas-phase chemistry and emissions (mol/mol/s)
+ ! this allows the condensation (gasaerexch) routine to apply production and condensation loss
+ ! together, which is more accurate numerically
+ ! NOTE - must be >= zero, as numerical method can fail when it is negative
+ ! NOTE - currently only the values for h2so4 and nh3 should be non-zero
+
+! qxxx_del_yyyy are mix-ratio changes over full time step (deltat)
+! qxxx_delsub_yyyy are mix-ratio changes over time sub-step (dtsubstep)
+ real(r8), dimension( 1:max_mode ) :: &
+ qnum_cur, qnum_sv1
+ real(r8), dimension( 1:max_mode ) :: &
+ qnum_del_cond, qnum_del_rnam, qnum_del_nnuc, qnum_del_coag, &
+ qnum_delsub_cond, qnum_delsub_coag
+
+ real(r8), dimension( 1:max_mode ) :: &
+ qnumcw_cur, qnumcw_sv1
+ real(r8), dimension( 1:max_mode ) :: &
+ qnumcw_del_rnam
+
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur, qaer_sv1
+ real(r8), dimension( 1:max_aer, 1:max_agepair ) :: &
+ qaer_delsub_coag_in
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_del_cond, qaer_del_rnam, qaer_del_nnuc, qaer_del_coag, &
+ qaer_delsub_grow4rnam, &
+ qaer_delsub_cond, qaer_delsub_coag
+
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaercw_cur, qaercw_sv1
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaercw_del_rnam, &
+ qaercw_delsub_grow4rnam
+
+ real(r8), dimension( 1:max_mode ) :: &
+ qwtr_cur
+
+ real(r8) :: aircon ! air molar density (kmol/m3)
+ real(r8) :: del_h2so4_gasprod
+ real(r8) :: del_h2so4_aeruptk
+ real(r8) :: dnclusterdt
+ real(r8) :: dtsubstep ! time sub-step
+ real(r8) :: gas_diffus(max_gas) ! gas diffusivity at current temp and pres (m2/s)
+ real(r8) :: gas_freepath(max_gas) ! gas mean free path at current temp and pres (m)
+
+ real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf
+ real(r8) :: tmp_relhum
+ real(r8) :: uptkaer(max_gas,max_mode)
+ real(r8) :: uptkrate_h2so4
+
+
+
+! air molar density (kmol/m3)
+ aircon = pmid/(r_universal*temp)
+
+ n_mode = ntot_amode
+
+ qgas_cur = qgas3
+ qaer_cur = qaer3
+ qnum_cur = qnum3
+ qwtr_cur = qwtr3
+ qnumcw_cur = qnumcw3
+ qaercw_cur = qaercw3
+
+
+ qgas_netprod_otrproc(:) = 0.0_r8
+ if ( ( do_cond ) .and. &
+ ( gaexch_h2so4_uptake_optaa == 2 ) ) then
+ do igas = 1, ngas
+ if ((igas == igas_h2so4) .or. (igas == igas_nh3)) then
+! if gaexch_h2so4_uptake_optaa == 2, then
+! if qgas increases from pre-gaschem to post-cldchem,
+! start from the pre-gaschem mix-ratio and add in the production
+! during the integration
+! if it decreases,
+! start from post-cldchem mix-ratio
+! *** currently just do this for h2so4 and nh3
+ qgas_netprod_otrproc(igas) = (qgas3(igas) - qgas1(igas))/deltat
+ if ( qgas_netprod_otrproc(igas) >= 0.0_r8 ) then
+ qgas_cur(igas) = qgas1(igas)
+ else
+ qgas_netprod_otrproc(igas) = 0.0_r8
+ end if
+ end if
+ end do ! igas
+ end if
+
+
+ qgas_del_cond = 0.0_r8
+ qgas_del_nnuc = 0.0_r8
+
+ qaer_del_cond = 0.0_r8
+ qaer_del_rnam = 0.0_r8
+ qaer_del_nnuc = 0.0_r8
+ qaer_del_coag = 0.0_r8
+ qaer_delsub_cond = 0.0_r8
+
+ qaercw_del_rnam = 0.0_r8
+
+ qnum_del_cond = 0.0_r8
+ qnum_del_rnam = 0.0_r8
+ qnum_del_nnuc = 0.0_r8
+ qnum_del_coag = 0.0_r8
+ qnum_delsub_cond = 0.0_r8
+
+ qnumcw_del_rnam = 0.0_r8
+
+ dnclusterdt = 0.0_r8
+
+
+ ntsubstep = 1
+ dtsubstep = deltat
+ if (ntsubstep > 1) dtsubstep = deltat/ntsubstep
+
+ del_h2so4_gasprod = max( qgas3(igas_h2so4)-qgas1(igas_h2so4), 0.0_r8 )/ntsubstep
+
+!
+!
+! loop over multiple time sub-steps
+!
+!
+jtsubstep_loop: &
+ do jtsubstep = 1, ntsubstep
+
+
+!
+!
+! gas-aerosol exchange
+!
+!
+ uptkrate_h2so4 = 0.0_r8
+do_cond_if_block10: &
+ if ( do_cond ) then
+
+ qgas_sv1 = qgas_cur
+ qnum_sv1 = qnum_cur
+ qaer_sv1 = qaer_cur
+
+#if ( defined( MOSAIC_SPECIES ) )
+ if ( mosaic ) then
+ tmp_relhum = min( relhum, 0.98_r8 )
+ call mosaic_gasaerexch_1subarea_intr( nstep, &!Intent(ins)
+ lchnk, i, k, jsub, &
+ temp, tmp_relhum, pmid, &
+ aircon, dtsubstep, n_mode, &
+ dgn_a, dgn_awet, qaer_cur, &!Intent(inouts)
+ qgas_cur, qnum_cur, qwtr_cur, &
+ qgas_avg, qgas_netprod_otrproc, &
+ uptkrate_h2so4, misc_vars_aa_sub )
+ else
+#endif
+ call mam_gasaerexch_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ jtsubstep, ntsubstep, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qgas_netprod_otrproc, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ dgn_a, dgn_awet, wetdens, &
+ uptkaer, uptkrate_h2so4 )
+#if ( defined( MOSAIC_SPECIES ) )
+ end if
+#endif
+
+ if (newnuc_h2so4_conc_optaa == 11) then
+ qgas_avg(igas_h2so4) = 0.5_r8*(qgas_sv1(igas_h2so4) + qgas_cur(igas_h2so4))
+ else if (newnuc_h2so4_conc_optaa == 12) then
+ qgas_avg(igas_h2so4) = qgas_cur(igas_h2so4)
+ end if
+
+ qgas_del_cond = qgas_del_cond + (qgas_cur - (qgas_sv1 + qgas_netprod_otrproc*dtsubstep))
+ qnum_delsub_cond = qnum_cur - qnum_sv1
+ qaer_delsub_cond = qaer_cur - qaer_sv1
+! qaer_delsub_grow4rnam = change in qaer_del_cond during latest condensation calculations
+ qaer_delsub_grow4rnam = qaer_cur - qaer_sv1
+
+ del_h2so4_aeruptk = qgas_cur(igas_h2so4) &
+ - (qgas_sv1(igas_h2so4) + qgas_netprod_otrproc(igas_h2so4)*dtsubstep)
+
+ else ! do_cond_if_block10
+
+ qgas_avg(1:ngas) = qgas_cur(1:ngas)
+ qaer_delsub_grow4rnam(:,:) = 0.0_r8
+
+ del_h2so4_aeruptk = 0.0_r8
+
+ end if do_cond_if_block10
+
+
+!
+!
+! renaming after "continuous growth"
+!
+!
+do_rename_if_block30: &
+ if ( do_rename ) then
+
+ mtoo_renamexf(:) = 0
+ mtoo_renamexf(nait) = nacc
+
+! qaer_delsub_grow4rnam = change in qaer from cloud chemistry and gas condensation
+! qaercw_delsub_grow4rnam = change in qaercw from cloud chemistry
+ qaer_delsub_grow4rnam = (qaer3 - qaer2)/ntsubstep + qaer_delsub_grow4rnam
+ qaercw_delsub_grow4rnam = (qaercw3 - qaercw2)/ntsubstep
+
+ qnum_sv1 = qnum_cur
+ qaer_sv1 = qaer_cur
+ qnumcw_sv1 = qnumcw_cur
+ qaercw_sv1 = qaercw_cur
+
+ call mam_rename_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ iscldy_subarea, &
+ mtoo_renamexf, &
+ n_mode, &
+ qnum_cur, &
+ qaer_cur, qaer_delsub_grow4rnam, &
+ qwtr_cur, &
+ qnumcw_cur, &
+ qaercw_cur, qaercw_delsub_grow4rnam )
+
+ qnum_del_rnam = qnum_del_rnam + (qnum_cur - qnum_sv1)
+ qaer_del_rnam = qaer_del_rnam + (qaer_cur - qaer_sv1)
+ qnumcw_del_rnam = qnumcw_del_rnam + (qnumcw_cur - qnumcw_sv1)
+ qaercw_del_rnam = qaercw_del_rnam + (qaercw_cur - qaercw_sv1)
+
+ end if do_rename_if_block30
+
+
+!
+!
+! primary carbon aging
+!
+!
+ if ( ( n_agepair > 0 ) .and. &
+ ( do_cond .eqv. .true. ) ) then
+
+ qaer_delsub_coag_in = 0.0_r8
+ qaer_delsub_coag = 0.0_r8
+ qnum_delsub_coag = 0.0_r8
+
+ call mam_pcarbon_aging_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, dgn_a, do_cond, &
+ n_mode, &
+ qnum_cur, qnum_delsub_cond, qnum_delsub_coag, &
+ qaer_cur, qaer_delsub_cond, qaer_delsub_coag, &
+ qaer_delsub_coag_in, &
+ qwtr_cur )
+
+ end if
+
+
+! accumulate sub-step q-dels
+ if ( do_cond ) then
+ qnum_del_cond = qnum_del_cond + qnum_delsub_cond
+ qaer_del_cond = qaer_del_cond + qaer_delsub_cond
+ end if
+
+ end do jtsubstep_loop
+
+
+!
+!
+! final mix ratios
+!
+!
+ qgas4 = qgas_cur
+ qaer4 = qaer_cur
+ qnum4 = qnum_cur
+ qwtr4 = qwtr_cur
+ qnumcw4 = qnumcw_cur
+ qaercw4 = qaercw_cur
+
+! final mix ratio changes
+
+ qgas_delaa(:,iqtend_cond) = qgas_del_cond(:)
+ qgas_delaa(:,iqtend_rnam) = 0.0_r8
+ qgas_delaa(:,iqtend_nnuc) = 0.0_r8
+ qgas_delaa(:,iqtend_coag) = 0.0_r8
+
+ qnum_delaa(:,iqtend_cond) = qnum_del_cond(:)
+ qnum_delaa(:,iqtend_rnam) = qnum_del_rnam(:)
+ qnum_delaa(:,iqtend_nnuc) = 0.0_r8
+ qnum_delaa(:,iqtend_coag) = 0.0_r8
+
+ qaer_delaa(:,:,iqtend_cond) = qaer_del_cond(:,:)
+ qaer_delaa(:,:,iqtend_rnam) = qaer_del_rnam(:,:)
+ qaer_delaa(:,:,iqtend_nnuc) = 0.0_r8
+ qaer_delaa(:,:,iqtend_coag) = 0.0_r8
+
+ qnumcw_delaa(:,iqqcwtend_rnam) = qnumcw_del_rnam(:)
+
+ qaercw_delaa(:,:,iqqcwtend_rnam) = qaercw_del_rnam(:,:)
+
+ misc_vars_aa_sub%ncluster_tend_nnuc_1grid = dnclusterdt
+
+ return
+ end subroutine mam_amicphys_1subarea_cloudy
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine mam_amicphys_1subarea_clear( &
+ do_cond, do_rename, &
+ do_newnuc, do_coag, &
+ nstep, lchnk, i, k, &
+ latndx, lonndx, lund, &
+ loffset, deltat, &
+ jsub, nsubarea, &
+ iscldy_subarea, afracsub, &
+ temp, pmid, pdel, &
+ zmid, pblh, relhum, &
+ dgn_a, dgn_awet, wetdens, &
+ qgas1, qgas3, qgas4, &
+ qgas_delaa, &
+ qnum3, qnum4, qnum_delaa, &
+ qaer3, qaer4, qaer_delaa, &
+ qwtr3, qwtr4, &
+ misc_vars_aa_sub )
+!
+! calculates changes to gas and aerosol sub-area TMRs (tracer mixing ratios)
+! for a single clear sub-area (with indices = lchnk,i,k,jsub)
+! qgas3, qaer3, qnum3 are the current incoming TMRs
+! qgas4, qaer4, qnum4 are the updated outgoing TMRs
+!
+! this routine calculates changes involving
+! gas-aerosol exchange (condensation/evaporation)
+! growth from smaller to larger modes (renaming) due to condensation
+! new particle nucleation
+! coagulation
+! transfer of particles from hydrophobic modes to hydrophilic modes (aging)
+! due to condensation and coagulation
+!
+ use physconst, only: r_universal
+
+ logical, intent(in) :: do_cond, do_rename, do_newnuc, do_coag
+ logical, intent(in) :: iscldy_subarea ! true if sub-area is cloudy
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: loffset
+ integer, intent(in) :: jsub, nsubarea ! sub-area index, number of sub-areas
+
+ real(r8), intent(in) :: afracsub ! fractional area of sub-area (0-1)
+ real(r8), intent(in) :: deltat ! time step (s)
+
+ real(r8), intent(in) :: temp ! temperature at model levels (K)
+ real(r8), intent(in) :: pmid ! pressure at layer center (Pa)
+ real(r8), intent(in) :: pdel ! pressure thickness of layer (Pa)
+ real(r8), intent(in) :: zmid ! altitude (above ground) at layer center (m)
+ real(r8), intent(in) :: pblh ! planetary boundary layer depth (m)
+ real(r8), intent(in) :: relhum ! relative humidity (0-1)
+
+ real(r8), intent(inout) :: dgn_a(max_mode)
+ real(r8), intent(inout) :: dgn_awet(max_mode)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+ real(r8), intent(inout) :: wetdens(max_mode)
+ ! interstitial aerosol wet density (kg/m3)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+
+! qXXXN (X=gas,aer,wat,num; N=1:4) are sub-area mixing ratios
+! XXX=gas - gas species
+! XXX=aer - aerosol mass species (excluding water)
+! XXX=wat - aerosol water
+! XXX=num - aerosol number
+! N=1 - before gas-phase chemistry
+! N=2 - before cloud chemistry
+! N=3 - current incoming values (before gas-aerosol exchange, newnuc, coag)
+! N=4 - updated outgoing values (after gas-aerosol exchange, newnuc, coag)
+!
+! qXXX_delaa are TMR changes (not tendencies)
+! for different processes, which are used to produce history output
+! for a clear sub-area, the processes are condensation/evaporation (and associated aging),
+! renaming, coagulation, and nucleation
+ real(r8), intent(in ), dimension( 1:max_gas ) :: &
+ qgas1, qgas3
+ real(r8), intent(inout), dimension( 1:max_gas ) :: &
+ qgas4
+ real(r8), intent(inout), dimension( 1:max_gas, 1:nqtendaa ) :: &
+ qgas_delaa
+
+ real(r8), intent(in ), dimension( 1:max_mode ) :: &
+ qnum3
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum4
+ real(r8), intent(inout), dimension( 1:max_mode, 1:nqtendaa ) :: &
+ qnum_delaa
+
+ real(r8), intent(in ), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer3
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer4
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode, 1:nqtendaa ) :: &
+ qaer_delaa
+
+ real(r8), intent(in ), dimension( 1:max_mode ) :: &
+ qwtr3
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr4
+
+ type ( misc_vars_aa_type ), intent(inout) :: misc_vars_aa_sub
+
+! local
+ integer, parameter :: ntot_poaspec = npoa
+ integer, parameter :: ntot_soaspec = nsoa
+
+ integer :: iaer, igas, ip
+ integer :: jtsubstep
+ integer :: ll
+ integer :: modefrm, modetoo
+! if mtoo_renamexf(n) > 0, then mode n gets renamed into mode mtoo_renamexf(n)
+! if mtoo_renamexf(n) <= 0, then mode n does not have renaming
+ integer :: mtoo_renamexf(max_mode)
+ integer :: n, ntsubstep
+ integer :: n_mode
+ integer :: ntot_soamode
+
+ logical, parameter :: flag_pcarbon_opoa_frac_zero = .true.
+ logical, parameter :: flag_nh4_lt_2so4_each_step = .false.
+
+ logical :: skip_soamode(max_mode) ! true if this mode does not have soa
+
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas_cur, qgas_sv1, qgas_avg
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas_del_cond, qgas_del_nnuc, qgas_netprod_otrproc
+ ! qgas_netprod_otrproc = gas net production rate from other processes
+ ! such as gas-phase chemistry and emissions (mol/mol/s)
+ ! this allows the condensation (gasaerexch) routine to apply production and condensation loss
+ ! together, which is more accurate numerically
+ ! NOTE - must be >= zero, as numerical method can fail when it is negative
+ ! NOTE - currently only the values for h2so4 and nh3 should be non-zero
+
+! qxxx_del_yyyy are mix-ratio changes over full time step (deltat)
+! qxxx_delsub_yyyy are mix-ratio changes over time sub-step (dtsubstep)
+ real(r8), dimension( 1:max_mode ) :: &
+ qnum_cur, qnum_sv1
+ real(r8), dimension( 1:max_mode ) :: &
+ qnum_del_cond, qnum_del_rnam, qnum_del_nnuc, qnum_del_coag, &
+ qnum_delsub_cond, qnum_delsub_coag
+
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur, qaer_sv1
+ real(r8), dimension( 1:max_aer, 1:max_agepair ) :: &
+ qaer_delsub_coag_in
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_del_cond, qaer_del_rnam, qaer_del_nnuc, qaer_del_coag, &
+ qaer_delsub_grow4rnam, &
+ qaer_delsub_cond, qaer_delsub_coag
+
+ real(r8), dimension( 1:max_mode ) :: &
+ qwtr_cur
+
+ real(r8) :: aircon ! air molar density (kmol/m3)
+ real(r8) :: del_h2so4_gasprod
+ real(r8) :: del_h2so4_aeruptk
+ real(r8) :: dnclusterdt, dnclusterdt_substep
+ real(r8) :: dtsubstep ! time sub-step
+ real(r8) :: gas_diffus(max_gas) ! gas diffusivity at current temp and pres (m2/s)
+ real(r8) :: gas_freepath(max_gas) ! gas mean free path at current temp and pres (m)
+
+ real(r8) :: tmpa, tmpb, tmpc, tmpd, tmpe, tmpf
+ real(r8) :: uptkaer(max_gas,max_mode)
+ real(r8) :: uptkrate_h2so4
+
+
+
+! air molar density (kmol/m3)
+ aircon = pmid/(r_universal*temp)
+
+ n_mode = ntot_amode
+
+ qgas_cur = qgas3
+ qaer_cur = qaer3
+ qnum_cur = qnum3
+ qwtr_cur = qwtr3
+
+ qgas_netprod_otrproc(:) = 0.0_r8
+ if ( ( do_cond ) .and. &
+ ( gaexch_h2so4_uptake_optaa == 2 ) ) then
+ do igas = 1, ngas
+ if ((igas == igas_h2so4) .or. (igas == igas_nh3)) then
+! if gaexch_h2so4_uptake_optaa == 2, then
+! if qgas increases from pre-gaschem to post-cldchem,
+! start from the pre-gaschem mix-ratio and add in the production
+! during the integration
+! if it decreases,
+! start from post-cldchem mix-ratio
+! *** currently just do this for h2so4 and nh3
+ qgas_netprod_otrproc(igas) = (qgas3(igas) - qgas1(igas))/deltat
+ if ( qgas_netprod_otrproc(igas) >= 0.0_r8 ) then
+ qgas_cur(igas) = qgas1(igas)
+ else
+ qgas_netprod_otrproc(igas) = 0.0_r8
+ end if
+ end if
+ end do ! igas
+ end if
+
+ qgas_del_cond = 0.0_r8
+ qgas_del_nnuc = 0.0_r8
+
+ qaer_del_cond = 0.0_r8
+ qaer_del_rnam = 0.0_r8
+ qaer_del_nnuc = 0.0_r8
+ qaer_del_coag = 0.0_r8
+ qaer_delsub_coag_in = 0.0_r8
+ qaer_delsub_cond = 0.0_r8
+ qaer_delsub_coag = 0.0_r8
+
+ qnum_del_cond = 0.0_r8
+ qnum_del_rnam = 0.0_r8
+ qnum_del_nnuc = 0.0_r8
+ qnum_del_coag = 0.0_r8
+ qnum_delsub_cond = 0.0_r8
+ qnum_delsub_coag = 0.0_r8
+
+ dnclusterdt = 0.0_r8
+
+
+ ntsubstep = 1
+ dtsubstep = deltat
+ if (ntsubstep > 1) dtsubstep = deltat/ntsubstep
+
+ del_h2so4_gasprod = max( qgas3(igas_h2so4)-qgas1(igas_h2so4), 0.0_r8 )/ntsubstep
+
+!
+!
+! loop over multiple time sub-steps
+!
+!
+jtsubstep_loop: &
+ do jtsubstep = 1, ntsubstep
+
+
+!
+!
+! gas-aerosol exchange
+!
+!
+ uptkrate_h2so4 = 0.0_r8
+do_cond_if_block10: &
+ if ( do_cond ) then
+
+ qgas_sv1 = qgas_cur
+ qnum_sv1 = qnum_cur
+ qaer_sv1 = qaer_cur
+
+#if ( defined( MOSAIC_SPECIES ) )
+ if ( mosaic ) then
+ call mosaic_gasaerexch_1subarea_intr( nstep, &!Intent(ins)
+ lchnk, i, k, jsub, &
+ temp, relhum, pmid, &
+ aircon, dtsubstep, n_mode, &
+ dgn_a, dgn_awet, qaer_cur, &!Intent(inouts)
+ qgas_cur, qnum_cur, qwtr_cur, &
+ qgas_avg, qgas_netprod_otrproc, &
+ uptkrate_h2so4, misc_vars_aa_sub )
+ else
+#endif
+ call mam_gasaerexch_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ jtsubstep, ntsubstep, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qgas_netprod_otrproc, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ dgn_a, dgn_awet, wetdens, &
+ uptkaer, uptkrate_h2so4 )
+#if ( defined( MOSAIC_SPECIES ) )
+ end if
+#endif
+
+ if (newnuc_h2so4_conc_optaa == 11) then
+ qgas_avg(igas_h2so4) = 0.5_r8*(qgas_sv1(igas_h2so4) + qgas_cur(igas_h2so4))
+ else if (newnuc_h2so4_conc_optaa == 12) then
+ qgas_avg(igas_h2so4) = qgas_cur(igas_h2so4)
+ end if
+
+ qgas_del_cond = qgas_del_cond + (qgas_cur - (qgas_sv1 + qgas_netprod_otrproc*dtsubstep))
+ qnum_delsub_cond = qnum_cur - qnum_sv1
+ qaer_delsub_cond = qaer_cur - qaer_sv1
+! qaer_del_grow4rnam = change in qaer_del_cond during latest condensation calculations
+ qaer_delsub_grow4rnam = qaer_cur - qaer_sv1
+
+ del_h2so4_aeruptk = qgas_cur(igas_h2so4) &
+ - (qgas_sv1(igas_h2so4) + qgas_netprod_otrproc(igas_h2so4)*dtsubstep)
+
+ else ! do_cond_if_block10
+
+ qgas_avg(1:ngas) = qgas_cur(1:ngas)
+ qaer_delsub_grow4rnam(:,:) = 0.0_r8
+
+ del_h2so4_aeruptk = 0.0_r8
+
+ end if do_cond_if_block10
+
+
+!
+!
+! renaming after "continuous growth"
+!
+!
+do_rename_if_block30: &
+ if ( do_rename ) then
+
+ mtoo_renamexf(:) = 0
+ mtoo_renamexf(nait) = nacc
+
+ qnum_sv1 = qnum_cur
+ qaer_sv1 = qaer_cur
+
+ call mam_rename_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ iscldy_subarea, &
+ mtoo_renamexf, &
+ n_mode, &
+ qnum_cur, &
+ qaer_cur, qaer_delsub_grow4rnam, &
+ qwtr_cur )
+
+ qnum_del_rnam = qnum_del_rnam + (qnum_cur - qnum_sv1)
+ qaer_del_rnam = qaer_del_rnam + (qaer_cur - qaer_sv1)
+
+ end if do_rename_if_block30
+
+
+!
+!
+! new particle formation (nucleation)
+!
+!
+do_newnuc_if_block50: &
+ if ( do_newnuc ) then
+
+ qgas_sv1 = qgas_cur
+ qnum_sv1 = qnum_cur
+ qaer_sv1 = qaer_cur
+
+ call mam_newnuc_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ zmid, pblh, relhum, &
+ uptkrate_h2so4, del_h2so4_gasprod, del_h2so4_aeruptk, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qnum_cur, &
+ qaer_cur, &
+ qwtr_cur, &
+ dnclusterdt_substep )
+
+ qgas_del_nnuc = qgas_del_nnuc + (qgas_cur - qgas_sv1)
+ qnum_del_nnuc = qnum_del_nnuc + (qnum_cur - qnum_sv1)
+ qaer_del_nnuc = qaer_del_nnuc + (qaer_cur - qaer_sv1)
+ dnclusterdt = dnclusterdt + dnclusterdt_substep*(dtsubstep/deltat)
+
+ end if do_newnuc_if_block50
+
+
+!
+!
+! coagulation part
+!
+!
+ if ( do_coag ) then
+
+ qnum_sv1 = qnum_cur
+ qaer_sv1 = qaer_cur
+
+ call mam_coag_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ dgn_a, dgn_awet, wetdens, &
+ n_mode, &
+ qnum_cur, &
+ qaer_cur, qaer_delsub_coag_in, &
+ qwtr_cur )
+
+ qnum_delsub_coag = qnum_cur - qnum_sv1
+ qaer_delsub_coag = qaer_cur - qaer_sv1
+
+ end if
+
+
+!
+!
+! primary carbon aging
+!
+!
+ if ( n_agepair > 0 ) then
+
+ call mam_pcarbon_aging_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, dgn_a, do_cond, &
+ n_mode, &
+ qnum_cur, qnum_delsub_cond, qnum_delsub_coag, &
+ qaer_cur, qaer_delsub_cond, qaer_delsub_coag, &
+ qaer_delsub_coag_in, &
+ qwtr_cur )
+
+ end if
+
+
+! accumulate sub-step q-dels
+ if ( do_coag ) then
+ qnum_del_coag = qnum_del_coag + qnum_delsub_coag
+ qaer_del_coag = qaer_del_coag + qaer_delsub_coag
+ end if
+ if ( do_cond ) then
+ qnum_del_cond = qnum_del_cond + qnum_delsub_cond
+ qaer_del_cond = qaer_del_cond + qaer_delsub_cond
+ end if
+
+ end do jtsubstep_loop
+
+
+!
+!
+! final mix ratios
+!
+!
+ qgas4 = qgas_cur
+ qaer4 = qaer_cur
+ qnum4 = qnum_cur
+ qwtr4 = qwtr_cur
+
+! final mix ratio changes
+
+ qgas_delaa(:,iqtend_cond) = qgas_del_cond(:)
+ qgas_delaa(:,iqtend_rnam) = 0.0_r8
+ qgas_delaa(:,iqtend_nnuc) = qgas_del_nnuc(:)
+ qgas_delaa(:,iqtend_coag) = 0.0_r8
+
+ qnum_delaa(:,iqtend_cond) = qnum_del_cond(:)
+ qnum_delaa(:,iqtend_rnam) = qnum_del_rnam(:)
+ qnum_delaa(:,iqtend_nnuc) = qnum_del_nnuc(:)
+ qnum_delaa(:,iqtend_coag) = qnum_del_coag(:)
+
+ qaer_delaa(:,:,iqtend_cond) = qaer_del_cond(:,:)
+ qaer_delaa(:,:,iqtend_rnam) = qaer_del_rnam(:,:)
+ qaer_delaa(:,:,iqtend_nnuc) = qaer_del_nnuc(:,:)
+ qaer_delaa(:,:,iqtend_coag) = qaer_del_coag(:,:)
+
+ misc_vars_aa_sub%ncluster_tend_nnuc_1grid = dnclusterdt
+
+ return
+ end subroutine mam_amicphys_1subarea_clear
+
+
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+#if ( defined( MOSAIC_SPECIES ) )
+ subroutine mosaic_gasaerexch_1subarea_intr( nstep, &!Intent(ins)
+ lchnk, i_in, k_in, jsub_in, &
+ temp, relhum, pmid, &
+ aircon, dtsubstep, n_mode, &
+ dgn_a, dgn_awet, qaer_cur, &!Intent(inouts)
+ qgas_cur, qnum_cur, qwtr_cur, &
+ qgas_avg, qgas_netprod_otrproc, &
+ uptkrate_h2so4, misc_vars_aa_sub )
+ !------------------------------------------------------------------------------!
+ !Purpose: This routine acts as an interface between Mosaic and CAM
+ !Future work:
+ !===========
+ !1. Clean Mosaic code and get rid of the arguments which stays constant
+ ! for the entire simulation
+ !3. Please handle the Mosaic counters, either use pbuf or make them internal to
+ ! Mosaic
+ !4. Use get_nstep() for it_mosaic or pull out the it_mosaic .eq. 1 computation
+ ! to the init routines
+ !5. SOA from CAM is stored in LIM2 of Mosaic. Rest of the 7 SOA species in
+ ! Mosaic are populated with zeros
+ !6. Some variables in Mosaic had to be initialized to zero. Please revisit and
+ ! fix whatever is necessary
+ !7. jhyst_leg is constant for now and is equal to jhyst_up
+ !
+ !Author: Balwinder Singh (PNNL)
+ !------------------------------------------------------------------------------!
+ !Use statements
+ use module_mosaic_box_aerchem, only: mosaic_box_aerchemistry
+ use infnan, only: nan, bigint
+ use physconst, only: mwh2o
+ use module_data_mosaic_aero, only: naer_mosaic => naer, &
+ inh4_a, ilim2_a, iso4_a, ina_a, icl_a, ibc_a, ioin_a, ioc_a, &
+ ino3_a, icl_a, ica_a, ico3_a, &
+ ilim2_g, ih2so4_g, inh3_g, ihno3_g, ihcl_g, &
+ jhyst_up, jtotal, &
+ nbin_a, nbin_a_max, ngas_volatile, nmax_astem, nmax_mesa, nsalt, &
+ mosaic_vars_aa_type
+#ifdef SPMD
+ use spmd_dyn, only: mpicom_xy, iam
+ use units, only: getunit, freeunit
+#endif
+
+ implicit none
+
+ !Args: intent(in)
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: i_in, k_in ! column and level indices
+ integer, intent(in) :: jsub_in ! subarea index
+
+ real(r8), intent(in) :: temp !Temperature at model levels (K)
+ real(r8), intent(in) :: relhum !Relative humidity (0-1)
+ real(r8), intent(in) :: pmid !Pressure at layer center (Pa)
+ real(r8), intent(in) :: aircon !Air molar density (kmol/m3)
+ real(r8), intent(in) :: dtsubstep !Time sub-step (s)
+ integer, intent(in) :: n_mode !current number of active modes
+
+ !Args: intent(inout)
+ real(r8), intent(inout) :: dgn_a(max_mode) !Dry geo. mean dia. (m) of number distrib.
+ real(r8), intent(inout) :: dgn_awet(max_mode) !Wet geo. mean dia. (m) of number distrib.
+ real(r8), intent(inout) :: qaer_cur(max_aer,max_mode) !Current aerosol mass mix ratios (mol/mol)
+ real(r8), intent(inout) :: qgas_cur(max_gas) !Current gas mix ratios (mol/mol)
+ real(r8), intent(inout) :: qnum_cur(max_mode) !Current aerosol number mix ratios (#/kmol)
+ real(r8), intent(inout) :: qwtr_cur(max_mode) !Current aerosol water mix ratios (mol/mol)
+ real(r8), intent(inout) :: qgas_avg(max_gas) !average gas conc. over dtchem time step (mol/mol)
+ real(r8), intent(inout) :: qgas_netprod_otrproc(max_gas)
+ ! qgas_netprod_otrproc = gas net production rate from other processes
+ ! such as gas-phase chemistry and emissions (mol/mol/s)
+ ! this allows the condensation (gasaerexch) routine to apply production and condensation loss
+ ! together, which is more accurate numerically
+ ! NOTE - must be >= zero, as numerical method can fail when it is negative
+ ! NOTE - currently only the values for h2so4 and nh3 should be non-zero
+ real(r8), intent(inout) :: uptkrate_h2so4 ! rate of h2so4 uptake by aerosols (1/s)
+ type ( misc_vars_aa_type ), intent(inout) :: misc_vars_aa_sub
+
+ !Local Variables - [To be sent as args to Mosaic code]
+ integer :: ierr
+! integer :: it_mosaic !Time step counter for Mosaic
+! integer :: jASTEM_fail !Counter to indicate if the ASTEM convergence failed in Mosaic
+ real(r8) :: dtchem !Timestep in seconds
+ real(r8) :: T_K !Temperature in K
+
+
+ integer :: mcall_load_mosaic_parameters !Flag to decide whether to call 'load_mosaic_parameters' or not(*BALLI not used anymore)
+ integer :: mcall_print_aer_in !Flag to decide whether to call 'print_aer' or not
+
+ integer, dimension(nbin_a_max) :: jaerosolstate !Aerosol state (solid, liquid, gas)
+! integer, dimension(nbin_a_max) :: iter_mesa !MESA iterations counters
+ integer, dimension(nbin_a_max) :: jaerosolstate_bgn !Aerosol state at the begining (solid, liquid, gas)
+ integer, dimension(nbin_a_max) :: jhyst_leg
+
+
+ real(r8) :: aH2O !Relative humidity in fraction(variaes between 0 and 1)
+ real(r8) :: P_atm !Pressure in atm units
+ real(r8) :: RH_pc !Relative humidity in %age(variaes between 0 and 100)
+ real(r8) :: cair_mol_m3 !Air molar density (mol/m3)
+
+ real(r8), dimension(nbin_a_max) :: water_a !Current aerosol water mix ratios (kg/m3)
+ real(r8), dimension(nbin_a_max) :: sigmag_a !Geometric standard deviation for aerosol mode
+ real(r8), dimension(nbin_a_max) :: Dp_dry_a !Dry geo. mean dia. (cm) of number distrib.
+
+ real(r8), dimension(nbin_a_max) :: num_a !Current aerosol number mix ratios (#/cm3)
+ real(r8), dimension(nbin_a_max) :: dp_wet_a !Diameter of aerosol in (cm)
+ real(r8), dimension(nbin_a_max) :: mass_dry_a_bgn !g/cc(air) **BALLI*** comment missing
+ real(r8), dimension(nbin_a_max) :: mass_dry_a !g/cc(air) **BALLI*** comment missing
+ real(r8), dimension(nbin_a_max) :: dens_dry_a_bgn !g/cc **BALLI*** comment missing
+ real(r8), dimension(nbin_a_max) :: dens_dry_a !g/cc **BALLI*** comment missing
+ real(r8), dimension(nbin_a_max) :: water_a_hyst !kg(water)/m^3(air) hysteresis (at 60% RH) **BALLI*** comment missing
+ real(r8), dimension(nbin_a_max) :: aH2O_a !Relative humidity in fraction(variaes between 0 and 1)
+ real(r8), dimension(nbin_a_max) :: gam_ratio
+
+ real(r8), dimension(ngas_volatile) :: gas !Current gas mix ratios (nano mol/m3)
+ real(r8), dimension(ngas_volatile) :: gas_avg ! average gas conc. over dtchem time step (nmol/m3)
+ real(r8), dimension(ngas_volatile) :: gas_netprod_otrproc
+ ! gas_netprod_otrproc = gas net production rate from other processes
+ ! such as gas-phase chemistry and emissions (mol/mol/s)
+ ! NOTE - must be >= zero, as numerical method can fail when it is negative
+ ! NOTE - currently for mosaic, only the value for h2so4 can be non-zero
+ real(r8), dimension(naer_mosaic,3,nbin_a_max) :: aer !Current aerosol mass mix ratios (nano mol/m3)
+
+ !Local Variables - [other local variables]
+ character(len=500) :: tmp_str, nlfile, sballi
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ character(len=500) :: infile
+ logical, parameter :: debug_mosaic = .false.
+ integer, parameter :: iam = 0
+#endif
+! logical :: zero_water_flag, flag_itr_kel
+ integer :: imode, ibin, iaer, igas, istate, isalt, ibin_in, iaer_in, istate_in
+ integer :: unitn
+
+ !BALLI - Following should be in the modules as parameter
+ real(r8), parameter :: oneatminv = 1.0_r8/1.01325e5_r8
+ !BALLI - Following should be in the modules as parameter - ENDS
+
+ !BSINGH - For converting CAM units to Mosaic units
+ real(r8) :: nano_mult_cair, aer_tmp
+ real(r8) :: num_cam_to_mos_units, wtr_cam_to_mos_units
+
+ !BSINGH - For converting Mosaic units to CAM units
+ real(r8) :: nano_mult_cair_inv
+ real(r8) :: num_mos_to_cam_units, wtr_mos_to_cam_units
+
+ !BSINGH - For debugging mosiac code
+! integer, dimension(6) :: hostgridinfo
+ integer, dimension(nbin_a_max) :: jaerosolstate_in
+ integer, dimension(nbin_a_max) :: jhyst_leg_in
+
+ real(r8), dimension(nbin_a_max) :: num_a_in
+ real(r8), dimension(nbin_a_max) :: dp_wet_a_in
+ real(r8), dimension(nbin_a_max) :: water_a_in
+ real(r8), dimension(nbin_a_max) :: sigmag_a_in
+ real(r8), dimension(nbin_a_max) :: Dp_dry_a_in
+
+ real(r8), dimension(ngas_volatile) :: gas_in, gas_netprod_otrproc_in, gas_avg_in
+
+ real(r8), dimension(naer_mosaic,3,nbin_a_max) :: aer_in
+
+ real(r8), dimension(naer_mosaic) :: kappa_nonelectro
+
+ type (mosaic_vars_aa_type) :: mosaic_vars_aa
+
+ !BSINGH - For storing points having trouble converging
+ logical,parameter :: convergence_pt_trk = .true. !For tracking points where convergence failed, let the run proceed
+! logical :: f_neg_vol_tmp
+
+
+ ! allocate the allocatable parts of mosaic_vars_aa
+ allocate( mosaic_vars_aa%iter_mesa(nbin_a_max), stat=ierr )
+ if (ierr /= 0) then
+ print *, '*** subr mosaic_gasaerexch_1subarea_intr - allocate error for mosaic_vars_aa%iter_mesa'
+ stop
+ end if
+
+
+ !if(nstep>17 .and. i_in == 14)write(202,*)'AMICPHYS I K:',i_in,k_in,nstep,lchnk
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+ !Populate MOSAIC variables
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+
+ !Counters:
+ !BSINGH - This counter is internal to Mosaic model.
+ ! It indicates if ASTEM convergence failed in Mosaic
+! jASTEM_fail = 0
+ mosaic_vars_aa%jastem_fail = 0
+
+ !BSINGH - This is time step number in Mosaic
+! it_mosaic = nstep
+ mosaic_vars_aa%it_mosaic = nstep
+
+ !Inputs for Mosaic model (Should be intent-ins for Mosaic model)
+ aH2O = relhum !Relative humidity [fraction between 0 and 1]
+ T_K = temp !Temperature in K
+ P_atm = pmid * oneatminv !Pressure (atm)
+ RH_pc = aH2O * 100.0_r8 !Relative humidity [%age between 0 and 100]
+ cair_mol_m3 = aircon * 1000.0_r8 !Air molar density (mol/m3){units conversion: aircon[kmol/m3] * 1.0e3[mol/kmol]}
+ dtchem = dtsubstep !timestep (s)
+
+ jhyst_leg(1:nbin_a_max) = jhyst_up
+
+ !Flags to control Mosaic model
+ mcall_load_mosaic_parameters = 1 !**BALLI.. This flag is not used anymore
+ mcall_print_aer_in = 0 !**BALLI...insert a dummy call to print_aer
+
+
+ !Populate aersols
+ nbin_a = n_mode ! current number of modes
+
+ aer(:,:,:) = 0.0_r8 !initialized to zero
+
+ !Populate aerosol numbers and water species
+ num_a(:) = 0.0_r8 !Initialized to zero
+ water_a(:) = 0.0_r8 !initialized to zero
+
+ !BSINGH - units of qnum_cur in CAM are #/kmol of air. In Mosaic, units are #/cm3
+ !Units conversion: qnum_cur[#/kmol] * 1.0e-3[kmol/mol] * cair_mol_m3[mol/m3] * 1.0e-6[m3/cm3]
+
+ num_cam_to_mos_units = 1.0e-3_r8 * cair_mol_m3 * 1.0e-6_r8
+
+ !BSINGH - units for water in CAM are mol/mol. In Mosaic, units are kg/m3
+ !Units conversion: qwtr_cur[mol/mol] * mwh2o[g/mol] * cair_mol_m3[mol/m3] * 1.0e-3[kg/g]
+
+ wtr_cam_to_mos_units = mwh2o * cair_mol_m3 * 1.0e-3_r8
+
+
+ nano_mult_cair = cair_mol_m3 * 1.0e9_r8
+
+ do imode = 1, n_mode
+ !Notes:
+ !1. NCL(sea salt) of CAM is mapped in NA and CL of MOSAIC
+ !2. SOA of CAM is lumped into LIM2 species of MOSAIC !BALLI *ASK RAHUL and Dick
+ !3. Species NO3, MSA, CO3, Ca do not exist in CAM therefore not mapped here
+ !4. Species ARO1, ARO2, ALK1, OLE1, API1, API2, LIM1 are SOA species in MOSAIC
+ ! which are not used in CAM-MOSAIC framework as of now
+ !5. CAM units are (mol/mol of air) which are converted to Mosaic units (nano mol/m3).
+
+ !Units conversion:qaer_cur[mol/mol] * cair_mol_m3[mol/m3] * 1.0e9[nmol/mol]
+ aer(inh4_a, jtotal, imode) = qaer_cur(iaer_nh4, imode) * nano_mult_cair
+ aer(ilim2_a, jtotal, imode) = qaer_cur(iaer_soa, imode) * nano_mult_cair
+ aer(iso4_a, jtotal, imode) = qaer_cur(iaer_so4, imode) * nano_mult_cair
+ aer(ina_a, jtotal, imode) = qaer_cur(iaer_ncl, imode) * nano_mult_cair
+ if (iaer_cl > 0) then
+ aer(icl_a, jtotal, imode) = qaer_cur(iaer_cl, imode) * nano_mult_cair
+ else
+ aer(icl_a, jtotal, imode) = qaer_cur(iaer_ncl, imode) * nano_mult_cair
+ end if
+ if (iaer_no3 > 0) &
+ aer(ino3_a, jtotal, imode) = qaer_cur(iaer_no3, imode) * nano_mult_cair
+ if (iaer_ca > 0) &
+ aer(ica_a, jtotal, imode) = qaer_cur(iaer_ca, imode) * nano_mult_cair
+ if (iaer_co3 > 0) &
+ aer(ico3_a, jtotal, imode) = qaer_cur(iaer_co3, imode) * nano_mult_cair
+
+ !Units of BC, OC and DST in CAM are (mol/mol of air) and nano-g/m3 in MOSAIC
+ !Units conversion:qaer_cur[mol/mol] * mw_aer[g/mol] * cair_mol_m3[mol/m3] * 1.0e9[nano-g/g]
+ aer(ibc_a, jtotal, imode) = qaer_cur(iaer_bc, imode) * mw_aer(iaer_bc) * nano_mult_cair
+ aer(ioin_a, jtotal, imode) = qaer_cur(iaer_dst, imode) * mw_aer(iaer_dst) * nano_mult_cair !BSINGH - "Other inorganic(oin)" in Mosaic is DST in CAM
+ aer(ioc_a, jtotal, imode) = qaer_cur(iaer_pom, imode) * mw_aer(iaer_pom) * nano_mult_cair
+
+ !Populate aerosol number and water species
+ num_a(imode) = qnum_cur(imode) * num_cam_to_mos_units
+ water_a(imode) = qwtr_cur(imode) * wtr_cam_to_mos_units
+ end do
+
+ !Populate gases
+ gas(:) = 0.0_r8 !Initialized to zero
+ !BSINGH - only 3 gases are avialble in CAM (SOAG, H2SO4, NH3).
+ !SOAG is stored in LIM2 gas species as of now
+ !CAM units are (mol/mol of air) which are converted to Mosaic units (nano mol/m3).
+ gas_avg(:) = 0.0_r8
+
+ !Units conversion:qgas_cur[mol/mol] * cair_mol_m3[mol/m3] * 10.0e9[nmol/mol]
+ gas(ilim2_g) = qgas_cur(igas_soa) * nano_mult_cair
+ gas(ih2so4_g) = qgas_cur(igas_h2so4) * nano_mult_cair
+ gas(inh3_g) = qgas_cur(igas_nh3) * nano_mult_cair
+ if (igas_hno3 > 0) &
+ gas(ihno3_g) = qgas_cur(igas_hno3) * nano_mult_cair
+ if (igas_hcl > 0) &
+ gas(ihcl_g) = qgas_cur(igas_hcl) * nano_mult_cair
+
+ !Populate gas_netprod_otrproc
+ gas_netprod_otrproc(:) = 0.0_r8
+ gas_netprod_otrproc(ih2so4_g) = qgas_netprod_otrproc(igas_h2so4) * nano_mult_cair
+ ! nh3 gas-phase chem production should be zero (unless we include emissions)
+ ! and doing simultaneous production and condensation in mosaic is more complicated
+ ! for nh3 that for h2so4
+ ! so for now, just add in the production here
+ gas(inh3_g) = gas(inh3_g) + max( qgas_netprod_otrproc(igas_nh3)*dtchem, 0.0_r8 ) * nano_mult_cair
+
+
+ !BSINGH - Initialize the following variables as 'nan' and then assign values to a subset of their dimesions
+ Dp_dry_a(:) = nan
+ sigmag_a(:) = nan
+ dp_wet_a(:) = nan
+
+ sigmag_a(1:n_mode) = sigmag_aer(1:n_mode) !Geometric standard deviation for aerosol mode
+ !Dry geo. mean dia.(cm) of number distrib [convert from m to cm]!**BALLI: check if it meant to be in,inout or out only and units also
+ Dp_dry_a(1:n_mode) = dgn_a(1:n_mode) * 100.0_r8 * fcvt_dgnum_dvolmean(1:n_mode)
+ !Wet geo. mean dia.(cm) of number distrib [convert from m to cm]!**BALLI: check if it meant to be in,inout or out only and untis also
+ dp_wet_a(1:n_mode) = dgn_awet(1:n_mode) * 100.0_r8 * fcvt_dgnum_dvolmean(1:n_mode)
+
+
+ !BSINGH - These are output variables from Mosaic.
+ !Declared as nan to make sure that they are not inadvertently 'used' before assignment.
+! iter_mesa(:) = bigint
+ mosaic_vars_aa%iter_mesa(1:nbin_a_max) = 0
+ jaerosolstate_bgn(:) = bigint
+ jaerosolstate(:) = bigint
+
+ mass_dry_a_bgn(:) = nan
+ mass_dry_a(:) = nan
+ dens_dry_a_bgn(:) = nan
+ dens_dry_a(:) = nan
+ water_a_hyst(:) = nan
+ aH2O_a(:) = nan
+ gam_ratio(:) = nan
+
+
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+ !END [Populate MOSAIC variables]
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ !BSINGH - This section is required ONLY for the MAM box model
+ ! to see if it can reproduce errors encountered by the
+ ! CAM model during runtime(e.g. convergence errors).
+ ! This block repopulate all the information which is
+ ! going into the mosaic box (intent-ins and intent-inouts).
+ ! It is a binary read to preserve the accuracy.
+
+ if(debug_mosaic) then
+ !Read a binary file which has all the inputs to the mosaic box
+ !and stop the model
+
+ unitn = 101
+ infile = 'mosaic_error_7.bin'
+ open( unitn, file=trim(infile), status='old', form='unformatted', CONVERT = 'BIG_ENDIAN' )
+
+ read(unitn)aH2O
+ read(unitn)T_K
+ read(unitn)P_atm
+ read(unitn)RH_pc
+ read(unitn)dtchem
+
+ do ibin = 1, ntot_amode !nbin_a_max
+ read(unitn)num_a(ibin),water_a(ibin),Dp_dry_a(ibin), &
+ sigmag_a(ibin),dp_wet_a(ibin),jhyst_leg(ibin), &
+ jaerosolstate(ibin)
+ end do
+
+
+ do igas = 1, ngas_volatile
+ read(unitn) gas(igas), gas_avg(igas), gas_netprod_otrproc(igas)
+ enddo
+
+ do ibin = 1, ntot_amode !nbin_a_max
+ do istate = 1, 3
+ do iaer = 1 , naer
+ read(unitn)iaer_in,istate_in,ibin_in, aer_tmp
+ aer(iaer_in,istate_in,ibin_in) = aer_tmp
+ end do
+ end do
+ end do
+ close(unitn)
+ endif
+ !BSINGH -----xxx ENDS reading file for debugging mosaic xxxx----
+#endif
+
+
+ !Store the variables which are intent(inout) to Mosaic box model
+ !for debuging purposes
+ aer_in(:,:,:) = aer(:,:,:)
+ num_a_in(:) = num_a(:)
+ water_a_in(:) = water_a(:)
+ gas_in(:) = gas(:)
+ Dp_dry_a_in(:) = Dp_dry_a(:)
+ sigmag_a_in(:) = sigmag_a(:)
+ dp_wet_a_in(:) = dp_wet_a(:)
+ jhyst_leg_in(:) = jhyst_leg(:)
+ jaerosolstate_in(:) = jaerosolstate(:)
+ gas_netprod_otrproc_in(:) = gas_netprod_otrproc(:)
+ gas_avg_in(:) = gas_avg(:)
+
+
+ !BSINGH - zero_water_flag becomes .true. if water is zero in liquid phase
+! zero_water_flag = .false.
+ mosaic_vars_aa%zero_water_flag = .false.
+ !BSINGH - flag_itr_kel becomes true when kelvin iteration in mdofule_mosaic_ext.F90 are greater then 100
+! flag_itr_kel = .false.
+ mosaic_vars_aa%flag_itr_kel = .false.
+
+
+ !Store grid info
+! hostgridinfo(1) = i_in
+! hostgridinfo(2) = k_in
+! hostgridinfo(3) = lchnk
+! hostgridinfo(4:6) = bigint
+ mosaic_vars_aa%hostgridinfo(1) = i_in
+ mosaic_vars_aa%hostgridinfo(2) = k_in
+ mosaic_vars_aa%hostgridinfo(3) = lchnk
+ mosaic_vars_aa%hostgridinfo(4:6) = bigint
+ mosaic_vars_aa%it_host = 0
+
+
+ ! *** maybe these should be bigint or nan ???
+ mosaic_vars_aa%f_mos_fail = -1
+ mosaic_vars_aa%isteps_astem = 0
+ mosaic_vars_aa%isteps_astem_max = 0
+ mosaic_vars_aa%jastem_call = 0
+ mosaic_vars_aa%jmesa_call = 0
+ mosaic_vars_aa%jmesa_fail = 0
+ mosaic_vars_aa%niter_mesa_max = 0
+ mosaic_vars_aa%nmax_astem = nmax_astem
+ mosaic_vars_aa%nmax_mesa = nmax_mesa
+ mosaic_vars_aa%cumul_steps_astem = 0.0_r8
+ mosaic_vars_aa%niter_mesa = 0.0_r8
+ mosaic_vars_aa%xnerr_astem_negative(:,:) = 0.0_r8
+
+
+ ! set kappa values for non-electrolyte species
+ ! reason for doing this here is that if cam eventually has multiple varieties of dust and/or pom,
+ ! then the dust hygroscopicity may vary spatially and temporally,
+ ! and the kappa values cannot be constants
+ kappa_nonelectro(:) = 0.0_r8
+ kappa_nonelectro(ibc_a ) = 0.0001 ! previously kappa_poa = 0.0001
+ kappa_nonelectro(ioc_a ) = 0.0001 ! previously kappa_bc = 0.0001
+ kappa_nonelectro(ilim2_a) = 0.1 ! previously kappa_soa = 0.1
+ kappa_nonelectro(ioin_a ) = 0.06 ! previously kappa_oin = 0.06
+
+
+ !Call MOSAIC parameterization
+ !BSINGH - jASTEM_fail is in arg list to know if the mosiac model converged or not
+ !BSINGH - Following variables are not required by CAM but they still exist in the
+ ! calling arguments as intent-outs as Mosaic model needs them to be in the
+ ! arg list:
+ ! gam_ratio, iter_mesa, aH2O_a,jaerosolstate, mass_dry_a_bgn, mass_dry_a,
+ ! dens_dry_a_bgn, dens_dry_a, water_a_hyst, jaerosolstate_bgn
+
+! *** ff03h version ***
+! call mosaic_box_aerchemistry( &
+! hostgridinfo, it_mosaic, aH2O, T_K, &!Intent-ins
+! P_atm, RH_pc, dtchem, &
+! mcall_load_mosaic_parameters, mcall_print_aer_in, sigmag_a, &
+! jaerosolstate, aer, &!Intent-inouts
+! num_a, water_a, gas, &
+! gas_avg, gas_netprod_otrproc, Dp_dry_a, &
+! dp_wet_a, jhyst_leg, zero_water_flag, flag_itr_kel, &
+! mass_dry_a_bgn, mass_dry_a, &!Intent-outs
+! dens_dry_a_bgn, dens_dry_a, water_a_hyst, aH2O_a, &
+! gam_ratio, jaerosolstate_bgn, jASTEM_fail, &
+! iter_MESA, f_neg_vol_tmp )
+
+! *** ff04a version ***
+ call mosaic_box_aerchemistry( aH2O, T_K, &!Intent-ins
+ P_atm, RH_pc, dtchem, &
+ mcall_load_mosaic_parameters, mcall_print_aer_in, sigmag_a, &
+ kappa_nonelectro, &
+ jaerosolstate, aer, &!Intent-inouts
+ num_a, water_a, gas, &
+ gas_avg, gas_netprod_otrproc, Dp_dry_a, &
+ dp_wet_a, jhyst_leg, &
+ mosaic_vars_aa, &
+ mass_dry_a_bgn, mass_dry_a, &!Intent-outs
+ dens_dry_a_bgn, dens_dry_a, water_a_hyst, aH2O_a, &
+ uptkrate_h2so4, gam_ratio, jaerosolstate_bgn )
+
+! *** ff04a version ***
+! subr mosaic_box_aerchemistry( aH2O, T_K, &!Intent-ins
+! P_atm, RH_pc, dtchem, &
+! mcall_load_mosaic_parameters, mcall_print_aer_in, sigmag_a, &
+! kappa_nonelectro, &
+! jaerosolstate, aer, &!Intent-inouts
+! num_a, water_a, gas, &
+! gas_avg, gas_netprod_otrproc, Dp_dry_a, &
+! dp_wet_a, jhyst_leg, &
+! mosaic_vars_aa, &
+! mass_dry_a_bgn, mass_dry_a, &!Intent-outs
+! dens_dry_a_bgn, dens_dry_a, water_a_hyst, aH2O_a, &
+! uptkrate_h2so4, gam_ratio, jaerosolstate_bgn )
+
+ if (mosaic_vars_aa%flag_itr_kel) then
+ misc_vars_aa_sub%max_kelvin_iter_1grid = misc_vars_aa_sub%max_kelvin_iter_1grid + 1.0_r8
+ endif
+
+ if (mosaic_vars_aa%jASTEM_fail > 0 .or. mosaic_vars_aa%zero_water_flag .or. mosaic_vars_aa%f_mos_fail > 0 ) then !solver in ASTEM didn't converge
+
+ !Let the run proceed and track the points(i,k) where the run fails convergence
+ if(convergence_pt_trk .and. mosaic_vars_aa%jASTEM_fail > 0 ) then
+ misc_vars_aa_sub%cnvrg_fail_1grid = misc_vars_aa_sub%cnvrg_fail_1grid + 1.0_r8
+ else
+ !Printout a binary file which has all the inputs to the mosaic box
+ !and stop the model
+
+ !Generate a unit number and form file name based on process number
+#ifdef SPMD
+ unitn = getunit()
+ write(tmp_str,*)iam
+ write(nlfile,*)'mosaic_error_',trim(adjustl(tmp_str)),'.bin'
+#else
+ unitn = 101
+ nlfile = 'mosiac_error.txt'
+#endif
+ !Open a binary file, remember it is written out as BIG ENDIAN
+ open( unitn, file=trim(nlfile), status='unknown', form = 'unformatted' )
+
+ write(unitn)aH2O !Write relative humidity
+ write(unitn)T_K !Write relative temp
+ write(unitn)P_atm !Write relative pressure
+ write(unitn)RH_pc
+ write(unitn)dtchem
+ !Write variables with 'nbin_a_max' dimension
+ do ibin = 1, ntot_amode!nbin_a_max
+ write(unitn)num_a_in(ibin),water_a_in(ibin),Dp_dry_a_in(ibin), &
+ sigmag_a_in(ibin),dp_wet_a_in(ibin),jhyst_leg_in(ibin), &
+ jaerosolstate_in(ibin)
+ end do
+
+ !Write gas array
+ do igas = 1, ngas_volatile
+ write(unitn) gas_in(igas), gas_avg_in(igas), gas_netprod_otrproc_in(igas)
+ enddo
+
+ !Write aerosols
+ do ibin = 1, ntot_amode !nbin_a_max
+ do istate = 1, 3
+ do iaer = 1 , naer_mosaic
+ write(unitn)iaer,istate,ibin,aer_in(iaer,istate,ibin)
+ end do
+ end do
+ end do
+ !Close the file
+ close(unitn)
+#ifdef SPMD
+ !free unit number
+ call freeunit(unitn)
+#endif
+ !Write error message and stop the model.
+ write(tmp_str,*) 'Error in Mosaic, jASTEM_fail= ', mosaic_vars_aa%jASTEM_fail, &
+ ' zero_water_flag: ', mosaic_vars_aa%zero_water_flag, &
+ ' f_mos_fail:', mosaic_vars_aa%f_mos_fail
+ call endrun (tmp_str)
+ endif
+ endif
+
+
+ ! copy other diagnostic outputs (that are written to history) from mosaic_vars_aa to misc_vars_aa_sub
+ misc_vars_aa_sub%xnerr_astem_negative_1grid(:,:) = mosaic_vars_aa%xnerr_astem_negative(:,:)
+
+ ! deallocate the allocatable parts of mosaic_vars_aa
+ deallocate( mosaic_vars_aa%iter_mesa, stat=ierr )
+ if (ierr /= 0) then
+ print *, '*** subr mosaic_gasaerexch_1subarea_intr - deallocate error for mosaic_vars_aa%iter_mesa'
+ stop
+ end if
+
+
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+ !Process MOSAIC output and store it in CAM data structures
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+ !BSINGH - units of qnum_cur in CAM are #/kmol of air. In Mosaic, units are #/cm3
+ num_mos_to_cam_units = 1.0_r8/num_cam_to_mos_units !Take inverse of cam_to_mos units
+ num_cam_to_mos_units = nan !To avoid inadvertent use
+
+ !BSINGH - units for water in CAM are mol/mol. In Mosaic, units are kg/m3
+ wtr_mos_to_cam_units = 1.0_r8/wtr_cam_to_mos_units !Take inverse of cam_to_mos units
+ wtr_cam_to_mos_units = nan !To avoid inadvertent use
+
+ nano_mult_cair_inv = 1.0_r8/nano_mult_cair !Take inverse of cam to mosaic units
+ nano_mult_cair = nan !To avoid inadvertent use
+
+ do imode = 1, n_mode
+ !Notes:
+ !1. NCL(sea salt) of CAM is mapped in NA and CL of MOSAIC
+ !2. SOA of CAM is lumped into LIM2 species of MOSAIC !BALLI *ASK RAHUL and Dick
+ !3. Species NO3, MSA, CO3, Ca do not exist in CAM therefore not mapped here
+ !4. Species ARO1, ARO2, ALK1, OLE1, API1, API2, LIM1 are SOA species in MOSAIC
+ ! which are not used in CAM-MOSAIC framework as of now
+ !5. CAM units are (mol/mol of air) and Mosaic units are (nano mol/m3).
+
+ qaer_cur(iaer_nh4, imode) = aer(inh4_a, jtotal , imode) * nano_mult_cair_inv
+ qaer_cur(iaer_soa, imode) = aer(ilim2_a, jtotal , imode) * nano_mult_cair_inv
+ qaer_cur(iaer_so4, imode) = aer(iso4_a, jtotal , imode) * nano_mult_cair_inv
+ qaer_cur(iaer_ncl, imode) = aer(ina_a, jtotal , imode) * nano_mult_cair_inv
+ if (iaer_cl > 0) &
+ qaer_cur(iaer_cl, imode) = aer(icl_a, jtotal , imode) * nano_mult_cair_inv
+ if (iaer_no3 > 0) &
+ qaer_cur(iaer_no3, imode) = aer(ino3_a, jtotal , imode) * nano_mult_cair_inv
+ if (iaer_ca > 0) &
+ qaer_cur(iaer_ca, imode) = aer(ica_a, jtotal , imode) * nano_mult_cair_inv
+ if (iaer_co3 > 0) &
+ qaer_cur(iaer_co3, imode) = aer(ico3_a, jtotal , imode) * nano_mult_cair_inv
+
+ !Units of BC, OC and DST in CAM are (mol/mol of air) and nano-g/m3 in MOSAIC
+ qaer_cur(iaer_bc, imode) = (aer(ibc_a, jtotal , imode)/mw_aer(iaer_bc)) * nano_mult_cair_inv
+ qaer_cur(iaer_dst, imode) = (aer(ioin_a, jtotal , imode)/mw_aer(iaer_dst)) * nano_mult_cair_inv !BSINGH - "Other inorganic" in Mosaic is DST in CAM
+ qaer_cur(iaer_pom, imode) = (aer(ioc_a, jtotal , imode)/mw_aer(iaer_pom)) * nano_mult_cair_inv
+
+ !Populate aerosol number and water species
+ qnum_cur(imode) = num_a(imode) * num_mos_to_cam_units
+ qwtr_cur(imode) = water_a(imode) * wtr_mos_to_cam_units
+ end do
+
+ !BSINGH - only 3 gases are avialble in CAM (SOAG, H2SO4, NH3).
+ !SOAG is stored in LIM2 gas species as of now
+
+ qgas_cur(igas_soa) = gas(ilim2_g) * nano_mult_cair_inv
+ qgas_cur(igas_h2so4) = gas(ih2so4_g) * nano_mult_cair_inv
+ qgas_cur(igas_nh3) = gas(inh3_g) * nano_mult_cair_inv
+
+ qgas_avg(igas_soa) = gas_avg(ilim2_g) * nano_mult_cair_inv
+ qgas_avg(igas_h2so4) = gas_avg(ih2so4_g) * nano_mult_cair_inv
+ qgas_avg(igas_nh3) = gas_avg(inh3_g) * nano_mult_cair_inv
+
+ if (igas_hno3 > 0) then
+ qgas_cur(igas_hno3) = gas( ihno3_g) * nano_mult_cair_inv
+ qgas_avg(igas_hno3) = gas_avg(ihno3_g) * nano_mult_cair_inv
+ end if
+ if (igas_hcl > 0) then
+ qgas_cur(igas_hcl) = gas( ihcl_g) * nano_mult_cair_inv
+ qgas_avg(igas_hcl) = gas_avg(ihcl_g) * nano_mult_cair_inv
+ end if
+
+ !update mode diameters
+ !Dry geo. mean dia.(m) of number distrib [convert from cm to m]
+ dgn_a(1:n_mode) = Dp_dry_a(1:n_mode) * 0.01_r8 / fcvt_dgnum_dvolmean(1:n_mode)
+ !Wet geo. mean dia.(m) of number distrib [convert from cm to m]
+ dgn_awet(1:n_mode) = dp_wet_a(1:n_mode) * 0.01_r8 / fcvt_dgnum_dvolmean(1:n_mode)
+
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+ !END [Process MOSAIC output ....]
+ !------------------------------------------------------------!
+ !------------------------------------------------------------!
+
+
+ end subroutine mosaic_gasaerexch_1subarea_intr
+#endif
+
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+ subroutine mam_gasaerexch_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ jtsubstep, ntsubstep, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qgas_netprod_otrproc, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ dgn_a, dgn_awet, wetdens, &
+ uptkaer, uptkrate_h2so4 )
+
+! uses
+
+ implicit none
+
+! arguments
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: jtsubstep, ntsubstep ! time substep info from calling routine
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ real(r8), intent(in) :: dtsubstep ! integration timestep (s)
+ real(r8), intent(in) :: temp ! air temperature (K)
+ real(r8), intent(in) :: pmid ! air pressure at model levels (Pa)
+ real(r8), intent(in) :: aircon ! air molar concentration (kmol/m3)
+
+ real(r8), intent(inout), dimension( 1:max_gas ) :: &
+ qgas_cur, & ! current gas mix ratios (mol/mol)
+ qgas_avg ! average gas mix ratios over the dtsubstep integration
+ real(r8), intent(in ), dimension( 1:max_gas ) :: &
+ qgas_netprod_otrproc
+ ! qgas_netprod_otrproc = gas net production rate from other processes
+ ! such as gas-phase chemistry and emissions (mol/mol/s)
+ ! this allows the condensation (gasaerexch) routine to apply production and condensation loss
+ ! together, which is more accurate numerically
+ ! NOTE - must be >= zero, as numerical method can fail when it is negative
+ ! NOTE - currently only the values for h2so4 and nh3 should be non-zero
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur ! current aerosol mass mix ratios (mol/mol)
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum_cur ! current aerosol number mix ratios (#/kmol)
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr_cur ! current aerosol water mix ratios (mol/mol)
+! qgas/aer/num/wtr_cur values are updated during the dtsubstep integration
+
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ dgn_a, & ! dry geo. mean dia. (m) of number distrib.
+ dgn_awet, & ! wet geo. mean dia. (m) of number distrib.
+ wetdens ! interstitial aerosol wet density (kg/m3)
+ real(r8), intent(inout), dimension( 1:max_gas, 1:max_mode ) :: &
+ uptkaer ! gas to aerosol mass transfer rate (1/s)
+ real(r8), intent(inout) :: uptkrate_h2so4
+ ! h2so4(g) to aerosol mass transfer rate, summed over all modes (1/s)
+ ! this is needed by the nucleation routine (mam_newnuc_1subarea)
+
+! local
+ integer :: iaer, igas, ip
+ integer :: ll
+ integer :: n
+
+ logical, parameter :: flag_nh4_lt_2so4_each_step = .false.
+
+ real(r8), dimension( 1:max_gas ) :: &
+ gas_diffus, & ! gas diffusivity at current temp and pres (m2/s)
+ gas_freepath ! gas mean free path at current temp and pres (m)
+
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas_prv
+
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_prv
+
+ real(r8) :: tmpa, tmpb, tmpc
+ real(r8) :: tmp_kxt, tmp_kxt2, tmp_pxt, tmp_pok
+ real(r8) :: tmp_q1, tmp_q2, tmp_q3, tmp_q4, tmp_q5
+ real(r8) :: tmp_qdel_cond
+ real(r8) :: uptkrate(max_mode)
+
+
+ qgas_avg(1:ngas) = 0.0_r8
+
+
+! calc gas uptake (mass transfer) rates
+ if (jtsubstep == 1) then
+
+ tmpa = pmid/1.013e5_r8
+ do igas = 1, ngas
+ gas_diffus(igas) = gas_diffusivity( &
+ temp, tmpa, mw_gas(igas), vol_molar_gas(igas) )
+
+ tmpb = mean_molecular_speed( temp, mw_gas(igas) )
+
+ gas_freepath(igas) = 3.0_r8 * gas_diffus(igas) / tmpb
+
+! subr gas_aer_uptkrates_1box1gas( &
+! accom, gasdiffus, gasfreepath, &
+! beta, nmode, dgncur_awet, lnsg, uptkrate )
+ call gas_aer_uptkrates_1box1gas( &
+ accom_coef_gas(igas), gas_diffus(igas), gas_freepath(igas), &
+ 0.0_r8, ntot_amode, dgn_awet, alnsg_aer, uptkrate )
+
+ iaer = igas
+ do n = 1, ntot_amode
+ if ( lmap_aer(iaer,n) > 0 .or. &
+ mode_aging_optaa(n) > 0 ) then
+ ! uptkrate is for number = 1 #/m3, so mult. by number conc. (#/m3)
+ uptkaer(igas,n) = uptkrate(n) * (qnum_cur(n) * aircon)
+ else
+ ! mode does not contain this species
+ uptkaer(igas,n) = 0.0_r8
+ end if
+ end do
+ end do ! igas
+
+ do igas = 1, ngas
+ ! use cam5.1.00 uptake rates
+ if (igas <= nsoa ) uptkaer(igas,1:ntot_amode) = uptkaer(igas_h2so4,1:ntot_amode)*0.81
+ if (igas == igas_nh3) uptkaer(igas,1:ntot_amode) = uptkaer(igas_h2so4,1:ntot_amode)*2.08
+ end do ! igas
+ uptkrate_h2so4 = sum( uptkaer(igas_h2so4,1:ntot_amode) )
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( k == pver .and. ldiagd1 ) write(lund,'(a,2i4,1p,10e11.3)') 'i,k,h2so4_uprt', i, k, uptkaer(igas_h2so4,1:ntot_amode)
+! if (i==1 .and. k==4) then
+! write(*,*) 'uptake rates at i=1, k=4, igas down, nmode across'
+! do igas = 1, ngas
+! write(*,'(1p,10e10.2)') uptkaer(igas,1:ntot_amode)
+! end do
+! write(*,*) 'dgn_awet then sigmag then qnum'
+! write(*,'(1p,10e10.2)') dgn_awet(1:ntot_amode)
+! write(*,'(1p,10e10.2)') sigmag_aer(1:ntot_amode)
+! write(*,'(1p,10e10.2)') qnum_cur(1:ntot_amode)
+! end if
+#endif
+
+ end if ! (jtsubstep == 1)
+
+
+! do soa
+ call mam_soaexch_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ uptkaer )
+
+
+! do other gases (that are assumed non-volatile) with no time sub-stepping
+ do igas = nsoa+1, ngas
+ iaer = igas
+ qgas_prv(igas) = qgas_cur(igas)
+ qaer_prv(iaer,1:n_mode) = qaer_cur(iaer,1:n_mode)
+ end do
+
+ do igas = nsoa+1, ngas
+ iaer = igas
+ if ( (igas == igas_hno3) .or. &
+ (igas == igas_hcl ) ) cycle
+
+ tmpa = sum( uptkaer(igas,1:n_mode) )
+ tmp_kxt = tmpa*dtsubstep
+ tmp_pxt = qgas_netprod_otrproc(igas)*dtsubstep
+ tmp_q1 = qgas_prv(igas)
+ ! tmp_q1 = mix-rat at t=tcur
+ ! tmp_q3 = mix-rat at t=tcur+dtsubstep
+ ! tmp_q4 = avg mix-rat between t=tcur and t=tcur+dtsubstep
+ if (tmp_kxt >= 1.0e-20_r8) then
+ if (tmp_kxt > 0.001_r8) then
+ tmp_pok = tmp_pxt/tmp_kxt
+ tmp_q3 = (tmp_q1 - tmp_pok)*exp(-tmp_kxt) + tmp_pok
+ tmp_q4 = (tmp_q1 - tmp_pok)*(1.0_r8 - exp(-tmp_kxt))/tmp_kxt + tmp_pok
+ else
+ tmp_kxt2 = tmp_kxt*tmp_kxt
+ tmp_q3 = tmp_q1 *(1.0_r8 - tmp_kxt + tmp_kxt2*0.5_r8) &
+ + tmp_pxt*(1.0_r8 - tmp_kxt*0.5_r8 + tmp_kxt2/6.0_r8)
+ tmp_q4 = tmp_q1 *(1.0_r8 - tmp_kxt*0.5_r8 + tmp_kxt2/6.0_r8) &
+ + tmp_pxt*(0.5_r8 - tmp_kxt/6.0_r8 + tmp_kxt2/24.0_r8)
+ end if
+ qgas_cur(igas) = tmp_q3
+ tmp_qdel_cond = (tmp_q1 + tmp_pxt) - tmp_q3
+ qgas_avg(igas) = tmp_q4
+ do n = 1, n_mode
+ if (uptkaer(igas,n) <= 0.0_r8) cycle
+ tmpc = tmp_qdel_cond*(uptkaer(igas,n)/tmpa)
+ qaer_cur(iaer,n) = qaer_prv(iaer,n) + tmpc
+ end do
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag82 ) then
+ if (i==1 .and. k==pver .and. igas==igas_h2so4) then
+ tmp_q2 = tmp_q1 + tmp_pxt
+
+ write(lun82,'(/a,2i5,1p,8e17.9)') 'gasaer - i, k, sum_uprt_so4, qav', &
+ i, k, tmpa, -1.0
+ tmp_q2 = max( 1.0e-30_r8, tmp_q2 )
+ write(lun82,'(/a,2i5,1p,8e17.9)') 'gasaer - i, k, q1, q2, q3, q4 ', &
+ i, k, tmp_q1, tmp_q2, tmp_q3, tmp_q4
+ write(lun82,'(/a,2i5,1p,8e17.9)') 'gasaer - i, k, k*t, p*t, p/k, t ', &
+ i, k, tmp_kxt, tmp_pxt, tmp_pok, dtsubstep, tmp_qdel_cond
+ end if
+ end if
+#endif
+
+ else
+ ! tmp_kxt < 1.0e-20_r8 so uptake to aerosols ~= 0.0
+ ! in this case, do not bother to update qaer_cur
+ tmp_q3 = tmp_q1 + tmp_pxt
+ tmp_q4 = tmp_q1 + tmp_pxt*0.5_r8
+ qgas_cur(igas) = tmp_q3
+ qgas_avg(igas) = tmp_q4
+ end if
+ end do ! igas
+
+ if ( igas_nh3 > 0 ) then
+! do not allow nh4 to exceed 2*so4 (molar basis)
+ iaer = iaer_nh4 ; igas = igas_nh3
+ do n = 1, n_mode
+ if (uptkaer(igas,n) <= 0.0_r8) cycle
+ tmpa = qaer_cur(iaer,n) - 2.0_r8*qaer_cur(iaer_so4,n)
+ if (tmpa > 0.0_r8) then
+ qaer_cur(iaer,n) = qaer_cur(iaer,n) - tmpa
+ qgas_cur(igas) = qgas_cur(igas) + tmpa
+ qgas_avg(igas) = qgas_avg(igas) + tmpa*0.5_r8
+ end if
+ end do
+ end if
+
+
+ return
+ end subroutine mam_gasaerexch_1subarea
+
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+ subroutine mam_soaexch_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ uptkaer )
+!
+! calculate soa condensation/evaporation for i,k,jsub over time dtsubstep
+!
+
+! uses
+ use modal_aero_data, only: lptr2_soa_a_amode
+
+
+ implicit none
+
+! arguments
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ real(r8), intent(in) :: dtsubstep ! current integration timestep (s)
+ real(r8), intent(in) :: temp ! temperature (K)
+ real(r8), intent(in) :: pmid ! pressure at model levels (Pa)
+ real(r8), intent(in) :: aircon ! air molar concentration (kmol/m3)
+
+ real(r8), intent(inout), dimension( 1:max_gas ) :: &
+ qgas_cur, qgas_avg
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum_cur
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr_cur
+ real(r8), intent(in ), dimension( 1:max_gas, 1:max_mode ) :: &
+ uptkaer
+
+! local
+ integer, parameter :: ntot_poaspec = npoa
+ integer, parameter :: ntot_soaspec = nsoa
+
+ integer :: iaer, igas, ip
+ integer :: ll
+ integer :: n, niter, niter_max
+ integer :: ntot_soamode
+
+ logical, parameter :: flag_pcarbon_opoa_frac_zero = .true.
+
+ logical :: skip_soamode(max_mode) ! true if this mode does not have soa
+
+ real(r8), dimension( 1:max_gas ) :: &
+ qgas_prv
+
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_prv
+
+ real(r8) :: uptkaer_soag_tmp(nsoa,max_mode)
+
+ real(r8), parameter :: a_min1 = 1.0e-20
+ real(r8), parameter :: g_min1 = 1.0e-20
+ real(r8), parameter :: alpha_astem = 0.05_r8 ! parameter used in calc of time step
+ real(r8), parameter :: dtsub_fixed = -1.0 ! fixed sub-step for time integration (s)
+! real(r8), parameter :: dtsub_fixed = 10.0 ! fixed sub-step for time integration (s)
+ real(r8), parameter :: rgas = 8.3144_r8 ! gas constant in J/K/mol
+
+ real(r8) :: a_ooa_sum_tmp(max_mode) ! total ooa (=soa+opoa) in a mode
+ real(r8) :: a_opoa(max_mode) ! oxidized-poa aerosol mixrat (mol/mol at actual mw)
+ real(r8) :: a_soa(ntot_soaspec,max_mode) ! soa aerosol mixrat (mol/mol at actual mw)
+ real(r8) :: a_soa_tmp(ntot_soaspec,max_mode) ! temporary soa aerosol mixrat (mol/mol)
+ real(r8) :: beta(ntot_soaspec,max_mode) ! dtcur*xferrate
+ real(r8) :: delh_vap_soa(ntot_soaspec) ! delh_vap_soa = heat of vaporization for gas soa (J/mol)
+ real(r8) :: del_g_soa_tmp(ntot_soaspec)
+ real(r8) :: dtcur ! current time step (s)
+ real(r8) :: dtfull ! full time step (s)
+ real(r8) :: dtmax ! = (dtfull-tcur)
+ real(r8) :: dtsum_qgas_avg
+ real(r8) :: g0_soa(ntot_soaspec) ! ambient soa gas equilib mixrat (mol/mol at actual mw)
+ real(r8) :: g_soa(ntot_soaspec) ! soa gas mixrat (mol/mol at actual mw)
+ real(r8) :: g_star(ntot_soaspec,max_mode) ! soa gas mixrat that is in equilib
+ ! with each aerosol mode (mol/mol)
+ real(r8) :: mw_poa(ntot_poaspec) ! actual molec wght of poa
+ real(r8) :: mw_soa(ntot_soaspec) ! actual molec wght of soa
+ real(r8) :: opoa_frac(ntot_poaspec,max_mode) ! fraction of poa that is opoa
+ real(r8) :: phi(ntot_soaspec,max_mode) ! "relative driving force"
+ real(r8) :: p0_soa(ntot_soaspec) ! soa gas equilib vapor presssure (atm)
+ real(r8) :: p0_soa_298(ntot_soaspec) ! p0_soa_298 = soa gas equilib vapor presssure (atm) at 298 k
+ real(r8) :: sat(ntot_soaspec,max_mode) ! sat(m,ll) = g0_soa(ll)/a_ooa_sum_tmp(m) = g_star(m,ll)/a_soa(m,ll)
+ ! used by the numerical integration scheme -- it is not a saturation rato!
+ real(r8) :: tcur ! current integration time (from 0 s)
+
+ real(r8) :: tmpa, tmpb, tmpc
+
+ real(r8) :: tot_soa(ntot_soaspec) ! g_soa + sum( a_soa(:) )
+
+
+! calc ntot_soamode = "last" mode on which soa is allowed to condense
+ ntot_soamode = 0
+ do n = 1, ntot_amode
+ if (n == nufi) cycle
+ if (mode_aging_optaa(n) > 0) ntot_soamode = n
+ if (lptr2_soa_a_amode(n,1) > 0) ntot_soamode = n
+ end do
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( i*k == top_lev .and. ldiagd1 ) write(lund,'(/a,5i5)') &
+ 'ntot_amode, ntot_amode_extd, n_mode, ntot_soamode', &
+ ntot_amode, ntot_amode_extd, n_mode, ntot_soamode
+#endif
+
+ opoa_frac = 0.1_r8
+! for primary carbon mode, set opoa_frac=0 for consistency with older code
+! (this could be changed)
+ if ( flag_pcarbon_opoa_frac_zero ) then
+ if (npca > 0) opoa_frac(:,npca) = 0.0_r8
+ end if
+
+ delh_vap_soa = 156.0e3
+! delh_vap_soa = 30.0e3 ! 11-jun-2012
+ p0_soa_298 = 1.0e-10
+
+! calc ambient equilibrium soa gas
+ do ll = 1, ntot_soaspec
+ p0_soa(ll) = p0_soa_298(ll) * &
+ exp( -(delh_vap_soa(ll)/rgas)*((1.0/temp)-(1.0/298.0)) )
+ g0_soa(ll) = 1.01325e5*p0_soa(ll)/pmid
+ end do
+
+ niter_max = 1000
+ niter = 0
+ dtfull = dtsubstep
+ tcur = 0.0
+ dtcur = 0.0
+ phi(:,:) = 0.0
+ g_star(:,:) = 0.0
+ g_soa(:) = 0.0
+ a_opoa(:) = 0.0
+ a_soa(:,:) = 0.0
+
+!
+! main integration loop -- does multiple substeps to reach dtfull
+!
+ qgas_avg(1:nsoa) = 0.0_r8
+ dtsum_qgas_avg = 0.0_r8
+
+time_loop: &
+ do while (tcur < dtfull-1.0e-3_r8 )
+
+ niter = niter + 1
+ if (niter > niter_max) exit
+
+
+! set qxxx_prv to be current value
+ qgas_prv(1:nsoa) = qgas_cur(1:nsoa)
+ qaer_prv = qaer_cur
+! qaer_num = qnum_cur
+
+
+! determine which modes have non-zero transfer rates
+! and are involved in the soa gas-aerosol transfer
+! for diameter = 1 nm and number = 1 #/cm3, xferrate ~= 1e-9 s-1
+ do n = 1, ntot_soamode
+ skip_soamode(n) = .true.
+ do ll = 1, ntot_soaspec
+ if (uptkaer(ll,n) > 1.0e-15_r8) then
+ uptkaer_soag_tmp(ll,n) = uptkaer(ll,n)
+ skip_soamode(n) = .false.
+ else
+ uptkaer_soag_tmp(ll,n) = 0.0_r8
+ end if
+ end do
+ end do
+
+! load incoming soag and soaa into temporary arrays
+! force things to be non-negative
+! calc tot_soa(ll)
+! calc a_opoa (always slightly >0)
+!
+! *** questions ***
+! > why not use qgas and qaer instead of g_soa and a_soa
+! > why not calc the following on every substep because
+! nuc and coag may change things:
+! skip)soamode, uptkaer_soag_tmp, tot_soa, a_opoa
+! > include gasprod for soa ??
+! > create qxxx_bgn = qxxx_cur at the very beginning (is it needed)
+!
+ do ll = 1, ntot_soaspec
+ g_soa(ll) = max( qgas_prv(ll), 0.0_r8 )
+ tot_soa(ll) = g_soa(ll)
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_soa(ll,n) = max( qaer_prv(ll,n), 0.0_r8 )
+ tot_soa(ll) = tot_soa(ll) + a_soa(ll,n)
+ end do
+ end do
+
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_opoa(n) = 0.0_r8
+ do ll = 1, ntot_poaspec
+ a_opoa(n) = a_opoa(n) + opoa_frac(ll,n) * max( qaer_prv(iaer_pom+ll-1,n), 0.0_r8 )
+ end do
+ end do
+
+
+! determine time step
+ tmpa = 0.0 ! time integration parameter for all soa species
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_ooa_sum_tmp(n) = a_opoa(n) + sum( a_soa(1:ntot_soaspec,n) )
+ end do
+ do ll = 1, ntot_soaspec
+ tmpb = 0.0 ! time integration parameter for a single soa species
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ sat(ll,n) = g0_soa(ll)/max( a_ooa_sum_tmp(n), a_min1 )
+ g_star(ll,n) = sat(ll,n)*a_soa(ll,n)
+ phi(ll,n) = (g_soa(ll) - g_star(ll,n))/max( g_soa(ll), g_star(ll,n), g_min1 )
+ tmpb = tmpb + uptkaer_soag_tmp(ll,n)*abs(phi(ll,n))
+ end do
+ tmpa = max( tmpa, tmpb )
+ end do
+
+ if (dtsub_fixed > 0.0_r8) then
+ dtcur = dtsub_fixed
+ tcur = tcur + dtcur
+ else
+ dtmax = dtfull-tcur
+ if (dtmax*tmpa <= alpha_astem) then
+! here alpha_astem/tmpa >= dtmax, so this is final substep
+ dtcur = dtmax
+ tcur = dtfull
+ else
+ dtcur = alpha_astem/tmpa
+ tcur = tcur + dtcur
+ end if
+ end if
+
+
+! step 1 - for modes where soa is condensing, estimate "new" a_soa(ll,n)
+! using an explicit calculation with "old" g_soa
+! and g_star(ll,n) calculated using "old" a_soa(ll,n)
+! do this to get better estimate of "new" a_soa(ll,n) and sat(ll,n)
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ do ll = 1, ntot_soaspec
+ ! first ll loop calcs a_soa_tmp(ll,n) & a_ooa_sum_tmp
+ a_soa_tmp(ll,n) = a_soa(ll,n)
+ beta(ll,n) = dtcur*uptkaer_soag_tmp(ll,n)
+ del_g_soa_tmp(ll) = g_soa(ll) - g_star(ll,n)
+ if (del_g_soa_tmp(ll) > 0.0_r8) then
+ a_soa_tmp(ll,n) = a_soa(ll,n) + beta(ll,n)*del_g_soa_tmp(ll)
+ end if
+ end do
+ a_ooa_sum_tmp(n) = a_opoa(n) + sum( a_soa_tmp(1:ntot_soaspec,n) )
+ do ll = 1, ntot_soaspec
+ ! second ll loop calcs sat & g_star
+ if (del_g_soa_tmp(ll) > 0.0_r8) then
+ sat(ll,n) = g0_soa(ll)/max( a_ooa_sum_tmp(n), a_min1 )
+ g_star(ll,n) = sat(ll,n)*a_soa_tmp(ll,n) ! this just needed for diagnostics
+ end if
+ end do
+ end do
+
+
+! step 2 - implicit in g_soa and semi-implicit in a_soa,
+! with g_star(ll,n) calculated semi-implicitly
+ do ll = 1, ntot_soaspec
+ tmpa = 0.0
+ tmpb = 0.0
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ tmpa = tmpa + a_soa(ll,n)/(1.0_r8 + beta(ll,n)*sat(ll,n))
+ tmpb = tmpb + beta(ll,n)/(1.0_r8 + beta(ll,n)*sat(ll,n))
+ end do
+
+ g_soa(ll) = (tot_soa(ll) - tmpa)/(1.0_r8 + tmpb)
+ g_soa(ll) = max( 0.0_r8, g_soa(ll) )
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_soa(ll,n) = (a_soa(ll,n) + beta(ll,n)*g_soa(ll))/ &
+ (1.0_r8 + beta(ll,n)*sat(ll,n))
+ end do
+ end do
+
+
+! update mix ratios for soa species
+ do igas = 1, nsoa
+ iaer = igas
+ qgas_cur(igas) = g_soa(igas)
+ tmpc = qgas_cur(igas) - qgas_prv(igas)
+ qgas_avg(igas) = qgas_avg(igas) + dtcur*(qgas_prv(igas) + 0.5_r8*tmpc)
+ do n = 1, ntot_soamode
+ qaer_cur(iaer,n) = a_soa(iaer,n)
+ tmpc = qaer_cur(iaer,n) - qaer_prv(iaer,n)
+ end do
+ end do
+
+
+ dtsum_qgas_avg = dtsum_qgas_avg + dtcur
+
+ end do time_loop
+
+! convert qgas_avg from sum_over[ qgas*dt_cut ] to an average
+ do igas = 1, nsoa
+ qgas_avg(igas) = max( 0.0_r8, qgas_avg(igas)/dtsum_qgas_avg )
+ end do
+
+
+ return
+ end subroutine mam_soaexch_1subarea
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine mam_rename_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ iscldy_subarea, &
+ mtoo_renamexf, &
+ n_mode, &
+ qnum_cur, &
+ qaer_cur, qaer_del_grow4rnam, &
+ qwtr_cur, &
+ qnumcw_cur, &
+ qaercw_cur, qaercw_del_grow4rnam )
+
+#if ( defined CAM_VERSION_IS_ACME )
+ use shr_spfn_mod, only: erfc => shr_spfn_erfc ! acme version of cam
+#else
+ use error_function, only: erfc ! mozart-mosaic version of cam
+#endif
+
+ logical, intent(in) :: iscldy_subarea ! true if sub-area is cloudy
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: mtoo_renamexf(max_mode)
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum_cur
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur
+ real(r8), intent(in ), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_del_grow4rnam
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr_cur
+
+ real(r8), intent(inout), optional, dimension( 1:max_mode ) :: &
+ qnumcw_cur
+ real(r8), intent(inout), optional, dimension( 1:max_aer, 1:max_mode ) :: &
+ qaercw_cur
+ real(r8), intent(in ), optional, dimension( 1:max_aer, 1:max_mode ) :: &
+ qaercw_del_grow4rnam
+
+
+! !DESCRIPTION:
+! computes TMR (tracer mixing ratio) tendencies for "mode renaming"
+! during a continuous growth process
+! currently this transfers number and mass (and surface) from the aitken
+! to accumulation mode after gas condensation or stratiform-cloud
+! aqueous chemistry
+! (convective cloud aqueous chemistry not yet implemented)
+!
+! !REVISION HISTORY:
+!
+
+! local variables
+ integer :: iaer
+ integer :: mfrm, mtoo
+ integer :: n, npair
+
+ integer, parameter :: ldiag1 = 0
+
+ real(r8), parameter :: frelax = 27.0_r8
+ real(r8), parameter :: onethird = 1.0_r8/3.0_r8
+
+ real(r8) :: deldryvol_a(ntot_amode)
+ real(r8) :: deldryvol_c(ntot_amode)
+ real(r8) :: dp_belowcut(max_mode)
+ real(r8) :: dp_cut(max_mode)
+ real(r8) :: dgn_aftr, dgn_xfer
+ real(r8) :: dgn_t_new, dgn_t_old, dgn_t_oldaa
+ real(r8) :: dryvol_t_del, dryvol_t_new
+ real(r8) :: dryvol_t_old, dryvol_t_oldaa, dryvol_t_oldbnd
+ real(r8) :: dryvol_a(ntot_amode)
+ real(r8) :: dryvol_c(ntot_amode)
+ real(r8) :: dryvol_smallest(ntot_amode)
+ real(r8) :: factoraa(ntot_amode)
+ real(r8) :: factoryy(ntot_amode)
+ real(r8) :: lndp_cut(max_mode)
+ real(r8) :: lndgn_new, lndgn_old
+ real(r8) :: lndgv_new, lndgv_old
+ real(r8) :: num_t_old, num_t_oldbnd
+ real(r8) :: tailfr_volnew, tailfr_volold
+ real(r8) :: tailfr_numnew, tailfr_numold
+ real(r8) :: tmpa, tmpb, tmpd
+ real(r8) :: tmp_alnsg2(max_mode)
+ real(r8) :: v2nhirlx(ntot_amode), v2nlorlx(ntot_amode)
+ real(r8) :: xfercoef, xfertend
+ real(r8) :: xferfrac_vol, xferfrac_num, xferfrac_max
+ real(r8) :: yn_tail, yv_tail
+
+
+ xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8) ! 1-eps
+
+! calculate variable used in the renamingm mode" of each renaming pair
+! also compute dry-volume change during the continuous growth process
+ npair = 0
+ do n = 1, ntot_amode
+ mtoo = mtoo_renamexf(n)
+ if (mtoo <= 0) cycle
+
+ npair = npair + 1
+ mfrm = n
+ factoraa(mfrm) = (pi/6.)*exp(4.5*(alnsg_aer(mfrm)**2))
+ factoraa(mtoo) = (pi/6.)*exp(4.5*(alnsg_aer(mtoo)**2))
+ factoryy(mfrm) = sqrt( 0.5 )/alnsg_aer(mfrm)
+! dryvol_smallest is a very small volume mixing ratio (m3-AP/kmol-air)
+! used for avoiding overflow. it corresponds to dp = 1 nm
+! and number = 1e-5 #/mg-air ~= 1e-5 #/cm3-air
+ dryvol_smallest(mfrm) = 1.0e-25
+! v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax
+! v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax
+ v2nlorlx(mfrm) = ( 1._r8 / ( (pi/6._r8)* &
+ (dgnumlo_aer(mfrm)**3._r8)*exp(4.5_r8*alnsg_aer(mfrm)**2._r8) ) ) * frelax
+ v2nhirlx(mfrm) = ( 1._r8 / ( (pi/6._r8)* &
+ (dgnumhi_aer(mfrm)**3._r8)*exp(4.5_r8*alnsg_aer(mfrm)**2._r8) ) ) / frelax
+
+ tmp_alnsg2(mfrm) = 3.0 * (alnsg_aer(mfrm)**2)
+ dp_cut(mfrm) = sqrt( &
+ dgnum_aer(mfrm)*exp(1.5*(alnsg_aer(mfrm)**2)) * &
+ dgnum_aer(mtoo)*exp(1.5*(alnsg_aer(mtoo)**2)) )
+ lndp_cut(mfrm) = log( dp_cut(mfrm) )
+ dp_belowcut(mfrm) = 0.99*dp_cut(mfrm)
+ end do
+ if (npair <= 0) return
+
+! compute aerosol dry-volume for the "from mode" of each renaming pair
+! also compute dry-volume change during the continuous growth process
+ do n = 1, ntot_amode
+ mtoo = mtoo_renamexf(n)
+ if (mtoo <= 0) cycle
+
+ tmpa = 0.0_r8 ; tmpb = 0.0_r8
+ do iaer = 1, naer
+! fac_m2v_aer converts (kmol-AP/kmol-air) to (m3-AP/kmol-air)
+ tmpa = tmpa + qaer_cur(iaer,n)*fac_m2v_aer(iaer)
+ tmpb = tmpb + qaer_del_grow4rnam(iaer,n)*fac_m2v_aer(iaer)
+ end do
+ dryvol_a(n) = tmpa-tmpb ! dry volume before growth
+ deldryvol_a(n) = tmpb ! change to dry volume due to growth
+
+ if ( iscldy_subarea ) then
+ tmpa = 0.0_r8 ; tmpb = 0.0_r8
+ do iaer = 1, naer
+! fac_m2v_aer converts (kmol-AP/kmol-air) to (m3-AP/kmol-air)
+ tmpa = tmpa + qaercw_cur(iaer,n)*fac_m2v_aer(iaer)
+ tmpb = tmpb + qaercw_del_grow4rnam(iaer,n)*fac_m2v_aer(iaer)
+ end do
+ dryvol_c(n) = tmpa-tmpb
+ deldryvol_c(n) = tmpb
+ end if ! ( iscldy_subarea ) then
+
+ end do
+
+
+!
+! loop over renaming pairs
+!
+mainloop1_ipair: do n = 1, ntot_amode
+
+ mfrm = n
+ mtoo = mtoo_renamexf(n)
+ if (mtoo <= 0) cycle mainloop1_ipair
+
+! dryvol_t_old is the old total (a+c) dry-volume for the "from" mode
+! in m^3-AP/kmol-air
+! dryvol_t_new is the new total dry-volume
+! (old/new = before/after the continuous growth)
+! num_t_old is total number in particles/kmol-air
+ if ( iscldy_subarea ) then
+ dryvol_t_old = dryvol_a(mfrm) + dryvol_c(mfrm)
+ dryvol_t_del = deldryvol_a(mfrm) + deldryvol_c(mfrm)
+ num_t_old = (qnum_cur(mfrm) + qnumcw_cur(mfrm))
+ else
+ dryvol_t_old = dryvol_a(mfrm)
+ dryvol_t_del = deldryvol_a(mfrm)
+ num_t_old = qnum_cur(mfrm)
+ end if
+ dryvol_t_new = dryvol_t_old + dryvol_t_del
+
+! no renaming if dryvol_t_new ~ 0 or dryvol_t_del ~ 0
+ if (dryvol_t_new .le. dryvol_smallest(mfrm)) cycle mainloop1_ipair
+ dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
+ if (rename_method_optaa .ne. 40) then
+ if (dryvol_t_del .le. 1.0e-6*dryvol_t_oldbnd) cycle mainloop1_ipair
+ end if
+
+ num_t_old = max( 0.0_r8, num_t_old )
+ dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
+ num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old )
+ num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd )
+
+! no renaming if dgnum < "base" dgnum,
+ dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird
+ if (dgn_t_new .le. dgnum_aer(mfrm)) cycle mainloop1_ipair
+
+! compute new fraction of number and mass in the tail (dp > dp_cut)
+ lndgn_new = log( dgn_t_new )
+ lndgv_new = lndgn_new + tmp_alnsg2(mfrm)
+ yn_tail = (lndp_cut(mfrm) - lndgn_new)*factoryy(mfrm)
+ yv_tail = (lndp_cut(mfrm) - lndgv_new)*factoryy(mfrm)
+ tailfr_numnew = 0.5_r8*erfc( yn_tail )
+ tailfr_volnew = 0.5_r8*erfc( yv_tail )
+
+! compute old fraction of number and mass in the tail (dp > dp_cut)
+ dgn_t_old = &
+ (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird
+ dgn_t_oldaa = dgn_t_old
+ dryvol_t_oldaa = dryvol_t_old
+
+ if (rename_method_optaa .eq. 40) then
+ if (dgn_t_old .gt. dp_belowcut(mfrm)) then
+ ! this revised volume corresponds to dgn_t_old == dp_belowcut, and same number conc
+ dryvol_t_old = dryvol_t_old * (dp_belowcut(mfrm)/dgn_t_old)**3
+ dgn_t_old = dp_belowcut(mfrm)
+ end if
+ if ((dryvol_t_new-dryvol_t_old) .le. 1.0e-6_r8*dryvol_t_oldbnd) cycle mainloop1_ipair
+ else if (dgn_t_new .ge. dp_cut(mfrm)) then
+! if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_old and
+! dp_belowcut to guarantee some transfer
+ dgn_t_old = min( dgn_t_old, dp_belowcut(mfrm) )
+ end if
+ lndgn_old = log( dgn_t_old )
+ lndgv_old = lndgn_old + tmp_alnsg2(mfrm)
+ yn_tail = (lndp_cut(mfrm) - lndgn_old)*factoryy(mfrm)
+ yv_tail = (lndp_cut(mfrm) - lndgv_old)*factoryy(mfrm)
+ tailfr_numold = 0.5_r8*erfc( yn_tail )
+ tailfr_volold = 0.5_r8*erfc( yv_tail )
+
+! transfer fraction is difference between new and old tail-fractions
+! transfer fraction for number cannot exceed that of mass
+ tmpa = tailfr_volnew*dryvol_t_new - tailfr_volold*dryvol_t_old
+ if (tmpa .le. 0.0_r8) cycle mainloop1_ipair
+
+ xferfrac_vol = min( tmpa, dryvol_t_new )/dryvol_t_new
+ xferfrac_vol = min( xferfrac_vol, xferfrac_max )
+ xferfrac_num = tailfr_numnew - tailfr_numold
+ xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) )
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag98 ) write(lun98,'(/a,2i3,1p,10e11.3)') &
+ 'rename i,k, xf n/v', i, k, xferfrac_num, xferfrac_vol
+#endif
+
+#if ( defined( CAMBOX_NEVER_ACTIVATE_THIS ) )
+! diagnostic output start ----------------------------------------
+ if (ldiag1 > 0) then
+ icol_diag = -1
+ if ((lonndx(i) == 37) .and. (latndx(i) == 23)) icol_diag = i
+ if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then
+ ! write(lund,97010) fromwhere, nstep, lchnk, i, k, ipair
+ write(lund,97010) fromwhere, nstep, latndx(i), lonndx(i), k, ipair
+ write(lund,97020) 'drv olda/oldbnd/old/new/del', &
+ dryvol_t_oldaa, dryvol_t_oldbnd, dryvol_t_old, dryvol_t_new, dryvol_t_del
+ write(lund,97020) 'num old/oldbnd, dgnold/new ', &
+ num_t_old, num_t_oldbnd, dgn_t_old, dgn_t_new
+ write(lund,97020) 'tailfr v_old/new, n_old/new', &
+ tailfr_volold, tailfr_volnew, tailfr_numold, tailfr_numnew
+ tmpa = max(1.0d-10,xferfrac_vol) / max(1.0d-10,xferfrac_num)
+ dgn_xfer = dgn_t_new * tmpa**onethird
+ tmpa = max(1.0d-10,(1.0d0-xferfrac_vol)) / &
+ max(1.0d-10,(1.0d0-xferfrac_num))
+ dgn_aftr = dgn_t_new * tmpa**onethird
+ write(lund,97020) 'xferfrac_v/n; dgn_xfer/aftr', &
+ xferfrac_vol, xferfrac_num, dgn_xfer, dgn_aftr
+ !97010 format( / 'RENAME ', a, ' nx,lc,i,k,ip', i8, 4i4 )
+ 97010 format( / 'RENAME ', a, ' nx,lat,lon,k,ip', i8, 4i4 )
+ 97020 format( a, 6(1pe15.7) )
+ end if
+ end if ! (ldiag1 > 0)
+! diagnostic output end ------------------------------------------
+#endif
+
+
+!
+! compute changes to number and species masses
+!
+ tmpd = qnum_cur(mfrm)*xferfrac_num
+ qnum_cur(mfrm) = qnum_cur(mfrm) - tmpd
+ qnum_cur(mtoo) = qnum_cur(mtoo) + tmpd
+ do iaer = 1, naer
+ tmpd = qaer_cur(iaer,mfrm)*xferfrac_vol
+ qaer_cur(iaer,mfrm) = qaer_cur(iaer,mfrm) - tmpd
+ qaer_cur(iaer,mtoo) = qaer_cur(iaer,mtoo) + tmpd
+ end do ! iaer
+
+ if ( iscldy_subarea ) then
+ tmpd = qnumcw_cur(mfrm)*xferfrac_num
+ qnumcw_cur(mfrm) = qnumcw_cur(mfrm) - tmpd
+ qnumcw_cur(mtoo) = qnumcw_cur(mtoo) + tmpd
+ do iaer = 1, naer
+ tmpd = qaercw_cur(iaer,mfrm)*xferfrac_vol
+ qaercw_cur(iaer,mfrm) = qaercw_cur(iaer,mfrm) - tmpd
+ qaercw_cur(iaer,mtoo) = qaercw_cur(iaer,mtoo) + tmpd
+ end do ! iaer
+ end if ! ( iscldy_subarea ) then
+
+
+#if ( defined( CAMBOX_NEVER_ACTIVATE_THIS ) )
+! diagnostic output start ----------------------------------------
+ if (ldiag1 > 0) then
+ if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then
+ if (lstooa .gt. 0) then
+ write(lund,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq, &
+ cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset), &
+ deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend), &
+ deltat*dqdt(i,k,lstooa), deltat*(dqdt(i,k,lstooa) + xfertend)
+ else
+ write(lund,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq, &
+ cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset), &
+ deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend)
+ end if
+ end if
+ end if
+! diagnostic output end ------------------------------------------
+#endif
+
+
+ end do mainloop1_ipair
+
+
+ return
+ end subroutine mam_rename_1subarea
+
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+ subroutine mam_newnuc_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ deltat, &
+ temp, pmid, aircon, &
+ zmid, pblh, relhum, &
+ uptkrate_h2so4, del_h2so4_gasprod, del_h2so4_aeruptk, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qnum_cur, &
+ qaer_cur, &
+ qwtr_cur, &
+ dnclusterdt )
+
+! uses
+ use chem_mods, only: adv_mass
+
+ use modal_aero_newnuc, only: &
+ mer07_veh02_nuc_mosaic_1box, qh2so4_cutoff
+
+ implicit none
+
+! arguments
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ real(r8), intent(in) :: deltat ! model timestep (s)
+ real(r8), intent(in) :: temp ! temperature (K)
+ real(r8), intent(in) :: pmid ! pressure at model levels (Pa)
+ real(r8), intent(in) :: aircon ! air molar concentration (kmol/m3)
+ real(r8), intent(in) :: zmid ! midpoint height above surface (m)
+ real(r8), intent(in) :: pblh ! pbl height (m)
+ real(r8), intent(in) :: relhum ! relative humidity (0-1)
+ real(r8), intent(in) :: uptkrate_h2so4
+ real(r8), intent(in) :: del_h2so4_gasprod
+ real(r8), intent(in) :: del_h2so4_aeruptk
+
+ real(r8), intent(inout) :: dnclusterdt ! cluster nucleation rate (#/m3/s)
+
+ real(r8), intent(inout), dimension( 1:max_gas ) :: &
+ qgas_cur
+ real(r8), intent(in ), dimension( 1:max_gas ) :: &
+ qgas_avg
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum_cur
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr_cur
+
+! DESCRIPTION:
+! computes changes due to aerosol nucleation (new particle formation)
+! treats both nucleation and subsequent growth of new particles
+! to aitken mode size
+! uses the following parameterizations
+! vehkamaki et al. (2002) parameterization for binary
+! homogeneous nucleation (h2so4-h2o) plus
+! kerminen and kulmala (2002) parameterization for
+! new particle loss during growth to aitken size
+!
+! REVISION HISTORY:
+! R.Easter 2007.09.14: Adapted from MIRAGE2 code and CMAQ V4.6 code
+!
+
+! local variables
+ integer, parameter :: ldiag1=-1, ldiag2=-1, ldiag3=-1, ldiag4=-1
+ integer, parameter :: newnuc_method_flagaa = 11
+! integer, parameter :: newnuc_method_flagaa = 12
+ ! 1=merikanto et al (2007) ternary 2=vehkamaki et al (2002) binary
+ ! 11=merikanto ternary + first-order boundary layer
+ ! 12=merikanto ternary + second-order boundary layer
+
+ integer :: itmp
+ integer :: l
+ integer :: ldiagveh02
+ integer :: m
+
+ real(r8) :: dens_nh4so4a
+ real(r8) :: dmdt_ait, dmdt_aitsv1, dmdt_aitsv2, dmdt_aitsv3
+ real(r8) :: dndt_ait, dndt_aitsv1, dndt_aitsv2, dndt_aitsv3
+ real(r8) :: dnh4dt_ait, dso4dt_ait
+ real(r8) :: dpnuc
+ real(r8) :: dplom_mode(1), dphim_mode(1)
+ real(r8) :: mass1p
+ real(r8) :: mass1p_aithi, mass1p_aitlo
+ real(r8) :: qh2so4_cur, qh2so4_avg, qh2so4_del
+ real(r8) :: qnh3_cur, qnh3_del, qnh4a_del
+ real(r8) :: qnuma_del
+ real(r8) :: qso4a_del
+ real(r8) :: relhumnn
+ real(r8) :: tmpa, tmpb, tmpc
+ real(r8) :: tmp_q2, tmp_q3
+ real(r8) :: tmp_q_del
+ real(r8) :: tmp_frso4, tmp_uptkrate
+
+ character(len=1) :: tmpch1, tmpch2, tmpch3
+
+
+! begin
+ dnclusterdt = 0.0_r8
+
+! qh2so4_cur = current qh2so4, after aeruptk
+! qh2so4_avg = average qh2so4 over time-step
+ qh2so4_cur = qgas_cur(igas_h2so4)
+
+ if ( (gaexch_h2so4_uptake_optaa == 1) .and. &
+ (newnuc_h2so4_conc_optaa == 1) ) then
+! estimate qh2so4_avg using the method in standard cam5.2 modal_aero_newnuc
+
+ ! skip if h2so4 vapor < qh2so4_cutoff
+ if (qh2so4_cur <= qh2so4_cutoff) goto 80000
+
+ tmpa = max( 0.0_r8, del_h2so4_gasprod )
+ tmp_q3 = qh2so4_cur
+ ! tmp_q2 = qh2so4 before aeruptk
+ ! (note tmp_q3, tmp_q2 both >= 0.0)
+ tmp_q2 = tmp_q3 + max( 0.0_r8, -del_h2so4_aeruptk )
+
+ ! tmpb = log( tmp_q2/tmp_q3 ) BUT with some checks added
+ if (tmp_q2 <= tmp_q3) then
+ tmpb = 0.0_r8
+ else
+ tmpc = tmp_q2 * exp( -20.0_r8 )
+ if (tmp_q3 <= tmpc) then
+ tmp_q3 = tmpc
+ tmpb = 20.0_r8
+ else
+ tmpb = log( tmp_q2/tmp_q3 )
+ end if
+ end if
+ ! d[ln(qh2so4)]/dt (1/s) from uptake (condensation) to aerosol
+ tmp_uptkrate = tmpb/deltat
+
+! qh2so4_avg = estimated average qh2so4
+! when production & loss are done simultaneously
+ if (tmpb <= 0.1_r8) then
+ qh2so4_avg = tmp_q3*(1.0_r8 + 0.5_r8*tmpb) - 0.5_r8*tmpa
+ else
+ tmpc = tmpa/tmpb
+ qh2so4_avg = (tmp_q3 - tmpc)*((exp(tmpb)-1.0_r8)/tmpb) + tmpc
+ end if
+ else
+! use qh2so4_avg and first-order loss rate calculated in mam_gasaerexch_1subarea
+ qh2so4_avg = qgas_avg(igas_h2so4)
+ tmp_uptkrate = uptkrate_h2so4
+ end if
+
+ if (qh2so4_avg <= qh2so4_cutoff) goto 80000
+
+ if (igas_nh3 > 0) then
+ qnh3_cur = max( 0.0_r8, qgas_cur(igas_nh3) )
+ else
+ qnh3_cur = 0.0_r8
+ end if
+
+! dry-diameter limits for "grown" new particles
+ dplom_mode(1) = exp( 0.67_r8*log(dgnumlo_aer(nait)) &
+ + 0.33_r8*log(dgnum_aer(nait)) )
+ dphim_mode(1) = dgnumhi_aer(nait)
+
+! mass1p_... = mass (kg) of so4 & nh4 in a single particle of diameter ...
+! (assuming same dry density for so4 & nh4)
+! mass1p_aitlo - dp = dplom_mode(1)
+! mass1p_aithi - dp = dphim_mode(1)
+ tmpa = dens_so4a_host*pi/6.0_r8
+ mass1p_aitlo = tmpa*(dplom_mode(1)**3)
+ mass1p_aithi = tmpa*(dphim_mode(1)**3)
+
+! limit RH to between 0.1% and 99%
+ relhumnn = max( 0.01_r8, min( 0.99_r8, relhum ) )
+
+
+! call ... routine to get nucleation rates
+ ldiagveh02 = -1
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if (ldiag2 > 0) then
+ if ((lonndx == 37) .and. (latndx == 23)) then
+ if ((k >= 24) .or. (mod(k,4) == 0)) then
+ ldiagveh02 = +1
+ write(lund,'(/a,i8,3i4,f8.2,1p,4e10.2)') &
+ 'veh02 call - nstep,lat,lon,k; tk,rh,p,cair', &
+ nstep, latndx, lonndx, k, &
+ temp, relhumnn, pmid, aircon*1.0e3_r8
+ ! output aircon at (mol/m3)
+ end if
+ end if
+ end if ! (ldiag2 > 0)
+#endif
+
+ call mer07_veh02_nuc_mosaic_1box( &
+ newnuc_method_flagaa, &
+ deltat, temp, relhumnn, pmid, &
+ zmid, pblh, &
+ qh2so4_cur, qh2so4_avg, qnh3_cur, tmp_uptkrate, &
+ mw_so4a_host, &
+ 1, 1, dplom_mode, dphim_mode, &
+ itmp, qnuma_del, qso4a_del, qnh4a_del, &
+ qh2so4_del, qnh3_del, dens_nh4so4a, &
+ ldiagveh02, dnclusterdt )
+!----------------------------------------------------------------------
+! subr mer07_veh02_nuc_mosaic_1box( &
+! newnuc_method_flagaa, &
+! dtnuc, temp_in, rh_in, press_in, &
+! qh2so4_cur, qh2so4_avg, qnh3_cur, h2so4_uptkrate, &
+! nsize, maxd_asize, dplom_sect, dphim_sect, &
+! isize_nuc, qnuma_del, qso4a_del, qnh4a_del, &
+! qh2so4_del, qnh3_del, dens_nh4so4a )
+!
+!! subr arguments (in)
+! real(r8), intent(in) :: dtnuc ! nucleation time step (s)
+! real(r8), intent(in) :: temp_in ! temperature, in k
+! real(r8), intent(in) :: rh_in ! relative humidity, as fraction
+! real(r8), intent(in) :: press_in ! air pressure (pa)
+!
+! real(r8), intent(in) :: qh2so4_cur, qh2so4_avg
+! ! gas h2so4 mixing ratios (mol/mol-air)
+! real(r8), intent(in) :: qnh3_cur ! gas nh3 mixing ratios (mol/mol-air)
+! ! qxxx_cur = current value (after gas chem and condensation)
+! ! qxxx_avg = estimated average value (for simultaneous source/sink calcs)
+! real(r8), intent(in) :: h2so4_uptkrate ! h2so4 uptake rate to aerosol (1/s)
+
+!
+! integer, intent(in) :: nsize ! number of aerosol size bins
+! integer, intent(in) :: maxd_asize ! dimension for dplom_sect, ...
+! real(r8), intent(in) :: dplom_sect(maxd_asize) ! dry diameter at lower bnd of bin (m)
+! real(r8), intent(in) :: dphim_sect(maxd_asize) ! dry diameter at upper bnd of bin (m)
+!
+!! subr arguments (out)
+! integer, intent(out) :: isize_nuc ! size bin into which new particles go
+! real(r8), intent(out) :: qnuma_del ! change to aerosol number mixing ratio (#/mol-air)
+! real(r8), intent(out) :: qso4a_del ! change to aerosol so4 mixing ratio (mol/mol-air)
+! real(r8), intent(out) :: qnh4a_del ! change to aerosol nh4 mixing ratio (mol/mol-air)
+! real(r8), intent(out) :: qh2so4_del ! change to gas h2so4 mixing ratio (mol/mol-air)
+! real(r8), intent(out) :: qnh3_del ! change to gas nh3 mixing ratio (mol/mol-air)
+! ! aerosol changes are > 0; gas changes are < 0
+! real(r8), intent(out) :: dens_nh4so4a ! dry-density of the new nh4-so4 aerosol mass (kg/m3)
+!----------------------------------------------------------------------
+
+
+! convert qnuma_del from (#/mol-air) to (#/kmol-air)
+ qnuma_del = qnuma_del*1.0e3_r8
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag97 ) then
+ write(lun97,'(/a,2i5,1p,3e11.3,2x,3e11.3)') &
+ 'newnuc - i, k, qavg s/n, uprt, rh 1/2', &
+ i, k, qh2so4_avg, qh2so4_cur, qnh3_cur, &
+ tmp_uptkrate, relhum, relhumnn
+ write(lun97,'( a,10x,1p,3e11.3,2x,3e11.3)') &
+ ' del qn, qso4a, qnh4a ', &
+ qnuma_del, qso4a_del, qnh4a_del
+ end if
+#endif
+
+! number nuc rate (#/kmol-air/s) from number nuc amt
+ dndt_ait = qnuma_del/deltat
+
+! fraction of mass nuc going to so4
+ tmpa = qso4a_del*mw_so4a_host
+ if (igas_nh3 > 0) then
+ tmpb = tmpa + qnh4a_del*mw_nh4a_host
+ tmp_frso4 = max( tmpa, 1.0e-35_r8 )/max( tmpb, 1.0e-35_r8 )
+ else
+ tmpb = tmpa
+ tmp_frso4 = 1.0_r8
+ end if
+
+! mass nuc rate (kg/kmol-air/s) from mass nuc amts
+ dmdt_ait = max( 0.0_r8, (tmpb/deltat) )
+
+ dndt_aitsv1 = dndt_ait
+ dmdt_aitsv1 = dmdt_ait
+ dndt_aitsv2 = 0.0
+ dmdt_aitsv2 = 0.0
+ dndt_aitsv3 = 0.0
+ dmdt_aitsv3 = 0.0
+ tmpch1 = ' '
+ tmpch2 = ' '
+
+ if (dndt_ait < 1.0e2) then
+! ignore newnuc if number rate < 100 #/kmol-air/s ~= 0.3 #/mg-air/d
+ dndt_ait = 0.0
+ dmdt_ait = 0.0
+ tmpch1 = 'A'
+
+ else
+ dndt_aitsv2 = dndt_ait
+ dmdt_aitsv2 = dmdt_ait
+ tmpch1 = 'B'
+
+! mirage2 code checked for complete h2so4 depletion here,
+! but this is now done in mer07_veh02_nuc_mosaic_1box
+ mass1p = dmdt_ait/dndt_ait
+ dndt_aitsv3 = dndt_ait
+ dmdt_aitsv3 = dmdt_ait
+
+! apply particle size constraints
+ if (mass1p < mass1p_aitlo) then
+! reduce dndt to increase new particle size
+ dndt_ait = dmdt_ait/mass1p_aitlo
+ tmpch1 = 'C'
+ else if (mass1p > mass1p_aithi) then
+! reduce dmdt to decrease new particle size
+ dmdt_ait = dndt_ait*mass1p_aithi
+ tmpch1 = 'E'
+ end if
+ end if
+
+! *** apply adjustment factor to avoid unrealistically high
+! aitken number concentrations in mid and upper troposphere
+ dndt_ait = dndt_ait * newnuc_adjust_factor_dnaitdt
+ dmdt_ait = dmdt_ait * newnuc_adjust_factor_dnaitdt
+
+ tmp_q_del = dndt_ait*deltat
+ qnum_cur( nait) = qnum_cur( nait) + tmp_q_del
+
+! dso4dt_ait, dnh4dt_ait are (kmol/kmol-air/s)
+ dso4dt_ait = dmdt_ait*tmp_frso4/mw_so4a_host
+ dnh4dt_ait = dmdt_ait*(1.0_r8 - tmp_frso4)/mw_nh4a_host
+
+ if (dso4dt_ait > 0.0_r8) then
+ tmp_q_del = dso4dt_ait*deltat
+ qaer_cur( iaer_so4,nait) = qaer_cur( iaer_so4,nait) + tmp_q_del
+
+ tmp_q_del = min( tmp_q_del, qgas_cur(igas_h2so4) )
+ qgas_cur( igas_h2so4) = qgas_cur( igas_h2so4) - tmp_q_del
+ end if
+
+ if ((igas_nh3 > 0) .and. (dnh4dt_ait > 0.0_r8)) then
+ tmp_q_del = dnh4dt_ait*deltat
+ qaer_cur( iaer_nh4,nait) = qaer_cur( iaer_nh4,nait) + tmp_q_del
+
+ tmp_q_del = min( tmp_q_del, qgas_cur(igas_nh3) )
+ qgas_cur( igas_nh3) = qgas_cur( igas_nh3) - tmp_q_del
+ end if
+
+!! temporary diagnostic
+! if (ldiag3 > 0) then
+! if ((dndt_ait /= 0.0_r8) .or. (dmdt_ait /= 0.0_r8)) then
+! write(lund,'(3a,1x,i7,3i5,1p,5e12.4)') &
+! 'newnucxx', tmpch1, tmpch2, nstep, lchnk, i, k, &
+! dndt_ait, dmdt_ait, cldx
+!! call endrun( 'modal_aero_newnuc_sub' )
+! end if
+! end if
+
+
+#if ( defined( CAMBOX_NEVER_ACTIVATE_THIS ) )
+! diagnostic output start ----------------------------------------
+ if (ldiag4 > 0) then
+ if ((lonndx == 37) .and. (latndx == 23)) then
+ if ((k >= 24) .or. (mod(k,4) == 0)) then
+ write(lund,97010) nstep, latndx, lonndx, k, temp, aircon*1.0e3_r8
+ write(lund,97020) 'pmid ', &
+ pmid
+ write(lund,97030) 'qv,qvsw, rh_av, rh_clr ', &
+ qv(i,k), qvswtr, relhumav, relhum
+ write(lund,97020) 'h2so4_cur, _av, nh3_cur', &
+ qh2so4_cur, qh2so4_avg, qnh3_cur
+ write(lund,97020) 'del_h2so4_gasprod, _aeruptk ', &
+ del_h2so4_gasprod(i,k), del_h2so4_aeruptk(i,k), &
+ tmp_uptkrate*3600.0
+ write(lund,97020) ' '
+ write(lund,97050) 'tmpch1, tmpch2 ', tmpch1, tmpch2
+ write(lund,97020) 'dndt_, dmdt_aitsv1 ', &
+ dndt_aitsv1, dmdt_aitsv1
+ write(lund,97020) 'dndt_, dmdt_aitsv2 ', &
+ dndt_aitsv2, dmdt_aitsv2
+ write(lund,97020) 'dndt_, dmdt_aitsv3 ', &
+ dndt_aitsv3, dmdt_aitsv3
+ write(lund,97020) 'dndt_, dmdt_ait ', &
+ dndt_ait, dmdt_ait
+ write(lund,97020) 'dso4dt_, dnh4dt_ait ', &
+ dso4dt_ait, dnh4dt_ait
+ write(lund,97020) 'qso4a_del, qh2so4_del ', &
+ qso4a_del, qh2so4_del
+ write(lund,97020) 'qnh4a_del, qnh3_del ', &
+ qnh4a_del, qnh3_del
+ write(lund,97020) 'dqdt(h2so4), (nh3) ', &
+ dqdt(i,k,l_h2so4), dqdt(i,k,l_nh3)
+ write(lund,97020) 'dqdt(so4a), (nh4a), (numa) ', &
+ dqdt(i,k,lso4ait), dqdt(i,k,lnh4ait), dqdt(i,k,lnumait)
+
+ dpnuc = 0.0
+ if (dndt_aitsv1 > 1.0e-5) dpnuc = (6.0*dmdt_aitsv1/ &
+ (pi*dens_so4a_host*dndt_aitsv1))**0.3333333
+ if (dpnuc > 0.0) then
+ write(lund,97020) 'dpnuc, dp_aitlo, _aithi ', &
+ dpnuc, dplom_mode(1), dphim_mode(1)
+ write(lund,97020) 'mass1p, mass1p_aitlo, _aithi ', &
+ mass1p, mass1p_aitlo, mass1p_aithi
+ end if
+
+97010 format( / 'NEWNUC nstep,lat,lon,k,tk,cair', i8, 3i4, f8.2, 1pe12.4 )
+97020 format( a, 1p, 6e12.4 )
+97030 format( a, 1p, 2e12.4, 0p, 5f10.6 )
+97040 format( 29x, 1p, 6e12.4 )
+97050 format( a, 2(3x,a) )
+ end if ! ((k >= 24) .or. (mod(k,4) == 0))
+ end if ! ((lonndx == 37) .and. (latndx == 23))
+ end if ! (ldiag4 > 0)
+! diagnostic output end ------------------------------------------
+#endif
+
+
+80000 continue
+
+
+ return
+ end subroutine mam_newnuc_1subarea
+
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+ subroutine mam_coag_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ deltat, &
+ temp, pmid, aircon, &
+ dgn_a, dgn_awet, wetdens, &
+ n_mode, &
+ qnum_cur, &
+ qaer_cur, qaer_del_coag_in, &
+ qwtr_cur )
+
+! coag between aitken, pcarbon, and accum modes
+! inter-modal coag of ultrafine mode
+
+! uses
+ use modal_aero_coag, only: getcoags_wrapper_f
+
+ implicit none
+
+! arguments
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ real(r8), intent(in) :: deltat ! model timestep (s)
+ real(r8), intent(in) :: temp ! temperature at model levels (K)
+ real(r8), intent(in) :: pmid ! pressure at layer center (Pa)
+ real(r8), intent(in) :: aircon ! air molar concentration (kmol/m3)
+ real(r8), intent(in) :: dgn_a(max_mode)
+ real(r8), intent(in) :: dgn_awet(max_mode)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+ real(r8), intent(in) :: wetdens(max_mode)
+ ! interstitial aerosol wet density (kg/m3)
+ ! dry & wet geo. mean dia. (m) of number distrib.
+
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum_cur
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur
+ real(r8), intent(out), dimension( 1:max_aer, 1:max_agepair ) :: &
+ qaer_del_coag_in
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr_cur
+
+! local variables
+ integer :: iaer, ip
+ integer :: modefrm, modetoo
+ integer :: n
+
+ real(r8), parameter :: epsilonx1 = epsilon( 1.0_r8 )
+ real(r8), parameter :: epsilonx2 = epsilonx1*2.0_r8
+
+ real(r8) :: tmp1, tmp2, tmp3, tmp4
+ real(r8) :: tmpa, tmpb, tmpc, tmpn
+ real(r8) :: tmp_dq, tmp_xf
+ real(r8) :: xbetaij2i, xbetaij2j, xbetaii2, xbetajj2
+ real(r8) :: ybetaij0(max_coagpair), ybetaij3(max_coagpair), &
+ ybetaii0(max_coagpair), ybetajj0(max_coagpair)
+
+ real(r8), dimension( 1:max_mode ) :: &
+ qnum_tmpa, qnum_tmpb, qnum_tmpc
+ real(r8), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_tmpa, qaer_tmpb, qaer_tmpc
+
+! DESCRIPTION:
+
+ qnum_tmpa = max( 0.0_r8, qnum_cur )
+ qaer_tmpa = max( 0.0_r8, qaer_cur )
+ qnum_tmpb = qnum_tmpa
+ qaer_tmpb = qaer_tmpa
+ qaer_del_coag_in = 0.0_r8
+
+!
+! compute coagulation rates using cmaq "fast" method
+! (based on E. Whitby's approximation approach)
+! here subr. arguments are all in mks unit
+!
+ lun15n = 149 + i
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag15n ) write(lun15n,'(//a,3i5,1p,e11.3)') 'coag - nstep,i,k', nstep, i, k, aircon
+#endif
+
+ do ip = 1, n_coagpair
+ modefrm = modefrm_coagpair(ip)
+ modetoo = modetoo_coagpair(ip)
+
+! call getcoags_wrapper_f( &
+! airtemp, airprs, &
+! dgatk, dgacc, &
+! sgatk, sgacc, &
+! xxlsgat, xxlsgac, &
+! pdensat, pdensac, &
+! betaij0, betaij2i, betaij2j, betaij3, &
+! betaii0, betaii2, betajj0, betajj2 )
+ call getcoags_wrapper_f( &
+ temp, pmid, &
+ dgn_awet(modefrm), dgn_awet(modetoo), &
+ sigmag_aer(modefrm), sigmag_aer(modetoo), &
+ alnsg_aer(modefrm), alnsg_aer(modetoo), &
+ wetdens(modefrm), wetdens(modetoo), &
+ ybetaij0(ip), xbetaij2i, xbetaij2j, ybetaij3(ip), &
+ ybetaii0(ip), xbetaii2, ybetajj0(ip), xbetajj2 )
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+! short diagnostics for coag coefficients
+ if ( ldiag15n ) write(lun15n,'(a,i5,1p,10e11.3)') 'ip, ybeta ', ip, &
+ ybetaij0(ip), ybetaij3(ip), ybetaii0(ip), ybetajj0(ip)
+
+! long diagnostics for coag coefficients
+! if ( ldiag15n ) then
+! if ( ip == 1 ) then
+! write(lun15n,'(a,1p,2e12.4)') 'temp, pmid', temp, pmid
+! write(lun15n,'(a/a/a/a/a)') &
+! 'modefrm, modetoo, ip, ', &
+! 'ybetaij0(ip), ybetaij3(ip), ybetaii0(ip), ybetajj0(ip), [m3/s]', &
+! 'dgn_awet(modefrm)*1.0e6, dgn_awet(modetoo)*1.0e6, ', &
+! 'sigmag_aer(modefrm), sigmag_aer(modetoo), ', &
+! 'wetdens(modefrm)*1.0e-3, wetdens(modetoo)*1.0e-3 '
+! end if
+! write(lun15n,'(a,2i3,i5,1p,4e11.3, 0p,2x,2f7.4,2(2x,2f6.3))') &
+! 'ip, ybeta ', modefrm, modetoo, ip, &
+! ybetaij0(ip), ybetaij3(ip), ybetaii0(ip), ybetajj0(ip), &
+! dgn_awet(modefrm)*1.0e6, dgn_awet(modetoo)*1.0e6, &
+! sigmag_aer(modefrm), sigmag_aer(modetoo), &
+! wetdens(modefrm)*1.0e-3, wetdens(modetoo)*1.0e-3
+! end if
+#endif
+
+ ! convert coag coefficients from (m3/s) to (kmol-air/s)
+ ybetaij0(ip) = ybetaij0(ip)*aircon
+ ybetaij3(ip) = ybetaij3(ip)*aircon
+ ybetaii0(ip) = ybetaii0(ip)*aircon
+ ybetajj0(ip) = ybetajj0(ip)*aircon
+ end do ! ip
+
+
+! first calculate changes to number
+! use the following order because
+! accum number loss depends on accum number
+! pcarbon number loss depends on pcarbon and accum number
+! maccum number loss depends on maccum, pcarbon, and accum number
+! aitken number loss depends on aitken, maccum, pcarbon, and accum number
+! maitken number loss depends on maitken, aitken, maccum, pcarbon, and accum number
+! the average number concencentrations (over current time step)
+! of other modes can thus be used to calculate the number loss of a mode
+
+! accum mode number loss - analytical solution
+ tmpa = max( 0.0_r8, deltat*ybetajj0(1) )
+ qnum_tmpb(nacc) = qnum_tmpa(nacc) / &
+ ( 1.0_r8 + ybetajj0(1)*deltat*qnum_tmpa(nacc) )
+ qnum_tmpc(nacc) = (qnum_tmpa(nacc) + qnum_tmpb(nacc))*0.5_r8
+
+! pcarbon mode number loss - approximate analytical solution
+! using average number conc. for accum mode
+ if (npca > 0) then
+ tmpa = max( 0.0_r8, deltat*ybetaij0(2)*qnum_tmpc(nacc) )
+ tmpb = max( 0.0_r8, deltat*ybetaii0(2) )
+ tmpn = qnum_tmpa(npca)
+ if (tmpa < 1.0e-5_r8) then
+ qnum_tmpb(npca) = tmpn / &
+ ( 1.0_r8 + (tmpa+tmpb*tmpn)*(1.0_r8 + 0.5_r8*tmpa) )
+ else
+ tmpc = exp(-tmpa)
+ qnum_tmpb(npca) = tmpn*tmpc / &
+ ( 1.0_r8 + (tmpb*tmpn/tmpa)*(1.0_r8-tmpc) )
+ end if
+ qnum_tmpc(npca) = (qnum_tmpa(npca) + qnum_tmpb(npca))*0.5_r8
+ end if
+
+! marine-organics accum mode number loss - approximate analytical solution
+! using average number conc. for accum and pcarbon modes
+ if (nmacc > 0) then
+ tmpa = ybetaij0( 9)*qnum_tmpc(nacc) &
+ + ybetaij0(10)*qnum_tmpc(npca)
+ tmpa = max( 0.0_r8, deltat*tmpa )
+ tmpb = max( 0.0_r8, deltat*ybetaii0(9) )
+ tmpn = qnum_tmpa(nmacc)
+ if (tmpa < 1.0e-5_r8) then
+ qnum_tmpb(nmacc) = tmpn / &
+ ( 1.0_r8 + (tmpa+tmpb*tmpn)*(1.0_r8 + 0.5_r8*tmpa) )
+ else
+ tmpc = exp(-tmpa)
+ qnum_tmpb(nmacc) = tmpn*tmpc / &
+ ( 1.0_r8 + (tmpb*tmpn/tmpa)*(1.0_r8-tmpc) )
+ end if
+ qnum_tmpc(nmacc) = (qnum_tmpa(nmacc) + qnum_tmpb(nmacc))*0.5_r8
+ end if
+
+! aitken mode number loss - approximate analytical solution
+! using average number conc. for accum, pcarbon, and marine-org accum modes
+ tmpa = ybetaij0(1)*qnum_tmpc(nacc)
+ if (npca > 0) tmpa = tmpa + ybetaij0(3)*qnum_tmpc(npca)
+ if (nmacc > 0) tmpa = tmpa + ybetaij0(4)*qnum_tmpc(nmacc)
+ tmpa = max( 0.0_r8, deltat*tmpa )
+ tmpb = max( 0.0_r8, deltat*ybetaii0(1) )
+ tmpn = qnum_tmpa(nait)
+ if (tmpa < 1.0e-5_r8) then
+ qnum_tmpb(nait) = tmpn / &
+ ( 1.0_r8 + (tmpa+tmpb*tmpn)*(1.0_r8 + 0.5_r8*tmpa) )
+ else
+ tmpc = exp(-tmpa)
+ qnum_tmpb(nait) = tmpn*tmpc / &
+ ( 1.0_r8 + (tmpb*tmpn/tmpa)*(1.0_r8-tmpc) )
+ end if
+ qnum_tmpc(nait) = (qnum_tmpa(nait) + qnum_tmpb(nait))*0.5_r8
+
+! marine-organics aitken mode number loss - approximate analytical solution
+! using average number conc. for accum, pcarbon, aitken, and marine-org accum modes
+ if (nmait > 0) then
+ tmpa = ybetaij0(5)*qnum_tmpc(nacc) + ybetaij0(7)*qnum_tmpc(nait) &
+ + ybetaij0(6)*qnum_tmpc(npca) + ybetaij0(8)*qnum_tmpc(nmacc)
+ tmpa = max( 0.0_r8, deltat*tmpa )
+ tmpb = max( 0.0_r8, deltat*ybetaii0(5) )
+ tmpn = qnum_tmpa(nmait)
+ if (tmpa < 1.0e-5_r8) then
+ qnum_tmpb(nmait) = tmpn / &
+ ( 1.0_r8 + (tmpa+tmpb*tmpn)*(1.0_r8 + 0.5_r8*tmpa) )
+ else
+ tmpc = exp(-tmpa)
+ qnum_tmpb(nmait) = tmpn*tmpc / &
+ ( 1.0_r8 + (tmpb*tmpn/tmpa)*(1.0_r8-tmpc) )
+ end if
+ qnum_tmpc(nmait) = (qnum_tmpa(nmait) + qnum_tmpb(nmait))*0.5_r8
+ end if
+
+
+! now calculate mass transfers between modes
+! the transfer amounts are calculated using as an exponential decay of
+! the initial mass concentrations,
+! where the decay rate is calculated using the average (over time step)
+! number concentrations for each mode
+! the mass transfer calculations are first-order accurate in time,
+! because the mass transferred out of a mode does not
+! include any mass transferred in during the time step
+! with this approach, the ordering is not important, but the mass transfer
+! calculations are done in the reverse order of the number loss calculations
+
+! mass transfer out of marine-organics aitken mode
+! uses average number conc. for accum, aitken, pcarbon, and marine-org accum modes
+ if (nmait > 0) then
+ tmp1 = max( 0.0_r8, ybetaij3(5)*qnum_tmpc(nacc) )
+ tmp2 = max( 0.0_r8, ybetaij3(6)*qnum_tmpc(npca) )
+ tmp3 = max( 0.0_r8, ybetaij3(7)*qnum_tmpc(nait) )
+ tmp4 = max( 0.0_r8, ybetaij3(8)*qnum_tmpc(nmacc) )
+ tmpa = tmp1 + tmp2 + tmp3 + tmp4
+ tmpc = deltat*tmpa
+ if (tmpc > epsilonx2) then
+ ! calc coag change only when it is not ~= zero
+ tmp_xf = 1.0_r8 - exp(-tmpc)
+ tmp2 = tmp2/tmpa
+ tmp3 = tmp3/tmpa
+ tmp4 = tmp4/tmpa
+ tmp1 = 1.0_r8 - (tmp2 + tmp3 + tmp4)
+ do iaer = 1, naer
+ tmp_dq = tmp_xf*qaer_tmpa(iaer,nmait)
+ qaer_tmpb(iaer,nmait) = qaer_tmpb(iaer,nmait) - tmp_dq
+ qaer_tmpb(iaer,nacc ) = qaer_tmpb(iaer,nacc ) + tmp_dq*tmp1
+ qaer_tmpb(iaer,npca ) = qaer_tmpb(iaer,npca ) + tmp_dq*tmp2
+ qaer_tmpb(iaer,nait ) = qaer_tmpb(iaer,nait ) + tmp_dq*tmp3
+ qaer_tmpb(iaer,nmacc) = qaer_tmpb(iaer,nmacc) + tmp_dq*tmp4
+ qaer_del_coag_in(iaer,i_agepair_pca ) &
+ = qaer_del_coag_in(iaer,i_agepair_pca ) + tmp_dq*tmp2
+ qaer_del_coag_in(iaer,i_agepair_macc) &
+ = qaer_del_coag_in(iaer,i_agepair_macc) + tmp_dq*tmp4
+ end do
+ end if
+ end if
+
+! (ip == 2) modefrm = npca ; modetoo = nacc
+! (ip == 1) modefrm = nait ; modetoo = nacc
+! (ip == 3) modefrm = nait ; modetoo = npca
+! (ip == 4) modefrm = nait ; modetoo = nmacc
+! (ip == 5) modefrm = nmait ; modetoo = nacc
+! (ip == 6) modefrm = nmait ; modetoo = npca
+! (ip == 7) modefrm = nmait ; modetoo = nait
+! (ip == 8) modefrm = nmait ; modetoo = nmacc
+! (ip == 9) modefrm = nmacc ; modetoo = nacc
+! (ip ==10) modefrm = nmacc ; modetoo = npca
+
+! mass transfer out of aitken mode
+! uses average number conc. for accum, pcarbon, and marine-org accum modes
+ tmp1 = max( 0.0_r8, ybetaij3(1)*qnum_tmpc(nacc) )
+ if (nmacc > 0) then
+ tmp2 = max( 0.0_r8, ybetaij3(3)*qnum_tmpc(npca) )
+ tmp3 = max( 0.0_r8, ybetaij3(4)*qnum_tmpc(nmacc) )
+ else if (npca > 0) then
+ tmp2 = max( 0.0_r8, ybetaij3(3)*qnum_tmpc(npca) )
+ tmp3 = 0.0_r8
+ else
+ tmp2 = 0.0_r8
+ tmp3 = 0.0_r8
+ end if
+ tmpa = tmp1 + tmp2 + tmp3
+ tmpc = deltat*tmpa
+ if (tmpc > epsilonx2) then
+ ! calc coag change only when it is not ~= zero
+ tmp_xf = 1.0_r8 - exp(-tmpc)
+ if (nmacc > 0) then
+ tmp2 = tmp2/tmpa
+ tmp3 = tmp3/tmpa
+ tmp1 = 1.0_r8 - (tmp2 + tmp3)
+ do iaer = 1, naer
+ tmp_dq = tmp_xf*qaer_tmpa(iaer,nait)
+ qaer_tmpb(iaer,nait) = qaer_tmpb(iaer,nait) - tmp_dq
+ qaer_tmpb(iaer,nacc) = qaer_tmpb(iaer,nacc) + tmp_dq*tmp1
+ qaer_tmpb(iaer,npca) = qaer_tmpb(iaer,npca) + tmp_dq*tmp2
+ qaer_tmpb(iaer,nmacc) = qaer_tmpb(iaer,nmacc) + tmp_dq*tmp3
+ qaer_del_coag_in(iaer,i_agepair_pca) &
+ = qaer_del_coag_in(iaer,i_agepair_pca) + tmp_dq*tmp2
+ qaer_del_coag_in(iaer,i_agepair_macc) &
+ = qaer_del_coag_in(iaer,i_agepair_macc) + tmp_dq*tmp3
+ end do
+ else if (npca > 0) then
+ tmp2 = tmp2/tmpa
+ tmp1 = 1.0_r8 - tmp2
+ do iaer = 1, naer
+ tmp_dq = tmp_xf*qaer_tmpa(iaer,nait)
+ qaer_tmpb(iaer,nait) = qaer_tmpb(iaer,nait) - tmp_dq
+ qaer_tmpb(iaer,nacc) = qaer_tmpb(iaer,nacc) + tmp_dq*tmp1
+ qaer_tmpb(iaer,npca) = qaer_tmpb(iaer,npca) + tmp_dq*tmp2
+ qaer_del_coag_in(iaer,i_agepair_pca) &
+ = qaer_del_coag_in(iaer,i_agepair_pca) + tmp_dq*tmp2
+ end do
+ else
+ do iaer = 1, naer
+ tmp_dq = tmp_xf*qaer_tmpa(iaer,nait)
+ qaer_tmpb(iaer,nait) = qaer_tmpb(iaer,nait) - tmp_dq
+ qaer_tmpb(iaer,nacc) = qaer_tmpb(iaer,nacc) + tmp_dq
+ end do
+ end if
+ end if
+
+!! old version for 3 and 7 mode only
+!! mass transfer out of aitken mode mass
+!! uses average number conc. for accum and pcarbon modes
+! tmpa = max( 0.0_r8, ybetaij3(1)*qnum_tmpc(nacc) )
+! if (npca > 0) then
+! tmpb = max( 0.0_r8, ybetaij3(3)*qnum_tmpc(npca) )
+! tmpc = tmpa + tmpb
+! else
+! tmpc = tmpa
+! end if
+! tmpc = deltat*tmpc
+! if (tmpc > epsilonx2) then
+! ! calc coag change only when it is not ~= zero
+! tmp_xf = 1.0_r8 - exp(-tmpc)
+! if (npca > 0) then
+! tmp2 = tmpb/(tmpa + tmpb + epsilonx1)
+! tmp1 = 1.0_r8 - tmp2
+! do iaer = 1, naer
+! tmp_dq = tmp_xf*qaer_tmpa(iaer,nait)
+! qaer_tmpb(iaer,nait) = qaer_tmpb(iaer,nait) - tmp_dq
+! qaer_tmpb(iaer,nacc) = qaer_tmpb(iaer,nacc) + tmp_dq*tmp1
+! qaer_tmpb(iaer,npca) = qaer_tmpb(iaer,npca) + tmp_dq*tmp2
+! qaer_del_coag_in(iaer,i_agepair_pca) &
+! = qaer_del_coag_in(iaer,i_agepair_pca) + tmp_dq*tmp2
+! end do
+! else
+! do iaer = 1, naer
+! tmp_dq = tmp_xf*qaer_tmpa(iaer,nait)
+! qaer_tmpb(iaer,nait) = qaer_tmpb(iaer,nait) - tmp_dq
+! qaer_tmpb(iaer,nacc) = qaer_tmpb(iaer,nacc) + tmp_dq
+! end do
+! end if
+! end if
+
+! mass transfer out of marine-organics accum mode
+! uses average number conc. for accum and pcarbon modes
+ if (nmacc > 0) then
+ tmp1 = max( 0.0_r8, ybetaij3( 9)*qnum_tmpc(nacc) )
+ tmp2 = max( 0.0_r8, ybetaij3(10)*qnum_tmpc(npca) )
+ tmpa = tmp1 + tmp2
+ tmpc = deltat*tmpa
+ if (tmpc > epsilonx2) then
+ ! calc coag change only when it is not ~= zero
+ tmp_xf = 1.0_r8 - exp(-tmpc)
+ tmp2 = tmp2/tmpa
+ tmp1 = 1.0_r8 - tmp2
+ do iaer = 1, naer
+ tmp_dq = tmp_xf*qaer_tmpa(iaer,nmacc)
+ qaer_tmpb(iaer,nmacc) = qaer_tmpb(iaer,nmacc) - tmp_dq
+ qaer_tmpb(iaer,nacc ) = qaer_tmpb(iaer,nacc ) + tmp_dq*tmp1
+ qaer_tmpb(iaer,npca ) = qaer_tmpb(iaer,npca ) + tmp_dq*tmp2
+ qaer_del_coag_in(iaer,i_agepair_pca ) &
+ = qaer_del_coag_in(iaer,i_agepair_pca ) + tmp_dq*tmp2
+ end do
+ end if
+ end if
+
+! mass transfer out of pcarbon mode
+! uses average number conc. for accum mode
+ if (npca > 0) then
+ tmpc = max( 0.0_r8, ybetaij3(2)*qnum_tmpc(nacc) )
+ tmpc = deltat*tmpc
+ if (tmpc > epsilonx2) then
+ tmp_xf = 1.0_r8 - exp(-tmpc)
+ do iaer = 1, naer
+ tmp_dq = tmp_xf*qaer_tmpa(iaer,npca)
+ qaer_tmpb(iaer,npca) = qaer_tmpb(iaer,npca) - tmp_dq
+ qaer_tmpb(iaer,nacc) = qaer_tmpb(iaer,nacc) + tmp_dq
+ end do
+ end if
+ end if
+
+! mass transfer out of accum mode - there is no transfer out of this mode
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( ldiag15n ) then
+! diagnostics
+ do n = 1, 3
+ write(lun15n,'(a,i5,1p,10e11.3)') 'n, qnum_tmpa/b/c', n, &
+ qnum_tmpa(n), qnum_tmpc(n), qnum_tmpb(n), &
+ qnum_tmpb(n)-qnum_tmpa(n), &
+ 1.0_r8-qnum_tmpb(n)/max(1.0e-5_r8,qnum_tmpa(n))
+ end do
+ do n = 1, 3
+ write(lun15n,'(a,i5,1p,10e11.3)') 'n, dgnd/w, densw', n, &
+ dgn_a(n), dgn_awet(n), wetdens(n)
+ end do
+ end if
+#endif
+
+ qnum_cur = qnum_tmpb
+ qaer_cur = qaer_tmpb
+
+ return
+ end subroutine mam_coag_1subarea
+
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+ subroutine mam_pcarbon_aging_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ deltat, dgn_a, do_cond, &
+ n_mode, &
+ qnum_cur, qnum_del_cond, qnum_del_coag, &
+ qaer_cur, qaer_del_cond, qaer_del_coag, &
+ qaer_del_coag_in, &
+ qwtr_cur )
+
+! uses
+
+ implicit none
+
+! arguments
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ logical, intent(in) :: do_cond ! true if condensation (gas-aerosol exch) is on
+
+ real(r8), intent(in) :: deltat ! model timestep (s)
+ real(r8), intent(in), dimension( 1:max_mode ) :: &
+ dgn_a ! dgnum_dry of mode
+
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qnum_cur, qnum_del_cond, qnum_del_coag
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: &
+ qaer_cur, qaer_del_cond, qaer_del_coag
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_agepair ) :: &
+ qaer_del_coag_in
+! *** need to add qaer_del_coag_nmoacc_in
+ real(r8), intent(inout), dimension( 1:max_mode ) :: &
+ qwtr_cur
+
+! local variables
+ integer :: iaer, ipair, itmpa
+ integer :: nfrm, ntoo
+
+ real(r8) :: fac_volsfc
+ real(r8) :: tmpa, tmp1, tmp2, tmp3, tmp4
+ real(r8) :: vol_core, vol_shell
+ real(r8) :: xferfrac_max, xferfrac_pcage
+
+
+!
+agepair_loop1: &
+ do ipair = 1, n_agepair
+
+ nfrm = modefrm_agepair(ipair)
+ ntoo = modetoo_agepair(ipair)
+
+ vol_shell = qaer_cur(iaer_so4,nfrm)*fac_m2v_aer(iaer_so4)
+ tmp3 = qaer_del_cond(iaer_so4,nfrm) *fac_m2v_aer(iaer_so4)
+ tmp4 = qaer_del_coag_in(iaer_so4,ipair)*fac_m2v_aer(iaer_so4)
+
+ do iaer = 1, naer
+! species that contribute to aging are
+! so4 (but it is already done)
+! soa, nh4 and no3
+! ncl and cl (when aging_include_seasalt == .true.)
+ if ( (iaer <= nsoa ) .or. &
+ (iaer == iaer_nh4) .or. &
+ (iaer == iaer_no3) .or. &
+ (iaer == iaer_cl ) ) then
+ continue
+ else if (iaer == iaer_ncl) then
+ if (aging_include_seasalt .eqv. .false.) cycle
+ else
+ cycle
+ end if
+
+ if ( (iaer == iaer_cl ) .and. &
+ (aging_include_seasalt .eqv. .false.) ) then
+ ! special case - only include the cl from condensation
+ tmp1 = max( qaer_del_cond(iaer,nfrm), 0.0_r8 )
+ tmp2 = max( qaer_del_coag_in(iaer,ipair), 0.0_r8 ) + tmp1
+ if (tmp2 >= 1.0e-35_r8) then
+ vol_shell = vol_shell + qaer_cur(iaer,nfrm)*fac_m2v_eqvhyg_aer(iaer)*(tmp1/tmp2)
+ tmp3 = tmp3 + qaer_del_cond(iaer,nfrm)*fac_m2v_eqvhyg_aer(iaer)
+ end if
+ else
+ vol_shell = vol_shell + qaer_cur(iaer,nfrm)*fac_m2v_eqvhyg_aer(iaer)
+ tmp3 = tmp3 + qaer_del_cond(iaer,nfrm)*fac_m2v_eqvhyg_aer(iaer)
+ tmp4 = tmp4 + qaer_del_coag_in(iaer,ipair)*fac_m2v_eqvhyg_aer(iaer)
+ end if
+ end do
+
+ if ( do_cond ) then
+ tmp3 = max( tmp3, 1.0e-35_r8 )
+ tmp3 = tmp3/(tmp3 + max( tmp4, 0.0_r8 ))
+ else
+ tmp3 = 0.0_r8
+ end if
+ tmp4 = 1.0_r8 - tmp3
+
+ vol_core = 0.0
+ do iaer = 1, naer
+ ! for core volume, only include the mapped species
+ ! which are primary and low hygroscopicity
+ if (lmap_aer(iaer,nfrm) > 0) &
+ vol_core = vol_core + qaer_cur(iaer,nfrm)*fac_m2v_aer(iaer)
+ end do
+! ratio1 = vol_shell/vol_core =
+! actual hygroscopic-shell-volume/carbon-core-volume after gas uptake
+! ratio2 = 6.0_r8*dr_so4_monolayers_pcage/(dgncur_a*fac_volsfc)
+! = (shell-volume corresponding to n_so4_monolayers_pcage)/core-volume
+! The 6.0/(dgncur_a*fac_volsfc) = (mode-surface-area/mode-volume)
+! Note that vol_shell includes both so4+nh4 AND soa as "equivalent so4",
+! The soa_equivso4_factor accounts for the lower hygroscopicity of soa.
+!
+! Define xferfrac_pcage = min( 1.0, ratio1/ratio2)
+! But ratio1/ratio2 == tmp1/tmp2, and coding below avoids possible overflow
+!
+ fac_volsfc = exp( 2.5*(alnsg_aer(nfrm)**2) )
+ xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8) ! 1-eps
+
+ tmp1 = vol_shell*dgn_a(nfrm)*fac_volsfc
+ tmp2 = max( 6.0_r8*dr_so4_monolayers_pcage*vol_core, 0.0_r8 )
+ if (tmp1 >= tmp2) then
+ xferfrac_pcage = xferfrac_max
+ else
+ xferfrac_pcage = min( tmp1/tmp2, xferfrac_max )
+ end if
+
+ do iaer = 1, naer
+ if (lmap_aer(iaer,nfrm) > 0) then
+ ! species is pom or bc
+ ! transfer the aged fraction to accum mode
+ ! include this transfer change in the cond and/or coag change (for mass budget)
+ tmpa = qaer_cur(iaer,nfrm)*xferfrac_pcage
+ qaer_cur(iaer,nfrm) = qaer_cur(iaer,nfrm) - tmpa
+ qaer_cur(iaer,ntoo) = qaer_cur(iaer,ntoo) + tmpa
+ qaer_del_cond(iaer,nfrm) = qaer_del_cond(iaer,nfrm) - tmpa*tmp3
+ qaer_del_cond(iaer,ntoo) = qaer_del_cond(iaer,ntoo) + tmpa*tmp3
+ qaer_del_coag(iaer,nfrm) = qaer_del_coag(iaer,nfrm) - tmpa*tmp4
+ qaer_del_coag(iaer,ntoo) = qaer_del_coag(iaer,ntoo) + tmpa*tmp4
+ else
+ ! species is soa, so4, or nh4 produced by condensation or coagulation
+ ! transfer all of it to accum mode
+ ! also transfer the condensation and coagulation changes
+ ! to accum mode (for mass budget)
+ qaer_cur(iaer,ntoo) = qaer_cur(iaer,ntoo) &
+ + qaer_cur(iaer,nfrm)
+ qaer_del_cond(iaer,ntoo) = qaer_del_cond(iaer,ntoo) &
+ + qaer_del_cond(iaer,nfrm)
+ qaer_del_coag(iaer,ntoo) = qaer_del_coag(iaer,ntoo) &
+ + qaer_del_coag(iaer,nfrm)
+ qaer_cur(iaer,nfrm) = 0.0_r8
+ qaer_del_cond(iaer,nfrm) = 0.0_r8
+ qaer_del_coag(iaer,nfrm) = 0.0_r8
+ end if
+ end do
+ ! number - transfer the aged fraction to accum mode
+ ! include this transfer change in the cond and/or coag change (for mass budget)
+ tmpa = qnum_cur(nfrm)*xferfrac_pcage
+ qnum_cur(nfrm) = qnum_cur(nfrm) - tmpa
+ qnum_cur(ntoo) = qnum_cur(ntoo) + tmpa
+ qnum_del_cond(nfrm) = qnum_del_cond(nfrm) - tmpa*tmp3
+ qnum_del_cond(ntoo) = qnum_del_cond(ntoo) + tmpa*tmp3
+ qnum_del_coag(nfrm) = qnum_del_coag(nfrm) - tmpa*tmp4
+ qnum_del_coag(ntoo) = qnum_del_coag(ntoo) + tmpa*tmp4
+
+ end do agepair_loop1
+
+ return
+ end subroutine mam_pcarbon_aging_1subarea
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ function mean_molecular_speed( temp, rmw )
+ implicit none
+ real(8) :: mean_molecular_speed ! (m/s)
+ real(8) :: temp ! temperature (K)
+ real(8) :: rmw ! molec. weight (g/mol)
+ mean_molecular_speed = 145.5_8 * sqrt(temp/rmw)
+ return
+ end function mean_molecular_speed
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ function gas_diffusivity( t_k, p_atm, rmw, vm )
+ implicit none
+ real(8) :: gas_diffusivity ! (m2/s)
+ real(8) :: t_k ! temperature (K)
+ real(8) :: p_atm ! pressure (atmospheres)
+ real(8) :: rmw ! molec. weight (g/mol)
+ real(8) :: vm ! molar volume (units = ??)
+
+ real(8) :: dgas
+
+ dgas = (1.0e-3_8 * t_k**1.75_8 * sqrt(1./rmw + 0.035_8))/ &
+ (p_atm * (vm**0.3333333333333333_8 + 2.7189_8)**2)
+ gas_diffusivity = dgas*1.0e-4_8
+ return
+ end function gas_diffusivity
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine gas_aer_uptkrates_1box1gas( &
+ accom, gasdiffus, gasfreepath, &
+ beta_inp, n_mode, dgncur_awet, lnsg, uptkrate )
+!
+! /
+! computes uptkrate = | dx dN/dx gas_conden_rate(Dp(x))
+! /
+! using Gauss-Hermite quadrature of order nghq=2
+!
+! Dp = particle diameter (cm)
+! x = ln(Dp)
+! dN/dx = log-normal particle number density distribution
+! gas_conden_rate(Dp) = 2 * pi * gasdiffus * Dp * F(Kn,ac)
+! F(Kn,ac) = Fuchs-Sutugin correction factor
+! Kn = Knudsen number
+! ac = accomodation coefficient
+!
+ implicit none
+
+ integer, parameter :: r8 = 8
+
+ integer, intent(in) :: n_mode ! number of modes
+
+ real(r8), intent(in) :: accom ! accomodation coefficient (--)
+ real(r8), intent(in) :: gasdiffus ! gas diffusivity (m2/s)
+ real(r8), intent(in) :: gasfreepath ! gas mean free path (m)
+ real(r8), intent(in) :: beta_inp ! quadrature parameter (--)
+ real(r8), intent(in) :: dgncur_awet(n_mode)
+ ! mode-median wet diameter of number distribution (m)
+ real(r8), intent(in) :: lnsg(n_mode)
+ ! ln( sigmag ) (--)
+ real(r8), intent(out) :: uptkrate(n_mode)
+ ! gas-to-aerosol mass transfer rates (1/s)
+ ! for number concentration = 1 #/m3
+
+
+! local
+ integer, parameter :: nghq = 2
+ integer :: i, iq, k, l1, l2, la, n
+
+ real(r8), parameter :: tworootpi = 3.5449077018110320_r8
+ real(r8), parameter :: root2 = 1.4142135623730950_r8
+ real(r8), parameter :: one = 1.0_r8
+ real(r8), parameter :: two = 2.0_r8
+
+ real(r8) :: accomxp283, accomxp75
+ real(r8) :: beta
+ real(r8) :: const
+ real(r8) :: dp, dum_m2v
+ real(r8) :: fuchs_sutugin
+ real(r8) :: knudsen
+ real(r8) :: lndp, lndpgn
+ real(r8) :: sumghq
+ real(r8) :: tmpa
+ real(r8), save :: xghq(nghq), wghq(nghq) ! quadrature abscissae and weights
+
+ data xghq / 0.70710678, -0.70710678 /
+ data wghq / 0.88622693, 0.88622693 /
+
+
+ accomxp283 = accom * 0.283_r8
+ accomxp75 = accom * 0.75_r8
+
+! outermost loop over all modes
+ do n = 1, n_mode
+
+ lndpgn = log( dgncur_awet(n) ) ! (m)
+
+! beta = dln(uptake_rate)/dln(dp)
+! = 2.0 in free molecular regime, 1.0 in continuum regime
+! if uptake_rate ~= a * (dp**beta), then the 2 point quadrature is very accurate
+ if (abs(beta_inp-1.5_r8) > 0.5_r8) then
+! dp = dgncur_awet(n) * exp( 1.5_r8*(lnsg(n)**2) )
+ dp = dgncur_awet(n)
+ knudsen = two*gasfreepath/dp
+ ! tmpa = dln(fuchs_sutugin)/d(knudsen)
+ tmpa = one/(one+knudsen) - (two*knudsen + one + accomxp283) / &
+ ( knudsen*( knudsen + one + accomxp283 ) + accomxp75 )
+ beta = one - knudsen*tmpa
+ beta = max( one, min( two, beta ) )
+ else
+ beta = beta_inp
+ end if
+
+ const = tworootpi * exp( beta*lndpgn + 0.5_r8*(beta*lnsg(n))**2 )
+
+! sum over gauss-hermite quadrature points
+ sumghq = 0.0
+ do iq = 1, nghq
+ lndp = lndpgn + beta*lnsg(n)**2 + root2*lnsg(n)*xghq(iq)
+ dp = exp(lndp)
+
+ knudsen = two*gasfreepath/dp
+
+! fkn = ( 0.75*accomcoef*(1. + xkn) ) / &
+! ( xkn**2 + xkn + 0.283*xkn*accomcoef + 0.75*accomcoef )
+ fuchs_sutugin = &
+ ( accomxp75*(one + knudsen) ) / &
+ ( knudsen*( knudsen + one + accomxp283 ) + accomxp75 )
+
+ sumghq = sumghq + wghq(iq)*dp*fuchs_sutugin/(dp**beta)
+ end do
+ uptkrate(n) = const * gasdiffus * sumghq
+
+ end do ! "do n = 1, ntot_soamode"
+
+
+ return
+ end subroutine gas_aer_uptkrates_1box1gas
+
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine modal_aero_amicphys_init( imozart, species_class )
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! set do_adjust and do_aitken flags
+! create history fields for column tendencies associated with
+! modal_aero_calcsize
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+use cam_history, only : fieldname_len
+use cam_logfile, only : iulog
+use chem_mods, only : adv_mass
+use constituents, only : pcnst, cnst_get_ind, cnst_name
+use mo_chem_utls, only : get_spc_ndx
+use mo_tracname, only : solsym
+use physconst, only : mwdry, mwh2o
+use spmd_utils, only : masterproc
+use phys_control,only : phys_getopts
+
+use modal_aero_data, only : &
+ cnst_name_cw, &
+ dgnum_amode, dgnumlo_amode, dgnumhi_amode, &
+ lmassptr_amode, lmassptrcw_amode, &
+ modeptr_accum, modeptr_aitken, modeptr_pcarbon, modeptr_ufine, &
+#if ( defined MODAL_AERO_9MODE )
+ modeptr_maccum, modeptr_maitken, &
+#endif
+ nspec_amode, &
+ numptr_amode, numptrcw_amode, sigmag_amode
+
+implicit none
+
+!-----------------------------------------------------------------------
+! arguments
+ integer, intent(in) :: imozart
+ integer, intent(in) :: species_class(:)
+
+!-----------------------------------------------------------------------
+! local
+ integer, parameter :: big_neg_int = -999888777
+ integer, parameter :: big_pos_int = 999888777
+ integer :: iaer, igas, ip, ipair, itmpa
+ integer :: j, jac, jsoa
+ integer :: l, l1, l2, lac
+ integer :: lmz, lmz2, loffset
+ integer :: l_so4g, l_nh4g, l_msag
+ integer :: m
+ integer :: n, na, nb, nc
+ integer :: nspec
+
+ real(r8) :: tmp1, tmp2
+
+ character(len=fieldname_len) :: tmpnamea, tmpnameb
+ character(128) :: msg, fmtaa
+ character(2) :: tmpch2
+ !-----------------------------------------------------------------------
+
+
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ ldiag82 = .true. ; lun82 = 82
+ ldiag97 = .true. ; lun97 = 97
+ ldiag98 = .true. ; lun98 = 98
+ ldiag13n = .true. ; lun13n = 130
+ ldiag15n = .true. ; lun15n = 150
+ ldiagd1 = .true.
+#else
+ ldiag82 = .false. ; lun82 = iulog
+ ldiag97 = .false. ; lun97 = iulog
+ ldiag98 = .false. ; lun98 = iulog
+ ldiag13n = .false. ; lun13n = iulog
+ ldiag15n = .false. ; lun15n = iulog
+ ldiagd1 = .false.
+#endif
+
+
+ call mam_set_lptr2_and_specxxx2
+
+
+ mwuse_soa(:) = 150.0_r8
+ mwuse_poa(:) = 150.0_r8
+
+! set ngas, name_gas, and igas_xxx
+! set naer, name_aerpfx, and iaer_xxx
+ name_gas = '???'
+ name_aerpfx = '???'
+ name_aer = '???'
+ name_aercw = '???'
+ name_num = '???'
+ name_numcw = '???'
+
+ igas_h2so4 = 0 ; igas_nh3 = 0
+ iaer_bc = 0 ; iaer_dst = 0
+ iaer_ncl = 0 ; iaer_nh4 = 0
+ iaer_pom = 0 ; iaer_soa = 0
+ iaer_so4 = 0
+ iaer_no3 = 0 ; iaer_cl = 0
+ iaer_ca = 0 ; iaer_co3 = 0
+ iaer_mpoly = 0 ; iaer_mprot = 0
+ iaer_mlip = 0 ; iaer_mhum = 0
+ iaer_mproc = 0 ;
+
+ if (nsoa == 1) then
+ name_gas(1) = 'SOAG'
+ name_aerpfx(1) = 'soa'
+ else if (nsoa == 2) then
+ jsoa = 1 ; name_gas(jsoa) = 'SOAGa' ; name_aerpfx(jsoa) = 'soaa' ! jsoa=1
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGb' ; name_aerpfx(jsoa) = 'soab' ! jsoa=2
+ else if (nsoa == 6) then
+ jsoa = 1 ; name_gas(jsoa) = 'SOAGa1' ; name_aerpfx(jsoa) = 'soaa1' ! jsoa=1
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGa2' ; name_aerpfx(jsoa) = 'soaa2' ! jsoa=2
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGa3' ; name_aerpfx(jsoa) = 'soaa3' ! jsoa=3
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGb1' ; name_aerpfx(jsoa) = 'soab1' ! jsoa=4
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGb2' ; name_aerpfx(jsoa) = 'soab2' ! jsoa=5
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGb3' ; name_aerpfx(jsoa) = 'soab3' ! jsoa=6
+ else
+ call endrun( 'modal_aero_amicphys_init ERROR - bad nsoa' )
+ end if
+ ngas = nsoa
+ naer = nsoa
+ igas_soa = 1
+ iaer_soa = 1
+
+ ngas = ngas + 1
+ name_gas(ngas) = 'H2SO4'
+ naer = naer + 1
+ name_aerpfx(naer) = 'so4'
+ igas_h2so4 = ngas
+ iaer_so4 = naer
+
+ if ( (ntot_amode==7) .or. &
+ (ntot_amode==8) .or. &
+ (ntot_amode==9) ) then
+ ngas = ngas + 1
+ name_gas(ngas) = 'NH3'
+ naer = naer + 1
+ name_aerpfx(naer) = 'nh4'
+ igas_nh3 = ngas
+ iaer_nh4 = naer
+ end if
+
+#if ( ( defined MODAL_AERO_7MODE ) && ( defined MOSAIC_SPECIES ) )
+ ngas = ngas + 1
+ name_gas(ngas) = 'HNO3'
+ naer = naer + 1
+ name_aerpfx(naer) = 'no3'
+ igas_hno3 = ngas
+ iaer_no3 = naer
+
+ ngas = ngas + 1
+ name_gas(ngas) = 'HCL'
+ naer = naer + 1
+ name_aerpfx(naer) = 'cl'
+ igas_hcl = ngas
+ iaer_cl = naer
+#endif
+
+ iaer_pom = naer + 1
+ if (npoa == 1) then
+ naer = naer + 1
+ name_aerpfx(naer) = 'pom'
+ else if (npoa == 2) then
+ naer = naer + 1
+ name_aerpfx(naer) = 'poma'
+ naer = naer + 1
+ name_aerpfx(naer) = 'pomb'
+ else
+ call endrun( 'modal_aero_amicphys_init ERROR - bad npoa' )
+ end if
+
+ iaer_bc = naer + 1
+ if (nbc == 1) then
+ naer = naer + 1
+ name_aerpfx(naer) = 'bc'
+ else if (nbc == 2) then
+ naer = naer + 1
+ name_aerpfx(naer) = 'bca'
+ naer = naer + 1
+ name_aerpfx(naer) = 'bcb'
+ else
+ call endrun( 'modal_aero_amicphys_init ERROR - bad nbc' )
+ end if
+
+ naer = naer + 1
+ name_aerpfx(naer) = 'ncl'
+ iaer_ncl = naer
+ naer = naer + 1
+ name_aerpfx(naer) = 'dst'
+ iaer_dst = naer
+
+#if ( ( defined MODAL_AERO_7MODE ) && ( defined MOSAIC_SPECIES ) )
+ naer = naer + 1
+ name_aerpfx(naer) = 'ca'
+ iaer_ca = naer
+ naer = naer + 1
+ name_aerpfx(naer) = 'co3'
+ iaer_co3 = naer
+#endif
+
+ if (ntot_amode==9) then
+ naer = naer + 1
+ name_aerpfx(naer) = 'mpoly'
+ iaer_mpoly = naer
+ naer = naer + 1
+ name_aerpfx(naer) = 'mprot'
+ iaer_mprot = naer
+ naer = naer + 1
+ name_aerpfx(naer) = 'mlip'
+ iaer_mlip = naer
+ naer = naer + 1
+ name_aerpfx(naer) = 'mhum'
+ iaer_mhum = naer
+ naer = naer + 1
+ name_aerpfx(naer) = 'mproc'
+ iaer_mproc = naer
+ end if
+
+ if ((ngas /= max_gas) .or. (naer /= max_aer)) then
+ write(iulog,'(a,4i10)') 'ngas, max_gas, naer, max_aer', &
+ ngas, max_gas, naer, max_aer
+ call endrun( 'modal_aero_amicphys_init ERROR - bad ngas or naer' )
+ end if
+
+ lmapcc_all(:) = 0
+
+! set gas mapping
+ loffset = imozart - 1
+ lmap_gas(:) = 0
+ mwhost_gas(:) = 1.0_r8
+ mw_gas(:) = 1.0_r8
+ fcvt_gas(:) = 1.0_r8
+
+ vol_molar_gas = 42.88_r8 ! value for h2so4
+ accom_coef_gas = 0.65_r8 ! value for h2so4
+
+ do igas = 1, ngas
+ call cnst_get_ind( name_gas(igas), l, .false. )
+ if (l < 1 .or. l > pcnst) then
+ msg = 'modal_aero_amicphys_init ERROR - lmap_gas for ' // name_gas(igas)
+ call endrun( msg )
+ end if
+ lmz = l - loffset
+ lmz2 = get_spc_ndx( name_gas(igas) )
+ if (lmz /= lmz2 .or. lmz <= 0) then
+ msg = 'modal_aero_amicphys_init ERROR - lmz /= lmz2 for ' // name_gas(igas)
+ call endrun( msg )
+ end if
+ lmapcc_all(lmz) = lmapcc_val_gas
+ lmap_gas(igas) = lmz
+
+ mwhost_gas(igas) = adv_mass(lmz)
+ mw_gas(igas) = mwhost_gas(igas)
+ if (igas <= nsoa) mw_gas(igas) = mwuse_soa(igas)
+ fcvt_gas(igas) = mwhost_gas(igas)/mw_gas(igas)
+
+ if (igas <= nsoa) then
+ vol_molar_gas(igas) = vol_molar_gas(igas_h2so4) * (mw_gas(igas)/98.0_r8)
+ else if (igas == igas_nh3) then
+ vol_molar_gas(igas) = 14.90_r8
+ else if (igas == igas_hno3) then
+ vol_molar_gas(igas) = 24.11_r8
+ else if (igas == igas_hcl) then
+ vol_molar_gas(igas) = 21.48_r8
+ end if
+! values from mosaic code
+! v_molar(iv)= 42.88_r8 ! h2so4
+! v_molar(iv)= 24.11_r8 ! hno3
+! v_molar(iv)= 21.48_r8 ! hcl
+! v_molar(iv)= 14.90_r8 ! nh3
+! v_molar(iv)= 65.0_r8 ! soa
+
+ end do ! igas
+
+! set aerosol mass and number mapping
+ lmap_aer(:,:) = 0
+ lmap_aercw(:,:) = 0
+ lmapbb_aer(:,:) = 0
+ dens_aer(:) = 1.0_r8
+ hygro_aer(:) = 1.0_r8
+ mw_aer(:) = 1.0_r8
+ fcvt_aer(:) = 1.0_r8
+
+ lmap_num(:) = 0
+ lmap_numcw(:) = 0
+ fcvt_num = 1.0_r8 ! leave number mix-ratios unchanged (#/kmol-air)
+
+ fcvt_wtr = mwdry/mwh2o ! convert aerosol water mix-ratios from (kg/kg) to (mol/mol)
+
+ do n = 1, ntot_amode
+ do lac = 1, 2
+ do l1 = 1, nspec_amode(n)
+ if (lac == 1) then
+ l = lmassptr_amode(l1,n)
+ lmz = l - loffset
+ tmpnamea = cnst_name(l)
+ tmpch2 = '_a'
+ else
+ l = lmassptrcw_amode(l1,n)
+ lmz = 0
+ tmpnamea = cnst_name_cw(l)
+ tmpch2 = '_c'
+ end if
+ iaer = 0
+ do j = 1, naer
+ if (n <= 9) then
+ write(tmpnameb,'(2a,i1)') trim(name_aerpfx(j)), tmpch2, n
+ else
+ write(tmpnameb,'(2a,i2)') trim(name_aerpfx(j)), tmpch2, n
+ end if
+ if (tmpnamea == tmpnameb) then
+ iaer = j
+ exit
+ end if
+ end do
+ if (iaer <= 0) then
+ msg = 'modal_aero_amicphys_init ERROR - lmap_aer for ' // tmpnamea
+ call endrun( msg )
+ end if
+ if (lac == 1) then
+ name_aer(iaer,n) = tmpnamea
+ lmz2 = get_spc_ndx( tmpnamea )
+ if (lmz /= lmz2 .or. lmz <= 0) then
+ msg = 'modal_aero_amicphys_init ERROR - lmz /= lmz2 for ' // tmpnamea
+ call endrun( msg )
+ end if
+ lmapcc_all(lmz) = lmapcc_val_aer
+ lmap_aer(iaer,n) = l - loffset
+ lmapbb_aer(iaer,n) = l1
+
+ dens_aer(iaer) = specdens2_amode(l1,n)
+ hygro_aer(iaer) = spechygro2(l1,n)
+ mwhost_aer(iaer) = specmw2_amode(l1,n)
+ mw_aer(iaer) = mwhost_aer(iaer)
+
+ itmpa = iaer - iaer_pom + 1
+ if (iaer <= nsoa) then
+ mw_aer(iaer) = mwuse_soa(iaer)
+ else if ((1 <= itmpa) .and. (itmpa <= npoa)) then
+ mw_aer(iaer) = mwuse_poa(itmpa)
+ end if
+ fcvt_aer(iaer) = mwhost_aer(iaer)/mw_aer(iaer)
+ fac_m2v_aer(iaer) = mw_aer(iaer)/dens_aer(iaer)
+ else
+ name_aercw(iaer,n) = tmpnamea
+ lmap_aercw(iaer,n) = l - loffset
+ end if
+
+ end do ! l1
+ end do ! lac
+
+ lmap_num(n) = numptr_amode(n) - loffset
+ name_num(n) = cnst_name(numptr_amode(n))
+ lmz = lmap_num(n)
+ lmz2 = get_spc_ndx( name_num(n) )
+ if (lmz /= lmz2 .or. lmz <= 0) then
+ msg = 'modal_aero_amicphys_init ERROR - lmz /= lmz2 for ' // name_num(n)
+ call endrun( msg )
+ end if
+ lmapcc_all(lmz) = lmapcc_val_num
+
+ lmap_numcw(n) = numptrcw_amode(n) - loffset
+ name_numcw(n) = cnst_name_cw(numptrcw_amode(n))
+ mwhost_num = 1.0_r8
+
+ end do ! n
+
+ do iaer = 1, naer
+ fac_eqvso4hyg_aer(iaer) = hygro_aer(iaer)/hygro_aer(iaer_so4)
+ fac_m2v_eqvhyg_aer(iaer) = fac_m2v_aer(iaer) * fac_eqvso4hyg_aer(iaer)
+ end do ! naer
+
+ sigmag_aer(:) = 1.8_r8
+ sigmag_aer(1:ntot_amode) = sigmag_amode(1:ntot_amode)
+ alnsg_aer(1:max_mode) = log(sigmag_aer(1:max_mode))
+
+ dgnum_aer(:) = 3.0e-9_r8
+ dgnumlo_aer(:) = 1.0e-9_r8
+ dgnumhi_aer(:) = 10.0e-9_r8
+ dgnum_aer(1:ntot_amode) = dgnum_amode(1:ntot_amode)
+ dgnumhi_aer(1:ntot_amode) = dgnumhi_amode(1:ntot_amode)
+ dgnumlo_aer(1:ntot_amode) = dgnumlo_amode(1:ntot_amode)
+
+ ! converts number geometric_mean diameter to volume-mean diameter
+ fcvt_dgnum_dvolmean(1:max_mode) = exp( 1.5_r8*(alnsg_aer(1:max_mode)**2) )
+
+ dens_so4a_host = dens_aer(iaer_so4)
+ mw_so4a_host = mwhost_aer(iaer_so4)
+ if (iaer_nh4 > 0) then
+ mw_nh4a_host = mwhost_aer(iaer_nh4)
+ else
+ mw_nh4a_host = mw_so4a_host
+ end if
+
+
+ nacc = modeptr_accum
+ nait = modeptr_aitken
+ npca = modeptr_pcarbon
+ nufi = modeptr_ufine
+#if ( defined MODAL_AERO_9MODE )
+ nmacc = modeptr_maccum
+ nmait = modeptr_maitken
+#else
+ nmacc = big_neg_int
+ nmait = big_neg_int
+#endif
+ if ( nufi <= 0 .and. &
+ ntot_amode_extd > ntot_amode ) nufi = ntot_amode_extd
+
+! aging pairs
+ ipair = 0
+ modefrm_agepair(:) = big_neg_int
+ modetoo_agepair(:) = big_neg_int
+ mode_aging_optaa(:) = 0
+ i_agepair_pca = big_neg_int ; i_agepair_macc = big_neg_int ; i_agepair_mait = big_neg_int ;
+ if (npca > 0 .and. nacc > 0) then
+ ipair = ipair + 1
+ modefrm_agepair(ipair) = npca
+ modetoo_agepair(ipair) = nacc
+ i_agepair_pca = ipair
+ mode_aging_optaa(npca) = 1
+ end if
+ if (nmacc > 0 .and. nacc > 0) then
+ ipair = ipair + 1
+ modefrm_agepair(ipair) = nmacc
+ modetoo_agepair(ipair) = nacc
+ i_agepair_macc = ipair
+ mode_aging_optaa(nmacc) = 1
+ end if
+ if (nmait > 0 .and. nait > 0) then
+ ipair = ipair + 1
+ modefrm_agepair(ipair) = nmait
+ modetoo_agepair(ipair) = nait
+ i_agepair_mait = ipair
+ mode_aging_optaa(nmait) = 1
+ end if
+ n_agepair = ipair
+
+! coagulation pairs
+!
+! mam version modes involved in coagulation # of coag pairs
+! ----------- ----------------------------- ---------------
+! 3 mode accum, aitken 1
+! 4,7 mode accum, aitken, pcarbon 3
+! 9 mode accum, aitken, pcarbon, maccum, maitken 10
+! (pcarbon = primary carbon)
+! (maccum = primary marine-organics accum)
+! (maitken = primary marine-organics aitken)
+!
+! 9 mode -- 5 participating modes and 10 possible coagulation pairs
+! 6 possible coagulation pairs involve a smaller and a larger sized mode
+! the resulting particle is placed in the larger-sized mode
+! aitken + [ accum, pcarbon, maccum ]
+! maitken + [ accum, pcarbon, maccum ]
+! 4 possible coagulation pairs involve similar sized modes
+! the resulting particle is placed in the mode that is aged
+! or contains the largest number of species
+! pcarbon + accum --> accum (aged)
+! maitken + aitken --> aitken (aged)
+! maccum + accum --> accum (aged)
+! maccum + pcarbon --> pcarbon (largest number of species)
+! note that 2 of the coagulation pairs results in aging, so
+! aitken + pcarbon --> pcarbon (temporary) --> accum
+! aitken + maccum --> maccum (temporary) --> accum
+! each mode also has self-coagulation which only affects number
+ ipair = 0
+ modefrm_coagpair(:) = big_neg_int
+ modetoo_coagpair(:) = big_neg_int
+ modeend_coagpair(:) = big_neg_int
+ do ip = 1, 11
+ na = big_neg_int ; nb = big_neg_int
+ nc = big_pos_int
+ if (ip == 1) then
+ na = nait ; nb = nacc
+ else if (ip == 2) then
+ na = npca ; nb = nacc
+ else if (ip == 3) then
+ na = nait ; nb = npca
+ nc = nacc
+ else if (ip == 4) then
+ na = nait ; nb = nmacc
+ nc = nacc
+ else if (ip == 5) then
+ na = nmait ; nb = nacc
+ else if (ip == 6) then
+ na = nmait ; nb = npca
+ else if (ip == 7) then
+ na = nmait ; nb = nait
+ else if (ip == 8) then
+ na = nmait ; nb = nmacc
+ else if (ip == 9) then
+ na = nmacc ; nb = nacc
+ else if (ip == 10) then
+ na = nmacc ; nb = npca
+ end if
+ if (nc == big_pos_int) nc = nb
+
+ if (na < 1 .or. nb < 1 .or. nc < 1) cycle
+ ipair = ipair + 1
+ modefrm_coagpair(ipair) = na
+ modetoo_coagpair(ipair) = nb
+ modeend_coagpair(ipair) = nc
+ end do
+ n_coagpair = ipair
+
+
+! diagnostics
+ if ( masterproc ) then
+ write(iulog,'(/a)') 'modal_aero_amicphys_init start'
+
+ write(iulog,'(/a,i12)') &
+ 'mdo_gaexch_cldy_subarea ', mdo_gaexch_cldy_subarea
+ write(iulog,'( a,i12)') &
+ 'gaexch_h2so4_uptake_optaa ', gaexch_h2so4_uptake_optaa
+ write(iulog,'( a,i12)') &
+ 'newnuc_h2so4_conc_optaa ', newnuc_h2so4_conc_optaa
+ write(iulog,'( a,i12)') &
+ 'rename_method_optaa ', rename_method_optaa
+ write(iulog,'( a,1p,e12.4)') &
+ 'newnuc_adjust_factor_pbl ', newnuc_adjust_factor_pbl
+
+ write(iulog,'(/a56,10i5)') &
+ 'ngas, max_gas, naer, max_aer', &
+ ngas, max_gas, naer, max_aer
+ write(iulog,'(/a56,10i5)') &
+ 'nsoa, npoa, nbc', &
+ nsoa, npoa, nbc
+ write(iulog,'(/a56,10i5)') &
+ 'igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl', &
+ igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl
+ write(iulog,'(/a56,10i5)') &
+ 'iaer_soa, iaer_so4, iaer_nh4, iaer_no3, iaer_cl', &
+ iaer_soa, iaer_so4, iaer_nh4, iaer_no3, iaer_cl
+ write(iulog,'(/a56,10i5)') &
+ 'iaer_pom, iaer_bc, iaer_ncl, iaer_dst, iaer_ca, iaer_co3', &
+ iaer_pom, iaer_bc, iaer_ncl, iaer_dst, iaer_ca, iaer_co3
+ write(iulog,'(/a56,10i5)') &
+ 'iaer_mpoly, iaer_mprot, iaer_mlip, iaer_mhum, iaer_mproc', &
+ iaer_mpoly, iaer_mprot, iaer_mlip, iaer_mhum, iaer_mproc
+ write(iulog,'(/a)') &
+ 'fac_eqvso4hyg_aer(1:naer)'
+ write(iulog,'(4(a,1pe10.3,3x))') &
+ ( name_aerpfx(iaer)(1:6), fac_eqvso4hyg_aer(iaer), iaer=1,naer )
+
+ write(iulog,'(/a)') 'igas, lmap, name, mwhost, mw, fcvt, accom, vmol'
+ do igas = 1, ngas
+ write(iulog,'(2i4,2x,a,2f10.4,1p,3e12.4)') &
+ igas, lmap_gas(igas), name_gas(igas), &
+ mwhost_gas(igas), mw_gas(igas), fcvt_gas(igas), &
+ accom_coef_gas(igas), vol_molar_gas(igas)
+ end do
+
+ do n = 1, ntot_amode
+ write(iulog,'(/a,i5)') &
+ 'iaer, lmap, name, mwhost, mw, fcvt, dens, fac_m2v, hygro for mode', n
+ write(iulog,'(2i4,2x,a,20x,1p,e12.4)') &
+ 0, lmap_num(n), name_num(n), fcvt_num
+ write(iulog,'(2i4,2x,a,20x,1p,e12.4)') &
+ 0, lmap_numcw(n), name_numcw(n)
+ do iaer = 1, naer
+ if (lmap_aer(iaer,n) > 0) then
+ if (max(mwhost_aer(iaer),mw_aer(iaer)) <= 9999.9999_r8) then
+ fmtaa = '(2i4,2x,a,2f10.4,1p,5e12.4)'
+ else
+ fmtaa = '(2i4,2x,a,2f10.2,1p,5e12.4)'
+ end if
+ write(iulog,fmtaa) &
+ iaer, lmap_aer(iaer,n), name_aer(iaer,n), &
+ mwhost_aer(iaer), mw_aer(iaer), fcvt_aer(iaer), &
+ dens_aer(iaer), fac_m2v_aer(iaer), hygro_aer(iaer)
+ write(iulog,'(2i4,2x,a,2f10.4,1p,4e12.4)') &
+ iaer, lmap_aercw(iaer,n), name_aercw(iaer,n)
+ end if
+ end do
+ end do ! n
+
+ write(iulog,'(/a)') 'l, lmz, lmapcc_all, species_class, name'
+ do lmz = 1, gas_pcnst
+ l = lmz + loffset
+ j = -99
+ if (l <= pcnst) j = species_class(l)
+ write(iulog,'(4i5,2x,a)') &
+ lmz+loffset, lmz, lmapcc_all(lmz), j, solsym(lmz)
+ end do
+
+ end if ! ( masterproc )
+
+
+ call m_a_amicphys_init_history( loffset )
+
+
+ if ( masterproc ) write(iulog,'(/a)') 'modal_aero_amicphys_init end'
+
+ return
+ end subroutine modal_aero_amicphys_init
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine mam_set_lptr2_and_specxxx2
+!
+! initializes the following
+! lptr2_soa_a_amode, lptr2_soa_g_amode, &
+! specdens2_amode, spechygro2, specmw2_amode
+! when the multiple nbc/npoa/nsoa flavors is implemented,
+! this can be done in modal_aero_initialize_data
+!
+ use cam_logfile, only : iulog
+ use constituents, only : pcnst, cnst_get_ind, cnst_name
+
+ use modal_aero_data, only : &
+ lspectype_amode, &
+ lptr_soa_a_amode, lptr2_soa_a_amode, lptr2_soa_g_amode, &
+ nspec_amode, ntot_amode, &
+ specdens_amode, spechygro, specmw_amode
+
+ implicit none
+
+ integer :: jsoa
+ integer :: l1, l2
+ integer :: n
+
+
+ if (nsoa == 1) then
+ jsoa = 1
+ call cnst_get_ind( 'SOAG', l1, .false. )
+ if (l1 < 1 .or. l1 > pcnst) &
+ call endrun( 'mam_set_lptr2_and_specxxx2 ERROR - no SOAG' )
+ lptr2_soa_g_amode(jsoa) = l1
+ do n = 1, ntot_amode
+ lptr2_soa_a_amode(n,jsoa) = lptr_soa_a_amode(n)
+ end do
+ else
+ call endrun( 'mam_set_lptr2_and_specxxx2 ERROR - expecting nsoa = 1' )
+ end if
+
+ do n = 1, ntot_amode
+ do l1 = 1, nspec_amode(n)
+ l2 = lspectype_amode(l1,n)
+ specmw2_amode(l1,n) = specmw_amode(l2)
+ specdens2_amode(l1,n) = specdens_amode(l2)
+ spechygro2(l1,n) = spechygro(l2)
+ end do
+ end do
+
+
+ return
+ end subroutine mam_set_lptr2_and_specxxx2
+
+
+!--------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------
+ subroutine m_a_amicphys_init_history( loffset )
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! set do_adjust and do_aitken flags
+! create history fields for column tendencies associated with
+! modal_aero_calcsize
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+use cam_history, only : addfld, add_default, fieldname_len, phys_decomp
+use cam_logfile, only : iulog
+use constituents, only : pcnst, cnst_get_ind, cnst_name
+use spmd_utils, only : masterproc
+use phys_control,only : phys_getopts
+
+use modal_aero_data, only : &
+ cnst_name_cw, &
+ modeptr_accum, modeptr_aitken, modeptr_pcarbon, modeptr_ufine
+!use modal_aero_rename
+
+implicit none
+
+!-----------------------------------------------------------------------
+! arguments
+ integer, intent(in) :: loffset
+
+!-----------------------------------------------------------------------
+! local
+ integer :: iaer, igas, ipair, iok
+ integer :: lmz, lmza, lmzb, lmzc
+ integer :: m
+ integer :: n, na, nb, nc
+
+ real(r8) :: tmp1, tmp2
+
+ character(len=fieldname_len) :: tmpnamea, tmpnameb
+ character(len=fieldname_len+3) :: fieldname
+ character(128) :: long_name
+ character(128) :: msg
+ character(8) :: unit
+ character(2) :: tmpch2
+
+ logical :: history_aerosol ! Output the MAM aerosol tendencies
+ logical :: history_aerocom ! Output the aerocom history
+ !-----------------------------------------------------------------------
+
+
+ call phys_getopts( history_aerosol_out = history_aerosol )
+#if ( defined CAM_VERSION_IS_ACME )
+ history_aerocom = .false.
+#else
+ call phys_getopts( history_aerocom_out = history_aerocom )
+#endif
+
+
+!
+! set the do_q_coltendaa
+!
+ do_q_coltendaa(:,:) = .false.
+
+
+! gas-->aer condensation and resulting aging
+ do igas = 1, ngas
+ lmz = lmap_gas(igas)
+ if (lmz <= 0) cycle
+ do_q_coltendaa(lmz,iqtend_cond) = .true.
+ iaer = igas
+ do n = 1, ntot_amode
+ lmz = lmap_aer(iaer,n)
+ if (lmz <= 0) cycle
+ do_q_coltendaa(lmz,iqtend_cond) = .true.
+ end do ! n
+ end do ! igas
+
+ do ipair = 1, n_agepair
+ na = modefrm_agepair(ipair)
+ nb = modetoo_agepair(ipair)
+ if (na < 1 .or. nb < 1) cycle
+
+ lmza = lmap_num(na)
+ lmzb = lmap_num(nb)
+ do_q_coltendaa(lmza,iqtend_cond) = .true.
+ do_q_coltendaa(lmzb,iqtend_cond) = .true.
+ do iaer = 1, naer
+ lmza = lmap_aer(iaer,na)
+ lmzb = lmap_aer(iaer,nb)
+ if (lmza > 0) then
+ do_q_coltendaa(lmza,iqtend_cond) = .true.
+ if (lmzb > 0) do_q_coltendaa(lmzb,iqtend_cond) = .true.
+ end if
+ end do ! iaer
+ end do ! ipair
+
+! define history fields for gas-->aer condensation and resulting aging
+ do lmz = 1, gas_pcnst
+ if ( do_q_coltendaa(lmz,iqtend_cond)) then
+ tmpnamea = cnst_name(lmz+loffset)
+ fieldname = trim(tmpnamea) // '_sfgaex1'
+ long_name = trim(tmpnamea) // ' gas-aerosol-exchange primary column tendency'
+ unit = 'kg/m2/s'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if ( history_aerosol ) call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit
+ end if
+ end do ! lmz
+
+! define history fields for 3d soa production for aerocom
+ do igas = 1, nsoa
+ lmz = lmap_gas(igas)
+ if (lmz <= 0) cycle
+ if ( .not. do_q_coltendaa(lmz,iqtend_cond)) cycle
+ if ( .not. history_aerocom ) cycle
+
+ tmpnamea = cnst_name(lmz+loffset)
+ fieldname = trim(tmpnamea) // '_sfgaex3d'
+ long_name = trim(tmpnamea) // ' gas-aerosol-exchange primary 3d tendency'
+ unit = 'kg/m2/s'
+ call addfld( fieldname, unit, pver, 'A', long_name, phys_decomp )
+ call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,3x),2i5)') &
+ 'gasaerexch addfld', fieldname, unit, igas, lmz+loffset
+ end do
+
+
+! renaming during gas-->aer condensation or cloud chemistry
+ na = modeptr_aitken
+ nb = modeptr_accum
+ if (na > 0 .and. nb > 0) then
+ lmza = lmap_num(na)
+ lmzb = lmap_num(nb)
+ do_q_coltendaa(lmza,iqtend_rnam) = .true.
+ do_q_coltendaa(lmzb,iqtend_rnam) = .true.
+ lmza = lmap_numcw(na)
+ lmzb = lmap_numcw(nb)
+ do_qqcw_coltendaa(lmza,iqqcwtend_rnam) = .true.
+ do_qqcw_coltendaa(lmzb,iqqcwtend_rnam) = .true.
+ do iaer = 1, naer
+ lmza = lmap_aer(iaer,na)
+ lmzb = lmap_aer(iaer,nb)
+ if (lmza > 0) then
+ do_q_coltendaa(lmza,iqtend_rnam) = .true.
+ if (lmzb > 0) do_q_coltendaa(lmzb,iqtend_rnam) = .true.
+ end if
+ lmza = lmap_aercw(iaer,na)
+ lmzb = lmap_aercw(iaer,nb)
+ if (lmza > 0) then
+ do_qqcw_coltendaa(lmza,iqqcwtend_rnam) = .true.
+ if (lmzb > 0) do_qqcw_coltendaa(lmzb,iqqcwtend_rnam) = .true.
+ end if
+ end do ! iaer
+ end if ! (na > 0 .and. nb > 0)
+
+! define history fields for renaming during gas-->aer condensation or cloud chemistry
+ do lmz = 1, gas_pcnst
+ if ( do_q_coltendaa(lmz,iqtend_rnam)) then
+ tmpnamea = cnst_name(lmz+loffset)
+ fieldname = trim(tmpnamea) // '_sfgaex2'
+ long_name = trim(tmpnamea) // ' gas-aerosol-exchange renaming column tendency'
+ unit = 'kg/m2/s'
+ if (tmpnamea(1:4) == 'num_' .or. tmpnamea(1:4) == 'NUM_') unit = '#/m2/s'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if ( history_aerosol ) call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit
+ end if
+ if ( do_qqcw_coltendaa(lmz,iqqcwtend_rnam)) then
+ tmpnamea = cnst_name_cw(lmz+loffset)
+ fieldname = trim(tmpnamea) // '_sfgaex2'
+ long_name = trim(tmpnamea) // ' gas-aerosol-exchange renaming column tendency'
+ unit = 'kg/m2/s'
+ if (tmpnamea(1:4) == 'num_' .or. tmpnamea(1:4) == 'NUM_') unit = '#/m2/s'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if ( history_aerosol ) call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,3x))') 'gasaerexch addfld', fieldname, unit
+ end if
+ end do ! lmz
+
+
+
+! coagulation
+ do ipair = 1, n_coagpair
+ na = modefrm_coagpair(ipair)
+ nb = modetoo_coagpair(ipair)
+ nc = modeend_coagpair(ipair)
+ if (na < 1 .or. nb < 1 .or. nc < 1) cycle
+
+ lmza = lmap_num(na)
+ lmzb = lmap_num(nb)
+ lmzc = lmap_num(nc)
+ do_q_coltendaa(lmza,iqtend_coag) = .true.
+ do_q_coltendaa(lmzb,iqtend_coag) = .true.
+ do_q_coltendaa(lmzc,iqtend_coag) = .true.
+ do iaer = 1, naer
+ lmza = lmap_aer(iaer,na)
+ lmzb = lmap_aer(iaer,nb)
+ lmzc = lmap_aer(iaer,nc)
+ if (lmza > 0) then
+ do_q_coltendaa(lmza,iqtend_coag) = .true.
+ if (lmzc > 0) do_q_coltendaa(lmzc,iqtend_coag) = .true.
+ end if
+ if (nb == nc) cycle
+ if (lmzb > 0) then
+ do_q_coltendaa(lmzb,iqtend_coag) = .true.
+ if (lmzc > 0) do_q_coltendaa(lmzc,iqtend_coag) = .true.
+ end if
+ end do ! iaer
+ end do ! ipair
+
+! define history fields for coagulation
+ do lmz = 1, gas_pcnst
+ if ( do_q_coltendaa(lmz,iqtend_coag)) then
+ tmpnamea = cnst_name(lmz+loffset)
+ fieldname = trim(tmpnamea) // '_sfcoag1'
+ long_name = trim(tmpnamea) // ' modal_aero coagulation column tendency'
+ unit = 'kg/m2/s'
+ if (tmpnamea(1:4) == 'num_' .or. tmpnamea(1:4) == 'NUM_') unit = '#/m2/s'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if ( history_aerosol ) call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,3x))') 'modal_aero_coag_init addfld', fieldname, unit
+ end if
+ end do ! lmz
+
+
+! nucleation
+ n = modeptr_aitken
+ do igas = 1, ngas
+ iok = 0
+ if (igas == igas_h2so4) iok = 1
+ if (igas == igas_nh3 ) iok = 1
+ if (iok <= 0) cycle
+ lmz = lmap_gas(igas)
+ if (lmz > 0) then
+ do_q_coltendaa(lmz,iqtend_nnuc) = .true.
+ iaer = igas
+ lmz = lmap_aer(iaer,n)
+ if (lmz > 0) do_q_coltendaa(lmz,iqtend_nnuc) = .true.
+ end if
+ end do ! igas
+ lmzc = lmap_num(n)
+ do_q_coltendaa(lmzc,iqtend_nnuc) = .true.
+
+! define history fields for nucleation
+ do lmz = 1, gas_pcnst
+ if ( do_q_coltendaa(lmz,iqtend_nnuc)) then
+ tmpnamea = cnst_name(lmz+loffset)
+ fieldname = trim(tmpnamea) // '_sfnnuc1'
+ long_name = trim(tmpnamea) // ' modal_aero new particle nucleation column tendency'
+ unit = 'kg/m2/s'
+ if (tmpnamea(1:4) == 'num_' .or. tmpnamea(1:4) == 'NUM_') unit = '#/m2/s'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if ( history_aerosol ) call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,3x))') 'modal_aero_newnuc_init addfld', fieldname, unit
+ end if
+ end do ! lmz
+
+ if ( history_aerocom ) then
+ tmpnamea = cnst_name(lmzc+loffset)
+ fieldname = trim(tmpnamea) // '_nuc1'
+ long_name = trim(tmpnamea) // ' modal_aero new particle nucleation tendency'
+ unit = '#/m3/s'
+ call addfld( fieldname, unit, pver, 'A', long_name, phys_decomp )
+ call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,2x))') &
+ 'modal_aero_newnuc_init addfld', fieldname, unit
+
+ fieldname = trim(tmpnamea) // '_nuc2'
+ long_name = trim(tmpnamea) // ' modal_aero cluster nucleation rate'
+ unit = '#/m3/s'
+ call addfld( fieldname, unit, pver, 'A', long_name, phys_decomp )
+ call add_default( fieldname, 1, ' ' )
+ if ( masterproc ) write(iulog,'(3(a,2x))') &
+ 'modal_aero_newnuc_init addfld', fieldname, unit
+ endif
+
+
+#if ( defined( MOSAIC_SPECIES ) )
+ if ( mosaic ) then
+ !BSINGH - Adding addfld and add_default call for tracking convergence failures
+ call addfld('convergence_fail', 'no units', pver, 'A', 'For tracking MOSAIC convergence failure', phys_decomp )
+ call addfld('max_kelvin_iter', 'no units', pver, 'A', 'For tracking when MOSAIC kelvin iterations hit max ', phys_decomp )
+ call add_default( 'convergence_fail', 1, ' ' )
+ call add_default( 'max_kelvin_iter', 1, ' ' )
+
+ do n = 1, 4
+ do m = 1, 5
+ fieldname = ' '
+ write( fieldname(1:16), '(a,i1,a,i1)') 'astem_negval_', m, '_', n
+ call addfld( fieldname, 'no units', pver, 'A', 'For tracking ASTEM negative values', phys_decomp )
+ call add_default( fieldname, 1, ' ' )
+ end do
+ end do
+ end if
+#endif
+
+ return
+ end subroutine m_a_amicphys_init_history
+
+
+!----------------------------------------------------------------------
+
+end module modal_aero_amicphys
+
+
diff --git a/components/cam/src/chemistry/modal_aero/modal_aero_coag.F90 b/components/cam/src/chemistry/modal_aero/modal_aero_coag.F90
index 40401256632d..e4a526225273 100644
--- a/components/cam/src/chemistry/modal_aero/modal_aero_coag.F90
+++ b/components/cam/src/chemistry/modal_aero/modal_aero_coag.F90
@@ -11,6 +11,7 @@ module modal_aero_coag
! !USES:
use shr_kind_mod, only: r8 => shr_kind_r8
+ use cam_logfile, only: iulog
use chem_mods, only: gas_pcnst
use modal_aero_data, only: maxd_aspectype
@@ -19,7 +20,7 @@ module modal_aero_coag
save
! !PUBLIC MEMBER FUNCTIONS:
- public modal_aero_coag_sub, modal_aero_coag_init
+ public :: modal_aero_coag_sub, modal_aero_coag_init, getcoags_wrapper_f
! !PUBLIC DATA MEMBERS:
integer, parameter :: pcnstxx = gas_pcnst
@@ -86,7 +87,7 @@ subroutine modal_aero_coag_sub( &
use modal_aero_gasaerexch, only: n_so4_monolayers_pcage, &
soa_equivso4_factor
- use cam_abortutils, only: endrun
+ use cam_abortutils, only: endrun
use cam_history, only: outfld, fieldname_len
use chem_mods, only: adv_mass
use constituents, only: pcnst, cnst_name
@@ -209,7 +210,7 @@ subroutine modal_aero_coag_sub( &
dotend(:) = .false.
dqdt(1:ncol,:,:) = 0.0_r8
- lunout = 6
+ lunout = iulog
!
@@ -759,7 +760,7 @@ subroutine modal_aero_coag_init
use modal_aero_gasaerexch, only: &
modefrm_pcage, nspecfrm_pcage, lspecfrm_pcage, lspectoo_pcage
- use cam_abortutils, only: endrun
+ use cam_abortutils, only: endrun
use cam_history, only: addfld, add_default, fieldname_len, phys_decomp
use constituents, only: pcnst, cnst_name
use spmd_utils, only: masterproc
@@ -785,7 +786,7 @@ subroutine modal_aero_coag_init
call phys_getopts( history_aerosol_out = history_aerosol )
- lunout = 6
+ lunout = iulog
!
! define "from mode" and "to mode" for each coagulation pairing
! currently just a2-->a1 coagulation
@@ -815,9 +816,9 @@ subroutine modal_aero_coag_init
modetoo_acoag(3) = modeptr_pcarbon
modetooeff_acoag(3) = modeptr_accum
if (modefrm_pcage <= 0) then
- write(*,*) '*** modal_aero_coag_init error'
- write(*,*) ' pair_option_acoag, modefrm_pcage mismatch'
- write(*,*) ' pair_option_acoag, modefrm_pcage =', &
+ write(iulog,*) '*** modal_aero_coag_init error'
+ write(iulog,*) ' pair_option_acoag, modefrm_pcage mismatch'
+ write(iulog,*) ' pair_option_acoag, modefrm_pcage =', &
pair_option_acoag, modefrm_pcage
call endrun( 'modal_aero_coag_init error' )
end if
@@ -838,9 +839,9 @@ subroutine modal_aero_coag_init
if ( (mfrm < 1) .or. (mfrm > ntot_amode) .or. &
(mtoo < 1) .or. (mtoo > ntot_amode) .or. &
(mtef < 1) .or. (mtef > ntot_amode) ) then
- write(*,*) '*** modal_aero_coag_init error'
- write(*,*) ' ipair, ntot_amode =', ipair, ntot_amode
- write(*,*) ' mfrm, mtoo, mtef =', mfrm, mtoo, mtef
+ write(iulog,*) '*** modal_aero_coag_init error'
+ write(iulog,*) ' ipair, ntot_amode =', ipair, ntot_amode
+ write(iulog,*) ' mfrm, mtoo, mtef =', mfrm, mtoo, mtef
call endrun( 'modal_aero_coag_init error' )
end if
@@ -983,9 +984,11 @@ subroutine modal_aero_coag_init
if ( history_aerosol ) then
call add_default( fieldname, 1, ' ' )
endif
- if ( masterproc ) write(*,'(3(a,2x))') &
+ if ( masterproc ) write(iulog,'(3(a,2x))') &
'modal_aero_coag_init addfld', fieldname, unit
end do ! l = ...
+ if ( masterproc ) write(iulog,'(a)') &
+ 'modal_aero_coag_init ALL DONE'
return
diff --git a/components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90 b/components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90
index f789744e4aaf..c90954db310b 100644
--- a/components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90
+++ b/components/cam/src/chemistry/modal_aero/modal_aero_convproc.F90
@@ -20,6 +20,7 @@ module modal_aero_convproc
use ppgrid, only: pver, pcols, pverp, begchunk, endchunk
use cam_history, only: outfld, addfld, add_default, phys_decomp
use cam_logfile, only: iulog
+ use cam_abortutils, only: endrun
use physconst, only: spec_class_aerosol, spec_class_gas
implicit none
@@ -64,13 +65,14 @@ module modal_aero_convproc
!
! Private module data
-! (none currently)
!
logical, private :: convproc_do_gas, convproc_do_aer
+ logical, private :: convproc_prevap_resusp_fixaa = .false. ! REASTER 08/05/2015
+ ! convproc_method_fixaa - see explanation in subr. ma_convproc_tend( &
+ integer, private :: convproc_method_activate
! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers
! 2=do secondary activation with prescribed supersat
- integer, private :: convproc_method_activate
!=========================================================================================
contains
@@ -111,13 +113,16 @@ subroutine ma_convproc_init
integer :: npass_calc_updraft
logical :: history_aerosol ! Output the MAM aerosol tendencies
+ logical :: resus_fix
+ character(len=100) :: msg
!
! Add history fields
!
call phys_getopts( history_aerosol_out=history_aerosol, &
- convproc_do_aer_out = convproc_do_aer, convproc_do_gas_out = convproc_do_gas, &
- convproc_method_activate_out = convproc_method_activate)
+ convproc_do_aer_out = convproc_do_aer, &
+ convproc_do_gas_out = convproc_do_gas, &
+ convproc_method_activate_out = convproc_method_activate )
call addfld( 'SH_MFUP_MAX', 'kg/m2', 1, 'A', &
'Shallow conv. column-max updraft mass flux', phys_decomp )
@@ -133,8 +138,7 @@ subroutine ma_convproc_init
call addfld( 'DP_KCLDBASE', '1', 1, 'A', &
'Deep conv. cloudbase level index', phys_decomp )
- if ( history_aerosol .and. &
- ( convproc_do_aer .or. convproc_do_gas) ) then
+ if ( history_aerosol .and. convproc_do_aer ) then
call add_default( 'SH_MFUP_MAX', 1, ' ' )
call add_default( 'SH_WCLDBASE', 1, ' ' )
call add_default( 'SH_KCLDBASE', 1, ' ' )
@@ -188,7 +192,9 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
aerdepwetis, &
mu, md, du, eu, &
ed, dp, dsubcld, &
- jt, maxg, ideep, lengath, species_class )
+ jt, maxg, ideep, lengath, species_class, &
+ mam_prevap_resusp_optaa, &
+ history_aero_prevap_resusp )
!-----------------------------------------------------------------------
!
! Purpose:
@@ -212,7 +218,6 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
use constituents, only: pcnst, cnst_name
use error_messages, only: alloc_err
- use cam_abortutils, only: endrun
use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode
! Arguments
@@ -253,10 +258,12 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
integer, intent(in) :: ideep(pcols) ! Gathering array
integer, intent(in) :: lengath ! Gathered min lon indices over which to operate
integer, intent(in) :: species_class(:)
+ integer, intent(in) :: mam_prevap_resusp_optaa
+ logical, intent(in) :: history_aero_prevap_resusp
! Local variables
- integer, parameter :: nsrflx = 5 ! last dimension of qsrflx
+ integer, parameter :: nsrflx = 6 ! last dimension of qsrflx ! REASTER 08/05/2015
integer :: i, ii, itmpa
integer :: k
integer :: l, ll, lchnk
@@ -283,6 +290,10 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
!
! Initialize
!
+
+! apply this minor fix when doing resuspend to coarse mode
+ if (mam_prevap_resusp_optaa >= 30) convproc_prevap_resusp_fixaa = .true.
+
lchnk = state%lchnk
ncol = state%ncol
nstep = get_nstep()
@@ -352,7 +363,7 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
ed, dp, dsubcld, &
jt, maxg, ideep, lengath, &
qb, dqdt, dotend, nsrflx, qsrflx, &
- species_class )
+ species_class, mam_prevap_resusp_optaa )
! apply deep conv processing tendency and prepare for shallow conv processing
@@ -380,8 +391,8 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
! 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)
+ sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,6) ! REASTER 08/05/2015
+ sflxed(1:ncol,l) = sflxed(1:ncol,l) + qsrflx(1:ncol,l,6) ! REASTER 08/05/2015
end if
if (species_class(l) == spec_class_aerosol) then
@@ -409,7 +420,7 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
sh_frac, icwmrsh, rprdsh, evapcsh, dlfsh, &
cmfmcsh, sh_e_ed_ratio, &
qb, dqdt, dotend, nsrflx, qsrflx, &
- species_class )
+ species_class, mam_prevap_resusp_optaa )
! apply shallow conv processing tendency
@@ -435,7 +446,7 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
if ((species_class(l) == spec_class_aerosol) .or. &
(species_class(l) == 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)
+ sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,6) ! REASTER 08/05/2015
end if
if (species_class(l) == spec_class_aerosol) then
@@ -464,11 +475,13 @@ subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, &
call outfld( trim(cnst_name(l))//'SFWET', aerdepwetis(:,l), pcols, lchnk )
call outfld( trim(cnst_name(l))//'SFSIC', sflxic(:,l), pcols, lchnk )
+ if ( history_aero_prevap_resusp ) &
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 )
+ call outfld( trim(cnst_name(l))//'SFSID', sflxid(:,l), pcols, lchnk )
+ if ( history_aero_prevap_resusp ) &
+ call outfld( trim(cnst_name(l))//'SFSED', sflxed(:,l), pcols, lchnk )
end if
end do ! ll
end do ! n
@@ -487,7 +500,7 @@ subroutine ma_convproc_dp_intr( &
ed, dp, dsubcld, &
jt, maxg, ideep, lengath, &
q, dqdt, dotend, nsrflx, qsrflx, &
- species_class )
+ species_class, mam_prevap_resusp_optaa )
!-----------------------------------------------------------------------
!
! Purpose:
@@ -513,7 +526,6 @@ subroutine ma_convproc_dp_intr( &
use physconst, only: gravit, rair
use phys_grid, only: get_lat_all_p, get_lon_all_p, get_rlat_all_p, get_rlon_all_p
- use cam_abortutils, only: endrun
use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode
@@ -550,6 +562,7 @@ subroutine ma_convproc_dp_intr( &
integer, intent(in) :: ideep(pcols) ! Gathering array
integer, intent(in) :: lengath ! Gathered min lon indices over which to operate
integer, intent(in) :: species_class(:)
+ integer, intent(in) :: mam_prevap_resusp_optaa
! real(r8), intent(in) :: concld(pcols,pver) ! Convective cloud cover
@@ -826,6 +839,7 @@ subroutine ma_convproc_dp_intr( &
dp_frac, icwmrdp, rprddp, evapcdp, &
fracice, &
dqdt, dotend, nsrflx, qsrflx, &
+ species_class, mam_prevap_resusp_optaa, & ! REASTER 08/05/2015
xx_mfup_max, xx_wcldbase, xx_kcldbase, &
lun, itmpveca )
! ed, dp, dsubcld, jt, &
@@ -912,7 +926,7 @@ subroutine ma_convproc_sh_intr( &
sh_frac, icwmrsh, rprdsh, evapcsh, dlfsh, &
cmfmcsh, sh_e_ed_ratio, &
q, dqdt, dotend, nsrflx, qsrflx, &
- species_class )
+ species_class, mam_prevap_resusp_optaa )
!-----------------------------------------------------------------------
!
! Purpose:
@@ -938,7 +952,6 @@ subroutine ma_convproc_sh_intr( &
use physconst, only: gravit, rair
use phys_grid, only: get_lat_all_p, get_lon_all_p, get_rlat_all_p, get_rlon_all_p
- use cam_abortutils, only: endrun
use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode
@@ -962,6 +975,7 @@ subroutine ma_convproc_sh_intr( &
real(r8), intent(in) :: cmfmcsh(pcols,pverp) ! Shallow conv mass flux (kg/m2/s)
real(r8), intent(in) :: sh_e_ed_ratio(pcols,pver) ! shallow conv [ent/(ent+det)] ratio
integer, intent(in) :: species_class(:)
+ integer, intent(in) :: mam_prevap_resusp_optaa
! real(r8), intent(in) :: concld(pcols,pver) ! Convective cloud cover
@@ -1351,6 +1365,7 @@ subroutine ma_convproc_sh_intr( &
sh_frac, icwmrsh, rprdsh, evapcsh, &
fracice, &
dqdt, dotend, nsrflx, qsrflx, &
+ species_class, mam_prevap_resusp_optaa, & ! REASTER 08/05/2015
xx_mfup_max, xx_wcldbase, xx_kcldbase, &
lun, itmpveca2 )
@@ -1453,6 +1468,7 @@ subroutine ma_convproc_tend( &
cldfrac, icwmr, rprd, evapc, &
fracice, &
dqdt, doconvproc, nsrflx, qsrflx, &
+ species_class, mam_prevap_resusp_optaa, & ! REASTER 08/05/2015
xx_mfup_max, xx_wcldbase, xx_kcldbase, &
lun, idiag_in )
@@ -1497,7 +1513,6 @@ subroutine ma_convproc_tend( &
use ppgrid, only: pcols, pver
use physconst, only: gravit, rair, rhoh2o
use constituents, only: pcnst, cnst_name
- use cam_abortutils, only: endrun
use modal_aero_data, only: cnst_name_cw, &
lmassptr_amode, lmassptrcw_amode, &
@@ -1553,11 +1568,17 @@ subroutine ma_convproc_tend( &
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)
+ ! 1 = activation of interstial to conv-cloudborne
+ ! 2 = resuspension of conv-cloudborne to interstital
+ ! 3 = aqueous chemistry (not implemented yet, so zero)
+ ! 4 = wet removal
+ ! 5 = actual precip-evap resuspension (what actually is applied to a species)
+ ! 6 = pseudo precip-evap resuspension (for history file) ! REASTER 08/05/2015
+ integer, intent(in) :: species_class(:) ! REASTER 08/05/2015
+ integer, intent(in) :: mam_prevap_resusp_optaa ! REASTER 08/05/2015
+ 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
@@ -1579,6 +1600,7 @@ subroutine ma_convproc_tend( &
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 ! REASTER 08/05/2015
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
@@ -1608,6 +1630,7 @@ subroutine ma_convproc_tend( &
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_prevap_hist(pcnst_extd,pver) ! similar but used for history output ! REASTER 08/05/2015
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
@@ -1629,6 +1652,7 @@ subroutine ma_convproc_tend( &
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) sumprevap_hist(pcnst_extd) ! sum (over layers) of dp*dcondt_prevap_hist ! REASTER 08/05/2015
real(r8) sumresusp(pcnst_extd) ! sum (over layers) of dp*dcondt_resusp
real(r8) sumwetdep(pcnst_extd) ! sum (over layers) of dp*dconudt_wetdep
@@ -1807,6 +1831,17 @@ subroutine ma_convproc_tend( &
! Zero out values at "top of cloudtop", "base of cloudbase"
ktop = jt(i)
kbot = mx(i)
+! REASTER 08/05/2015 BEGIN
+! 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
+! in the first version of this routine, the precp evap resusp tendencies for k > kbot were ignored,
+! but that is now fixed
+! this was a minor bug with quite minor affects on the aerosol,
+! because convective precip evap is (or used to be) much less than stratiform precip evap )
+ kbot_prevap = kbot
+ if ( convproc_prevap_resusp_fixaa ) kbot_prevap = pver
+! REASTER 08/05/2015 END
mu_i(:) = 0.0
md_i(:) = 0.0
do k = ktop+1, kbot
@@ -1907,6 +1942,7 @@ subroutine ma_convproc_tend( &
dcondt_resusp(:,:) = 0.0
dcondt_wetdep(:,:) = 0.0
dcondt_prevap(:,:) = 0.0
+ dcondt_prevap_hist(:,:) = 0.0 ! REASTER 08/05/2015
dconudt_aqchem(:,:) = 0.0
dconudt_wetdep(:,:) = 0.0
! only initialize the activation tendency on ipass=1
@@ -2254,6 +2290,7 @@ subroutine ma_convproc_tend( &
sumwetdep(:) = 0.0
sumresusp(:) = 0.0
sumprevap(:) = 0.0
+ sumprevap_hist(:) = 0.0 ! REASTER 08/05/2015
maxflux(:) = 0.0
maxflux2(:) = 0.0
@@ -2371,10 +2408,12 @@ subroutine ma_convproc_tend( &
! calculate effects of precipitation evaporation
call ma_precpevap_convproc( dcondt, dcondt_wetdep, dcondt_prevap, &
+ dcondt_prevap_hist, & ! REASTER 08/05/2015
rprd, evapc, dp_i, &
icol, ktop, pcnst_extd, &
lun, idiag_in(icol), lchnk, &
- doconvproc_extd )
+ doconvproc_extd, &
+ species_class, mam_prevap_resusp_optaa ) ! REASTER 08/05/2015
if ( idiag_in(icol)>0 ) then
k = 26
do m = 16, 23, 7
@@ -2394,7 +2433,7 @@ subroutine ma_convproc_tend( &
! 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, pcnst_extd )
+ const, dp_i, ktop, kbot_prevap, pcnst_extd ) ! REASTER 08/05/2015
if ( idiag_in(icol)>0 ) then
k = 26
do m = 16, 23, 7
@@ -2413,7 +2452,8 @@ subroutine ma_convproc_tend( &
! calculate new column-tendency variables
do m = 2, ncnst_extd
if (doconvproc_extd(m)) then
- do k = ktop, kbot
+ ! should go to k=pver for dcondt_prevap, and this should be safe for other sums
+ do k = ktop, kbot_prevap ! REASTER 08/05/2015
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), &
@@ -2421,6 +2461,7 @@ subroutine ma_convproc_tend( &
sumprevap(m) = sumprevap(m) + dcondt_prevap(m,k)*dp_i(k)
maxprevap(m) = max( maxprevap(m), &
abs(dcondt_prevap(m,k)*dp_i(k)) )
+ sumprevap_hist(m) = sumprevap_hist(m) + dcondt_prevap_hist(m,k)*dp_i(k) ! REASTER 08/05/2015
end do
end if
end do ! m
@@ -2520,6 +2561,7 @@ subroutine ma_convproc_tend( &
sumaqchem(la) = sumaqchem(la) + sumaqchem(lc)
sumwetdep(la) = sumwetdep(la) + sumwetdep(lc)
sumprevap(la) = sumprevap(la) + sumprevap(lc)
+ sumprevap_hist(la) = sumprevap_hist(la) + sumprevap_hist(lc) ! REASTER 08/05/2015
! if (n==1 .and. ll==1) then
! write(lun,*) 'la, sumaqchem(la) =', la, sumaqchem(la)
! endif
@@ -2532,7 +2574,7 @@ subroutine ma_convproc_tend( &
!
do m = 2, ncnst
if (doconvproc(m)) then
- do k = ktop, kbot
+ do k = ktop, kbot_prevap ! should go to k=pver because of prevap ! REASTER 08/05/2015
dqdt_i(k,m) = dcondt(m,k)
dqdt(icol,k,m) = dqdt(icol,k,m) + dqdt_i(k,m)*xinv_ntsub
end do
@@ -2548,8 +2590,9 @@ subroutine ma_convproc_tend( &
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,6) = sumprevap_hist(m)*hund_ovr_g ! REASTER 08/05/2015
! qsrflx_i(m,1:4) = 0.
- qsrflx(icol,m,1:5) = qsrflx(icol,m,1:5) + qsrflx_i(m,1:5)*xinv_ntsub
+ qsrflx(icol,m,1:6) = qsrflx(icol,m,1:6) + qsrflx_i(m,1:6)*xinv_ntsub ! REASTER 08/05/2015
end if
end do ! m
@@ -2678,7 +2721,7 @@ subroutine ma_convproc_tend( &
! update the q_i for the next interation of the jtsub loop
do m = 2, ncnst
if (doconvproc(m)) then
- do k = ktop, kbot
+ do k = ktop, kbot_prevap ! should go to k=pver because of prevap ! REASTER 08/05/2015
q_i(k,m) = max( (q_i(k,m) + dqdt_i(k,m)*dtsub), 0.0_r8 )
end do
end if
@@ -2700,10 +2743,12 @@ end subroutine ma_convproc_tend
!=========================================================================================
subroutine ma_precpevap_convproc( &
dcondt, dcondt_wetdep, dcondt_prevap, &
+ dcondt_prevap_hist, & ! REASTER 08/05/2015
rprd, evapc, dp_i, &
icol, ktop, pcnst_extd, &
lun, idiag_prevap, lchnk, &
- doconvproc_extd )
+ doconvproc_extd, &
+ species_class, mam_prevap_resusp_optaa ) ! REASTER 08/05/2015
!-----------------------------------------------------------------------
!
! Purpose:
@@ -2716,9 +2761,11 @@ subroutine ma_precpevap_convproc( &
use ppgrid, only: pcols, pver
use constituents, only: pcnst
+ use physconst, only: spec_class_aerosol ! REASTER 08/05/2015
use modal_aero_data, only: &
- lmassptrcw_amode, nspec_amode, numptrcw_amode
+ lmassptrcw_amode, nspec_amode, numptrcw_amode, &
+ mmtoo_prevap_resusp ! REASTER 08/05/2015
implicit none
@@ -2735,6 +2782,19 @@ subroutine ma_precpevap_convproc( &
! portion of TMR tendency due to precip evaporation
! (actually, due to the adjustments made here)
! (on entry, this is 0.0)
+ real(r8), intent(inout) :: dcondt_prevap_hist(pcnst_extd,pver) ! REASTER 08/05/2015
+ ! this determines what goes into the history
+ ! precip-evap SFSEC variables
+ ! currently, the SFSEC resuspension are attributed
+ ! to the species that got scavenged,
+ ! WHICH IS NOT the species that actually
+ ! receives the resuspension
+ ! when modal_aero_wetdep_resusp_opt > 0
+ ! so when scavenged so4_c1 is resuspended as so4_a1,
+ ! this resuspension column-tendency shows
+ ! up in so4_c1SFSES
+ ! this is done to allow better tracking of the
+ ! resuspension in the mass-budget post-processing scripts
real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered)
real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered)
@@ -2747,10 +2807,12 @@ subroutine ma_precpevap_convproc( &
integer, intent(in) :: lchnk ! chunk index
logical, intent(in) :: doconvproc_extd(pcnst_extd) ! indicates which species to process
+ integer, intent(in) :: species_class(:) ! REASTER 08/05/2015
+ integer, intent(in) :: mam_prevap_resusp_optaa ! REASTER 08/05/2015
!-----------------------------------------------------------------------
! local variables
- integer :: k, l, ll, m, n
+ integer :: k, l, ll, m, m2, mmtoo, n ! REASTER 08/05/2015
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]
@@ -2760,9 +2822,47 @@ subroutine ma_precpevap_convproc( &
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]
+ character(len=100) :: msg
+
!-----------------------------------------------------------------------
+ if ( mam_prevap_resusp_optaa == 30 ) then
+ call ma_precpevap30_convproc( &
+ dcondt, dcondt_wetdep, dcondt_prevap, &
+ dcondt_prevap_hist, &
+ rprd, evapc, dp_i, &
+ icol, ktop, pcnst_extd, &
+ lun, idiag_prevap, lchnk, &
+ doconvproc_extd, &
+ species_class, mam_prevap_resusp_optaa )
+ return
+ else if ( mam_prevap_resusp_optaa /= 0 .and. &
+ mam_prevap_resusp_optaa /= 10 .and. &
+ mam_prevap_resusp_optaa /= 11 .and. &
+ mam_prevap_resusp_optaa /= 20 .and. &
+ mam_prevap_resusp_optaa /= 21 ) then
+ write(msg,'(a,2(1x,i10))') &
+ 'ma_precpevap_convproc - bad mam_prevap_resusp_optaa =', &
+ mam_prevap_resusp_optaa
+ call endrun( msg )
+ end if
+
+!
+! *** note use of non-standard units
+!
+! precip
+! tmpdp = dp_i is mb
+! rprd and evapc are kgwtr/kgair/s
+! pr_flux = tmpdp*rprd is mb*kgwtr/kgair/s
+! this works ok because the only important thing is fdel_pr_flux_evap which is dimensionless
+!
+! precip-borne aerosol
+! dcondt_wetdep is kgaero/kgair/s
+! wd_flux = tmpdp*dcondt_wetdep is mb*kgaero/kgair/s
+! dcondt_prevap = del_wd_flux_evap/tmpdp is kgaero/kgair/s
+! so this works ok too
+!
pr_flux = 0.0_r8
wd_flux(:) = 0.0_r8
@@ -2781,17 +2881,35 @@ subroutine ma_precpevap_convproc( &
del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) )
fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8)
+ if ( mam_prevap_resusp_optaa <= 0 ) then
+ fdel_pr_flux_evap = 0.0_r8 ! REASTER 08/05/2015 - turn off resuspension from precip evap
+ end if
+
do m = 2, pcnst_extd
if ( doconvproc_extd(m) ) then
- ! use -dcondt_wetdep(m,k) as it is negative (or zero)
+
+ ! dcondt_wetdep(m,k) is negative (or zero), so use -dcondt_wetdep(m,k) here
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
- wd_flux(m) = max( 0.0_r8, wd_flux(m)-del_wd_flux_evap )
+! REASTER 08/05/2015 BEGIN
+! wd_flux(m) = max( 0.0_r8, wd_flux(m)-del_wd_flux_evap )
+
+! dcondt_prevap(m,k) = del_wd_flux_evap/tmpdp
+! dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k)
+
+ ! do this for mam_prevap_resusp_optaa = 0,10,11,20,21
+ ! (also for trace gases when mam_prevap_resusp_opt = ???,
+ ! but currently modal_aero_convproc does not do trace gases)
+ dcondt_prevap_hist(m,k) = del_wd_flux_evap/tmpdp
dcondt_prevap(m,k) = del_wd_flux_evap/tmpdp
dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k)
- end if
- end do
+
+ wd_flux(m) = max( 0.0_r8, wd_flux(m)-del_wd_flux_evap )
+
+ end if ! ( doconvproc_extd(m) ) then
+ end do ! m = 2, pcnst_extd
+! REASTER 08/05/2015 END
pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap )
@@ -2818,6 +2936,259 @@ end subroutine ma_precpevap_convproc
+!=========================================================================================
+ subroutine ma_precpevap30_convproc( &
+ dcondt, dcondt_wetdep, dcondt_prevap, &
+ dcondt_prevap_hist, & ! REASTER 08/05/2015
+ rprd, evapc, dp_i, &
+ icol, ktop, pcnst_extd, &
+ lun, idiag_prevap, lchnk, &
+ doconvproc_extd, &
+ species_class, mam_prevap_resusp_optaa ) ! REASTER 08/05/2015
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Calculate resuspension of wet-removed aerosol species resulting precip evaporation
+! for mam_prevap_resusp_optaa = 30
+!
+! for aerosol mass species, do non-linear resuspension to coarse mode
+! for aerosol number species, all the resuspension is done in wetdepa_v2, so do nothing here
+!
+! Author: R. Easter
+!
+!-----------------------------------------------------------------------
+
+ use ppgrid, only: pcols, pver
+ use constituents, only: pcnst
+ use physconst, only: pi, spec_class_aerosol ! REASTER 08/05/2015
+
+ use modal_aero_data, only: &
+ lmassptr_amode, lmassptrcw_amode, lspectype_amode, &
+ nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, &
+ mmtoo_prevap_resusp, ntoo_prevap_resusp, & ! REASTER 08/05/2015
+ specdens_amode
+ use wetdep, only: faer_resusp_vs_fprec_evap_mpln
+
+ 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(inout) :: dcondt_prevap_hist(pcnst_extd,pver) ! REASTER 08/05/2015
+ ! this determines what goes into the history
+ ! precip-evap SFSEC variables
+ ! currently, the SFSEC resuspension are attributed
+ ! to the species that got scavenged,
+ ! WHICH IS NOT the species that actually
+ ! receives the resuspension
+ ! when modal_aero_wetdep_resusp_opt > 0
+ ! so when scavenged so4_c1 is resuspended as so4_a1,
+ ! this resuspension column-tendency shows
+ ! up in so4_c1SFSES
+ ! this is done to allow better tracking of the
+ ! resuspension in the mass-budget post-processing scripts
+
+ 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
+ integer, intent(in) :: species_class(:) ! REASTER 08/05/2015
+ integer, intent(in) :: mam_prevap_resusp_optaa ! REASTER 08/05/2015
+
+!-----------------------------------------------------------------------
+! local variables
+ integer :: k, l, ll, lspec, lspectype
+ integer :: m, m2, mmtoo, n, numtoo
+ real(r8) :: d1p_prevap_resusp ! dry-diameter of one resuspended aerosol particle (m)
+ 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) :: pr_flux_tmp
+ real(r8) :: pr_flux_base ! precip flux at an effective cloud base for calculations in a particular layer
+ real(r8) :: specdens_prevap_resusp(pcnst)
+ real(r8) :: tmpa, tmpb, tmpc, tmpd
+ real(r8) :: tmpdp ! delta-pressure (mb)
+ real(r8) :: u_old, u_tmp
+ real(r8) :: v1p_prevap_resusp ! dry-volume of one resuspended aerosol particle (m^3)
+ real(r8) :: wd_flux(pcnst_extd) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb]
+ real(r8) :: wd_flux_tmp(pcnst_extd)
+ real(r8) :: x_old, x_tmp, x_ratio
+!-----------------------------------------------------------------------
+
+!
+! *** note use of non-standard units
+!
+! precip
+! tmpdp = dp_i is mb
+! rprd and evapc are kgwtr/kgair/s
+! pr_flux = tmpdp*rprd is mb*kgwtr/kgair/s
+! this works ok because the only important thing is fdel_pr_flux_evap which is dimensionless
+!
+! precip-borne aerosol
+! dcondt_wetdep is kgaero/kgair/s
+! wd_flux = tmpdp*dcondt_wetdep is mb*kgaero/kgair/s
+! dcondt_prevap = del_wd_flux_evap/tmpdp is kgaero/kgair/s
+! so this works ok too
+!
+! *** dilip switched from tmpdg to tmpdpg = tmpdp/gravit
+! that is incorrect, but probably does not matter
+! for precip, the u_old and u_tmp are dimensionless
+! for aerosol, wd_flux units do not matter
+! only important thing is that tmpdp (or tmpdpg) is used
+! consistently when going from dcondt to wd_flux then to dcondt
+!
+
+ pr_flux = 0.0_r8
+ pr_flux_base = 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)
+
+! note - setting pr_flux_tmp, wd_flux_tmp, u_old, u_tmp, x_old, x_tmp
+! to zero at this point is not necessary since they are all calculated
+! "fresh" in each iteration of the "do k" loop
+! no big deal except it clutters up the code
+
+! 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)) )
+! fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8)
+
+! step 1 - precip evaporation and aerosol resuspension
+ tmpa = max( 0.0_r8, evapc(icol,k)*tmpdp )
+ pr_flux_tmp = max( 0.0_r8, pr_flux - tmpa )
+ pr_flux_tmp = min( pr_flux_base, pr_flux_tmp )
+
+ if (pr_flux_base < 1.0e-30_r8) then
+ ! when pr_flux_base=0, set u=0 to force 100% resuspension
+ u_old = 1.0_r8 ; x_old = 1.0_r8
+ u_tmp = 0.0_r8 ; x_tmp = 0.0_r8
+ x_ratio = 0.0_r8
+ pr_flux_base = 0.0_r8 ! this will start things fresh at the next layer
+ pr_flux_tmp = 0.0_r8 ! (the next layer will then have u_old = 1)
+ else
+ u_old = pr_flux/pr_flux_base
+ u_old = max( 0.0_r8, min( 1.0_r8, u_old ) )
+ x_old = 1.0_r8 - faer_resusp_vs_fprec_evap_mpln( 1.0_r8-u_old, 2)
+ x_old = max( 0.0_r8, min( 1.0_r8, x_old ) )
+
+ u_tmp = pr_flux_tmp/pr_flux_base
+ u_tmp = max( 0.0_r8, min( 1.0_r8, u_tmp ) )
+ u_tmp = min( u_tmp, u_old )
+ x_tmp = 1.0_r8 - faer_resusp_vs_fprec_evap_mpln( 1.0_r8-u_tmp, 2)
+ x_tmp = max( 0.0_r8, min( 1.0_r8, x_tmp ) )
+ x_tmp = min( x_tmp, x_old )
+
+ if (x_tmp < 1.0e-30_r8) then ! or check on x? note that should have x_tmp >= x
+ x_ratio = 0.0_r8
+ pr_flux_base = 0.0_r8 ! this will start things fresh at the next layer
+ pr_flux_tmp = 0.0_r8 ! (the next layer will then have u_old = 1)
+ else
+ x_ratio = x_tmp/x_old
+ end if
+ end if
+
+! step 2 - precip production and aerosol scavenging
+ tmpa = max( 0.0_r8, rprd(icol,k)*tmpdp )
+ pr_flux_base = max( 0.0_r8, pr_flux_base + tmpa )
+ pr_flux = max( 0.0_r8, pr_flux_tmp + tmpa )
+ pr_flux = min( pr_flux_base, pr_flux )
+
+
+ do m = 2, pcnst_extd
+ if ( .not. doconvproc_extd(m) ) cycle
+
+! step 1 again, but only the aerosol resuspension
+! wd_flux_tmp (updated) = (wd_flux coming into the layer) - (resuspension ! decrement)
+ wd_flux_tmp(m) = max( 0.0_r8, wd_flux(m) * x_ratio )
+ del_wd_flux_evap = max( 0.0_r8, wd_flux(m) - wd_flux_tmp(m) )
+
+! step 2 again, but only the aerosol scavenging
+! wd_flux (updated) = (wd_flux after resuspension) - (scavenging increment)
+ tmpa = max( 0.0_r8, -dcondt_wetdep(m,k)*tmpdp )
+ wd_flux(m) = max( 0.0_r8, wd_flux_tmp(m) + tmpa )
+
+ tmpc = del_wd_flux_evap/tmpdp
+
+ m2 = mod( m-1, pcnst ) + 1 ! for interstitial m2=m; for activated m2=m-pcnst
+ mmtoo = mmtoo_prevap_resusp(m2)
+
+ if ( species_class(m2) == spec_class_aerosol ) then
+ if (mmtoo > 0) then
+ ! current species is an aerosol mass species
+ ! because mmtoo_resusp <= 0 for aerosol number species
+
+ ! add the precip-evap (resuspension) to the history-tendency of the current species
+ dcondt_prevap_hist(m,k) = dcondt_prevap_hist(m,k) + tmpc
+ ! add the precip-evap (resuspension) to the actual tendencies
+ ! of appropriate
+ ! coarse-mode species
+ dcondt_prevap(mmtoo,k) = dcondt_prevap(mmtoo,k) + tmpc
+ dcondt(mmtoo,k) = dcondt(mmtoo,k) + tmpc
+ end if
+
+ else ! ( species_class(m2) /= spec_class_aerosol )
+ ! do this for trace gases (although currently modal_aero_convproc
+ ! does not treat trace gases)
+ dcondt_prevap_hist(m,k) = dcondt_prevap_hist(m,k) + tmpc
+ dcondt_prevap(m,k) = dcondt_prevap(m,k) + tmpc
+ dcondt(m,k) = dcondt(m,k) + tmpc
+ end if
+
+ end do ! m = 2, pcnst_extd
+
+ 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_precpevap30_convproc
+
+
+
!=========================================================================================
subroutine ma_activate_convproc( &
conu, dconudt, conent, &
@@ -3399,7 +3770,7 @@ end subroutine ma_activate_convproc_method2
!=========================================================================================
subroutine ma_resuspend_convproc( &
dcondt, dcondt_resusp, &
- const, dp_i, ktop, kbot, pcnst_extd )
+ const, dp_i, ktop, kbot_prevap, pcnst_extd ) ! REASTER 08/05/2015
!-----------------------------------------------------------------------
!
! Purpose:
@@ -3451,7 +3822,7 @@ subroutine ma_resuspend_convproc( &
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 ! indices of top and bottom cloud levels
+ integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels ! REASTER 08/05/2015
!-----------------------------------------------------------------------
! local variables
@@ -3477,7 +3848,7 @@ subroutine ma_resuspend_convproc( &
if ( (la <= 0) .or. (la > pcnst_extd) ) cycle
if ( (lc <= 0) .or. (lc > pcnst_extd) ) cycle
- do k = ktop, kbot
+ do k = ktop, kbot_prevap ! REASTER 08/05/2015
qdota = dcondt(la,k)
qdotc = dcondt(lc,k)
qdotac = qdota + qdotc
diff --git a/components/cam/src/chemistry/modal_aero/modal_aero_data.F90 b/components/cam/src/chemistry/modal_aero/modal_aero_data.F90
index 5e1c79b6285e..2b8c1260ace8 100644
--- a/components/cam/src/chemistry/modal_aero/modal_aero_data.F90
+++ b/components/cam/src/chemistry/modal_aero/modal_aero_data.F90
@@ -21,6 +21,18 @@ module modal_aero_data
integer, parameter :: ntot_amode = 3
#endif
+#if (( defined MODAL_AERO_3MODE ) || ( defined MODAL_AERO_4MODE )) && ( defined RAIN_EVAP_TO_COARSE_AERO )
+ logical, parameter :: rain_evap_to_coarse_aero = .true.
+#else
+ logical, parameter :: rain_evap_to_coarse_aero = .false.
+#endif
+
+ ! carbonaceous species counters - will eventually be set by configuration options
+ integer, parameter :: nbc = 1 ! number of differently tagged black-carbon aerosol species
+ integer, parameter :: npoa = 1 ! number of differently tagged primary-organic aerosol species
+ integer, parameter :: nsoa = 1 ! number of differently tagged secondary-organic aerosol species
+ integer, parameter :: nsoag = 1 ! number of differently tagged secondary-organic gas species
+
!
! definitions for aerosol chemical components
!
@@ -70,9 +82,17 @@ module modal_aero_data
#if ( defined MODAL_AERO_7MODE )
integer, parameter :: nspec_amode(ntot_amode) = (/ 6, 4, 2, 3, 3, 3, 3 /) ! SS
#elif ( defined MODAL_AERO_4MODE )
+#if (defined RAIN_EVAP_TO_COARSE_AERO)
+ integer, parameter :: nspec_amode(ntot_amode) = (/ 6, 3, 6, 2 /)
+#else
integer, parameter :: nspec_amode(ntot_amode) = (/ 6, 3, 3, 2 /)
+#endif
#elif ( defined MODAL_AERO_3MODE )
+#if (defined RAIN_EVAP_TO_COARSE_AERO)
+ integer, parameter :: nspec_amode(ntot_amode) = (/ 6, 3, 6 /)
+#else
integer, parameter :: nspec_amode(ntot_amode) = (/ 6, 3, 3 /)
+#endif
#endif
integer, parameter :: nspec_amode_max = 6
! input mprognum_amode, mdiagnum_amode, mprogsfc_amode, mcalcwater_amode
@@ -164,6 +184,10 @@ module modal_aero_data
modeptr_finedust, modeptr_fineseas, & !
modeptr_coardust, modeptr_coarseas
+ integer &
+ lptr2_soa_a_amode(ntot_amode,nsoa), &
+ lptr2_soa_g_amode(nsoag)
+
real(r8) :: &
specmw_so4_amode, specdens_so4_amode, &
specmw_nh4_amode, specdens_nh4_amode, &
@@ -177,11 +201,22 @@ module modal_aero_data
! cldphysics, aerosol, gas )
+ ! REASTER 08/04/2015 - used in precip evap resuspension to coarse mode
+ integer :: mam_prevap_resusp_optaa = 10
+! 0 = no resuspension
+! 10 = original mam method with resus_fix=.false. (so4_a1 --> so4_a1, so4_c1 --> so4_c1)
+! 20 = original mam method with resus_fix=.true. (so4_a1 & so4_c1 --> so4_a1)
+! 30 = resuspend to coarse mode, full non-linear method (so4_a1 & so4_c1 --> so4_a3)
+! 11 = like 10 but output column resuspension tendencies (rcscavt & rsscavt) to history
+! 21 = like 20 but a with a few xxx = max( 0.0, xxx) added in werdepa_v2
+
+ integer :: mmtoo_prevap_resusp(pcnst), ntoo_prevap_resusp(pcnst)
! threshold for reporting negatives from subr qneg3
real(r8) :: qneg3_worst_thresh_amode(pcnst)
integer, private :: qqcw(pcnst)=-1 ! Remaps modal_aero indices into pbuf
+
contains
subroutine qqcw_set_ptr(index, iptr)
diff --git a/components/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90 b/components/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90
index 2870a2f98b1c..d186e1128852 100644
--- a/components/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90
+++ b/components/cam/src/chemistry/modal_aero/modal_aero_initialize_data.F90
@@ -103,9 +103,16 @@ subroutine modal_aero_register(species_class)
xname_spectype(:nspec_amode(3),3) = (/ 'p-organic ', 'black-c ' /)
#elif ( defined MODAL_AERO_3MODE ) || ( defined MODAL_AERO_4MODE )
! mode 3 (coarse dust & seasalt) species
- xname_massptr(:nspec_amode(3),3) = (/ 'dst_a3 ', 'ncl_a3 ', 'so4_a3 ' /)
- xname_massptrcw(:nspec_amode(3),3) = (/ 'dst_c3 ', 'ncl_c3 ', 'so4_c3 ' /)
- xname_spectype(:nspec_amode(3),3) = (/ 'dust ', 'seasalt ', 'sulfate ' /)
+#if (defined RAIN_EVAP_TO_COARSE_AERO)
+ xname_massptr(:nspec_amode(3),3) = (/ 'dst_a3 ', 'ncl_a3 ', 'so4_a3 ', 'bc_a3 ','pom_a3 ','soa_a3 ' /)
+ xname_massptrcw(:nspec_amode(3),3) = (/ 'dst_c3 ', 'ncl_c3 ', 'so4_c3 ', 'bc_c3 ','pom_c3 ','soa_c3 ' /)
+ xname_spectype(:nspec_amode(3),3) = (/ 'dust ', 'seasalt ', 'sulfate ', 'black-c ','p-organic ', &
+ 's-organic ' /)
+#else
+ xname_massptr(:nspec_amode(3),3) = (/ 'dst_a3 ', 'ncl_a3 ', 'so4_a3 ' /)
+ xname_massptrcw(:nspec_amode(3),3) = (/ 'dst_c3 ', 'ncl_c3 ', 'so4_c3 ' /)
+ xname_spectype(:nspec_amode(3),3) = (/ 'dust ', 'seasalt ', 'sulfate ' /)
+#endif
#endif
#if ( defined MODAL_AERO_4MODE )
@@ -138,9 +145,7 @@ subroutine modal_aero_register(species_class)
xname_spectype(:nspec_amode(7),7) = (/ 'dust ', 'sulfate ', 'ammonium ' /)
#endif
- if(convproc_do_aer .or. convproc_do_gas) then
- species_class(:pcnst) = spec_class_undefined
- endif
+ species_class(:pcnst) = spec_class_undefined
do m = 1, ntot_amode
@@ -270,6 +275,7 @@ subroutine modal_aero_initialize(pbuf2d, imozart, species_class)
use constituents, only: pcnst
use physconst, only: rhoh2o, mwh2o
+ use modal_aero_amicphys, only: modal_aero_amicphys_init
use modal_aero_calcsize, only: modal_aero_calcsize_init
use modal_aero_coag, only: modal_aero_coag_init
use modal_aero_deposition, only: modal_aero_deposition_init
@@ -295,6 +301,7 @@ subroutine modal_aero_initialize(pbuf2d, imozart, species_class)
character(len=3) :: trnum ! used to hold mode number (as characters)
integer :: iaerosol, ibulk
+ integer :: mam_amicphys_optaa
integer :: numaerosols ! number of bulk aerosols in climate list
character(len=20) :: bulkname
real(r8) :: pi
@@ -307,7 +314,8 @@ subroutine modal_aero_initialize(pbuf2d, imozart, species_class)
pi = 4._r8*atan(1._r8)
call phys_getopts(convproc_do_gas_out = convproc_do_gas, &
- convproc_do_aer_out = convproc_do_aer)
+ convproc_do_aer_out = convproc_do_aer, &
+ mam_amicphys_optaa_out = mam_amicphys_optaa )
! Mode specific properties.
@@ -406,8 +414,6 @@ subroutine modal_aero_initialize(pbuf2d, imozart, species_class)
- !BSINGH(09/17/2014): The do-loop in the 'else' of the following if condition is wrong
- if (convproc_do_aer .or. convproc_do_gas) then
! At this point, species_class is either undefined or aerosol.
! For the "chemistry species" (imozart <= i <= imozart+gas_pcnst-1),
! set the undefined ones to gas, and leave the aerosol ones as is
@@ -421,15 +427,6 @@ subroutine modal_aero_initialize(pbuf2d, imozart, species_class)
species_class(i) = spec_class_gas
end if
end do
- else
-
- ! The following is incorrect because it overwrites values set in modal_aero_register,
- ! which is called before modal_aero_init
- ! BSINGH: It is not commented out as of now to maintain original code b4b status
- do i = 1, pcnst
- species_class(i) = spec_class_undefined
- end do
- endif
! set cnst_name_cw
@@ -483,13 +480,19 @@ subroutine modal_aero_initialize(pbuf2d, imozart, species_class)
!
! call other initialization routines
!
- call modal_aero_rename_init
- ! calcsize call must follow rename call
- call modal_aero_calcsize_init( pbuf2d )
- call modal_aero_gasaerexch_init
- ! coag call must follow gasaerexch call
- call modal_aero_coag_init
- call modal_aero_newnuc_init
+ if ( mam_amicphys_optaa > 0 ) then
+ call modal_aero_calcsize_init( pbuf2d, species_class )
+ call modal_aero_newnuc_init( mam_amicphys_optaa )
+ call modal_aero_amicphys_init( imozart, species_class )
+ else
+ call modal_aero_rename_init
+ ! calcsize call must follow rename call
+ call modal_aero_calcsize_init( pbuf2d, species_class )
+ call modal_aero_gasaerexch_init
+ ! coag call must follow gasaerexch call
+ call modal_aero_coag_init
+ call modal_aero_newnuc_init( mam_amicphys_optaa )
+ endif
! call modal_aero_deposition_init only if the user has not specified
! prescribed aerosol deposition fluxes
diff --git a/components/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90 b/components/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90
index 792b69009c47..ec8240920cd8 100644
--- a/components/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90
+++ b/components/cam/src/chemistry/modal_aero/modal_aero_newnuc.F90
@@ -13,6 +13,7 @@ module modal_aero_newnuc
! !USES:
use shr_kind_mod, only: r8 => shr_kind_r8
use shr_kind_mod, only: r4 => shr_kind_r4
+ use cam_logfile, only: iulog
use mo_constants, only: pi
use chem_mods, only: gas_pcnst
@@ -21,14 +22,30 @@ module modal_aero_newnuc
save
! !PUBLIC MEMBER FUNCTIONS:
- public modal_aero_newnuc_sub, modal_aero_newnuc_init
+ public :: modal_aero_newnuc_sub, modal_aero_newnuc_init, &
+ mer07_veh02_nuc_mosaic_1box
+
! !PUBLIC DATA MEMBERS:
+ integer, public :: newnuc_h2so4_conc_flag = 1
+
+! min h2so4 vapor for nuc calcs = 4.0e-16 mol/mol-air ~= 1.0e4 molecules/cm3,
+ real(r8), public, parameter :: qh2so4_cutoff = 4.0e-16_r8
+
+! adjustment factors
+ real(r8), parameter, public :: adjust_factor_dnaitdt = 1.0_r8 ! applied to final dnait/dt
+ real(r8), parameter, public :: adjust_factor_bin_tern_ratenucl = 1.0_r8 ! applied to binary/ternary nucleation rate
+! real(r8), parameter, public :: adjust_factor_pbl_ratenucl = 1.0_r8 ! applied to boundary layer nucleation rate
+ real(r8), public :: adjust_factor_pbl_ratenucl = 1.0_r8 ! applied to boundary layer nucleation rate
+
+
+! !NON-PUBLIC DATA MEMBERS:
integer, parameter :: pcnstxx = gas_pcnst
integer :: l_h2so4_sv, l_nh3_sv, lnumait_sv, lnh4ait_sv, lso4ait_sv
-! min h2so4 vapor for nuc calcs = 4.0e-16 mol/mol-air ~= 1.0e4 molecules/cm3,
- real(r8), parameter :: qh2so4_cutoff = 4.0e-16_r8
+! max cloud fraction for nuc calcs
+ real(r8), parameter :: cld_cutoff = 0.99_r8
+
! !DESCRIPTION: This module implements ...
!
@@ -66,15 +83,15 @@ subroutine modal_aero_newnuc_sub( &
! !USES:
use modal_aero_data
- use cam_abortutils, only: endrun
- use cam_history, only: outfld, fieldname_len
- use chem_mods, only: adv_mass
- use constituents, only: pcnst, cnst_name
- use physconst, only: gravit, mwdry, r_universal
- use ppgrid, only: pcols, pver
- use spmd_utils, only: iam, masterproc
- use wv_saturation, only: qsat
- use ref_pres, only: top_lev=>clim_modal_aero_top_lev
+ use cam_abortutils, only: endrun
+ use cam_history, only: outfld, fieldname_len
+ use chem_mods, only: adv_mass
+ use constituents, only: pcnst, cnst_name
+ use physconst, only: gravit, mwdry, r_universal
+ use ppgrid, only: pcols, pver
+ use spmd_utils, only: iam, masterproc
+ use wv_saturation, only: qsat
+ use ref_pres, only: top_lev=>clim_modal_aero_top_lev
implicit none
@@ -133,7 +150,6 @@ subroutine modal_aero_newnuc_sub( &
! 11=merikanto ternary + first-order boundary layer
! 12=merikanto ternary + second-order boundary layer
- real(r8) :: adjust_factor
real(r8) :: aircon
real(r8) :: cldx
real(r8) :: dens_nh4so4a
@@ -249,14 +265,21 @@ subroutine modal_aero_newnuc_sub( &
main_k: do k = top_lev, pver
main_i: do i = 1, ncol
-! skip if completely cloudy,
+! skip if (almost) completely cloudy,
! because all h2so4 vapor should be cloud-borne
- if (cld(i,k) >= 0.99_r8) cycle main_i
+ if (cld(i,k) >= cld_cutoff) cycle main_i
! qh2so4_cur = current qh2so4, after aeruptk
qh2so4_cur = q(i,k,l_h2so4)
+
! skip if h2so4 vapor < qh2so4_cutoff
- if (qh2so4_cur <= qh2so4_cutoff) cycle main_i
+! 05-jul-2013 - maybe should only skip here if qh2so4_cur << cutoff
+! because may have qh2so4_avg >> qh2so4_cur
+ if (newnuc_h2so4_conc_flag < 10) then
+ if (qh2so4_cur <= qh2so4_cutoff) cycle main_i
+ else
+ if (qh2so4_cur <= qh2so4_cutoff*1.0e-10_r8) cycle main_i
+ end if
tmpa = max( 0.0_r8, del_h2so4_gasprod(i,k) )
tmp_q3 = qh2so4_cur
@@ -294,6 +317,13 @@ subroutine modal_aero_newnuc_sub( &
tmpc = tmpa/tmpb
qh2so4_avg = (tmp_q3 - tmpc)*((exp(tmpb)-1.0_r8)/tmpb) + tmpc
end if
+
+ if (newnuc_h2so4_conc_flag == 11) then
+ qh2so4_avg = qh2so4_cur
+ else if (newnuc_h2so4_conc_flag == 12) then
+ qh2so4_avg = qh2so4_cur + 0.5_r8*max( 0.0_r8, -del_h2so4_aeruptk(i,k) )
+ end if
+
if (qh2so4_avg <= qh2so4_cutoff) cycle main_i
@@ -309,7 +339,7 @@ subroutine modal_aero_newnuc_sub( &
qvswtr = max( qvswtr, 1.0e-20_r8 )
relhumav = qv(i,k) / qvswtr
relhumav = max( 0.0_r8, min( 1.0_r8, relhumav ) )
-! relhum = non-cloudy area RH
+! relhum = non-cloudy area RH (note that 1-cldx >= .01)
cldx = max( 0.0_r8, cld(i,k) )
relhum = (relhumav - cldx) / (1.0_r8 - cldx)
relhum = max( 0.0_r8, min( 1.0_r8, relhum ) )
@@ -435,9 +465,8 @@ subroutine modal_aero_newnuc_sub( &
! *** apply adjustment factor to avoid unrealistically high
! aitken number concentrations in mid and upper troposphere
-! adjust_factor = 0.5
-! dndt_ait = dndt_ait * adjust_factor
-! dmdt_ait = dmdt_ait * adjust_factor
+ dndt_ait = dndt_ait * adjust_factor_dnaitdt
+ dmdt_ait = dmdt_ait * adjust_factor_dnaitdt
! set tendencies
pdel_fac = pdel(i,k)/gravit
@@ -573,8 +602,9 @@ subroutine mer07_veh02_nuc_mosaic_1box( &
mw_so4a_host, &
nsize, maxd_asize, dplom_sect, dphim_sect, &
isize_nuc, qnuma_del, qso4a_del, qnh4a_del, &
- qh2so4_del, qnh3_del, dens_nh4so4a, ldiagaa )
-! qh2so4_del, qnh3_del, dens_nh4so4a )
+ qh2so4_del, qnh3_del, dens_nh4so4a, ldiagaa, &
+ dnclusterdt )
+
use mo_constants, only: rgas, & ! Gas constant (J/K/kmol)
avogad => avogadro ! Avogadro's number (1/kmol)
use physconst, only: mw_so4a => mwso4, & ! Molecular weight of sulfate
@@ -657,6 +687,8 @@ subroutine mer07_veh02_nuc_mosaic_1box( &
real(r8), intent(out) :: qnh3_del ! change to gas nh3 mixing ratio (mol/mol-air)
! aerosol changes are > 0; gas changes are < 0
real(r8), intent(out) :: dens_nh4so4a ! dry-density of the new nh4-so4 aerosol mass (kg/m3)
+ real(r8), intent(out), optional :: &
+ dnclusterdt ! cluster nucleation rate (#/m3/s)
! subr arguments (out) passed via common block
! these are used to duplicate the outputs of yang zhang's original test driver
@@ -748,6 +780,7 @@ subroutine mer07_veh02_nuc_mosaic_1box( &
qnh4a_del = 0.0_r8
qh2so4_del = 0.0_r8
qnh3_del = 0.0_r8
+ if ( present ( dnclusterdt ) ) dnclusterdt = 0.0_r8
! if (qh2so4_avg .le. qh2so4_cutoff) return ! this no longer needed
! if (qh2so4_cur .le. qh2so4_cutoff) return ! this no longer needed
@@ -801,6 +834,8 @@ subroutine mer07_veh02_nuc_mosaic_1box( &
newnuc_method_flagaa2 = 2
end if
+ rateloge = rateloge &
+ + log( max( 1.0e-38_r8, adjust_factor_bin_tern_ratenucl ) )
! do boundary layer nuc
@@ -816,12 +851,14 @@ subroutine mer07_veh02_nuc_mosaic_1box( &
end if
-! if nucleation rate is less than 1e-6 #/m3/s ~= 0.1 #/cm3/day,
+! if nucleation rate is less than 1e-6 #/cm3/s ~= 0.1 #/cm3/day,
! exit with new particle formation = 0
if (rateloge .le. -13.82_r8) return
! if (ratenuclt .le. 1.0e-6) return
+
ratenuclt = exp( rateloge )
- ratenuclt_bb = ratenuclt*1.0e6_r8
+ ratenuclt_bb = ratenuclt*1.0e6_r8 ! ratenuclt_bb is #/m3/s; ratenuclt is #/cm3/s
+ if ( present ( dnclusterdt ) ) dnclusterdt = ratenuclt_bb
! wet/dry volume ratio - use simple kohler approx for ammsulf/ammbisulf
@@ -1184,7 +1221,8 @@ subroutine pbl_nuc_wang2008( so4vol, &
else
return
end if
- tmp_rateloge = log( tmp_ratenucl )
+ tmp_ratenucl = tmp_ratenucl * adjust_factor_pbl_ratenucl
+ tmp_rateloge = log( max( 1.0e-38_r8, tmp_ratenucl ) )
! exit if pbl nuc rate is lower than (incoming) ternary/binary rate
if (tmp_rateloge <= rateloge) return
@@ -1413,7 +1451,7 @@ end subroutine binary_nuc_vehk2002
!----------------------------------------------------------------------
!----------------------------------------------------------------------
-subroutine modal_aero_newnuc_init
+subroutine modal_aero_newnuc_init( mam_amicphys_optaa )
!-----------------------------------------------------------------------
!
@@ -1429,17 +1467,18 @@ subroutine modal_aero_newnuc_init
use modal_aero_data
use modal_aero_rename
-use cam_abortutils, only: endrun
-use cam_history, only: addfld, add_default, fieldname_len, phys_decomp
-use constituents, only: pcnst, cnst_get_ind, cnst_name
-use spmd_utils, only: masterproc
-use phys_control, only: phys_getopts
+use cam_abortutils, only: endrun
+use cam_history, only: addfld, add_default, fieldname_len, phys_decomp
+use constituents, only: pcnst, cnst_get_ind, cnst_name
+use spmd_utils, only: masterproc
+use phys_control, only: phys_getopts
implicit none
!-----------------------------------------------------------------------
! arguments
+ integer, intent(in) :: mam_amicphys_optaa
!-----------------------------------------------------------------------
! local
@@ -1458,8 +1497,6 @@ subroutine modal_aero_newnuc_init
!-----------------------------------------------------------------------
- call phys_getopts( history_aerosol_out = history_aerosol )
-
! set these indices
! skip if no h2so4 species
@@ -1480,19 +1517,19 @@ subroutine modal_aero_newnuc_init
lnh4ait = lptr_nh4_a_amode(mait)
end if
if ((l_h2so4 <= 0) .or. (l_h2so4 > pcnst)) then
- write(*,'(/a/)') &
+ write(iulog,'(/a/)') &
'*** modal_aero_newnuc bypass -- l_h2so4 <= 0'
return
else if ((lso4ait <= 0) .or. (lso4ait > pcnst)) then
- write(*,'(/a/)') &
+ write(iulog,'(/a/)') &
'*** modal_aero_newnuc bypass -- lso4ait <= 0'
return
else if ((lnumait <= 0) .or. (lnumait > pcnst)) then
- write(*,'(/a/)') &
+ write(iulog,'(/a/)') &
'*** modal_aero_newnuc bypass -- lnumait <= 0'
return
else if ((mait <= 0) .or. (mait > ntot_amode)) then
- write(*,'(/a/)') &
+ write(iulog,'(/a/)') &
'*** modal_aero_newnuc bypass -- modeptr_aitken <= 0'
return
end if
@@ -1506,6 +1543,10 @@ subroutine modal_aero_newnuc_init
!
! create history file column-tendency fields
!
+ if (mam_amicphys_optaa > 0) return
+
+ call phys_getopts( history_aerosol_out = history_aerosol )
+
dotend(:) = .false.
dotend(lnumait) = .true.
dotend(lso4ait) = .true.
@@ -1529,7 +1570,7 @@ subroutine modal_aero_newnuc_init
if ( history_aerosol ) then
call add_default( fieldname, 1, ' ' )
endif
- if ( masterproc ) write(*,'(3(a,2x))') &
+ if ( masterproc ) write(iulog,'(3(a,2x))') &
'modal_aero_newnuc_init addfld', fieldname, unit
end do ! l = ...
@@ -1695,7 +1736,7 @@ end subroutine ternary_nuc_merik2007
!----------------------------------------------------------------------
-#endif ! (defined MODAL_AERO)
+#endif
end module modal_aero_newnuc
diff --git a/components/cam/src/chemistry/mozart/chemistry.F90 b/components/cam/src/chemistry/mozart/chemistry.F90
index d6db48eba8fc..1d8fa64cd8f2 100644
--- a/components/cam/src/chemistry/mozart/chemistry.F90
+++ b/components/cam/src/chemistry/mozart/chemistry.F90
@@ -917,8 +917,8 @@ subroutine chem_init(phys_state, pbuf2d, species_class)
call phys_getopts( cam_chempkg_out=chem_name, &
history_aerosol_out=history_aerosol )
- ! Initialize aerosols
- call aero_model_init( pbuf2d, species_class )
+ ! Initialize aerosols - part 1 ! REASTER 8/4/2015
+ call aero_model_init( pbuf2d, species_class, 1 )
! aqueous chem initialization
call sox_inti()
@@ -1049,6 +1049,10 @@ subroutine chem_init(phys_state, pbuf2d, species_class)
trim(shr_megan_mechcomps(n)%name)//' MEGAN emissions flux',phys_decomp)
enddo
endif
+
+ ! Initialize aerosols - part 2 ! REASTER 8/4/2015
+ call aero_model_init( pbuf2d, species_class, 2 )
+
end subroutine chem_init
!================================================================================
diff --git a/components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90
index 676ca448618e..857ab328d4d6 100644
--- a/components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90
+++ b/components/cam/src/chemistry/mozart/mo_gas_phase_chemdr.F90
@@ -748,7 +748,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, &
! Aerosol processes ...
!
- call aero_model_gasaerexch( imozart-1, ncol, lchnk, delt, reaction_rates, &
+ call aero_model_gasaerexch( imozart-1, ncol, lchnk, delt, latndx, lonndx, reaction_rates, &
tfld, pmid, pdel, mbar, relhum, &
zm, qh2o, cwat, cldfr, ncldwtr, &
invariants(:,:,indexm), invariants, del_h2so4_gasprod, &
diff --git a/components/cam/src/chemistry/utils/modal_aero_calcsize.F90 b/components/cam/src/chemistry/utils/modal_aero_calcsize.F90
index c824611dcd66..6b1c24fa9aca 100644
--- a/components/cam/src/chemistry/utils/modal_aero_calcsize.F90
+++ b/components/cam/src/chemistry/utils/modal_aero_calcsize.F90
@@ -15,7 +15,7 @@ module modal_aero_calcsize
rad_cnst_get_mode_props, rad_cnst_get_mode_num
use cam_logfile, only: iulog
-use cam_abortutils, only: endrun
+use cam_abortutils, only: endrun
use cam_history, only: addfld, add_default, fieldname_len, phys_decomp, outfld
use constituents, only: pcnst, cnst_name
@@ -38,10 +38,6 @@ module modal_aero_calcsize
lspectype_amode, specmw_amode, specdens_amode, voltonumb_amode, &
cnst_name_cw
-use modal_aero_rename, only: lspectooa_renamexf, lspecfrma_renamexf, lspectooc_renamexf, lspecfrmc_renamexf, &
- modetoo_renamexf, nspecfrm_renamexf, npair_renamexf, modefrm_renamexf
-
-
#endif
@@ -57,6 +53,19 @@ module modal_aero_calcsize
integer :: dgnum_idx = -1
+integer, parameter, public :: maxpair_csizxf = 1
+integer, parameter, public :: maxspec_csizxf = ntot_aspectype
+
+integer, public :: npair_csizxf = -123456789
+integer, public :: modefrm_csizxf(maxpair_csizxf)
+integer, public :: modetoo_csizxf(maxpair_csizxf)
+integer, public :: nspecfrm_csizxf(maxpair_csizxf)
+integer, public :: lspecfrmc_csizxf(maxspec_csizxf,maxpair_csizxf)
+integer, public :: lspecfrma_csizxf(maxspec_csizxf,maxpair_csizxf)
+integer, public :: lspectooc_csizxf(maxspec_csizxf,maxpair_csizxf)
+integer, public :: lspectooa_csizxf(maxspec_csizxf,maxpair_csizxf)
+
+
!===============================================================================
contains
!===============================================================================
@@ -76,7 +85,7 @@ end subroutine modal_aero_calcsize_reg
!===============================================================================
!===============================================================================
-subroutine modal_aero_calcsize_init(pbuf2d)
+subroutine modal_aero_calcsize_init( pbuf2d, species_class)
use time_manager, only: is_first_step
use physics_buffer,only: pbuf_set_field
@@ -92,12 +101,15 @@ subroutine modal_aero_calcsize_init(pbuf2d)
!-----------------------------------------------------------------------
type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ integer, intent(in) :: species_class(:)
! local
- integer :: ipair, iq
+ integer :: ipair, iq, iqfrm, iqtoo
integer :: jac
- integer :: lsfrm, lstoo
- integer :: n, nacc, nait
+ integer :: lsfrm, lstoo, lsfrma, lsfrmc, lstooa, lstooc, lunout
+ integer :: mfrm, mtoo
+ integer :: n, nacc, nait, nspec
+ integer :: nchfrma, nchfrmc, nchfrmskip, nchtooa, nchtooc, nchtooskip
logical :: history_aerosol
character(len=fieldname_len) :: tmpnamea, tmpnameb
@@ -115,9 +127,14 @@ subroutine modal_aero_calcsize_init(pbuf2d)
call pbuf_set_field(pbuf2d, dgnum_idx, 0.0_r8)
endif
+ npair_csizxf = 0
+ modefrm_csizxf(1) = 0
+ modetoo_csizxf(1) = 0
+
#ifndef MODAL_AERO
do_adjust_default = .false.
do_aitacc_transfer_default = .false.
+
#else
! do_adjust_default allows adjustment to be turned on/off
do_adjust_default = .true.
@@ -138,7 +155,188 @@ subroutine modal_aero_calcsize_init(pbuf2d)
if ( .not. do_adjust_default ) return
- ! define history fields for number-adjust source-sink for all modes
+!
+! define history fields for number-adjust source-sink for all modes
+!
+
+do_aitacc_transfer_if_block1: &
+ if ( do_aitacc_transfer_default ) then
+!
+! compute pointers for aitken <--> accum mode transfer
+! (a2 <--> a1 transfer)
+! transfers include number_a, number_c, mass_a, mass_c
+!
+ npair_csizxf = 1
+ modefrm_csizxf(1) = nait
+ modetoo_csizxf(1) = nacc
+
+!
+! define species involved in each transfer pairing
+!
+aa_ipair: do ipair = 1, npair_csizxf
+
+ mfrm = modefrm_csizxf(ipair)
+ mtoo = modetoo_csizxf(ipair)
+ if (mfrm < 10) then
+ nchfrmskip = 1
+ else if (mfrm < 100) then
+ nchfrmskip = 2
+ else
+ nchfrmskip = 3
+ end if
+ if (mtoo < 10) then
+ nchtooskip = 1
+ else if (mtoo < 100) then
+ nchtooskip = 2
+ else
+ nchtooskip = 3
+ end if
+ nspec = 0
+
+aa_iqfrm: do iqfrm = -1, nspec_amode(mfrm)
+
+ if (iqfrm == -1) then
+ lsfrma = numptr_amode(mfrm)
+ lstooa = numptr_amode(mtoo)
+ lsfrmc = numptrcw_amode(mfrm)
+ lstooc = numptrcw_amode(mtoo)
+ else if (iqfrm == 0) then
+! bypass transfer of aerosol water due to calcsize transfer
+ cycle aa_iqfrm
+ else
+ lsfrma = lmassptr_amode(iqfrm,mfrm)
+ lsfrmc = lmassptrcw_amode(iqfrm,mfrm)
+ lstooa = 0
+ lstooc = 0
+ end if
+
+ if ((lsfrma < 1) .or. (lsfrma > pcnst)) then
+ write(iulog,9100) mfrm, iqfrm, lsfrma
+ call endrun( 'modal_aero_calcsize_init error aa' )
+ end if
+ if ((lsfrmc < 1) .or. (lsfrmc > pcnst)) then
+ write(iulog,9102) mfrm, iqfrm, lsfrmc
+ call endrun( 'modal_aero_calcsize_init error bb' )
+ end if
+
+ if (iqfrm > 0) then
+ nchfrma = len( trim( cnst_name(lsfrma) ) ) - nchfrmskip
+
+! find "too" species having same cnst_name as the "frm" species
+! (except for last 1/2/3 characters which are the mode index)
+ do iqtoo = 1, nspec_amode(mtoo)
+ lstooa = lmassptr_amode(iqtoo,mtoo)
+ nchtooa = len( trim( cnst_name(lstooa) ) ) - nchtooskip
+ if (cnst_name(lsfrma)(1:nchfrma) == cnst_name(lstooa)(1:nchtooa)) then
+ ! interstitial names match, so check cloudborne names too
+ nchfrmc = len( trim( cnst_name_cw(lsfrmc) ) ) - nchfrmskip
+ lstooc = lmassptrcw_amode(iqtoo,mtoo)
+ nchtooc = len( trim( cnst_name_cw(lstooc) ) ) - nchtooskip
+ if (cnst_name_cw(lsfrmc)(1:nchfrmc) /= &
+ cnst_name_cw(lstooc)(1:nchtooc)) lstooc = 0
+ exit
+ else
+ lstooa = 0
+ end if
+ end do
+ end if ! (iqfrm > 0)
+
+ if ((lstooc < 1) .or. (lstooc > pcnst)) lstooc = 0
+ if ((lstooa < 1) .or. (lstooa > pcnst)) lstooa = 0
+ if (lstooa == 0) then
+ write(iulog,9104) mfrm, iqfrm, lsfrma, iqtoo, lstooa
+ call endrun( 'modal_aero_calcsize_init error cc' )
+ end if
+ if ((lstooc == 0) .and. (iqfrm /= 0)) then
+ write(iulog,9104) mfrm, iqfrm, lsfrmc, iqtoo, lstooc
+ call endrun( 'modal_aero_calcsize_init error dd' )
+ end if
+
+ nspec = nspec + 1
+ lspecfrma_csizxf(nspec,ipair) = lsfrma
+ lspectooa_csizxf(nspec,ipair) = lstooa
+ lspecfrmc_csizxf(nspec,ipair) = lsfrmc
+ lspectooc_csizxf(nspec,ipair) = lstooc
+ end do aa_iqfrm
+
+ nspecfrm_csizxf(ipair) = nspec
+ end do aa_ipair
+
+9100 format( / '*** subr. modal_aero_calcsize_init' / &
+ 'lspecfrma out of range' / &
+ 'modefrm, ispecfrm, lspecfrma =', 3i6 / )
+9102 format( / '*** subr. modal_aero_calcsize_init' / &
+ 'lspecfrmc out of range' / &
+ 'modefrm, ispecfrm, lspecfrmc =', 3i6 / )
+9104 format( / '*** subr. modal_aero_calcsize_init' / &
+ 'lspectooa out of range' / &
+ 'modefrm, ispecfrm, lspecfrma, ispectoo, lspectooa =', 5i6 / )
+9106 format( / '*** subr. modal_aero_calcsize_init' / &
+ 'lspectooc out of range' / &
+ 'modefrm, ispecfrm, lspecfrmc, ispectoo, lspectooc =', 5i6 / )
+
+!
+! output results
+!
+ if ( masterproc ) then
+
+ write(iulog,9310) do_adjust_default, do_aitacc_transfer_default
+
+ do ipair = 1, npair_csizxf
+ mfrm = modefrm_csizxf(ipair)
+ mtoo = modetoo_csizxf(ipair)
+ write(iulog,9320) ipair, mfrm, mtoo
+
+ do iq = 1, nspecfrm_csizxf(ipair)
+ lsfrma = lspecfrma_csizxf(iq,ipair)
+ lstooa = lspectooa_csizxf(iq,ipair)
+ lsfrmc = lspecfrmc_csizxf(iq,ipair)
+ lstooc = lspectooc_csizxf(iq,ipair)
+ if (lstooa .gt. 0) then
+ write(iulog,9330) lsfrma, cnst_name(lsfrma), &
+ lstooa, cnst_name(lstooa)
+ else
+ write(iulog,9340) lsfrma, cnst_name(lsfrma)
+ end if
+ if (lstooc .gt. 0) then
+ write(iulog,9330) lsfrmc, cnst_name_cw(lsfrmc), &
+ lstooc, cnst_name_cw(lstooc)
+ else if (lsfrmc .gt. 0) then
+ write(iulog,9340) lsfrmc, cnst_name_cw(lsfrmc)
+ else
+ write(iulog,9350)
+ end if
+ end do ! iq
+
+ end do ! ipair
+ write(iulog,*)
+
+ end if ! ( masterproc )
+
+
+ else ! do_aitacc_transfer_if_block1
+
+ npair_csizxf = 0
+ if ( masterproc ) then
+ write(iulog,9310) do_adjust_default, do_aitacc_transfer_default
+ write(iulog,9320) 0, 0, 0
+ end if
+
+ end if do_aitacc_transfer_if_block1
+
+9310 format( / 'subr. modal_aero_calcsize_init' / &
+ 'do_adjust_default, do_aitacc_transfer_default = ', 2l10 )
+9320 format( 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3 )
+9330 format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a )
+9340 format( 5x, 'spec', i3, '=', a, ' ---> LOSS' )
+9350 format( 5x, 'no corresponding activated species' )
+
+
+
+! define history fields for number-adjust source-sink for all modes
+do_adjust_if_block2: &
+ if ( do_adjust_default ) then
+
do n = 1, ntot_amode
if (mprognum_amode(n) <= 0) cycle
@@ -155,7 +353,7 @@ subroutine modal_aero_calcsize_init(pbuf2d)
if (history_aerosol) then
call add_default(fieldname, 1, ' ')
end if
- if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname
+ if ( masterproc ) write(iulog,'(2a)') 'calcsize addfld - ', fieldname
fieldname = trim(tmpnamea) // '_sfcsiz2'
long_name = trim(tmpnamea) // ' calcsize number-adjust column sink'
@@ -163,84 +361,100 @@ subroutine modal_aero_calcsize_init(pbuf2d)
if (history_aerosol) then
call add_default(fieldname, 1, ' ')
end if
- if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname
+ if ( masterproc ) write(iulog,'(2a)') 'calcsize addfld - ', fieldname
end do ! jac = ...
+
end do ! n = ...
- if ( .not. do_aitacc_transfer_default ) return
- ! check that renaming ipair=1 is aitken-->accum
- ipair = 1
- if ((modefrm_renamexf(ipair) .ne. nait) .or. &
- (modetoo_renamexf(ipair) .ne. nacc)) then
- write( 6, '(//2a//)' ) &
- '*** modal_aero_calcaersize_init error -- ', &
- 'modefrm/too_renamexf(1) are wrong'
- call endrun( 'modal_aero_calcaersize_init error' )
- end if
+! define history fields for aitken-accum transfer
+do_aitacc_transfer_if_block2: &
+ if ( do_aitacc_transfer_default ) then
- ! define history fields for aitken-accum transfer
- do iq = 1, nspecfrm_renamexf(ipair)
+! check that calcsize transfer ipair=1 is aitken-->accum
+ ipair = 1
+ if ((modefrm_csizxf(ipair) .ne. nait) .or. &
+ (modetoo_csizxf(ipair) .ne. nacc)) then
+ write( iulog, '(//2a//)' ) &
+ '*** modal_aero_calcaersize_init error -- ', &
+ 'modefrm/too_csizxf(1) are wrong'
+ call endrun( 'modal_aero_calcaersize_init error' )
+ end if
- ! jac=1 does interstitial ("_a"); jac=2 does activated ("_c");
- do jac = 1, 2
+ do iq = 1, nspecfrm_csizxf(ipair)
- ! the lspecfrma_renamexf (and lspecfrmc_renamexf) are aitken species
- ! the lspectooa_renamexf (and lspectooc_renamexf) are accum species
- if (jac .eq. 1) then
- lsfrm = lspecfrma_renamexf(iq,ipair)
- lstoo = lspectooa_renamexf(iq,ipair)
- else
- lsfrm = lspecfrmc_renamexf(iq,ipair)
- lstoo = lspectooc_renamexf(iq,ipair)
- end if
- if ((lsfrm <= 0) .or. (lstoo <= 0)) cycle
+! jac=1 does interstitial ("_a"); jac=2 does activated ("_c");
+ do jac = 1, 2
- if (jac .eq. 1) then
- tmpnamea = cnst_name(lsfrm)
- tmpnameb = cnst_name(lstoo)
- else
- tmpnamea = cnst_name_cw(lsfrm)
- tmpnameb = cnst_name_cw(lstoo)
- end if
+! the lspecfrma_csizxf (and lspecfrmc_csizxf) are aitken species
+! the lspectooa_csizxf (and lspectooc_csizxf) are accum species
+ if (jac .eq. 1) then
+ lsfrm = lspecfrma_csizxf(iq,ipair)
+ lstoo = lspectooa_csizxf(iq,ipair)
+ else
+ lsfrm = lspecfrmc_csizxf(iq,ipair)
+ lstoo = lspectooc_csizxf(iq,ipair)
+ end if
+ if ((lsfrm <= 0) .or. (lstoo <= 0)) cycle
+
+ if (jac .eq. 1) then
+ tmpnamea = cnst_name(lsfrm)
+ tmpnameb = cnst_name(lstoo)
+ else
+ tmpnamea = cnst_name_cw(lsfrm)
+ tmpnameb = cnst_name_cw(lstoo)
+ end if
- unit = 'kg/m2/s'
- if ((tmpnamea(1:3) == 'num') .or. &
- (tmpnamea(1:3) == 'NUM')) unit = '#/m2/s'
- fieldname = trim(tmpnamea) // '_sfcsiz3'
- long_name = trim(tmpnamea) // ' calcsize aitken-to-accum adjust column tendency'
- call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
- if (history_aerosol) then
- call add_default(fieldname, 1, ' ')
- end if
- if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname
+ unit = 'kg/m2/s'
+ if ((tmpnamea(1:3) == 'num') .or. &
+ (tmpnamea(1:3) == 'NUM')) unit = '#/m2/s'
+ fieldname = trim(tmpnamea) // '_sfcsiz3'
+ long_name = trim(tmpnamea) // ' calcsize aitken-to-accum adjust column tendency'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if (history_aerosol) then
+ call add_default(fieldname, 1, ' ')
+ end if
+ if ( masterproc ) write(iulog,'(2a)') 'calcsize addfld - ', fieldname
- fieldname = trim(tmpnameb) // '_sfcsiz3'
- long_name = trim(tmpnameb) // ' calcsize aitken-to-accum adjust column tendency'
- call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
- if (history_aerosol) then
- call add_default(fieldname, 1, ' ')
- end if
- if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname
+ fieldname = trim(tmpnameb) // '_sfcsiz3'
+ long_name = trim(tmpnameb) // ' calcsize aitken-to-accum adjust column tendency'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if (history_aerosol) then
+ call add_default(fieldname, 1, ' ')
+ end if
+ if ( masterproc ) write(iulog,'(2a)') 'calcsize addfld - ', fieldname
- fieldname = trim(tmpnamea) // '_sfcsiz4'
- long_name = trim(tmpnamea) // ' calcsize accum-to-aitken adjust column tendency'
- call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
- if (history_aerosol) then
- call add_default(fieldname, 1, ' ')
- end if
- if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname
+ fieldname = trim(tmpnamea) // '_sfcsiz4'
+ long_name = trim(tmpnamea) // ' calcsize accum-to-aitken adjust column tendency'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if (history_aerosol) then
+ call add_default(fieldname, 1, ' ')
+ end if
+ if ( masterproc ) write(iulog,'(2a)') 'calcsize addfld - ', fieldname
- fieldname = trim(tmpnameb) // '_sfcsiz4'
- long_name = trim(tmpnameb) // ' calcsize accum-to-aitken adjust column tendency'
- call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
- if (history_aerosol) then
- call add_default(fieldname, 1, ' ')
- end if
- if ( masterproc ) write(*,'(2a)') 'calcsize addfld - ', fieldname
+ fieldname = trim(tmpnameb) // '_sfcsiz4'
+ long_name = trim(tmpnameb) // ' calcsize accum-to-aitken adjust column tendency'
+ call addfld( fieldname, unit, 1, 'A', long_name, phys_decomp )
+ if (history_aerosol) then
+ call add_default(fieldname, 1, ' ')
+ end if
+ if ( masterproc ) write(iulog,'(2a)') 'calcsize addfld - ', fieldname
- end do ! jac = ...
- end do ! iq = ...
+ end do ! jac = ...
+ end do ! iq = ...
+
+ end if do_aitacc_transfer_if_block2
+
+ end if do_adjust_if_block2
+
+
+ if ( masterproc ) then
+ write(iulog,'(/a)') 'l, species_class, name'
+ do n = 1, pcnst
+ write(iulog,'(2i4,2x,a)') n, species_class(n), cnst_name(n)
+ end do
+ end if
+ if ( masterproc ) write(iulog,'(a)') 'modal_aero_calcsize_init ALL DONE'
#endif
@@ -363,7 +577,7 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
! 3rd index --
! 1="standard" number adjust gain;
! 2="standard" number adjust loss;
- ! 3=aitken-->accum renaming; 4=accum-->aitken)
+ ! 3=aitken-->accum transfer; 4=accum-->aitken)
! 4th index --
! 1="a" species; 2="c" species
!-----------------------------------------------------------------------
@@ -688,7 +902,7 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
qsrflx(i,lnc,2,jac) = qsrflx(i,lnc,2,jac) + min(0.0_r8,dqqcwdt(i,k,lnc))*pdel_fac
- ! save number and dryvol for aitken <--> accum renaming
+ ! save number and dryvol for aitken <--> accum transfer
if ( do_aitacc_transfer ) then
if (n == nait) then
drv_a_aitsv(i,k) = drv_a
@@ -735,39 +949,32 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
ixfer_acc2ait_sv(:,:) = 0
if ( do_aitacc_transfer ) then
- ! old - on time first step, npair_renamexf will be <= 0,
- ! in which case need to do modal_aero_rename_init
- ! new - init is now done through chem_init and things below it
- if (npair_renamexf .le. 0) then
- npair_renamexf = 0
- ! call modal_aero_rename_init
- if (npair_renamexf .le. 0) then
- write( 6, '(//a//)' ) &
- '*** modal_aero_calcaersize_sub error -- npair_renamexf <= 0'
- call endrun( 'modal_aero_calcaersize_sub error' )
- end if
+ if (npair_csizxf .le. 0) then
+ write( iulog, '(//a//)' ) &
+ '*** modal_aero_calcaersize_sub error -- npair_csizxf <= 0'
+ call endrun( 'modal_aero_calcaersize_sub error' )
end if
- ! check that renaming ipair=1 is aitken-->accum
+ ! check that calcsize transfer ipair=1 is aitken-->accum
ipair = 1
- if ((modefrm_renamexf(ipair) .ne. nait) .or. &
- (modetoo_renamexf(ipair) .ne. nacc)) then
- write( 6, '(//2a//)' ) &
+ if ((modefrm_csizxf(ipair) .ne. nait) .or. &
+ (modetoo_csizxf(ipair) .ne. nacc)) then
+ write( iulog, '(//2a//)' ) &
'*** modal_aero_calcaersize_sub error -- ', &
- 'modefrm/too_renamexf(1) are wrong'
+ 'modefrm/too_csizxf(1) are wrong'
call endrun( 'modal_aero_calcaersize_sub error' )
end if
! set dotend() for species that will be transferred
- do iq = 1, nspecfrm_renamexf(ipair)
- lsfrm = lspecfrma_renamexf(iq,ipair)
- lstoo = lspectooa_renamexf(iq,ipair)
+ do iq = 1, nspecfrm_csizxf(ipair)
+ lsfrm = lspecfrma_csizxf(iq,ipair)
+ lstoo = lspectooa_csizxf(iq,ipair)
if ((lsfrm > 0) .and. (lstoo > 0)) then
dotend(lsfrm) = .true.
dotend(lstoo) = .true.
end if
- lsfrm = lspecfrmc_renamexf(iq,ipair)
- lstoo = lspectooc_renamexf(iq,ipair)
+ lsfrm = lspecfrmc_csizxf(iq,ipair)
+ lstoo = lspectooc_csizxf(iq,ipair)
if ((lsfrm > 0) .and. (lstoo > 0)) then
dotendqqcw(lsfrm) = .true.
dotendqqcw(lstoo) = .true.
@@ -778,8 +985,8 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
noxf_acc2ait(:) = .true.
do l1 = 1, nspec_amode(nacc)
la = lmassptr_amode(l1,nacc)
- do iq = 1, nspecfrm_renamexf(ipair)
- if (lspectooa_renamexf(iq,ipair) == la) then
+ do iq = 1, nspecfrm_csizxf(ipair)
+ if (lspectooa_csizxf(iq,ipair) == la) then
noxf_acc2ait(l1) = .false.
end if
end do
@@ -976,26 +1183,26 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
if ( masterproc ) then
if (idiagaa > 0) then
do j = 1, 2
- do iq = 1, nspecfrm_renamexf(ipair)
+ do iq = 1, nspecfrm_csizxf(ipair)
do jac = 1, 2
if (j .eq. 1) then
if (jac .eq. 1) then
- lsfrm = lspecfrma_renamexf(iq,ipair)
- lstoo = lspectooa_renamexf(iq,ipair)
+ lsfrm = lspecfrma_csizxf(iq,ipair)
+ lstoo = lspectooa_csizxf(iq,ipair)
else
- lsfrm = lspecfrmc_renamexf(iq,ipair)
- lstoo = lspectooc_renamexf(iq,ipair)
+ lsfrm = lspecfrmc_csizxf(iq,ipair)
+ lstoo = lspectooc_csizxf(iq,ipair)
end if
else
if (jac .eq. 1) then
- lsfrm = lspectooa_renamexf(iq,ipair)
- lstoo = lspecfrma_renamexf(iq,ipair)
+ lsfrm = lspectooa_csizxf(iq,ipair)
+ lstoo = lspecfrma_csizxf(iq,ipair)
else
- lsfrm = lspectooc_renamexf(iq,ipair)
- lstoo = lspecfrmc_renamexf(iq,ipair)
+ lsfrm = lspectooc_csizxf(iq,ipair)
+ lstoo = lspecfrmc_csizxf(iq,ipair)
end if
end if
- write( 6, '(a,3i3,2i4)' ) 'calcsize j,iq,jac, lsfrm,lstoo', &
+ write( iulog, '(a,3i3,2i4)' ) 'calcsize j,iq,jac, lsfrm,lstoo', &
j,iq,jac, lsfrm,lstoo
end do
end do
@@ -1018,30 +1225,30 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
xfercoef = xfercoef_vol_acc2ait
end if
- do iq = 1, nspecfrm_renamexf(ipair)
+ do iq = 1, nspecfrm_csizxf(ipair)
! jac=1 does interstitial ("_a"); jac=2 does activated ("_c");
do jac = 1, 2
- ! the lspecfrma_renamexf (and lspecfrmc_renamexf) are aitken species
- ! the lspectooa_renamexf (and lspectooc_renamexf) are accum species
+ ! the lspecfrma_csizxf (and lspecfrmc_csizxf) are aitken species
+ ! the lspectooa_csizxf (and lspectooc_csizxf) are accum species
! for j=1, want lsfrm=aitken species, lstoo=accum species
! for j=2, want lsfrm=accum species, lstoo=aitken species
if (j .eq. 1) then
if (jac .eq. 1) then
- lsfrm = lspecfrma_renamexf(iq,ipair)
- lstoo = lspectooa_renamexf(iq,ipair)
+ lsfrm = lspecfrma_csizxf(iq,ipair)
+ lstoo = lspectooa_csizxf(iq,ipair)
else
- lsfrm = lspecfrmc_renamexf(iq,ipair)
- lstoo = lspectooc_renamexf(iq,ipair)
+ lsfrm = lspecfrmc_csizxf(iq,ipair)
+ lstoo = lspectooc_csizxf(iq,ipair)
end if
else
if (jac .eq. 1) then
- lsfrm = lspectooa_renamexf(iq,ipair)
- lstoo = lspecfrma_renamexf(iq,ipair)
+ lsfrm = lspectooa_csizxf(iq,ipair)
+ lstoo = lspecfrma_csizxf(iq,ipair)
else
- lsfrm = lspectooc_renamexf(iq,ipair)
- lstoo = lspecfrmc_renamexf(iq,ipair)
+ lsfrm = lspectooc_csizxf(iq,ipair)
+ lstoo = lspecfrmc_csizxf(iq,ipair)
end if
end if
@@ -1129,19 +1336,19 @@ subroutine modal_aero_calcsize_sub(state, ptend, deltat, pbuf, do_adjust_in, &
! history fields for aitken-accum transfer
if ( .not. do_aitacc_transfer ) return
- do iq = 1, nspecfrm_renamexf(ipair)
+ do iq = 1, nspecfrm_csizxf(ipair)
! jac=1 does interstitial ("_a"); jac=2 does activated ("_c");
do jac = 1, 2
- ! the lspecfrma_renamexf (and lspecfrmc_renamexf) are aitken species
- ! the lspectooa_renamexf (and lspectooc_renamexf) are accum species
+ ! the lspecfrma_csizxf (and lspecfrmc_csizxf) are aitken species
+ ! the lspectooa_csizxf (and lspectooc_csizxf) are accum species
if (jac .eq. 1) then
- lsfrm = lspecfrma_renamexf(iq,ipair)
- lstoo = lspectooa_renamexf(iq,ipair)
+ lsfrm = lspecfrma_csizxf(iq,ipair)
+ lstoo = lspectooa_csizxf(iq,ipair)
else
- lsfrm = lspecfrmc_renamexf(iq,ipair)
- lstoo = lspectooc_renamexf(iq,ipair)
+ lsfrm = lspecfrmc_csizxf(iq,ipair)
+ lstoo = lspectooc_csizxf(iq,ipair)
end if
if ((lsfrm <= 0) .or. (lstoo <= 0)) cycle
@@ -1237,9 +1444,9 @@ subroutine modal_aero_calcsize_diag(state, pbuf, list_idx_in, dgnum_m)
call endrun('modal_aero_calcsize_diag called for'// &
'diagnostic list but dgnum_m pointer not present')
end if
- if (.not. associated(dgnum_m)) then
- call endrun('modal_aero_calcsize_diag called for'// &
- 'diagnostic list but dgnum_m not associated')
+ allocate(dgnum_m(pcols,pver,nmodes), stat=stat)
+ if (stat > 0) then
+ call endrun('modal_aero_calcsize_diag: allocation FAILURE: dgnum_m')
end if
end if
diff --git a/components/cam/src/physics/cam/gw_drag.F90 b/components/cam/src/physics/cam/gw_drag.F90
index 692b96ad1939..e111e1dbd5fc 100644
--- a/components/cam/src/physics/cam/gw_drag.F90
+++ b/components/cam/src/physics/cam/gw_drag.F90
@@ -288,7 +288,7 @@ subroutine gw_init()
write(iulog,*) ' '
write(iulog,*) "GW_DRAG: pgwv = ", pgwv
do l = -pgwv, pgwv
- write (iulog,'(A,I2,A,F7.2)') "GW_DRAG: cref(",l,") = ",cref(l)
+ write (iulog,'(A,I4,A,F7.2)') "GW_DRAG: cref(",l,") = ",cref(l)
enddo
write(iulog,*) 'GW_DRAG: kwv = ', kwv
write(iulog,*) 'GW_DRAG: fcrit2 = ', fcrit2
diff --git a/components/cam/src/physics/cam/phys_control.F90 b/components/cam/src/physics/cam/phys_control.F90
index 9883bebb63da..bd15ee677d05 100644
--- a/components/cam/src/physics/cam/phys_control.F90
+++ b/components/cam/src/physics/cam/phys_control.F90
@@ -66,11 +66,15 @@ module phys_control
! liquid budgets.
logical :: ssalt_tuning = .false. ! sea salt tuning flag for progseasalts_intr.F90
logical :: resus_fix = .false. ! to address resuspension bug fix in wetdep.F90
-logical :: convproc_do_aer = .false. ! to apply unified convective transport for aerosols
-logical :: convproc_do_gas = .false. ! to apply unified convective transport for gasses
+logical :: convproc_do_aer = .false. ! to apply unified convective transport/removal for aerosols
+logical :: convproc_do_gas = .false. ! to apply unified convective transport/removal for trace gases
+ ! *** the unified conv. trans/removal currently does not do gases ***
! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers
! 2=do secondary activation with prescribed supersat
-integer :: convproc_method_activate = 2 ! unified convective transport method
+integer :: convproc_method_activate = 2 ! controls activation in the unified convective transport/removal
+integer :: mam_amicphys_optaa = 0 ! <= 0 -- use old microphysics code (separate calls to gasaerexch,
+ ! newnuc, and coag routines)
+ ! > 0 -- use new microphysics code (single call to amicphys routine)
logical :: liqcf_fix = .false. ! liq cld fraction fix calc.
logical :: regen_fix = .false. ! aerosol regeneration bug fix for ndrop.F90
logical :: demott_ice_nuc = .false. ! use DeMott ice nucleation treatment in microphysics
@@ -150,6 +154,7 @@ subroutine phys_ctl_readnl(nlfile)
cld_macmic_num_steps, micro_do_icesupersat, &
fix_g1_err_ndrop, ssalt_tuning, resus_fix, convproc_do_aer, &
convproc_do_gas, convproc_method_activate, liqcf_fix, regen_fix, demott_ice_nuc, &
+ mam_amicphys_optaa, &
l_tracer_aero, l_vdiff, l_rayleigh, l_gw_drag, l_ac_energy_chk, &
l_bc_energy_fix, l_dry_adj, l_st_mac, l_st_mic, l_rad
!-----------------------------------------------------------------------------
@@ -206,6 +211,7 @@ subroutine phys_ctl_readnl(nlfile)
call mpibcast(convproc_do_aer, 1 , mpiint, 0, mpicom)
call mpibcast(convproc_do_gas, 1 , mpilog, 0, mpicom)
call mpibcast(convproc_method_activate, 1 , mpilog, 0, mpicom)
+ call mpibcast(mam_amicphys_optaa, 1 , mpilog, 0, mpicom)
call mpibcast(liqcf_fix, 1 , mpilog, 0, mpicom)
call mpibcast(regen_fix, 1 , mpilog, 0, mpicom)
call mpibcast(demott_ice_nuc, 1 , mpilog, 0, mpicom)
@@ -341,7 +347,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
do_clubb_sgs_out, do_tms_out, state_debug_checks_out, &
cld_macmic_num_steps_out, micro_do_icesupersat_out, &
fix_g1_err_ndrop_out, ssalt_tuning_out,resus_fix_out,convproc_do_aer_out, &
- convproc_do_gas_out, convproc_method_activate_out, &
+ convproc_do_gas_out, convproc_method_activate_out, mam_amicphys_optaa_out, &
liqcf_fix_out, regen_fix_out,demott_ice_nuc_out &
,l_tracer_aero_out, l_vdiff_out, l_rayleigh_out, l_gw_drag_out, l_ac_energy_chk_out &
,l_bc_energy_fix_out, l_dry_adj_out, l_st_mac_out, l_st_mic_out, l_rad_out &
@@ -386,6 +392,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
logical, intent(out), optional :: convproc_do_aer_out
logical, intent(out), optional :: convproc_do_gas_out
integer, intent(out), optional :: convproc_method_activate_out
+ integer, intent(out), optional :: mam_amicphys_optaa_out
logical, intent(out), optional :: liqcf_fix_out
logical, intent(out), optional :: regen_fix_out
logical, intent(out), optional :: demott_ice_nuc_out
@@ -433,7 +440,8 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
if ( present(resus_fix_out ) ) resus_fix_out = resus_fix
if ( present(convproc_do_aer_out ) ) convproc_do_aer_out = convproc_do_aer
if ( present(convproc_do_gas_out ) ) convproc_do_gas_out = convproc_do_gas
- if ( present(convproc_method_activate_out))convproc_method_activate_out= convproc_method_activate
+ if ( present(convproc_method_activate_out ) ) convproc_method_activate_out = convproc_method_activate
+ if ( present(mam_amicphys_optaa_out ) ) mam_amicphys_optaa_out = mam_amicphys_optaa
if ( present(liqcf_fix_out ) ) liqcf_fix_out = liqcf_fix
if ( present(regen_fix_out ) ) regen_fix_out = regen_fix
if ( present(demott_ice_nuc_out ) ) demott_ice_nuc_out = demott_ice_nuc
diff --git a/components/cam/src/physics/cam/physpkg.F90 b/components/cam/src/physics/cam/physpkg.F90
index 59c19bd0b338..df85bf23162f 100644
--- a/components/cam/src/physics/cam/physpkg.F90
+++ b/components/cam/src/physics/cam/physpkg.F90
@@ -857,7 +857,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out )
! here. For prognostic MAM the initialization is called from
! modal_aero_initialize
if (.not. prog_modal_aero) then
- call modal_aero_calcsize_init(pbuf2d)
+ call modal_aero_calcsize_init(pbuf2d, species_class)
endif
call modal_aero_wateruptake_init(pbuf2d)
diff --git a/components/homme/src/share/prim_state_mod.F90 b/components/homme/src/share/prim_state_mod.F90
index 17dfdc06818a..f170626f570a 100644
--- a/components/homme/src/share/prim_state_mod.F90
+++ b/components/homme/src/share/prim_state_mod.F90
@@ -728,7 +728,7 @@ subroutine prim_printstate(elem, tl,hybrid,hvcoord,nets,nete, fvm)
if (tstep_type>0) then !no longer support tracer advection with tstep_type = 0
do q=1,qsize
- write(iulog,'(a,i1,a,E22.14,a,2E15.7)') "Q",q,",Q diss, dQ^2/dt:",Qmass(q,2)," kg/m^2",&
+ write(iulog,'(a,i3,a,E22.14,a,2E15.7)') "Q",q,",Q diss, dQ^2/dt:",Qmass(q,2)," kg/m^2",&
(Qmass(q,2)-Qmass(q,1))/dt,(Qvar(q,2)-Qvar(q,1))/dt
enddo
endif
diff --git a/components/rtm/src/riverroute/RtmMod.F90 b/components/rtm/src/riverroute/RtmMod.F90
index 08aff5909503..febeb4d1804f 100644
--- a/components/rtm/src/riverroute/RtmMod.F90
+++ b/components/rtm/src/riverroute/RtmMod.F90
@@ -87,6 +87,7 @@ module RtmMod
character(len=256) :: nlfilename_rof = 'rof_in'
character(len=256) :: nlfilename_lnd = 'lnd_in'
+ real(r8), save :: delt_save ! previous delt !BSINGH- declare and initialize it globally
!
!EOP
!-----------------------------------------------------------------------
@@ -976,7 +977,7 @@ subroutine Rtmini()
call RtmHistFldsSet()
if (masterproc) write(iulog,*) subname //':: Success '
-
+ delt_save = 0.0
end subroutine Rtmini
!=======================================================================
@@ -1028,7 +1029,7 @@ subroutine Rtmrun(totrunin, rstwr, nlend, rdate)
real(r8) :: delt ! delt associated with subcycling
real(r8) :: delt_rtm ! real value of rtm_tstep
integer , save :: nsub_save ! previous nsub
- real(r8), save :: delt_save ! previous delt
+ !real(r8), save :: delt_save ! previous delt !BSINGH- declare and initialize it globally
logical , save :: first_time = .true. ! first time flag (for backwards compatibility)
character(len=256) :: filer ! restart file name
integer,parameter :: dbug = 1 ! local debug flag